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

Diff for /loncom/lond between versions 1.58 and 1.64

version 1.58, 2001/11/26 20:59:01 version 1.64, 2002/01/20 18:28:31
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
 # The LearningOnline Network  # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)  # lond "LON Daemon" Server (port "LOND" 5663)
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,  # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
 # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,  # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
 # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,  # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
Line 10 Line 35
 # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer  # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
 # 12/05 Scott Harrison  # 12/05 Scott Harrison
 # 12/05,12/13,12/29 Gerd Kortemeyer  # 12/05,12/13,12/29 Gerd Kortemeyer
   # YEAR=2001
 # Jan 01 Scott Harrison  # Jan 01 Scott Harrison
 # 02/12 Gerd Kortemeyer  # 02/12 Gerd Kortemeyer
 # 03/15 Scott Harrison  # 03/15 Scott Harrison
Line 17 Line 43
 # 04/02 Scott Harrison  # 04/02 Scott Harrison
 # 05/11,05/28,08/30 Gerd Kortemeyer  # 05/11,05/28,08/30 Gerd Kortemeyer
 # 9/30,10/22,11/13,11/15,11/16 Scott Harrison  # 9/30,10/22,11/13,11/15,11/16 Scott Harrison
 # 11/26 Gerd Kortemeyer  # 11/26,11/27 Gerd Kortemeyer
 #  # 12/20 Scott Harrison
 # $Id$  # 12/22 Gerd Kortemeyer
   # YEAR=2002
   # 01/20/02 Gerd Kortemeyer
 ###  ###
   
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
Line 53  sub catchexception { Line 81  sub catchexception {
      ."a crash with this error msg->[$error]</font>");       ."a crash with this error msg->[$error]</font>");
     &logthis('Famous last words: '.$status.' - '.$lastlog);      &logthis('Famous last words: '.$status.' - '.$lastlog);
     if ($client) { print $client "error: $error\n"; }      if ($client) { print $client "error: $error\n"; }
       $server->close();
     die($error);      die($error);
 }  }
   
   sub timeout {
       &logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>");
       &catchexception('Timeout');
   }
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
 $SIG{'QUIT'}=\&catchexception;  $SIG{'QUIT'}=\&catchexception;
Line 138  sub REAPER {                        # ta Line 171  sub REAPER {                        # ta
 sub HUNTSMAN {                      # signal handler for SIGINT  sub HUNTSMAN {                      # signal handler for SIGINT
     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
       &logthis("Free socket: ".shutdown($server,2)); # free up socket
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lond.pid");      unlink("$execdir/logs/lond.pid");
     &logthis("<font color=red>CRITICAL: Shutting down</font>");      &logthis("<font color=red>CRITICAL: Shutting down</font>");
Line 147  sub HUNTSMAN {                      # si Line 181  sub HUNTSMAN {                      # si
 sub HUPSMAN {                      # signal handler for SIGHUP  sub HUPSMAN {                      # signal handler for SIGHUP
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     close($server);                # free up socket      &logthis("Free socket: ".shutdown($server,2)); # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color=red>CRITICAL: Restarting</font>");
     unlink("$execdir/logs/lond.pid");      unlink("$execdir/logs/lond.pid");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
Line 158  sub checkchildren { Line 192  sub checkchildren {
     &initnewstatus();      &initnewstatus();
     &logstatus();      &logstatus();
     &logthis('Going to check on the children');      &logthis('Going to check on the children');
     map {      $docdir=$perlvar{'lonDocRoot'};
       foreach (sort keys %children) {
  sleep 1;   sleep 1;
         unless (kill 'USR1' => $_) {          unless (kill 'USR1' => $_) {
     &logthis ('Child '.$_.' is dead');      &logthis ('Child '.$_.' is dead');
             &logstatus($$.' is dead');              &logstatus($$.' is dead');
         }           } 
     } sort keys %children;      }
       sleep 5;
       foreach (sort keys %children) {
           unless (-e "$docdir/lon-status/londchld/$_.txt") {
       &logthis('Child '.$_.' did not respond');
               kill 9 => $_;
           }
       }
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 183  sub logthis { Line 225  sub logthis {
   
 sub logstatus {  sub logstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
       {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
     print $fh $$."\t".$status."\t".$lastlog."\n";      print $fh $$."\t".$status."\t".$lastlog."\n";
       $fh->close();
       }
       {
    my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");
           print $fh $status."\n".$lastlog."\n".time;
           $fh->close();
       }
 }  }
   
 sub initnewstatus {  sub initnewstatus {
Line 193  sub initnewstatus { Line 243  sub initnewstatus {
     my $now=time;      my $now=time;
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "LOND status $local - parent $$\n\n";      print $fh "LOND status $local - parent $$\n\n";
       opendir(DIR,"$docdir/lon-status/londchld");
       while ($filename=readdir(DIR)) {
           unlink("$docdir/lon-status/londchld/$filename");
       }
       closedir(DIR);
 }  }
   
 # -------------------------------------------------------------- Status setting  # -------------------------------------------------------------- Status setting
Line 402  sub make_new_child { Line 457  sub make_new_child {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
           $SIG{ALRM}= \&timeout;
         $lastlog='Forked ';          $lastlog='Forked ';
         $status='Forked';          $status='Forked';
   
Line 446  sub make_new_child { Line 502  sub make_new_child {
                   } else {                    } else {
       &logthis(        &logthis(
  "<font color=blue>WARNING: $clientip did not reply challenge</font>");   "<font color=blue>WARNING: $clientip did not reply challenge</font>");
                       print $client "bye\n";  
                       &status('No challenge reply '.$clientip);                        &status('No challenge reply '.$clientip);
                   }                    }
               } else {                } else {
   &logthis(    &logthis(
                     "<font color=blue>WARNING: "                      "<font color=blue>WARNING: "
                    ."$clientip failed to initialize: >$remotereq< </font>");                     ."$clientip failed to initialize: >$remotereq< </font>");
   print $client "bye\n";  
                   &status('No init '.$clientip);                    &status('No init '.$clientip);
               }                }
     } else {      } else {
               &logthis(                &logthis(
  "<font color=blue>WARNING: Unknown client $clientip</font>");   "<font color=blue>WARNING: Unknown client $clientip</font>");
               print $client "bye\n";  
               &status('Hung up on '.$clientip);                &status('Hung up on '.$clientip);
             }              }
             if ($clientok) {              if ($clientok) {
Line 473  sub make_new_child { Line 526  sub make_new_child {
                 chomp($userinput);                  chomp($userinput);
                 &status('Processing '.$hostid{$clientip}.': '.$userinput);                  &status('Processing '.$hostid{$clientip}.': '.$userinput);
                 my $wasenc=0;                  my $wasenc=0;
                   alarm(120);
 # ------------------------------------------------------------ See if encrypted  # ------------------------------------------------------------ See if encrypted
  if ($userinput =~ /^enc/) {   if ($userinput =~ /^enc/) {
   if ($cipher) {    if ($cipher) {
Line 1064  sub make_new_child { Line 1118  sub make_new_child {
                        }                         }
 # ------------------------------------------------------------------------ dump  # ------------------------------------------------------------------------ dump
                    } elsif ($userinput =~ /^dump/) {                     } elsif ($userinput =~ /^dump/) {
                        my ($cmd,$udom,$uname,$namespace)                         my ($cmd,$udom,$uname,$namespace,$regexp)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
                        $namespace=~s/\//\_/g;                         $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                          if (defined($regexp)) {
                             $regexp=&unescape($regexp);
          } else {
                             $regexp='.';
          }
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
                            foreach $key (keys %hash) {                             foreach $key (keys %hash) {
                                $qresult.="$key=$hash{$key}&";                                 if (eval('$key=~/$regexp/')) {
                                     $qresult.="$key=$hash{$key}&";
          }
                            }                             }
    if (untie(%hash)) {     if (untie(%hash)) {
               $qresult=~s/\&$//;                $qresult=~s/\&$//;
Line 1294  sub make_new_child { Line 1355  sub make_new_child {
                        &logthis(                         &logthis(
       "Client $clientip ($hostid{$clientip}) hanging up: $userinput");        "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
                        print $client "bye\n";                         print $client "bye\n";
                          $client->close();
        last;         last;
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
                    } else {                     } else {
Line 1301  sub make_new_child { Line 1363  sub make_new_child {
                        print $client "unknown_cmd\n";                         print $client "unknown_cmd\n";
                    }                     }
 # -------------------------------------------------------------------- complete  # -------------------------------------------------------------------- complete
      alarm(0);
                    &status('Listening to '.$hostid{$clientip});                     &status('Listening to '.$hostid{$clientip});
        }         }
 # ------------------------------------------------------ client unknown, refuse  # --------------------------------------------- client unknown or fishy, refuse
             } else {              } else {
         print $client "refused\n";          print $client "refused\n";
                   $client->close();
                 &logthis("<font color=blue>WARNING: "                  &logthis("<font color=blue>WARNING: "
                 ."Rejected client $clientip, closing connection</font>");                  ."Rejected client $clientip, closing connection</font>");
             }                            }              
Line 1316  sub make_new_child { Line 1380  sub make_new_child {
           
         # tidy up gracefully and finish          # tidy up gracefully and finish
           
           $client->close();
           $server->close();
   
         # this exit is VERY important, otherwise the child will become          # this exit is VERY important, otherwise the child will become
         # a producer of more and more children, forking yourself into          # a producer of more and more children, forking yourself into
         # process death.          # process death.
Line 1323  sub make_new_child { Line 1390  sub make_new_child {
     }      }
 }  }
   
   # ----------------------------------- POD (plain old documentation, CPAN style)
   
   =head1 NAME
   
   lond - "LON Daemon" Server (port "LOND" 5663)
   
   =head1 SYNOPSIS
   
   Should only be run as user=www.  Invoked by loncron.
   
   =head1 DESCRIPTION
   
   Preforker - server who forks first. Runs as a daemon. HUPs.
   Uses IDEA encryption
   
   =head1 README
   
   Not yet written.
   
   =head1 PREREQUISITES
   
   IO::Socket
   IO::File
   Apache::File
   Symbol
   POSIX
   Crypt::IDEA
   LWP::UserAgent()
   GDBM_File
   Authen::Krb4
   
   =head1 COREQUISITES
   
   =head1 OSNAMES
   
   linux
   
   =head1 SCRIPT CATEGORIES
   
   Server/Process
   
   =cut
   
   
   
Removed from v.1.58  
changed lines
  Added in v.1.64

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