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

Diff for /loncom/lond between versions 1.28 and 1.56

version 1.28, 2000/12/05 20:19:46 version 1.56, 2001/11/16 16:26:01
Line 9 Line 9
 # 06/26 Scott Harrison  # 06/26 Scott Harrison
 # 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 Gerd Kortemeyer  # 12/05,12/13,12/29 Gerd Kortemeyer
   # 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
 #  #
   # $Id$
   ###
   
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
 # preforker - server who forks first  # preforker - server who forks first
 # runs as a daemon  # runs as a daemon
Line 26  use Crypt::IDEA; Line 36  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  use Authen::Krb4;
   use lib '/home/httpd/lib/perl/';
   use localauth;
   
 # grabs exception and records it to log before exiting  # grabs exception and records it to log before exiting
 sub catchexception {  sub catchexception {
Line 39  sub catchexception { Line 51  sub catchexception {
     die($error);      die($error);
 }  }
   
 # grabs exception and records it to log before exiting  
 # NOTE: we must NOT use the regular (non-overrided) die function in  
 # the code because a handler CANNOT be attached to it  
 # (despite what some of the documentation says about SIG{__DIE__}.  
   
 sub catchdie {  
     my ($message)=@_;  
     $SIG{'QUIT'}='DEFAULT';  
     $SIG{__DIE__}='DEFAULT';  
     &logthis("<font color=red>CRITICAL: "  
      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "  
      ."\_\_DIE\_\_ with this error msg->[$message]</font>");  
     if ($client) { print $client "error: $message\n"; }  
     die($message);  
 }  
   
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
 $SIG{'QUIT'}=\&catchexception;  $SIG{'QUIT'}=\&catchexception;
Line 62  $SIG{__DIE__}=\&catchexception; Line 58  $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ------------------------------------ Read httpd access.conf and get variables
   
 open (CONFIG,"/etc/httpd/conf/access.conf")  open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
     || catchdie "Can't read access.conf";  
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {      if ($configline =~ /PerlSetVar/) {
Line 74  while ($configline=<CONFIG>) { Line 69  while ($configline=<CONFIG>) {
 }  }
 close(CONFIG);  close(CONFIG);
   
   # ----------------------------- Make sure this process is running from user=www
   my $wwwid=getpwnam('www');
   if ($wwwid!=$<) {
      $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
      $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
      system("echo 'User ID mismatch.  lond must be run as user www.' |\
    mailto $emailto -s '$subj' > /dev/null");
      exit 1;
   }
   
 # --------------------------------------------- Check if other instance running  # --------------------------------------------- Check if other instance running
   
 my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";  my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
Line 82  if (-e $pidfile) { Line 87  if (-e $pidfile) {
    my $lfh=IO::File->new("$pidfile");     my $lfh=IO::File->new("$pidfile");
    my $pide=<$lfh>;     my $pide=<$lfh>;
    chomp($pide);     chomp($pide);
    if (kill 0 => $pide) { catchdie "already running"; }     if (kill 0 => $pide) { die "already running"; }
 }  }
   
 $PREFORK=4; # number of children to maintain, at least four spare  $PREFORK=4; # number of children to maintain, at least four spare
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
   
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab")  open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     || catchdie "Can't read host file";  
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
Line 107  $server = IO::Socket::INET->new(LocalPor Line 111  $server = IO::Socket::INET->new(LocalPor
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 Reuse     => 1,                                  Reuse     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or catchdie "making socket: $@\n";    or die "making socket: $@\n";
   
 # --------------------------------------------------------- Do global variables  # --------------------------------------------------------- Do global variables
   
Line 140  sub HUPSMAN {                      # sig Line 144  sub HUPSMAN {                      # sig
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     close($server);                # free up socket      close($server);                # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color=red>CRITICAL: Restarting</font>");
       unlink("$execdir/logs/lond.pid");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lond");         # here we go again      exec("$execdir/lond");         # here we go again
 }  }
Line 290  sub ishome { Line 295  sub ishome {
   
 $fpid=fork;  $fpid=fork;
 exit if $fpid;  exit if $fpid;
 catchdie "Couldn't fork: $!" unless defined ($fpid);  die "Couldn't fork: $!" unless defined ($fpid);
   
 POSIX::setsid() or catchdie "Can't start new session: $!";  POSIX::setsid() or die "Can't start new session: $!";
   
 # ------------------------------------------------------- Write our PID on disk  # ------------------------------------------------------- Write our PID on disk
   
Line 331  sub make_new_child { Line 336  sub make_new_child {
     # block signal for fork      # block signal for fork
     $sigset = POSIX::SigSet->new(SIGINT);      $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)      sigprocmask(SIG_BLOCK, $sigset)
         or catchdie "Can't block SIGINT for fork: $!\n";          or die "Can't block SIGINT for fork: $!\n";
           
     catchdie "fork: $!" unless defined ($pid = fork);      die "fork: $!" unless defined ($pid = fork);
           
     if ($pid) {      if ($pid) {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or catchdie "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;          $children{$pid} = 1;
         $children++;          $children++;
         return;          return;
Line 348  sub make_new_child { Line 353  sub make_new_child {
           
         # unblock signals          # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or catchdie "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
   
         $tmpsnum=0;          $tmpsnum=0;
           
Line 365  sub make_new_child { Line 370  sub make_new_child {
             my $clientip=inet_ntoa($iaddr);              my $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis(              &logthis(
 "<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");  "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
               );
             my $clientok;              my $clientok;
             if ($clientrec) {              if ($clientrec) {
       my $remotereq=<$client>;        my $remotereq=<$client>;
Line 450  sub make_new_child { Line 456  sub make_new_child {
                        $loadavg =~ s/\s.*//g;                         $loadavg =~ s/\s.*//g;
                        my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};                         my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
        print $client "$loadpercent\n";         print $client "$loadpercent\n";
   # ----------------------------------------------------------------- currentauth
      } elsif ($userinput =~ /^currentauth/) {
        if ($wasenc==1) {
                          my ($cmd,$udom,$uname)=split(/:/,$userinput);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
                          if (-e $passfilename) {
      my $pf = IO::File->new($passfilename);
      my $realpasswd=<$pf>;
      chomp($realpasswd);
      my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
      my $availablecontent='';
      if ($howpwd eq 'krb4') {
          $availablecontent=$contentpwd;
      }
      print $client "$howpwd:$availablecontent\n";
          } else {
                             print $client "unknown_user\n";
                          }
        } else {
          print $client "refused\n";
        }
 # ------------------------------------------------------------------------ auth  # ------------------------------------------------------------------------ auth
                    } elsif ($userinput =~ /^auth/) {                     } elsif ($userinput =~ /^auth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 469  sub make_new_child { Line 497  sub make_new_child {
   (crypt($upass,$contentpwd) eq $contentpwd);    (crypt($upass,$contentpwd) eq $contentpwd);
                           } elsif ($howpwd eq 'unix') {                            } elsif ($howpwd eq 'unix') {
                               $contentpwd=(getpwnam($uname))[1];                                $contentpwd=(getpwnam($uname))[1];
                               $pwdcorrect=        my $pwauth_path="/usr/local/sbin/pwauth";
                                   (crypt($upass,$contentpwd) eq $contentpwd);        unless ($contentpwd eq 'x') {
     $pwdcorrect=
                                       (crypt($upass,$contentpwd) eq $contentpwd);
         }
         elsif (-e $pwauth_path) {
     open PWAUTH, "|$pwauth_path" or
         die "Cannot invoke authentication";
     print PWAUTH "$uname\n$upass\n";
     close PWAUTH;
     $pwdcorrect=!$?;
         }
                           } elsif ($howpwd eq 'krb4') {                            } elsif ($howpwd eq 'krb4') {
                               $pwdcorrect=(                                $pwdcorrect=(
                                  Authen::Krb4::get_pw_in_tkt($uname,"",                                   Authen::Krb4::get_pw_in_tkt($uname,"",
                                         $contentpwd,'krbtgt',$contentpwd,1,                                          $contentpwd,'krbtgt',$contentpwd,1,
      $upass) == 0);       $upass) == 0);
                           }                            } elsif ($howpwd eq 'localauth') {
       $pwdcorrect=&localauth::localauth($uname,$upass,
         $contentpwd);
     }
                           if ($pwdcorrect) {                            if ($pwdcorrect) {
                              print $client "authorized\n";                               print $client "authorized\n";
                           } else {                            } else {
Line 494  sub make_new_child { Line 535  sub make_new_child {
                        my                          my 
                        ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);                         ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
                        chomp($npass);                         chomp($npass);
                          $upass=&unescape($upass);
                          $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
                        if (-e $passfilename) {                         if (-e $passfilename) {
Line 508  sub make_new_child { Line 551  sub make_new_child {
                              $salt=substr($salt,6,2);                               $salt=substr($salt,6,2);
      my $ncpass=crypt($npass,$salt);       my $ncpass=crypt($npass,$salt);
                              { my $pf = IO::File->new(">$passfilename");                               { my $pf = IO::File->new(">$passfilename");
           print $pf "internal:$ncpass\n";; }                         print $pf "internal:$ncpass\n"; }             
                              print $client "ok\n";                               print $client "ok\n";
                            } else {                             } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
Line 522  sub make_new_child { Line 565  sub make_new_child {
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
      }       }
   # -------------------------------------------------------------------- makeuser
                      } elsif ($userinput =~ /^makeuser/) {
                   my $oldumask=umask(0077);
        if ($wasenc==1) {
                          my 
                          ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                          chomp($npass);
                          $npass=&unescape($npass);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
                          if (-e $passfilename) {
      print $client "already_exists\n";
                          } elsif ($udom ne $perlvar{'lonDefDomain'}) {
                              print $client "not_right_domain\n";
                          } else {
                              @fpparts=split(/\//,$proname);
                              $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
                              $fperror='';
                              for ($i=3;$i<=$#fpparts;$i++) {
                                  $fpnow.='/'.$fpparts[$i]; 
                                  unless (-e $fpnow) {
      unless (mkdir($fpnow,0777)) {
                                         $fperror="error:$!\n";
                                      }
                                  }
                              }
                              unless ($fperror) {
        if ($umode eq 'krb4') {
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "krb4:$npass\n"; 
                                  }             
                                  print $client "ok\n";
                                } elsif ($umode eq 'internal') {
          my $salt=time;
                                  $salt=substr($salt,6,2);
          my $ncpass=crypt($npass,$salt);
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "internal:$ncpass\n"; 
                                  }
                                  print $client "ok\n";
        } elsif ($umode eq 'localauth') {
          {
    my $pf = IO::File->new(">$passfilename");
               print $pf "localauth:$npass\n";
          }
          print $client "ok\n";
        } elsif ($umode eq 'unix') {
          {
    my $execpath="$perlvar{'lonDaemons'}/".
                 "lcuseradd";
    {
        my $se = IO::File->new("|$execpath");
        print $se "$uname\n";
        print $se "$npass\n";
        print $se "$npass\n";
    }
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "unix:\n"; 
          }
          print $client "ok\n";
        } elsif ($umode eq 'none') {
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "none:\n"; 
                                  }             
                                  print $client "ok\n";
                                } else {
                                  print $client "auth_mode_error\n";
                                }  
                              } else {
                                  print $client "$fperror\n";
                              }
                          }
        } else {
          print $client "refused\n";
        }
        umask($oldumask);
   # -------------------------------------------------------------- changeuserauth
                      } elsif ($userinput =~ /^changeuserauth/) {
        if ($wasenc==1) {
                          my 
                          ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                          chomp($npass);
                          $npass=&unescape($npass);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
          if ($udom ne $perlvar{'lonDefDomain'}) {
                              print $client "not_right_domain\n";
                          } else {
      if ($umode eq 'krb4') {
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "krb4:$npass\n"; 
                                  }             
                                  print $client "ok\n";
      } elsif ($umode eq 'internal') {
          my $salt=time;
                                  $salt=substr($salt,6,2);
          my $ncpass=crypt($npass,$salt);
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "internal:$ncpass\n"; 
                                  }
                                  print $client "ok\n";
      } elsif ($umode eq 'localauth') {
          {
      my $pf = IO::File->new(">$passfilename");
      print $pf "localauth:$npass\n";
          }
          print $client "ok\n";
      } elsif ($umode eq 'unix') {
          {
      my $execpath="$perlvar{'lonDaemons'}/".
          "lcuseradd";
      {
          my $se = IO::File->new("|$execpath");
          print $se "$uname\n";
          print $se "$npass\n";
          print $se "$npass\n";
      }
      my $pf = IO::File->new(">$passfilename");
      print $pf "unix:\n"; 
          }
          print $client "ok\n";
      } elsif ($umode eq 'none') {
                                  { 
      my $pf = IO::File->new(">$passfilename");
      print $pf "none:\n"; 
                                  }             
                                  print $client "ok\n";
      } else {
                                  print $client "auth_mode_error\n";
      }  
                          }
        } else {
          print $client "refused\n";
        }
 # ------------------------------------------------------------------------ home  # ------------------------------------------------------------------------ home
                    } elsif ($userinput =~ /^home/) {                     } elsif ($userinput =~ /^home/) {
                        my ($cmd,$udom,$uname)=split(/:/,$userinput);                         my ($cmd,$udom,$uname)=split(/:/,$userinput);
Line 613  sub make_new_child { Line 795  sub make_new_child {
                                print $sh "$clientip:$now\n";                                 print $sh "$clientip:$now\n";
     }      }
    }     }
                              unless ($fname=~/\.meta$/) {
          unlink("$fname.meta.$hostid{$clientip}");
                              }
                            $fname=~s/\/home\/httpd\/html\/res/raw/;                             $fname=~s/\/home\/httpd\/html\/res/raw/;
                            $fname="http://$thisserver/".$fname;                             $fname="http://$thisserver/".$fname;
                            print $client "$fname\n";                             print $client "$fname\n";
Line 648  sub make_new_child { Line 833  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 773  sub make_new_child { Line 958  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 844  sub make_new_child { Line 1029  sub make_new_child {
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $now=time;                         my $now=time;
                        {                         unless ($namespace=~/^nohist\_/) {
    my $hfh;     my $hfh;
    if (     if (
                              $hfh=IO::File->new(">>$proname/$namespace.hist")                               $hfh=IO::File->new(">>$proname/$namespace.hist")
Line 863  sub make_new_child { Line 1048  sub make_new_child {
                                $allkeys.=$key.':';                                 $allkeys.=$key.':';
                                $hash{"$version:$rid:$key"}=$value;                                 $hash{"$version:$rid:$key"}=$value;
                            }                             }
                            $allkeys=~s/:$//;                             $hash{"$version:$rid:timestamp"}=$now;
                              $allkeys.='timestamp';
                            $hash{"$version:keys:$rid"}=$allkeys;                             $hash{"$version:keys:$rid"}=$allkeys;
    if (untie(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
Line 909  sub make_new_child { Line 1095  sub make_new_child {
                        }                         }
 # ------------------------------------------------------------------- querysend  # ------------------------------------------------------------------- querysend
                    } elsif ($userinput =~ /^querysend/) {                     } elsif ($userinput =~ /^querysend/) {
                        my ($cmd,$query)=split(/:/,$userinput);                         my ($cmd,$query,
      $custom,$customshow)=split(/:/,$userinput);
        $query=~s/\n*$//g;         $query=~s/\n*$//g;
                      print $client sqlreply("$hostid{$clientip}\&$query")."\n";         unless ($custom or $customshow) {
      print $client "".
          sqlreply("$hostid{$clientip}\&$query")."\n";
          }
          else {
      print $client "".
          sqlreply("$hostid{$clientip}\&$query".
    "\&$custom"."\&$customshow")."\n";
          }
 # ------------------------------------------------------------------ queryreply  # ------------------------------------------------------------------ queryreply
                    } elsif ($userinput =~ /^queryreply/) {                     } elsif ($userinput =~ /^queryreply/) {
                        my ($cmd,$id,$reply)=split(/:/,$userinput);                          my ($cmd,$id,$reply)=split(/:/,$userinput); 
        my $store;         my $store;
                        my $execdir=$perlvar{'lonDaemons'};                         my $execdir=$perlvar{'lonDaemons'};
                        if ($store=IO::File->new(">$execdir/tmp/$id")) {                         if ($store=IO::File->new(">$execdir/tmp/$id")) {
      $reply=~s/\&/\n/g;
    print $store $reply;     print $store $reply;
    close $store;     close $store;
      my $store2=IO::File->new(">$execdir/tmp/$id.end");
      print $store2 "done\n";
      close $store2;
    print $client "ok\n";     print $client "ok\n";
        }         }
        else {         else {
Line 1013  sub make_new_child { Line 1212  sub make_new_child {
                        my $ulsout='';                         my $ulsout='';
                        my $ulsfn;                         my $ulsfn;
                        if (-e $ulsdir) {                         if (-e $ulsdir) {
                           while ($ulsfn=<$ulsdir/*>) {   if (opendir(LSDIR,$ulsdir)) {
      my @ulsstats=stat($ulsfn);                            while ($ulsfn=readdir(LSDIR)) {
        my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';                               $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
                           }                            }
                             closedir(LSDIR);
           }
        } else {         } else {
                           $ulsout='no_such_dir';                            $ulsout='no_such_dir';
                        }                         }
                        if ($ulsout eq '') { $ulsout='empty'; }                         if ($ulsout eq '') { $ulsout='empty'; }
                        print $client "$ulsout\n";                         print $client "$ulsout\n";
   # ------------------------------------------------------------------ Hanging up
                      } elsif (($userinput =~ /^exit/) ||
                               ($userinput =~ /^init/)) {
                          &logthis(
         "Client $clientip ($hostid{$clientip}) hanging up: $userinput");
                          print $client "bye\n";
          last;
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
                    } else {                     } else {
                        # unknown command                         # unknown command
Removed from v.1.28  
changed lines
  Added in v.1.56

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