--- loncom/lond 2003/02/03 18:03:52 1.108 +++ 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.108 2003/02/03 18:03:52 harris41 Exp $ +# $Id: lond,v 1.111 2003/03/04 22:32:20 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -855,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"; } } } @@ -1026,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 @@ -1054,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"; @@ -1096,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"; @@ -1122,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/) { @@ -1158,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/) { @@ -1186,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/) { @@ -1207,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/) { @@ -1248,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/) { @@ -1282,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/) { @@ -1322,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"; @@ -1356,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/) { @@ -1398,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/) { @@ -1422,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/) { @@ -1443,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/) { @@ -1463,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 @@ -1479,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);