--- loncom/lond 2003/01/15 19:34:02 1.107 +++ loncom/lond 2003/03/04 22:32:20 1.111 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.107 2003/01/15 19:34:02 matthew Exp $ +# $Id: lond,v 1.111 2003/03/04 22:32:20 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,29 +31,20 @@ # 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,2/8, # 03/07,05/31 Gerd Kortemeyer -# 06/26 Scott Harrison # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer -# 12/05 Scott Harrison # 12/05,12/13,12/29 Gerd Kortemeyer # YEAR=2001 -# Jan 01 Scott Harrison # 02/12 Gerd Kortemeyer -# 03/15 Scott Harrison # 03/24 Gerd Kortemeyer -# 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,11/27 Gerd Kortemeyer -# 12/20 Scott Harrison # 12/22 Gerd Kortemeyer # YEAR=2002 # 01/20/02,02/05 Gerd Kortemeyer # 02/05 Guy Albertelli -# 02/07 Scott Harrison # 02/12 Gerd Kortemeyer # 02/19 Matthew Hall # 02/25 Gerd Kortemeyer -# 05/11 Scott Harrison # 01/xx/2003 Ron Fox.. Remove preforking. This makes the general daemon # logic simpler (and there were problems maintaining the preforked # population). Since the time averaged connection rate is close to zero @@ -864,7 +855,9 @@ sub make_new_child { $fpnow.='/'.$fpparts[$i]; unless (-e $fpnow) { unless (mkdir($fpnow,0777)) { - $fperror="error:$!"; + $fperror="error: ".($!+0) + ." mkdir failed while attempting " + ."makeuser\n"; } } } @@ -1035,7 +1028,9 @@ sub make_new_child { print $hfh "$now:$hostid{$clientip}:$what\n"; print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." IO::File->new Failed " + ."while attempting log\n"; } } # ------------------------------------------------------------------------- put @@ -1063,10 +1058,14 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) failed ". + "while attempting put\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!) + ." tie(GDBM) Failed ". + "while attempting put\n"; } } else { print $client "refused\n"; @@ -1105,10 +1104,14 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting rolesput\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting rolesput\n"; } } else { print $client "refused\n"; @@ -1131,10 +1134,14 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting get\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting get\n"; } # ------------------------------------------------------------------------ eget } elsif ($userinput =~ /^eget/) { @@ -1167,10 +1174,14 @@ sub make_new_child { print $client "error:no_key\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting eget\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting eget\n"; } # ------------------------------------------------------------------------- del } elsif ($userinput =~ /^del/) { @@ -1195,10 +1206,14 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting del\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting del\n"; } # ------------------------------------------------------------------------ keys } elsif ($userinput =~ /^keys/) { @@ -1216,10 +1231,14 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting keys\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting keys\n"; } # ----------------------------------------------------------------- dumpcurrent } elsif ($userinput =~ /^currentdump/) { @@ -1257,10 +1276,14 @@ sub make_new_child { chop($qresult); print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting currentdump\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting currentdump\n"; } # ------------------------------------------------------------------------ dump } elsif ($userinput =~ /^dump/) { @@ -1291,10 +1314,14 @@ sub make_new_child { chop($qresult); print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting dump\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting dump\n"; } # ----------------------------------------------------------------------- store } elsif ($userinput =~ /^store/) { @@ -1331,10 +1358,14 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting store\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting store\n"; } } else { print $client "refused\n"; @@ -1365,10 +1396,14 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting restore\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting restore\n"; } # -------------------------------------------------------------------- chatsend } elsif ($userinput =~ /^chatsend/) { @@ -1407,7 +1442,9 @@ sub make_new_child { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." IO::File->new Failed ". + "while attempting queryreply\n"; } # ----------------------------------------------------------------------- idput } elsif ($userinput =~ /^idput/) { @@ -1431,10 +1468,14 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting idput\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting idput\n"; } # ----------------------------------------------------------------------- idget } elsif ($userinput =~ /^idget/) { @@ -1452,10 +1493,14 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed ". + "while attempting idget\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed ". + "while attempting idget\n"; } # ---------------------------------------------------------------------- tmpput } elsif ($userinput =~ /^tmpput/) { @@ -1472,7 +1517,9 @@ sub make_new_child { print $client "$id\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ."IO::File->new Failed ". + "while attempting tmpput\n"; } # ---------------------------------------------------------------------- tmpget @@ -1488,9 +1535,24 @@ sub make_new_child { close $store; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ."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);