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

Diff for /loncom/lond between versions 1.118 and 1.133

version 1.118, 2003/03/25 22:03:23 version 1.133, 2003/08/11 21:15:26
Line 57  use LONCAPA::Configuration; Line 57  use LONCAPA::Configuration;
   
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
 use Apache::File;  #use Apache::File;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
Line 73  my $DEBUG = 0;         # Non zero to ena Line 73  my $DEBUG = 0;         # Non zero to ena
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
   
   my $VERSION='$Revision$'; #' stupid emacs
   my $remoteVERSION;
 my $currenthostid;  my $currenthostid;
 my $currentdomainid;  my $currentdomainid;
 #  #
Line 274  sub checkchildren { Line 276  sub checkchildren {
             alarm(300);              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: $currenthostid killed lond process $_";      #$subj="LON: $currenthostid 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);      alarm(0);
   }    }
         }          }
Line 373  sub reconlonc { Line 375  sub reconlonc {
         if (kill 0 => $loncpid) {          if (kill 0 => $loncpid) {
     &logthis("lonc at pid $loncpid responding, sending USR1");      &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;              kill USR1 => $loncpid;
             sleep 5;  
             if (-e "$peerfile") { return; }  
             &logthis("$peerfile still not there, give it another try");  
             sleep 10;  
             if (-e "$peerfile") { return; }  
             &logthis(  
  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");  
         } else {          } else {
     &logthis(      &logthis(
               "<font color=red>CRITICAL: "                "<font color=red>CRITICAL: "
Line 515  while (1) { Line 510  while (1) {
     make_new_child($client);      make_new_child($client);
 }  }
   
 sub init_host_and_domain {  
     my ($remotereq) = @_;  
     my (undef,$hostid)=split(/:/,$remotereq);  
     if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }  
     if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {  
  $currenthostid=$hostid;  
  $currentdomainid=$hostdom{$hostid};  
  &logthis("Setting hostid to $hostid, and domain to $currentdomainid");  
     } else {  
  &logthis("Requested host id $hostid not an alias of ".  
  $perlvar{'lonHostID'}." refusing connection");  
  return 0;  
     }  
     return 1;  
 }  
   
 sub make_new_child {  sub make_new_child {
     my $client;      my $client;
     my $pid;      my $pid;
Line 557  sub make_new_child { Line 536  sub make_new_child {
     } else {      } else {
         # 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{CHLD} = 'DEFAULT'; #make this default so that pwauth returns 
                                   #don't get intercepted
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;          $SIG{ALRM}= \&timeout;
         $lastlog='Forked ';          $lastlog='Forked ';
Line 592  sub make_new_child { Line 573  sub make_new_child {
       my $remotereq=<$client>;        my $remotereq=<$client>;
               $remotereq=~s/[^\w:]//g;                $remotereq=~s/[^\w:]//g;
               if ($remotereq =~ /^init/) {                if ($remotereq =~ /^init/) {
   if (!&init_host_and_domain($remotereq)) {    &sethost("sethost:$perlvar{'lonHostID'}");
       &status("Got bad init message, exiting");  
       print $client "refused\n";  
       $client->close();  
       &logthis("<font color=blue>WARNING: "  
        ."Bad init message $remotereq, closing connection</font>");  
       exit;  
   }  
   my $challenge="$$".time;    my $challenge="$$".time;
                   print $client "$challenge\n";                    print $client "$challenge\n";
                   &status(                    &status(
Line 691  sub make_new_child { Line 665  sub make_new_child {
                           $loadavg=<$loadfile>;                            $loadavg=<$loadfile>;
                        }                         }
                        $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";
   # -------------------------------------------------------------------- userload
      } elsif ($userinput =~ /^userload/) {
          my $userloadpercent=&userload();
          print $client "$userloadpercent\n";
 # ----------------------------------------------------------------- currentauth  # ----------------------------------------------------------------- currentauth
    } elsif ($userinput =~ /^currentauth/) {     } elsif ($userinput =~ /^currentauth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 848  sub make_new_child { Line 826  sub make_new_child {
      if ($pwdcorrect) {       if ($pwdcorrect) {
  my $execdir=$perlvar{'lonDaemons'};   my $execdir=$perlvar{'lonDaemons'};
  &Debug("Opening lcpasswd pipeline");   &Debug("Opening lcpasswd pipeline");
  my $pf = IO::File->new("|$execdir/lcpasswd > /home/www/lcpasswd.log");   my $pf = IO::File->new("|$execdir/lcpasswd > $perlvar{'lonDaemons'}/logs/lcpasswd.log");
  print $pf "$uname\n$npass\n$npass\n";   print $pf "$uname\n$npass\n$npass\n";
  close $pf;   close $pf;
  my $err = $?;   my $err = $?;
Line 1091  sub make_new_child { Line 1069  sub make_new_child {
        ) { print $hfh "P:$now:$what\n"; }         ) { print $hfh "P:$now:$what\n"; }
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;                                 $hash{$key}=$value;
Line 1133  sub make_new_child { Line 1111  sub make_new_child {
                                  }                                   }
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
        &ManagePermissions($key, $udom, $uname,         &ManagePermissions($key, $udom, $uname,
Line 1179  sub make_new_child { Line 1157  sub make_new_child {
                                  }                                   }
        }         }
                        my @rolekeys=split(/\&/,$what);                         my @rolekeys=split(/\&/,$what);
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            foreach $key (@rolekeys) {                             foreach $key (@rolekeys) {
                                delete $hash{$key};                                 delete $hash{$key};
                 
Line 1209  sub make_new_child { Line 1187  sub make_new_child {
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        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)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 1241  sub make_new_child { Line 1219  sub make_new_child {
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        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)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 1287  sub make_new_child { Line 1265  sub make_new_child {
        ) { print $hfh "D:$now:$what\n"; }         ) { print $hfh "D:$now:$what\n"; }
        }         }
                        my @keys=split(/\&/,$what);                         my @keys=split(/\&/,$what);
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {        if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            foreach $key (@keys) {                             foreach $key (@keys) {
                                delete($hash{$key});                                 delete($hash{$key});
                            }                             }
Line 1311  sub make_new_child { Line 1289  sub make_new_child {
                        $namespace=~s/\W//g;                         $namespace=~s/\W//g;
                        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&";                                 $qresult.="$key&";
                            }                             }
Line 1429  sub make_new_child { Line 1407  sub make_new_child {
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
                                                     
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            my @previouskeys=split(/&/,$hash{"keys:$rid"});                             my @previouskeys=split(/&/,$hash{"keys:$rid"});
                            my $key;                             my $key;
                            $hash{"version:$rid"}++;                             $hash{"version:$rid"}++;
Line 1467  sub make_new_child { Line 1445  sub make_new_child {
                        chomp($rid);                         chomp($rid);
                        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)) {
                   my $version=$hash{"version:$rid"};                    my $version=$hash{"version:$rid"};
                            $qresult.="version=$version&";                             $qresult.="version=$version&";
                            my $scope;                             my $scope;
Line 1500  sub make_new_child { Line 1478  sub make_new_child {
                        print $client "ok\n";                         print $client "ok\n";
 # -------------------------------------------------------------------- chatretr  # -------------------------------------------------------------------- chatretr
                    } elsif ($userinput =~ /^chatretr/) {                     } elsif ($userinput =~ /^chatretr/) {
                        my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);                         my 
                           ($cmd,$cdom,$cnum,$udom,$uname)=split(/\:/,$userinput);
                        my $reply='';                         my $reply='';
                        foreach (&getchat($cdom,$cnum)) {                         foreach (&getchat($cdom,$cnum,$udom,$uname)) {
    $reply.=&escape($_).':';     $reply.=&escape($_).':';
                        }                         }
                        $reply=~s/\:$//;                         $reply=~s/\:$//;
Line 1543  sub make_new_child { Line 1522  sub make_new_child {
                               "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";                                "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
                        my $now=time;                         my $now=time;
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value.':'.$now;                                 $hash{$key}=$value.':'.$now;
Line 1577  sub make_new_child { Line 1556  sub make_new_child {
                            while (($key,$value) = each(%hash)) {                             while (($key,$value) = each(%hash)) {
                                my ($descr,$lasttime)=split(/\:/,$value);                                 my ($descr,$lasttime)=split(/\:/,$value);
                                if ($lasttime<$since) { next; }                                 if ($lasttime<$since) { next; }
                                if ($regexp eq '.') {                                 if ($description eq '.') {
                                    $qresult.=$key.'='.$descr.'&';                                     $qresult.=$key.'='.$descr.'&';
                                } else {                                 } else {
                                    my $unescapeVal = &unescape($descr);                                     my $unescapeVal = &unescape($descr);
                                    if (eval('$unescapeVal=~/$description/')) {                                     if (eval('$unescapeVal=~/$description/i')) {
                                        $qresult.="$key=$descr&";                                         $qresult.="$key=$descr&";
                                    }                                     }
                                }                                 }
Line 1613  sub make_new_child { Line 1592  sub make_new_child {
        ) { print $hfh "P:$now:$what\n"; }         ) { print $hfh "P:$now:$what\n"; }
        }         }
                        my @pairs=split(/\&/,$what);                         my @pairs=split(/\&/,$what);
                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
                            foreach $pair (@pairs) {                             foreach $pair (@pairs) {
        ($key,$value)=split(/=/,$pair);         ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;                                 $hash{$key}=$value;
Line 1638  sub make_new_child { Line 1617  sub make_new_child {
                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";                         my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
                        my @queries=split(/\&/,$what);                         my @queries=split(/\&/,$what);
                        my $qresult='';                         my $qresult='';
                  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) {                   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
                            for ($i=0;$i<=$#queries;$i++) {                             for ($i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";                                 $qresult.="$hash{$queries[$i]}&";
                            }                             }
Line 1739  sub make_new_child { Line 1718  sub make_new_child {
                        $client->close();                         $client->close();
        last;         last;
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
      } elsif ($userinput =~ /^sethost:/) {
          print $client &sethost($userinput)."\n";
      } elsif ($userinput =~/^version:/) {
          print $client &version($userinput)."\n";
                    } else {                     } else {
                        # unknown command                         # unknown command
                        print $client "unknown_cmd\n";                         print $client "unknown_cmd\n";
Line 1850  sub addline { Line 1833  sub addline {
 }  }
   
 sub getchat {  sub getchat {
     my ($cdom,$cname)=@_;      my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;      my %hash;
     my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
     my @entries=();      my @entries=();
Line 1859  sub getchat { Line 1842  sub getchat {
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  untie %hash;   untie %hash;
     }      }
     return @entries;      my @participants=();
       $cutoff=time-60;
       if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
       &GDBM_WRCREAT(),0640)) {
           $hash{$uname.':'.$udom}=time;
           foreach (sort keys %hash) {
       if ($hash{$_}>$cutoff) {
    $participants[$#participants+1]='active_participant:'.$_;
               }
           }
           untie %hash;
       }
       return (@participants,@entries);
 }  }
   
 sub chatadd {  sub chatadd {
Line 2031  sub make_passwd_file { Line 2026  sub make_passwd_file {
     {      {
  &Debug("Executing external: ".$execpath);   &Debug("Executing external: ".$execpath);
  &Debug("user  = ".$uname.", Password =". $npass);   &Debug("user  = ".$uname.", Password =". $npass);
  my $se = IO::File->new("|$execpath > /home/www/lcuseradd.log");   my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
  print $se "$uname\n";   print $se "$uname\n";
  print $se "$npass\n";   print $se "$npass\n";
  print $se "$npass\n";   print $se "$npass\n";
Line 2054  sub make_passwd_file { Line 2049  sub make_passwd_file {
     return $result;      return $result;
 }  }
   
   sub sethost {
       my ($remotereq) = @_;
       my (undef,$hostid)=split(/:/,$remotereq);
       if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
       if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
    $currenthostid=$hostid;
    $currentdomainid=$hostdom{$hostid};
    &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
       } else {
    &logthis("Requested host id $hostid not an alias of ".
    $perlvar{'lonHostID'}." refusing connection");
    return 'unable_to_set';
       }
       return 'ok';
   }
   
   sub version {
       my ($userinput)=@_;
       $remoteVERSION=(split(/:/,$userinput))[1];
       return "version:$VERSION";
   }
   
   #There is a copy of this in lonnet.pm
   sub userload {
       my $numusers=0;
       {
    opendir(LONIDS,$perlvar{'lonIDsDir'});
    my $filename;
    my $curtime=time;
    while ($filename=readdir(LONIDS)) {
       if ($filename eq '.' || $filename eq '..') {next;}
       my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];
       if ($curtime-$atime < 3600) { $numusers++; }
    }
    closedir(LONIDS);
       }
       my $userloadpercent=0;
       my $maxuserload=$perlvar{'lonUserLoadLim'};
       if ($maxuserload) {
    $userloadpercent=100*$numusers/$maxuserload;
       }
       $userloadpercent=sprintf("%.2f",$userloadpercent);
       return $userloadpercent;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Removed from v.1.118  
changed lines
  Added in v.1.133

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