--- loncom/lond 2003/01/15 04:43:14 1.106 +++ loncom/lond 2003/03/01 04:18:22 1.109 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.106 2003/01/15 04:43:14 foxr Exp $ +# $Id: lond,v 1.109 2003/03/01 04:18:22 foxr 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,8 @@ sub make_new_child { $fpnow.='/'.$fpparts[$i]; unless (-e $fpnow) { unless (mkdir($fpnow,0777)) { - $fperror="error:$!"; + $fperror="error: ".($!+0) + ." mkdir failed\n"; } } } @@ -1035,7 +1027,8 @@ 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\n"; } } # ------------------------------------------------------------------------- put @@ -1063,10 +1056,12 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!) + ." tie(GDBM) Failed\n"; } } else { print $client "refused\n"; @@ -1105,10 +1100,12 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } } else { print $client "refused\n"; @@ -1131,10 +1128,12 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ------------------------------------------------------------------------ eget } elsif ($userinput =~ /^eget/) { @@ -1167,10 +1166,12 @@ sub make_new_child { print $client "error:no_key\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ------------------------------------------------------------------------- del } elsif ($userinput =~ /^del/) { @@ -1195,10 +1196,12 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ------------------------------------------------------------------------ keys } elsif ($userinput =~ /^keys/) { @@ -1216,13 +1219,15 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ----------------------------------------------------------------- dumpcurrent - } elsif ($userinput =~ /^dumpcurrent/) { + } elsif ($userinput =~ /^currentdump/) { my ($cmd,$udom,$uname,$namespace) =split(/:/,$userinput); $namespace=~s/\//\_/g; @@ -1244,9 +1249,8 @@ sub make_new_child { next if (exists($data{$symb}) && exists($data{$symb}->{$param}) && $data{$symb}->{'v.'.$param} > $v); - #&logthis("v = ".$v." p = ".$param." s = ".$symb); $data{$symb}->{$param}=$value; - $data{$symb}->{'v.'.$param}=$value; + $data{$symb}->{'v.'.$param}=$v; } if (untie(%hash)) { while (my ($symb,$param_hash) = each(%data)) { @@ -1258,10 +1262,12 @@ sub make_new_child { chop($qresult); print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ------------------------------------------------------------------------ dump } elsif ($userinput =~ /^dump/) { @@ -1292,10 +1298,12 @@ sub make_new_child { chop($qresult); print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ----------------------------------------------------------------------- store } elsif ($userinput =~ /^store/) { @@ -1332,10 +1340,12 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } } else { print $client "refused\n"; @@ -1366,10 +1376,12 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # -------------------------------------------------------------------- chatsend } elsif ($userinput =~ /^chatsend/) { @@ -1408,7 +1420,8 @@ sub make_new_child { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." IO::File->new Failed\n"; } # ----------------------------------------------------------------------- idput } elsif ($userinput =~ /^idput/) { @@ -1432,10 +1445,12 @@ sub make_new_child { if (untie(%hash)) { print $client "ok\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ----------------------------------------------------------------------- idget } elsif ($userinput =~ /^idget/) { @@ -1453,10 +1468,12 @@ sub make_new_child { $qresult=~s/\&$//; print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." untie(GDBM) Failed\n"; } } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ." tie(GDBM) Failed\n"; } # ---------------------------------------------------------------------- tmpput } elsif ($userinput =~ /^tmpput/) { @@ -1473,7 +1490,8 @@ sub make_new_child { print $client "$id\n"; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ."IO::File->new Failed\n"; } # ---------------------------------------------------------------------- tmpget @@ -1489,7 +1507,8 @@ sub make_new_child { close $store; } else { - print $client "error:$!\n"; + print $client "error: ".($!+0) + ."IO::File->new Failed\n"; } # -------------------------------------------------------------------------- ls