--- loncom/lond 2004/03/09 16:12:26 1.182
+++ loncom/lond 2004/05/07 17:51:58 1.189
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.182 2004/03/09 16:12:26 raeburn Exp $
+# $Id: lond,v 1.189 2004/05/07 17:51:58 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,7 +53,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.182 $'; #' stupid emacs
+my $VERSION='$Revision: 1.189 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -822,7 +822,7 @@ sub REAPER { # ta
if (defined($children{$pid})) {
&logthis("Child $pid died");
delete($children{$pid});
- } else {
+ } elsif ($pid > 0) {
&logthis("Unknown Child $pid died");
}
} while ( $pid > 0 );
@@ -1827,27 +1827,25 @@ sub make_new_child {
# -------------------------------------- fetch a user file from a remote server
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
if(isClient) {
- my ($cmd,$fname,$fpath)=split(/:/,$userinput);
- my ($udom,$uname,$ufile)=split(/\//,$fname);
+ my ($cmd,$fname)=split(/:/,$userinput);
+ my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
my $udir=propath($udom,$uname).'/userfiles';
unless (-e $udir) { mkdir($udir,0770); }
if (-e $udir) {
- unless ($fpath eq '') {
- my $filepath = $udir;
- my @parts=split(/\//,$fpath);
- my $count;
- for ($count=0;$count<=$#parts;$count++) {
- $filepath .="/$parts[$count]";
- if ((-e $filepath)!=1) {
- mkdir($filepath,0770);
+ $ufile=~s/^[\.\~]+//;
+ my $path = $udir;
+ if ($ufile =~m|(.+)/([^/]+)$|) {
+ my @parts=split('/',$1);
+ foreach my $part (@parts) {
+ $path .= '/'.$part;
+ if ((-e $path)!=1) {
+ mkdir($path,0770);
}
}
}
- $ufile=~s/^[\.\~]+//;
- $ufile=~s/\///g;
- my $destname=$udir.'/'.$fpath.$ufile;
- my $transname=$udir.'/'.$fpath.$ufile.'.in.transit';
- my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile;
+ my $destname=$udir.'/'.$ufile;
+ my $transname=$udir.'/'.$ufile.'.in.transit';
+ my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
my $response;
{
my $ua=new LWP::UserAgent;
@@ -1857,7 +1855,7 @@ sub make_new_child {
if ($response->is_error()) {
unlink($transname);
my $message=$response->status_line;
- &logthis("LWP GET: $message for $fpath $fname ($remoteurl)");
+ &logthis("LWP GET: $message for $fname ($remoteurl)");
print $client "failed\n";
} else {
if (!rename($transname,$destname)) {
@@ -1873,7 +1871,37 @@ sub make_new_child {
}
} else {
Reply($client, "refused\n", $userinput);
-
+ }
+# --------------------------------------------------------- remove a user file
+ } elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc.
+ if(isClient) {
+ my ($cmd,$fname)=split(/:/,$userinput);
+ my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
+ &logthis("$udom - $uname - $ufile");
+ if ($ufile =~m|/\.\./|) {
+ # any files paths with /../ in them refuse
+ # to deal with
+ print $client "refused\n";
+ } else {
+ my $udir=propath($udom,$uname);
+ if (-e $udir) {
+ my $file=$udir.'/userfiles/'.$ufile;
+ if (-e $file) {
+ unlink($file);
+ if (-e $file) {
+ print $client "failed\n";
+ } else {
+ print $client "ok\n";
+ }
+ } else {
+ print $client "not_found\n";
+ }
+ } else {
+ print $client "not_home\n";
+ }
+ }
+ } else {
+ Reply($client, "refused\n", $userinput);
}
# ------------------------------------------ authenticate access to a user file
} elsif ($userinput =~ /^tokenauthuserfile/) { # Client only
@@ -1884,7 +1912,7 @@ sub make_new_child {
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
$session.'.id')) {
while (my $line=<ENVIN>) {
- if ($line=~/userfile\.$fname\=/) { $reply='ok'; }
+ if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
}
close(ENVIN);
print $client $reply."\n";
@@ -1900,7 +1928,7 @@ sub make_new_child {
if(isClient) {
my ($cmd,$fname)=split(/:/,$userinput);
if (-e $fname) {
- print $client &unsub($client,$fname,$clientip);
+ print $client &unsub($fname,$clientip);
} else {
print $client "not_found\n";
}
@@ -2595,7 +2623,7 @@ sub make_new_child {
$qresult.=$key.'='.$descr.'&';
} else {
my $unescapeVal = &unescape($descr);
- if (eval('$unescapeVal=~/$description/i')) {
+ if (eval('$unescapeVal=~/\Q$description\E/i')) {
$qresult.="$key=$descr&";
}
}
@@ -3012,17 +3040,36 @@ sub chatadd {
sub unsub {
my ($fname,$clientip)=@_;
my $result;
+ my $unsubs = 0; # Number of successful unsubscribes:
+
+
+ # An old way subscriptions were handled was to have a
+ # subscription marker file:
+
+ Debug("Attempting unlink of $fname.$clientname");
if (unlink("$fname.$clientname")) {
- $result="ok\n";
- } else {
- $result="not_subscribed\n";
- }
+ $unsubs++; # Successful unsub via marker file.
+ }
+
+ # The more modern way to do it is to have a subscription list
+ # file:
+
if (-e "$fname.subscription") {
my $found=&addline($fname,$clientname,$clientip,'');
- if ($found) { $result="ok\n"; }
+ if ($found) {
+ $unsubs++;
+ }
+ }
+
+ # If either or both of these mechanisms succeeded in unsubscribing a
+ # resource we can return ok:
+
+ if($unsubs) {
+ $result = "ok\n";
} else {
- if ($result != "ok\n") { $result="not_subscribed\n"; }
+ $result = "not_subscribed\n";
}
+
return $result;
}
@@ -3144,6 +3191,16 @@ sub make_passwd_file {
}
} elsif ($umode eq 'unix') {
{
+ #
+ # Don't allow the creation of privileged accounts!!! that would
+ # be real bad!!!
+ #
+ my $uid = getpwnam($uname);
+ if((defined $uid) && ($uid == 0)) {
+ &logthis(">>>Attempted to create privilged account blocked");
+ return "no_priv_account_error\n";
+ }
+
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
{
&Debug("Executing external: ".$execpath);