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

Diff for /loncom/lond between versions 1.188 and 1.193

version 1.188, 2004/04/29 10:24:40 version 1.193, 2004/06/08 22:09:44
Line 45  use Authen::Krb4; Line 45  use Authen::Krb4;
 use Authen::Krb5;  use Authen::Krb5;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use localauth;  use localauth;
   use localenroll;
 use File::Copy;  use File::Copy;
 use LONCAPA::ConfigFileEdit;  use LONCAPA::ConfigFileEdit;
   
Line 225  sub ValidManager { Line 226  sub ValidManager {
 #     1   - Success.  #     1   - Success.
 #  #
 sub CopyFile {  sub CopyFile {
     my $oldfile = shift;  
     my $newfile = shift;      my ($oldfile, $newfile) = @_;
   
     #  The file must exist:      #  The file must exist:
   
Line 326  sub AdjustHostContents { Line 327  sub AdjustHostContents {
 #      0       - failure and $! has an errno.  #      0       - failure and $! has an errno.
 #  #
 sub InstallFile {  sub InstallFile {
     my $Filename = shift;  
     my $Contents = shift;      my ($Filename, $Contents) = @_;
     my $TempFile = $Filename.".tmp";      my $TempFile = $Filename.".tmp";
   
     #  Open the file for write:      #  Open the file for write:
Line 564  sub isValidEditCommand { Line 565  sub isValidEditCommand {
 #                  file being edited.  #                  file being edited.
 #  #
 sub ApplyEdit {  sub ApplyEdit {
     my $directive   = shift;  
     my $editor      = shift;      my ($directive, $editor) = @_;
   
     # Break the directive down into its command and its parameters      # Break the directive down into its command and its parameters
     # (at most two at this point.  The meaning of the parameters, if in fact      # (at most two at this point.  The meaning of the parameters, if in fact
Line 649  sub AdjustOurHost { Line 650  sub AdjustOurHost {
 #        editor     - Editor containing the file.  #        editor     - Editor containing the file.
 #  #
 sub ReplaceConfigFile {  sub ReplaceConfigFile {
     my $filename  = shift;      
     my $editor    = shift;      my ($filename, $editor) = @_;
   
     CopyFile ($filename, $filename.".old");      CopyFile ($filename, $filename.".old");
   
Line 749  sub catchexception { Line 750  sub catchexception {
     $SIG{'QUIT'}='DEFAULT';      $SIG{'QUIT'}='DEFAULT';
     $SIG{__DIE__}='DEFAULT';      $SIG{__DIE__}='DEFAULT';
     &status("Catching exception");      &status("Catching exception");
     &logthis("<font color=red>CRITICAL: "      &logthis("<font color='red'>CRITICAL: "
      ."ABNORMAL EXIT. Child $$ for server $thisserver died through "       ."ABNORMAL EXIT. Child $$ for server $thisserver died through "
      ."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);
Line 760  sub catchexception { Line 761  sub catchexception {
   
 sub timeout {  sub timeout {
     &status("Handling Timeout");      &status("Handling Timeout");
     &logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>");      &logthis("<font color='red'>CRITICAL: TIME OUT ".$$."</font>");
     &catchexception('Timeout');      &catchexception('Timeout');
 }  }
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
Line 843  sub HUNTSMAN {                      # si Line 844  sub HUNTSMAN {                      # si
     &logthis("Free socket: ".shutdown($server,2)); # free up socket      &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>");
     &status("Done killing children");      &status("Done killing children");
     exit;                           # clean up with dignity      exit;                           # clean up with dignity
 }  }
Line 853  sub HUPSMAN {                      # sig Line 854  sub HUPSMAN {                      # sig
     &status("Killing children for restart (HUP)");      &status("Killing children for restart (HUP)");
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     &logthis("Free socket: ".shutdown($server,2)); # 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>");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lond.pid");      unlink("$execdir/logs/lond.pid");
     &status("Restarting self (HUP)");      &status("Restarting self (HUP)");
Line 1015  sub Debug { Line 1016  sub Debug {
 #     request - Original request from client.  #     request - Original request from client.
 #  #
 sub Reply {  sub Reply {
     my $fd      = shift;  
     my $reply   = shift;      my ($fd, $reply, $request) = @_;
     my $request = shift;  
   
     print $fd $reply;      print $fd $reply;
     Debug("Request was $request  Reply was $reply");      Debug("Request was $request  Reply was $reply");
Line 1095  sub reconlonc { Line 1095  sub reconlonc {
             kill USR1 => $loncpid;              kill USR1 => $loncpid;
         } else {          } else {
     &logthis(      &logthis(
               "<font color=red>CRITICAL: "                "<font color='red'>CRITICAL: "
              ."lonc at pid $loncpid not responding, giving up</font>");               ."lonc at pid $loncpid not responding, giving up</font>");
         }          }
     } else {      } else {
       &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');        &logthis('<font color="red">CRITICAL: lonc not running, giving up</font>');
     }      }
 }  }
   
Line 1203  my $execdir=$perlvar{'lonDaemons'}; Line 1203  my $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lond.pid");  open (PIDSAVE,">$execdir/logs/lond.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
 &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");  &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
 &status('Starting');  &status('Starting');
   
   
Line 1340  sub make_new_child { Line 1340  sub make_new_child {
     print $client "ok\n";      print $client "ok\n";
  } else {   } else {
     &logthis(      &logthis(
      "<font color=blue>WARNING: $clientip did not reply challenge</font>");       "<font color='blue'>WARNING: $clientip did not reply challenge</font>");
     &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>");
  &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>");
     &status('Hung up on '.$clientip);      &status('Hung up on '.$clientip);
  }   }
  if ($clientok) {   if ($clientok) {
Line 1365  sub make_new_child { Line 1365  sub make_new_child {
  }   }
  &reconlonc("$perlvar{'lonSockDir'}/$id");   &reconlonc("$perlvar{'lonSockDir'}/$id");
     }      }
     &logthis("<font color=green>Established connection: $clientname</font>");      &logthis("<font color='green'>Established connection: $clientname</font>");
     &status('Will listen to '.$clientname);      &status('Will listen to '.$clientname);
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
     while (my $userinput=<$client>) {      while (my $userinput=<$client>) {
Line 1562  sub make_new_child { Line 1562  sub make_new_child {
  $pwdcorrect=0;    $pwdcorrect=0; 
  # log error if it is not a bad password   # log error if it is not a bad password
  if ($krb4_error != 62) {   if ($krb4_error != 62) {
     &logthis('krb4:'.$uname.','.$contentpwd.','.      &logthis('krb4:'.$uname.','.
      &Authen::Krb4::get_err_txt($Authen::Krb4::error));       &Authen::Krb4::get_err_txt($Authen::Krb4::error));
  }   }
     }      }
Line 2533  sub make_new_child { Line 2533  sub make_new_child {
     }      }
 # ------------------------------------------------------------------- querysend  # ------------------------------------------------------------------- querysend
  } elsif ($userinput =~ /^querysend/) {   } elsif ($userinput =~ /^querysend/) {
     if(isClient) {      if (isClient) {
  my ($cmd,$query,   my ($cmd,$query,
     $arg1,$arg2,$arg3)=split(/\:/,$userinput);      $arg1,$arg2,$arg3)=split(/\:/,$userinput);
  $query=~s/\n*$//g;   $query=~s/\n*$//g;
Line 2623  sub make_new_child { Line 2623  sub make_new_child {
     $qresult.=$key.'='.$descr.'&';      $qresult.=$key.'='.$descr.'&';
  } else {   } else {
     my $unescapeVal = &unescape($descr);      my $unescapeVal = &unescape($descr);
     if (eval('$unescapeVal=~/$description/i')) {      if (eval('$unescapeVal=~/\Q$description\E/i')) {
  $qresult.="$key=$descr&";   $qresult.="$key=$descr&";
     }      }
  }   }
Line 2864  sub make_new_child { Line 2864  sub make_new_child {
     } else {      } else {
  print $client "refused\n";   print $client "refused\n";
     }      }
   #------------------------------- is auto-enrollment enabled?
                   } elsif ($userinput =~/^autorun/) {
                       if (isClient) {
                           my $outcome = &localenroll::run();
                           print $client "$outcome\n";
                       } else {
                           print $client "0\n";
                       }
   #------------------------------- get official sections (for auto-enrollment).
                   } elsif ($userinput =~/^autogetsections/) {
                       if (isClient) {
                           my ($cmd,$coursecode)=split(/:/,$userinput);
                           my @secs = &localenroll::get_sections($coursecode);
                           my $seclist = &escape(join(':',@secs));
                           print $client "$seclist\n";
                       } else {
                           print $client "refused\n";
                       }
   #----------------------- validate owner of new course section (for auto-enrollment).
                   } elsif ($userinput =~/^autonewcourse/) {
                       if (isClient) {
                           my ($cmd,$course_id,$owner)=split(/:/,$userinput);
                           my $outcome = &localenroll::new_course($course_id,$owner);
                           print $client "$outcome\n";
                       } else {
                           print $client "refused\n";
                       }
   #-------------- validate course section in schedule of classes (for auto-enrollment).
                   } elsif ($userinput =~/^autovalidatecourse/) {
                       if (isClient) {
                           my ($cmd,$course_id)=split(/:/,$userinput);
                           my $outcome=&localenroll::validate_courseID($course_id);
                           print $client "$outcome\n";
                       } else {
                           print $client "refused\n";
                       }
   #--------------------------- create password for new user (for auto-enrollment).
                   } elsif ($userinput =~/^autocreatepassword/) {
                       if (isClient) {
                           my ($cmd,$authparam)=split(/:/,$userinput);
                           my ($create_passwd,$authchk) = @_;
                           ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
                           print $client &escape($authparam.':'.$create_passwd.':'.$authchk)."\n";
                       } else {
                           print $client "refused\n";
                       }
   #---------------------------  read and remove temporary files (for auto-enrollment).
                   } elsif ($userinput =~/^autoretrieve/) {
                       if (isClient) {
                           my ($cmd,$filename) = split(/:/,$userinput);
                           my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
                           if ( (-e $source) && ($filename ne '') ) {
                               my $reply = '';
                               if (open(my $fh,$source)) {
                                   while (<$fh>) {
                                       chomp($_);
                                       $_ =~ s/^\s+//g;
                                       $_ =~ s/\s+$//g;
                                       $reply .= $_;
                                   }
                                   close($fh);
                                   print $client &escape($reply)."\n";
   #                                unlink($source);
                               } else {
                                   print $client "error\n";
                               }
                           } else {
                               print $client "error\n";
                           }
                       } else {
                           print $client "refused\n";
                       }
 # ------------------------------------------------------------- unknown command  # ------------------------------------------------------------- unknown command
   
  } else {   } else {
Line 2878  sub make_new_child { Line 2950  sub make_new_child {
  } else {   } else {
     print $client "refused\n";      print $client "refused\n";
     $client->close();      $client->close();
     &logthis("<font color=blue>WARNING: "      &logthis("<font color='blue'>WARNING: "
      ."Rejected client $clientip, closing connection</font>");       ."Rejected client $clientip, closing connection</font>");
  }   }
     }                   }             
           
 # =============================================================================  # =============================================================================
           
     &logthis("<font color=red>CRITICAL: "      &logthis("<font color='red'>CRITICAL: "
      ."Disconnect from $clientip ($clientname)</font>");           ."Disconnect from $clientip ($clientname)</font>");    
           
           
Line 2910  sub make_new_child { Line 2982  sub make_new_child {
 #  #
 sub ManagePermissions  sub ManagePermissions
 {  {
     my $request = shift;  
     my $domain  = shift;      my ($request, $domain, $user, $authtype) = @_;
     my $user    = shift;  
     my $authtype= shift;  
   
     # See if the request is of the form /$domain/_au      # See if the request is of the form /$domain/_au
     if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...      if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
Line 2930  sub ManagePermissions Line 3000  sub ManagePermissions
 #  #
 sub GetAuthType   sub GetAuthType 
 {  {
     my $domain = shift;  
     my $user   = shift;      my ($domain, $user)  = @_;
   
     Debug("GetAuthType( $domain, $user ) \n");      Debug("GetAuthType( $domain, $user ) \n");
     my $proname    = &propath($domain, $user);       my $proname    = &propath($domain, $user); 
Removed from v.1.188  
changed lines
  Added in v.1.193

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