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

Diff for /loncom/lond between versions 1.194 and 1.205.2.1

version 1.194, 2004/06/17 09:26:56 version 1.205.2.1, 2004/08/02 21:02:20
Line 50  use File::Copy; Line 50  use File::Copy;
 use LONCAPA::ConfigFileEdit;  use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
   use Fcntl qw(:flock);
   
 my $DEBUG = 1;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
Line 69  my $clientname;   # LonCAPA name of clie Line 70  my $clientname;   # LonCAPA name of clie
 my $server;  my $server;
 my $thisserver; # DNS of us.  my $thisserver; # DNS of us.
   
   my $keymode;
   
 #   # 
 #   Connection type is:  #   Connection type is:
 #      client                   - All client actions are allowed  #      client                   - All client actions are allowed
Line 352  sub ReadManagerTable { Line 355  sub ReadManagerTable {
    while(my $host = <MANAGERS>) {     while(my $host = <MANAGERS>) {
       chomp($host);        chomp($host);
       if ($host =~ "^#") {                  # Comment line.        if ($host =~ "^#") {                  # Comment line.
          logthis('<font color="green"> Skipping line: '. "$host</font>\n");  
          next;           next;
       }        }
       if (!defined $hostip{$host}) { # This is a non cluster member        if (!defined $hostip{$host}) { # This is a non cluster member
Line 1144  sub checkchildren { Line 1146  sub checkchildren {
     &logthis('Going to check on the children');      &logthis('Going to check on the children');
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     foreach (sort keys %children) {      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');
       delete($children{$_});
         }           } 
     }      }
     sleep 5;      sleep 5;
Line 1165  sub checkchildren { Line 1168  sub checkchildren {
     #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.$_`;
       delete($children{$_});
     alarm(0);      alarm(0);
   }    }
         }          }
Line 1172  sub checkchildren { Line 1176  sub checkchildren {
     $SIG{ALRM} = 'DEFAULT';      $SIG{ALRM} = 'DEFAULT';
     $SIG{__DIE__} = \&catchexception;      $SIG{__DIE__} = \&catchexception;
     &status("Finished checking children");      &status("Finished checking children");
       &logthis('Finished Checking children');
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 1216  sub logstatus { Line 1221  sub logstatus {
     &status("Doing logging");      &status("Doing logging");
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     {      {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");  
     print $fh $$."\t".$clientname."\t".$currenthostid."\t"  
  .$status."\t".$lastlog."\n";  
     $fh->close();  
     }  
     &status("Finished londstatus.txt");  
     {  
  my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");   my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt");
         print $fh $status."\n".$lastlog."\n".time;          print $fh $status."\n".$lastlog."\n".time."\n$keymode";
         $fh->close();          $fh->close();
     }      }
       &status("Finished $$.txt");
       {
    open(LOG,">>$docdir/lon-status/londstatus.txt");
    flock(LOG,LOCK_EX);
    print LOG $$."\t".$clientname."\t".$currenthostid."\t"
       .$status."\t".$lastlog."\t $keymode\n";
    flock(DB,LOCK_UN);
    close(LOG);
       }
     &status("Finished logging");      &status("Finished logging");
 }  }
   
Line 1527  sub make_new_child { Line 1534  sub make_new_child {
  #  If the remote is attempting a local init... give that a try:   #  If the remote is attempting a local init... give that a try:
  #   #
  my ($i, $inittype) = split(/:/, $remotereq);   my ($i, $inittype) = split(/:/, $remotereq);
   
    # If the connection type is ssl, but I didn't get my
    # certificate files yet, then I'll drop  back to 
    # insecure (if allowed).
   
    if($inittype eq "ssl") {
       my ($ca, $cert) = lonssl::CertificateFile;
       my $kfile       = lonssl::KeyFile;
       if((!$ca)   || 
          (!$cert) || 
          (!$kfile)) {
    $inittype = ""; # This forces insecure attempt.
    &logthis("<font color=\"blue\"> Certificates not "
    ."installed -- trying insecure auth</font>");
       }
       else { # SSL certificates are in place so
       } # Leave the inittype alone.
    }
   
  if($inittype eq "local") {   if($inittype eq "local") {
     my $key = LocalConnection($client, $remotereq);      my $key = LocalConnection($client, $remotereq);
     if($key) {      if($key) {
Line 1537  sub make_new_child { Line 1563  sub make_new_child {
  print $client "ok:local\n";   print $client "ok:local\n";
  &logthis('<font color="green"'   &logthis('<font color="green"'
  . "Successful local authentication </font>");   . "Successful local authentication </font>");
    $keymode = "local"
     } else {      } else {
  Debug("Failed to get local key");   Debug("Failed to get local key");
  $clientok = 0;   $clientok = 0;
Line 1550  sub make_new_child { Line 1577  sub make_new_child {
  my $cipherkey = pack("H32", $key);   my $cipherkey = pack("H32", $key);
  $cipher       = new IDEA($cipherkey);   $cipher       = new IDEA($cipherkey);
  &logthis('<font color="green">'   &logthis('<font color="green">'
  ."Successfull ssl authentication </font>");   ."Successfull ssl authentication with $clientname </font>");
    $keymode = "ssl";
             
     } else {      } else {
  $clientok = 0;   $clientok = 0;
Line 1562  sub make_new_child { Line 1590  sub make_new_child {
     if($ok) {      if($ok) {
  $clientok = 1;   $clientok = 1;
  &logthis('<font color="green">'   &logthis('<font color="green">'
  ."Successful insecure authentication </font>");   ."Successful insecure authentication with $clientname </font>");
  print $client "ok\n";   print $client "ok\n";
    $keymode = "insecure";
     } else {      } else {
  &logthis('<font color="yellow">'   &logthis('<font color="yellow">'
   ."Attempted insecure connection disallowed </font>");    ."Attempted insecure connection disallowed </font>");
Line 2812  sub make_new_child { Line 2841  sub make_new_child {
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
     foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
  my ($key,$value)=split(/=/,$pair);   my ($key,$descr,$inst_code)=split(/=/,$pair);
  $hash{$key}=$value.':'.$now;   $hash{$key}=$descr.':'.$inst_code.':'.$now;
     }      }
     if (untie(%hash)) {      if (untie(%hash)) {
  print $client "ok\n";   print $client "ok\n";
Line 2848  sub make_new_child { Line 2877  sub make_new_child {
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
     while (my ($key,$value) = each(%hash)) {      while (my ($key,$value) = each(%hash)) {
  my ($descr,$lasttime)=split(/\:/,$value);                                  my ($descr,$lasttime,$inst_code);
                                   if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) {
       ($descr,$inst_code,$lasttime)=($1,$2,$3);
                                   } else {
                                       ($descr,$lasttime) = split(/\:/,$value);
                                   }
  if ($lasttime<$since) { next; }   if ($lasttime<$since) { next; }
  if ($description eq '.') {   if ($description eq '.') {
     $qresult.=$key.'='.$descr.'&';      $qresult.=$key.'='.$descr.':'.$inst_code.'&';
  } else {   } else {
     my $unescapeVal = &unescape($descr);      my $unescapeVal = &unescape($descr);
     if (eval('$unescapeVal=~/\Q$description\E/i')) {      if (eval('$unescapeVal=~/\Q$description\E/i')) {
  $qresult.="$key=$descr&";   $qresult.=$key.'='.$descr.':'.$inst_code.'&';
     }      }
  }   }
     }      }
Line 3009  sub make_new_child { Line 3043  sub make_new_child {
  Reply($client, "refused\n", $userinput);   Reply($client, "refused\n", $userinput);
             
     }      }
   # ----------------------------------------- portfolio directory list (portls)
                   } elsif ($userinput =~ /^portls/) {
                       if(isClient) {
                           my ($cmd,$uname,$udom)=split(/:/,$userinput);
                           my $udir=propath($udom,$uname).'/userfiles/portfolio';
                           my $dirLine='';
                           my $dirContents='';
                           if (opendir(LSDIR,$udir.'/')){
                               while ($dirLine = readdir(LSDIR)){
                                   $dirContents = $dirContents.$dirLine.'<br />';
                               }
                           } else {
                               $dirContents = "No directory found\n";
                           }
                           print $client $dirContents."\n";
                       } else {
                           Reply($client, "refused\n", $userinput);
                       }
 # -------------------------------------------------------------------------- ls  # -------------------------------------------------------------------------- ls
  } elsif ($userinput =~ /^ls/) {   } elsif ($userinput =~ /^ls/) {
     if(isClient) {      if(isClient) {
Line 3096  sub make_new_child { Line 3148  sub make_new_child {
  print $client "refused\n";   print $client "refused\n";
     }      }
 #------------------------------- is auto-enrollment enabled?  #------------------------------- is auto-enrollment enabled?
                 } elsif ($userinput =~/^autorun/) {                  } elsif ($userinput =~/^autorun:/) {
                     if (isClient) {                      if (isClient) {
                         my $outcome = &localenroll::run();                          my ($cmd,$cdom) = split(/:/,$userinput);
                           my $outcome = &localenroll::run($cdom);
                         print $client "$outcome\n";                          print $client "$outcome\n";
                     } else {                      } else {
                         print $client "0\n";                          print $client "0\n";
                     }                      }
 #------------------------------- get official sections (for auto-enrollment).  #------------------------------- get official sections (for auto-enrollment).
                 } elsif ($userinput =~/^autogetsections/) {                  } elsif ($userinput =~/^autogetsections:/) {
                     if (isClient) {                      if (isClient) {
                         my ($cmd,$coursecode)=split(/:/,$userinput);                          my ($cmd,$coursecode,$cdom)=split(/:/,$userinput);
                         my @secs = &localenroll::get_sections($coursecode);                          my @secs = &localenroll::get_sections($coursecode,$cdom);
                         my $seclist = &escape(join(':',@secs));                          my $seclist = &escape(join(':',@secs));
                         print $client "$seclist\n";                          print $client "$seclist\n";
                     } else {                      } else {
                         print $client "refused\n";                          print $client "refused\n";
                     }                      }
 #----------------------- validate owner of new course section (for auto-enrollment).  #----------------------- validate owner of new course section (for auto-enrollment).
                 } elsif ($userinput =~/^autonewcourse/) {                  } elsif ($userinput =~/^autonewcourse:/) {
                     if (isClient) {                      if (isClient) {
                         my ($cmd,$course_id,$owner)=split(/:/,$userinput);                          my ($cmd,$inst_course_id,$owner,$cdom)=split(/:/,$userinput);
                         my $outcome = &localenroll::new_course($course_id,$owner);                          my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
                         print $client "$outcome\n";                          print $client "$outcome\n";
                     } else {                      } else {
                         print $client "refused\n";                          print $client "refused\n";
                     }                      }
 #-------------- validate course section in schedule of classes (for auto-enrollment).  #-------------- validate course section in schedule of classes (for auto-enrollment).
                 } elsif ($userinput =~/^autovalidatecourse/) {                  } elsif ($userinput =~/^autovalidatecourse:/) {
                     if (isClient) {                      if (isClient) {
                         my ($cmd,$course_id)=split(/:/,$userinput);                          my ($cmd,$inst_course_id,$cdom)=split(/:/,$userinput);
                         my $outcome=&localenroll::validate_courseID($course_id);                          my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
                         print $client "$outcome\n";                          print $client "$outcome\n";
                     } else {                      } else {
                         print $client "refused\n";                          print $client "refused\n";
                     }                      }
 #--------------------------- create password for new user (for auto-enrollment).  #--------------------------- create password for new user (for auto-enrollment).
                 } elsif ($userinput =~/^autocreatepassword/) {                  } elsif ($userinput =~/^autocreatepassword:/) {
                     if (isClient) {                      if (isClient) {
                         my ($cmd,$authparam)=split(/:/,$userinput);                          my ($cmd,$authparam,$cdom)=split(/:/,$userinput);
                         my ($create_passwd,$authchk) = @_;                          my ($create_passwd,$authchk);
                         ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);                          ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom);
                         print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";                          print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";
                     } else {                      } else {
                         print $client "refused\n";                          print $client "refused\n";
                     }                      }
 #---------------------------  read and remove temporary files (for auto-enrollment).  #---------------------------  read and remove temporary files (for auto-enrollment).
                 } elsif ($userinput =~/^autoretrieve/) {                  } elsif ($userinput =~/^autoretrieve:/) {
                     if (isClient) {                      if (isClient) {
                         my ($cmd,$filename) = split(/:/,$userinput);                          my ($cmd,$filename) = split(/:/,$userinput);
                         my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;                          my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
Line 3167  sub make_new_child { Line 3220  sub make_new_child {
                     } else {                      } else {
                         print $client "refused\n";                          print $client "refused\n";
                     }                      }
   #---------------------  read and retrieve institutional code format (for support form).
                   } elsif ($userinput =~/^autoinstcodeformat:/) {
                       if (isClient) {
                           my $reply;
                           my($cmd,$cdom,$course) = split(/:/,$userinput);
                           my @pairs = split/\&/,$course;
                           my %instcodes = ();
                           my %codes = ();
                           my @codetitles = ();
                           my %cat_titles = ();
                           my %cat_order = ();
                           foreach (@pairs) {
                               my ($key,$value) = split/=/,$_;
                               $instcodes{&unescape($key)} = &unescape($value);
                           }
                           my $formatreply = &localenroll::instcode_format($cdom,\%instcodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
                           if ($formatreply eq 'ok') {
                               my $codes_str = &hash2str(%codes);
                               my $codetitles_str = &array2str(@codetitles);
                               my $cat_titles_str = &hash2str(%cat_titles);
                               my $cat_order_str = &hash2str(%cat_order);
                               print $client $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'.$cat_order_str."\n";
                           }
                       } else {
                           print $client "refused\n";
                       }
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
   
  } else {   } else {
Line 3175  sub make_new_child { Line 3254  sub make_new_child {
  }   }
 # -------------------------------------------------------------------- complete  # -------------------------------------------------------------------- complete
  alarm(0);   alarm(0);
  &status('Listening to '.$clientname);   &status('Listening to '.$clientname." ($keymode)");
     }      }
 # --------------------------------------------- client unknown or fishy, refuse  # --------------------------------------------- client unknown or fishy, refuse
  } else {   } else {
Line 3574  sub userload { Line 3653  sub userload {
     return $userloadpercent;      return $userloadpercent;
 }  }
   
   # Routines for serializing arrays and hashes (copies from lonnet)
   
   sub array2str {
     my (@array) = @_;
     my $result=&arrayref2str(\@array);
     $result=~s/^__ARRAY_REF__//;
     $result=~s/__END_ARRAY_REF__$//;
     return $result;
   }
                                                                                    
   sub arrayref2str {
     my ($arrayref) = @_;
     my $result='__ARRAY_REF__';
     foreach my $elem (@$arrayref) {
       if(ref($elem) eq 'ARRAY') {
         $result.=&arrayref2str($elem).'&';
       } elsif(ref($elem) eq 'HASH') {
         $result.=&hashref2str($elem).'&';
       } elsif(ref($elem)) {
         #print("Got a ref of ".(ref($elem))." skipping.");
       } else {
         $result.=&escape($elem).'&';
       }
     }
     $result=~s/\&$//;
     $result .= '__END_ARRAY_REF__';
     return $result;
   }
                                                                                    
   sub hash2str {
     my (%hash) = @_;
     my $result=&hashref2str(\%hash);
     $result=~s/^__HASH_REF__//;
     $result=~s/__END_HASH_REF__$//;
     return $result;
   }
                                                                                    
   sub hashref2str {
     my ($hashref)=@_;
     my $result='__HASH_REF__';
     foreach (sort(keys(%$hashref))) {
       if (ref($_) eq 'ARRAY') {
         $result.=&arrayref2str($_).'=';
       } elsif (ref($_) eq 'HASH') {
         $result.=&hashref2str($_).'=';
       } elsif (ref($_)) {
         $result.='=';
         #print("Got a ref of ".(ref($_))." skipping.");
       } else {
           if ($_) {$result.=&escape($_).'=';} else { last; }
       }
   
       if(ref($hashref->{$_}) eq 'ARRAY') {
         $result.=&arrayref2str($hashref->{$_}).'&';
       } elsif(ref($hashref->{$_}) eq 'HASH') {
         $result.=&hashref2str($hashref->{$_}).'&';
       } elsif(ref($hashref->{$_})) {
          $result.='&';
         #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
       } else {
         $result.=&escape($hashref->{$_}).'&';
       }
     }
     $result=~s/\&$//;
     $result .= '__END_HASH_REF__';
     return $result;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
Removed from v.1.194  
changed lines
  Added in v.1.205.2.1

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