--- loncom/lond 2001/11/26 20:31:01 1.57 +++ loncom/lond 2001/11/29 18:56:31 1.60 @@ -1,6 +1,31 @@ #!/usr/bin/perl # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) +# +# $Id: lond,v 1.60 2001/11/29 18:56:31 www Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # 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, @@ -17,9 +42,8 @@ # 04/02 Scott Harrison # 05/11,05/28,08/30 Gerd Kortemeyer # 9/30,10/22,11/13,11/15,11/16 Scott Harrison -# 11/26 Gerd Kortemeyer +# 11/26,11/27 Gerd Kortemeyer # -# $Id: lond,v 1.57 2001/11/26 20:31:01 www Exp $ ### # based on "Perl Cookbook" ISBN 1-56592-243-3 @@ -53,6 +77,7 @@ sub catchexception { ."a crash with this error msg->[$error]"); &logthis('Famous last words: '.$status.' - '.$lastlog); if ($client) { print $client "error: $error\n"; } + $server->close(); die($error); } @@ -138,6 +163,7 @@ sub REAPER { # ta sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; + &logthis("Free socket: ".shutdown($server,2)); # free up socket my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lond.pid"); &logthis("CRITICAL: Shutting down"); @@ -147,7 +173,7 @@ sub HUNTSMAN { # si sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; - close($server); # free up socket + &logthis("Free socket: ".shutdown($server,2)); # free up socket &logthis("CRITICAL: Restarting"); unlink("$execdir/logs/lond.pid"); my $execdir=$perlvar{'lonDaemons'}; @@ -175,6 +201,7 @@ sub logthis { my $fh=IO::File->new(">>$execdir/logs/lond.log"); my $now=time; my $local=localtime($now); + $lastlog=$local.': '.$message; print $fh "$local ($$): $message\n"; } @@ -445,20 +472,17 @@ sub make_new_child { } else { &logthis( "WARNING: $clientip did not reply challenge"); - print $client "bye\n"; &status('No challenge reply '.$clientip); } } else { &logthis( "WARNING: " ."$clientip failed to initialize: >$remotereq< "); - print $client "bye\n"; &status('No init '.$clientip); } } else { &logthis( "WARNING: Unknown client $clientip"); - print $client "bye\n"; &status('Hung up on '.$clientip); } if ($clientok) { @@ -466,7 +490,7 @@ sub make_new_child { &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); &logthis( "Established connection: $hostid{$clientip}"); - &status('Listening to '.$hostid{$clientip}); + &status('Will listen to '.$hostid{$clientip}); # ------------------------------------------------------------ Process requests while (my $userinput=<$client>) { chomp($userinput); @@ -1293,16 +1317,20 @@ sub make_new_child { &logthis( "Client $clientip ($hostid{$clientip}) hanging up: $userinput"); print $client "bye\n"; + $client->close(); last; # ------------------------------------------------------------- unknown command } else { # unknown command print $client "unknown_cmd\n"; } -# ------------------------------------------------------ client unknown, refuse +# -------------------------------------------------------------------- complete + &status('Listening to '.$hostid{$clientip}); } +# --------------------------------------------- client unknown or fishy, refuse } else { print $client "refused\n"; + $client->close(); &logthis("WARNING: " ."Rejected client $clientip, closing connection"); } @@ -1313,6 +1341,9 @@ sub make_new_child { # tidy up gracefully and finish + $client->close(); + $server->close(); + # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death.