--- loncom/lond 2000/01/14 14:46:57 1.8 +++ loncom/lond 2000/05/01 20:22:39 1.11 @@ -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 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"; @@ -163,6 +185,7 @@ sub reply { } # -------------------------------------------- Return path to profile directory + sub propath { my ($udom,$uname)=@_; $udom=~s/\W//g; @@ -174,6 +197,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 +225,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 +287,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 +302,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 +375,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) { @@ -834,9 +866,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})"); # ============================================================================= }