--- loncom/lond 2000/01/12 19:30:43 1.7 +++ loncom/lond 2001/03/24 16:07:36 1.41 @@ -4,7 +4,17 @@ # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30, # 7/8,7/9,7/10,7/12,7/17,7/19,9/21, # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16, -# 12/7,12/15,01/06,01/11,01/12 Gerd Kortemeyer +# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, +# 03/07,05/31 Gerd Kortemeyer +# 06/26 Scott Harrison +# 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer +# 12/05 Scott Harrison +# 12/05,12/13,12/29 Gerd Kortemeyer +# Jan 01 Scott Harrison +# 02/12 Gerd Kortemeyer +# 03/15 Scott Harrison +# 03/24 Gerd Kortemeyer +# # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -21,6 +31,23 @@ use LWP::UserAgent(); use GDBM_File; use Authen::Krb4; +# grabs exception and records it to log before exiting +sub catchexception { + my ($error)=@_; + $SIG{'QUIT'}='DEFAULT'; + $SIG{__DIE__}='DEFAULT'; + &logthis("CRITICAL: " + ."ABNORMAL EXIT. Child $$ for server $wasserver died through " + ."a crash with this error msg->[$error]"); + if ($client) { print $client "error: $error\n"; } + die($error); +} + +# -------------------------------- Set signal handlers to record abnormal exits + +$SIG{'QUIT'}=\&catchexception; +$SIG{__DIE__}=\&catchexception; + # ------------------------------------ Read httpd access.conf and get variables open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; @@ -34,6 +61,27 @@ while ($configline=) { } close(CONFIG); +# ----------------------------- Make sure this process is running from user=www +my $wwwid=getpwnam('www'); +if ($wwwid!=$<) { + $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; + system("echo 'User ID mismatch. lond must be run as user www.' |\ + mailto $emailto -s '$subj' > /dev/null"); + exit 1; +} + +# --------------------------------------------- Check if other instance running + +my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid"; + +if (-e $pidfile) { + my $lfh=IO::File->new("$pidfile"); + my $pide=<$lfh>; + chomp($pide); + if (kill 0 => $pide) { die "already running"; } +} + $PREFORK=4; # number of children to maintain, at least four spare # ------------------------------------------------------------- Read hosts file @@ -79,7 +127,7 @@ sub HUNTSMAN { # si kill 'INT' => keys %children; my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lond.pid"); - &logthis("Shutting down"); + &logthis("CRITICAL: Shutting down"); exit; # clean up with dignity } @@ -87,7 +135,8 @@ sub HUPSMAN { # sig local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; close($server); # free up socket - &logthis("Restarting"); + &logthis("CRITICAL: Restarting"); + unlink("$execdir/logs/lond.pid"); my $execdir=$perlvar{'lonDaemons'}; exec("$execdir/lond"); # here we go again } @@ -103,6 +152,23 @@ sub logthis { print $fh "$local ($$): $message\n"; } + +# -------------------------------------------------------- Escape Special Chars + +sub escape { + my $str=shift; + $str =~ s/(\W)/"%".unpack('H2',$1)/eg; + return $str; +} + +# ----------------------------------------------------- Un-Escape Special Chars + +sub unescape { + my $str=shift; + $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + return $str; +} + # ----------------------------------------------------------- Send USR1 to lonc sub reconlonc { @@ -120,16 +186,20 @@ sub reconlonc { &logthis("$peerfile still not there, give it another try"); sleep 5; if (-e "$peerfile") { return; } - &logthis("$peerfile still not there, giving up"); + &logthis( + "WARNING: $peerfile still not there, giving up"); } else { - &logthis("lonc at pid $loncpid not responding, giving up"); + &logthis( + "CRITICAL: " + ."lonc at pid $loncpid not responding, giving up"); } } else { - &logthis('lonc not running, giving up'); + &logthis('CRITICAL: lonc not running, giving up'); } } # -------------------------------------------------- Non-critical communication + sub subreply { my ($cmd,$server)=@_; my $peerfile="$perlvar{'lonSockDir'}/$server"; @@ -162,18 +232,44 @@ sub reply { return $answer; } +# -------------------------------------------------------------- Talk to lonsql + +sub sqlreply { + my ($cmd)=@_; + my $answer=subsqlreply($cmd); + if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); } + return $answer; +} + +sub subsqlreply { + my ($cmd)=@_; + my $unixsock="mysqlsock"; + my $peerfile="$perlvar{'lonSockDir'}/$unixsock"; + my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", + Type => SOCK_STREAM, + Timeout => 10) + or return "con_lost"; + print $sclient "$cmd\n"; + my $answer=<$sclient>; + chomp($answer); + if (!$answer) { $answer="con_lost"; } + return $answer; +} + # -------------------------------------------- Return path to profile directory + sub propath { my ($udom,$uname)=@_; $udom=~s/\W//g; $uname=~s/\W//g; - my $subdir=$uname; + my $subdir=$uname.'__'; $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; return $proname; } # --------------------------------------- Is this the home server of an author? + sub ishome { my $author=shift; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; @@ -201,7 +297,7 @@ $execdir=$perlvar{'lonDaemons'}; open (PIDSAVE,">$execdir/logs/lond.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); -&logthis("Starting"); +&logthis("CRITICAL: ---------- Starting ----------"); # ------------------------------------------------------- Now we are on our own @@ -250,6 +346,8 @@ sub make_new_child { # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; + + $tmpsnum=0; # handle connections until we've reached $MAX_CLIENTS_PER_CHILD for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { @@ -263,7 +361,8 @@ sub make_new_child { my ($port,$iaddr)=unpack_sockaddr_in($caller); my $clientip=inet_ntoa($iaddr); my $clientrec=($hostid{$clientip} ne undef); - &logthis("Connect from $clientip ($hostid{$clientip})"); + &logthis( +"INFO: Connect from $clientip ($hostid{$clientip})"); my $clientok; if ($clientrec) { my $remotereq=<$client>; @@ -277,17 +376,26 @@ sub make_new_child { $clientok=1; print $client "ok\n"; } else { - &logthis("$clientip did not reply challenge"); + &logthis( + "WARNING: $clientip did not reply challenge"); + print $client "bye\n"; } } else { - &logthis("$clientip failed to initialize: >$remotereq<"); + &logthis( + "WARNING: " + ."$clientip failed to initialize: >$remotereq< "); + print $client "bye\n"; } } else { - &logthis("Unknown client $clientip"); + &logthis( + "WARNING: Unknown client $clientip"); + print $client "bye\n"; } if ($clientok) { # ---------------- New known client connecting, could mean machine online again &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); + &logthis( + "Established connection: $hostid{$clientip}"); # ------------------------------------------------------------ Process requests while (my $userinput=<$client>) { chomp($userinput); @@ -344,6 +452,7 @@ sub make_new_child { if ($wasenc==1) { my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput); chomp($upass); + $upass=unescape($upass); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; if (-e $passfilename) { @@ -382,6 +491,8 @@ sub make_new_child { my ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput); chomp($npass); + $upass=&unescape($upass); + $npass=&unescape($npass); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; if (-e $passfilename) { @@ -396,7 +507,7 @@ sub make_new_child { $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); { my $pf = IO::File->new(">$passfilename"); - print $pf "internal:$ncpass\n";; } + print $pf "internal:$ncpass\n"; } print $client "ok\n"; } else { print $client "non_authorized\n"; @@ -410,6 +521,63 @@ sub make_new_child { } else { print $client "refused\n"; } +# -------------------------------------------------------------------- makeuser + } elsif ($userinput =~ /^makeuser/) { + if ($wasenc==1) { + my + ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); + chomp($npass); + $npass=&unescape($npass); + my $proname=propath($udom,$uname); + my $passfilename="$proname/passwd"; + if (-e $passfilename) { + print $client "already_exists\n"; + } elsif ($udom ne $perlvar{'lonDefDomain'}) { + print $client "not_right_domain\n"; + } else { + @fpparts=split(/\//,$proname); + $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; + $fperror=''; + for ($i=3;$i<=$#fpparts;$i++) { + $fpnow.='/'.$fpparts[$i]; + unless (-e $fpnow) { + unless (mkdir($fpnow,0777)) { + $fperror="error:$!\n"; + } + } + } + unless ($fperror) { + if ($umode eq 'krb4') { + { + my $pf = IO::File->new(">$passfilename"); + print $pf "krb4:$npass\n"; + } + print $client "ok\n"; + } elsif ($umode eq 'internal') { + my $salt=time; + $salt=substr($salt,6,2); + my $ncpass=crypt($npass,$salt); + { + my $pf = IO::File->new(">$passfilename"); + print $pf "internal:$ncpass\n"; + } + print $client "ok\n"; + } elsif ($umode eq 'none') { + { + my $pf = IO::File->new(">$passfilename"); + print $pf "none:\n"; + } + print $client "ok\n"; + } else { + print $client "auth_mode_error\n"; + } + } else { + print $client "$fperror\n"; + } + } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------ home } elsif ($userinput =~ /^home/) { my ($cmd,$udom,$uname)=split(/:/,$userinput); @@ -447,11 +615,21 @@ sub make_new_child { $response=$ua->request($request,$transname); } if ($response->is_error()) { - unline($transname); + unlink($transname); my $message=$response->status_line; &logthis( "LWP GET: $message for $fname ($remoteurl)"); } else { + if ($remoteurl!~/\.meta$/) { + my $ua=new LWP::UserAgent; + my $mrequest= + new HTTP::Request('GET',$remoteurl.'.meta'); + my $mresponse= + $ua->request($mrequest,$fname.'.meta'); + if ($mresponse->is_error()) { + unlink($fname.'.meta'); + } + } rename($transname,$fname); } } @@ -480,24 +658,47 @@ sub make_new_child { my $ownership=ishome($fname); if ($ownership eq 'owner') { if (-e $fname) { + if (-d $fname) { + print $client "directory\n"; + } else { $now=time; { - my $sh=IO::File->new(">$fname.$hostid{$clientip}"); - print $sh "$clientip:$now\n"; + my $sh; + if ($sh= + IO::File->new(">$fname.$hostid{$clientip}")) { + print $sh "$clientip:$now\n"; + } } $fname=~s/\/home\/httpd\/html\/res/raw/; $fname="http://$thisserver/".$fname; print $client "$fname\n"; + } } else { print $client "not_found\n"; } } else { print $client "rejected\n"; } +# ------------------------------------------------------------------------- log + } elsif ($userinput =~ /^log/) { + my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); + chomp($what); + my $proname=propath($udom,$uname); + my $now=time; + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/activity.log")) { + print $hfh "$now:$hostid{$clientip}:$what\n"; + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; if ($namespace ne 'roles') { chomp($what); @@ -564,12 +765,13 @@ sub make_new_child { } elsif ($userinput =~ /^get/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } @@ -586,12 +788,13 @@ sub make_new_child { } elsif ($userinput =~ /^eget/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } @@ -621,6 +824,7 @@ sub make_new_child { } elsif ($userinput =~ /^del/) { my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($what); my $proname=propath($udom,$uname); @@ -648,11 +852,11 @@ sub make_new_child { } elsif ($userinput =~ /^keys/) { my ($cmd,$udom,$uname,$namespace) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; - chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { foreach $key (keys %hash) { $qresult.="$key&"; } @@ -669,11 +873,11 @@ sub make_new_child { } elsif ($userinput =~ /^dump/) { my ($cmd,$udom,$uname,$namespace) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; - chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { foreach $key (keys %hash) { $qresult.="$key=$hash{$key}&"; } @@ -690,6 +894,7 @@ sub make_new_child { } elsif ($userinput =~ /^store/) { my ($cmd,$udom,$uname,$namespace,$rid,$what) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; if ($namespace ne 'roles') { chomp($what); @@ -714,7 +919,8 @@ sub make_new_child { $allkeys.=$key.':'; $hash{"$version:$rid:$key"}=$value; } - $allkeys=~s/:$//; + $hash{"$version:$rid:timestamp"}=$now; + $allkeys.='timestamp'; $hash{"$version:keys:$rid"}=$allkeys; if (untie(%hash)) { print $client "ok\n"; @@ -731,11 +937,12 @@ sub make_new_child { } elsif ($userinput =~ /^restore/) { my ($cmd,$udom,$uname,$namespace,$rid) =split(/:/,$userinput); + $namespace=~s/\//\_/g; $namespace=~s/\W//g; chomp($rid); my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { my $version=$hash{"version:$rid"}; $qresult.="version=$version&"; my $scope; @@ -745,7 +952,7 @@ sub make_new_child { my $key; $qresult.="$scope:keys=$vkeys&"; foreach $key (@keys) { - $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&"; + $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&"; } } if (untie(%hash)) { @@ -757,6 +964,32 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ------------------------------------------------------------------- querysend + } elsif ($userinput =~ /^querysend/) { + my ($cmd,$query,$custom)=split(/:/,$userinput); + $query=~s/\n*$//g; + unless ($custom) { + print $client "". + sqlreply("$hostid{$clientip}\&$query")."\n"; + } + else { + print $client "". + sqlreply("$hostid{$clientip}\&$query". + "\&$custom")."\n"; + } +# ------------------------------------------------------------------ queryreply + } elsif ($userinput =~ /^queryreply/) { + my ($cmd,$id,$reply)=split(/:/,$userinput); + my $store; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new(">$execdir/tmp/$id")) { + print $store $reply; + close $store; + print $client "ok\n"; + } + else { + print $client "error:$!\n"; + } # ----------------------------------------------------------------------- idput } elsif ($userinput =~ /^idput/) { my ($cmd,$udom,$what)=split(/:/,$userinput); @@ -792,7 +1025,7 @@ sub make_new_child { my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my @queries=split(/\&/,$what); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { + if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } @@ -805,19 +1038,57 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ---------------------------------------------------------------------- tmpput + } elsif ($userinput =~ /^tmpput/) { + my ($cmd,$what)=split(/:/,$userinput); + my $store; + $tmpsnum++; + my $id=$$.'_'.$clientip.'_'.$tmpsnum; + $id=~s/\W/\_/g; + $what=~s/\n//g; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { + print $store $what; + close $store; + print $client "$id\n"; + } + else { + print $client "error:$!\n"; + } + +# ---------------------------------------------------------------------- tmpget + } elsif ($userinput =~ /^tmpget/) { + my ($cmd,$id)=split(/:/,$userinput); + chomp($id); + $id=~s/\W/\_/g; + my $store; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new("$execdir/tmp/$id.tmp")) { + my $reply=<$store>; + print $client "$reply\n"; + close $store; + } + else { + print $client "error:$!\n"; + } + # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { my ($cmd,$ulsdir)=split(/:/,$userinput); my $ulsout=''; my $ulsfn; if (-e $ulsdir) { - while ($ulsfn=<$ulsdir/*>) { + if (opendir(LSDIR,$ulsdir)) { + while ($ulsfn=readdir(LSDIR)) { my @ulsstats=stat($ulsfn); $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; } + closedir(LSDIR); + } } else { $ulsout='no_such_dir'; } + if ($ulsout eq '') { $ulsout='empty'; } print $client "$ulsout\n"; # ------------------------------------------------------------- unknown command } else { @@ -828,9 +1099,11 @@ sub make_new_child { } } else { print $client "refused\n"; - &logthis("Rejected client $clientip, closing connection"); + &logthis("WARNING: " + ."Rejected client $clientip, closing connection"); } - &logthis("Disconnect from $clientip ($hostid{$clientip})"); + &logthis("CRITICAL: " + ."Disconnect from $clientip ($hostid{$clientip})"); # ============================================================================= }