--- loncom/lond 2004/03/09 16:12:26 1.182 +++ loncom/lond 2004/05/11 19:51:49 1.190 @@ -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.190 2004/05/11 19:51:49 albertel 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.190 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -749,7 +749,7 @@ sub catchexception { $SIG{'QUIT'}='DEFAULT'; $SIG{__DIE__}='DEFAULT'; &status("Catching exception"); - &logthis("CRITICAL: " + &logthis("CRITICAL: " ."ABNORMAL EXIT. Child $$ for server $thisserver died through " ."a crash with this error msg->[$error]"); &logthis('Famous last words: '.$status.' - '.$lastlog); @@ -760,7 +760,7 @@ sub catchexception { sub timeout { &status("Handling Timeout"); - &logthis("CRITICAL: TIME OUT ".$$.""); + &logthis("CRITICAL: TIME OUT ".$$.""); &catchexception('Timeout'); } # -------------------------------- Set signal handlers to record abnormal exits @@ -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 ); @@ -843,7 +843,7 @@ sub HUNTSMAN { # si &logthis("Free socket: ".shutdown($server,2)); # free up socket my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lond.pid"); - &logthis("CRITICAL: Shutting down"); + &logthis("CRITICAL: Shutting down"); &status("Done killing children"); exit; # clean up with dignity } @@ -853,7 +853,7 @@ sub HUPSMAN { # sig &status("Killing children for restart (HUP)"); kill 'INT' => keys %children; &logthis("Free socket: ".shutdown($server,2)); # free up socket - &logthis("CRITICAL: Restarting"); + &logthis("CRITICAL: Restarting"); my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lond.pid"); &status("Restarting self (HUP)"); @@ -1095,11 +1095,11 @@ sub reconlonc { kill USR1 => $loncpid; } else { &logthis( - "CRITICAL: " + "CRITICAL: " ."lonc at pid $loncpid not responding, giving up"); } } else { - &logthis('CRITICAL: lonc not running, giving up'); + &logthis('CRITICAL: lonc not running, giving up'); } } @@ -1203,7 +1203,7 @@ my $execdir=$perlvar{'lonDaemons'}; open (PIDSAVE,">$execdir/logs/lond.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); -&logthis("CRITICAL: ---------- Starting ----------"); +&logthis("CRITICAL: ---------- Starting ----------"); &status('Starting'); @@ -1340,18 +1340,18 @@ sub make_new_child { print $client "ok\n"; } else { &logthis( - "WARNING: $clientip did not reply challenge"); + "WARNING: $clientip did not reply challenge"); &status('No challenge reply '.$clientip); } } else { &logthis( - "WARNING: " + "WARNING: " ."$clientip failed to initialize: >$remotereq< "); &status('No init '.$clientip); } } else { &logthis( - "WARNING: Unknown client $clientip"); + "WARNING: Unknown client $clientip"); &status('Hung up on '.$clientip); } if ($clientok) { @@ -1365,7 +1365,7 @@ sub make_new_child { } &reconlonc("$perlvar{'lonSockDir'}/$id"); } - &logthis("Established connection: $clientname"); + &logthis("Established connection: $clientname"); &status('Will listen to '.$clientname); # ------------------------------------------------------------ Process requests while (my $userinput=<$client>) { @@ -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=) { - 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&"; } } @@ -2850,14 +2878,14 @@ sub make_new_child { } else { print $client "refused\n"; $client->close(); - &logthis("WARNING: " + &logthis("WARNING: " ."Rejected client $clientip, closing connection"); } } # ============================================================================= - &logthis("CRITICAL: " + &logthis("CRITICAL: " ."Disconnect from $clientip ($clientname)"); @@ -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);