[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.109 and 1.114

version 1.109, 2003/03/01 04:18:22 version 1.114, 2003/03/14 19:29:36
Line 263  sub checkchildren { Line 263  sub checkchildren {
         }           } 
     }      }
     sleep 5;      sleep 5;
       $SIG{ALRM} = sub { die "timeout" };
       $SIG{__DIE__} = 'DEFAULT';
     foreach (sort keys %children) {      foreach (sort keys %children) {
         unless (-e "$docdir/lon-status/londchld/$_.txt") {          unless (-e "$docdir/lon-status/londchld/$_.txt") {
             eval {
               alarm(300);
     &logthis('Child '.$_.' did not respond');      &logthis('Child '.$_.' did not respond');
     kill 9 => $_;      kill 9 => $_;
     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
     $subj="LON: $perlvar{'lonHostID'} killed lond process $_";      $subj="LON: $perlvar{'lonHostID'} killed lond process $_";
     my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;      my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
     $execdir=$perlvar{'lonDaemons'};      $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  # --------------------------------------------------------------------- Logging
Line 856  sub make_new_child { Line 864  sub make_new_child {
                                unless (-e $fpnow) {                                 unless (-e $fpnow) {
    unless (mkdir($fpnow,0777)) {     unless (mkdir($fpnow,0777)) {
                                       $fperror="error: ".($!+0)                                        $fperror="error: ".($!+0)
   ." mkdir failed\n";    ." mkdir failed while attempting "
                                                 ."makeuser\n";
                                    }                                     }
                                }                                 }
                            }                             }
Line 1028  sub make_new_child { Line 1037  sub make_new_child {
                             print $client "ok\n";                               print $client "ok\n"; 
  } else {   } else {
                             print $client "error: ".($!+0)                              print $client "error: ".($!+0)
  ." IO::File->new Failed\n";   ." IO::File->new Failed "
                                       ."while attempting log\n";
         }          }
        }         }
 # ------------------------------------------------------------------------- put  # ------------------------------------------------------------------------- put
Line 1057  sub make_new_child { Line 1067  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) failed\n";    ." untie(GDBM) failed ".
                                         "while attempting put\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!)                             print $client "error: ".($!)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting put\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1101  sub make_new_child { Line 1113  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting rolesput\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting rolesput\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1129  sub make_new_child { Line 1143  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting get\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             if ($!+0 == 2) {
        ." tie(GDBM) Failed\n";                                 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  # ------------------------------------------------------------------------ eget
                    } elsif ($userinput =~ /^eget/) {                     } elsif ($userinput =~ /^eget/) {
Line 1167  sub make_new_child { Line 1188  sub make_new_child {
                               }                                }
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting eget\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting eget\n";
                        }                         }
 # ------------------------------------------------------------------------- del  # ------------------------------------------------------------------------- del
                    } elsif ($userinput =~ /^del/) {                     } elsif ($userinput =~ /^del/) {
Line 1197  sub make_new_child { Line 1220  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting del\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting del\n";
                        }                         }
 # ------------------------------------------------------------------------ keys  # ------------------------------------------------------------------------ keys
                    } elsif ($userinput =~ /^keys/) {                     } elsif ($userinput =~ /^keys/) {
Line 1220  sub make_new_child { Line 1245  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting keys\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting keys\n";
                        }                         }
 # ----------------------------------------------------------------- dumpcurrent  # ----------------------------------------------------------------- dumpcurrent
                    } elsif ($userinput =~ /^currentdump/) {                     } elsif ($userinput =~ /^currentdump/) {
Line 1263  sub make_new_child { Line 1290  sub make_new_child {
                              print $client "$qresult\n";                               print $client "$qresult\n";
                            } else {                             } else {
                              print $client "error: ".($!+0)                               print $client "error: ".($!+0)
  ." untie(GDBM) Failed\n";   ." untie(GDBM) Failed ".
                                        "while attempting currentdump\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting currentdump\n";
                        }                         }
 # ------------------------------------------------------------------------ dump  # ------------------------------------------------------------------------ dump
                    } elsif ($userinput =~ /^dump/) {                     } elsif ($userinput =~ /^dump/) {
Line 1299  sub make_new_child { Line 1328  sub make_new_child {
                                print $client "$qresult\n";                                 print $client "$qresult\n";
                            } else {                             } else {
                                print $client "error: ".($!+0)                                 print $client "error: ".($!+0)
    ." untie(GDBM) Failed\n";     ." untie(GDBM) Failed ".
                                          "while attempting dump\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting dump\n";
                        }                         }
 # ----------------------------------------------------------------------- store  # ----------------------------------------------------------------------- store
                    } elsif ($userinput =~ /^store/) {                     } elsif ($userinput =~ /^store/) {
Line 1341  sub make_new_child { Line 1372  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting store\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting store\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1377  sub make_new_child { Line 1410  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting restore\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting restore\n";
                        }                         }
 # -------------------------------------------------------------------- chatsend  # -------------------------------------------------------------------- chatsend
                    } elsif ($userinput =~ /^chatsend/) {                     } elsif ($userinput =~ /^chatsend/) {
Line 1421  sub make_new_child { Line 1456  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     print $client "error: ".($!+0)
        ." IO::File->new Failed\n";         ." IO::File->new Failed ".
                                      "while attempting queryreply\n";
        }         }
 # ----------------------------------------------------------------------- idput  # ----------------------------------------------------------------------- idput
                    } elsif ($userinput =~ /^idput/) {                     } elsif ($userinput =~ /^idput/) {
Line 1446  sub make_new_child { Line 1482  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting idput\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting idput\n";
                        }                         }
 # ----------------------------------------------------------------------- idget  # ----------------------------------------------------------------------- idget
                    } elsif ($userinput =~ /^idget/) {                     } elsif ($userinput =~ /^idget/) {
Line 1469  sub make_new_child { Line 1507  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting idget\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting idget\n";
                        }                         }
 # ---------------------------------------------------------------------- tmpput  # ---------------------------------------------------------------------- tmpput
                    } elsif ($userinput =~ /^tmpput/) {                     } elsif ($userinput =~ /^tmpput/) {
Line 1491  sub make_new_child { Line 1531  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     print $client "error: ".($!+0)
        ."IO::File->new Failed\n";         ."IO::File->new Failed ".
                                      "while attempting tmpput\n";
        }         }
   
 # ---------------------------------------------------------------------- tmpget  # ---------------------------------------------------------------------- tmpget
Line 1508  sub make_new_child { Line 1549  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     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  # -------------------------------------------------------------------------- ls
                    } elsif ($userinput =~ /^ls/) {                     } elsif ($userinput =~ /^ls/) {
                        my ($cmd,$ulsdir)=split(/:/,$userinput);                         my ($cmd,$ulsdir)=split(/:/,$userinput);
Line 1721  sub currentversion { Line 1776  sub currentversion {
     if ($fname=~/^(.+)\/[^\/]+$/) {      if ($fname=~/^(.+)\/[^\/]+$/) {
        $ulsdir=$1;         $ulsdir=$1;
     }      }
       my ($fnamere1,$fnamere2);
       # remove version if already specified
     $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;      $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;
     $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/;      # get the bits that go before and after the version number
       if ( $fname=~/^(.*\.)(\w+(?:\.meta)*)$/ ) {
    $fnamere1=$1;
    $fnamere2='.'.$2;
       }
     if (-e $fname) { $version=1; }      if (-e $fname) { $version=1; }
     if (-e $ulsdir) {      if (-e $ulsdir) {
        if(-d $ulsdir) {         if(-d $ulsdir) {
           if (opendir(LSDIR,$ulsdir)) {            if (opendir(LSDIR,$ulsdir)) {
   
              while ($ulsfn=readdir(LSDIR)) {               while ($ulsfn=readdir(LSDIR)) {
 # see if this is a regular file (ignore links produced earlier)  # see if this is a regular file (ignore links produced earlier)
                  my $thisfile=$ulsdir.'/'.$ulsfn;                   my $thisfile=$ulsdir.'/'.$ulsfn;
                  unless (-l $thisfile) {                   unless (-l $thisfile) {
     if ($thisfile=~/$fname/) {       if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
         if ($1>$version) { $version=$1; }   if ($1>$version) { $version=$1; }
                     }       }
  }   }
              }               }
              closedir(LSDIR);               closedir(LSDIR);
Removed from v.1.109  
changed lines
  Added in v.1.114

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>