--- loncom/lond 2000/01/14 14:46:57 1.8 +++ loncom/lond 2000/06/26 02:42:28 1.12 @@ -4,7 +4,8 @@ # 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,01/14 Gerd Kortemeyer +# 12/7,12/15,01/06,01/11,01/12,01/14,2/8, +# 03/07,05/31 Gerd Kortemeyer # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -79,7 +80,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 +88,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 +104,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 +138,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,7 +184,30 @@ sub reply { return $answer; } +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; @@ -174,6 +219,7 @@ sub propath { } # --------------------------------------- Is this the home server of an author? + sub ishome { my $author=shift; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; @@ -201,7 +247,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 @@ -263,7 +309,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 +324,23 @@ sub make_new_child { $clientok=1; print $client "ok\n"; } else { - &logthis("$clientip did not reply challenge"); + &logthis( + "WARNING: $clientip did not reply challenge"); } } else { - &logthis("$clientip failed to initialize: >$remotereq<"); + &logthis( + "WARNING: " + ."$clientip failed to initialize: >$remotereq< "); } } else { - &logthis("Unknown client $clientip"); + &logthis( + "WARNING: Unknown client $clientip"); } 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 +397,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) { @@ -494,6 +548,21 @@ sub make_new_child { } 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) @@ -763,6 +832,24 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ------------------------------------------------------------------- querysend + } elsif ($userinput =~ /^querysend/) { + my ($cmd,$query)=split(/:/,$userinput); + # make sure you get one \n and only one + $query=~s/\n*$//g; + print $client sqlreply("$hostid{$clientip}\&$query")."\n"; +# ------------------------------------------------------------------ queryreply + } elsif ($userinput =~ /^queryreply/) { + my ($cmd,$id,$reply)=split(/:/,$userinput); + my $store; + if ($store=IO::File->new(">/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); @@ -834,9 +921,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})"); # ============================================================================= }