--- loncom/lond 2003/03/01 04:18:22 1.109 +++ loncom/lond 2003/03/13 21:01:52 1.113 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.109 2003/03/01 04:18:22 foxr Exp $ +# $Id: lond,v 1.113 2003/03/13 21:01:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -263,17 +263,25 @@ sub checkchildren { } } sleep 5; + $SIG{ALRM} = sub { die "timeout" }; + $SIG{__DIE__} = 'DEFAULT'; foreach (sort keys %children) { unless (-e "$docdir/lon-status/londchld/$_.txt") { + eval { + alarm(300); &logthis('Child '.$_.' did not respond'); kill 9 => $_; $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; $subj="LON: $perlvar{'lonHostID'} killed lond process $_"; my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; $execdir=$perlvar{'lonDaemons'}; - $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_` + $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`; + alarm(0); + } } } + $SIG{ALRM} = 'DEFAULT'; + $SIG{__DIE__} = \&cathcexception; } # --------------------------------------------------------------------- Logging @@ -856,7 +864,8 @@ sub make_new_child { unless (-e $fpnow) { unless (mkdir($fpnow,0777)) { $fperror="error: ".($!+0) - ." mkdir failed\n"; + ." mkdir failed while attempting " + ."makeuser\n"; } } } @@ -1028,7 +1037,8 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." IO::File->new Failed\n"; + ." IO::File->new Failed " + ."while attempting log\n"; } } # ------------------------------------------------------------------------- put @@ -1057,11 +1067,13 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) failed\n"; + ." untie(GDBM) failed ". + "while attempting put\n"; } } else { print $client "error: ".($!) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting put\n"; } } else { print $client "refused\n"; @@ -1101,11 +1113,13 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting rolesput\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting rolesput\n"; } } else { print $client "refused\n"; @@ -1129,11 +1143,18 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting get\n"; } } else { - print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + if ($!+0 == 2) { + print $client "error:No such file or ". + "GDBM reported bad block error\n"; + } else { + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting get\n"; + } } # ------------------------------------------------------------------------ eget } elsif ($userinput =~ /^eget/) { @@ -1167,11 +1188,13 @@ sub make_new_child { } } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting eget\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting eget\n"; } # ------------------------------------------------------------------------- del } elsif ($userinput =~ /^del/) { @@ -1197,11 +1220,13 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting del\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting del\n"; } # ------------------------------------------------------------------------ keys } elsif ($userinput =~ /^keys/) { @@ -1220,11 +1245,13 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting keys\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting keys\n"; } # ----------------------------------------------------------------- dumpcurrent } elsif ($userinput =~ /^currentdump/) { @@ -1263,11 +1290,13 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting currentdump\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting currentdump\n"; } # ------------------------------------------------------------------------ dump } elsif ($userinput =~ /^dump/) { @@ -1299,11 +1328,13 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting dump\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting dump\n"; } # ----------------------------------------------------------------------- store } elsif ($userinput =~ /^store/) { @@ -1341,11 +1372,13 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting store\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting store\n"; } } else { print $client "refused\n"; @@ -1377,11 +1410,13 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting restore\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting restore\n"; } # -------------------------------------------------------------------- chatsend } elsif ($userinput =~ /^chatsend/) { @@ -1421,7 +1456,8 @@ sub make_new_child { } else { print $client "error: ".($!+0) - ." IO::File->new Failed\n"; + ." IO::File->new Failed ". + "while attempting queryreply\n"; } # ----------------------------------------------------------------------- idput } elsif ($userinput =~ /^idput/) { @@ -1446,11 +1482,13 @@ sub make_new_child { print $client "ok\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting idput\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting idput\n"; } # ----------------------------------------------------------------------- idget } elsif ($userinput =~ /^idget/) { @@ -1469,11 +1507,13 @@ sub make_new_child { print $client "$qresult\n"; } else { print $client "error: ".($!+0) - ." untie(GDBM) Failed\n"; + ." untie(GDBM) Failed ". + "while attempting idget\n"; } } else { print $client "error: ".($!+0) - ." tie(GDBM) Failed\n"; + ." tie(GDBM) Failed ". + "while attempting idget\n"; } # ---------------------------------------------------------------------- tmpput } elsif ($userinput =~ /^tmpput/) { @@ -1491,7 +1531,8 @@ sub make_new_child { } else { print $client "error: ".($!+0) - ."IO::File->new Failed\n"; + ."IO::File->new Failed ". + "while attempting tmpput\n"; } # ---------------------------------------------------------------------- tmpget @@ -1508,9 +1549,23 @@ sub make_new_child { } else { print $client "error: ".($!+0) - ."IO::File->new Failed\n"; + ."IO::File->new Failed ". + "while attempting tmpget\n"; } +# ---------------------------------------------------------------------- tmpdel + } elsif ($userinput =~ /^tmpdel/) { + my ($cmd,$id)=split(/:/,$userinput); + chomp($id); + $id=~s/\W/\_/g; + my $execdir=$perlvar{'lonDaemons'}; + if (unlink("$execdir/tmp/$id.tmp")) { + print $client "ok\n"; + } else { + print $client "error: ".($!+0) + ."Unlink tmp Failed ". + "while attempting tmpdel\n"; + } # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { my ($cmd,$ulsdir)=split(/:/,$userinput);