--- loncom/lond 2000/01/12 19:30:43 1.7 +++ loncom/lond 2000/07/21 00:40:37 1.18 @@ -4,7 +4,11 @@ # 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 Gerd Kortemeyer +# # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -79,7 +83,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 +91,7 @@ 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"); my $execdir=$perlvar{'lonDaemons'}; exec("$execdir/lond"); # here we go again } @@ -103,6 +107,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 +141,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 +187,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 +252,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 +301,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 +316,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 +331,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 +407,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) { @@ -452,6 +516,15 @@ sub make_new_child { &logthis( "LWP GET: $message for $fname ($remoteurl)"); } else { + if ($remoteurl!~/\.meta$/) { + 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,6 +553,9 @@ 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}"); @@ -488,16 +564,33 @@ sub make_new_child { $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,6 +657,7 @@ 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); @@ -586,6 +680,7 @@ 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); @@ -621,6 +716,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,8 +744,8 @@ 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)) { @@ -669,8 +765,8 @@ 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)) { @@ -690,6 +786,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); @@ -731,6 +828,7 @@ 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); @@ -757,6 +855,24 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ------------------------------------------------------------------- querysend + } elsif ($userinput =~ /^querysend/) { + my ($cmd,$query)=split(/:/,$userinput); + $query=~s/\n*$//g; + print $client sqlreply("$hostid{$clientip}\&$query")."\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); @@ -805,6 +921,40 @@ 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); @@ -818,6 +968,7 @@ sub make_new_child { } else { $ulsout='no_such_dir'; } + if ($ulsout eq '') { $ulsout='empty'; } print $client "$ulsout\n"; # ------------------------------------------------------------- unknown command } else { @@ -828,9 +979,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})"); # ============================================================================= }