Diff for /loncom/lond between versions 1.198 and 1.199

version 1.198, 2004/06/17 22:37:52 version 1.199, 2004/06/18 23:57:17
Line 48  use localauth; Line 48  use localauth;
 use localenroll;  use localenroll;
 use File::Copy;  use File::Copy;
 use LONCAPA::ConfigFileEdit;  use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;  
 use LONCAPA::lonssl;  
   
 my $DEBUG = 11;       # 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 62  my $currenthostid; Line 60  my $currenthostid;
 my $currentdomainid;  my $currentdomainid;
   
 my $client;  my $client;
 my $clientip; # IP address of client.  my $clientip;
 my $clientdns; # DNS name of client.  my $clientname;
 my $clientname; # LonCAPA name of client.  
   
 my $server;  my $server;
 my $thisserver; # DNS of us.  my $thisserver;
   
 my $keymode;  
   
 #   # 
 #   Connection type is:  #   Connection type is:
Line 80  my $keymode; Line 75  my $keymode;
   
 my $ConnectionType;  my $ConnectionType;
   
 my %hostid; # ID's for hosts in cluster by ip.  my %hostid;
 my %hostdom; # LonCAPA domain for hosts in cluster.  my %hostdom;
 my %hostip; # IPs for hosts in cluster.  my %hostip;
 my %hostdns; # ID's of hosts looked up by DNS name.  
   
 my %managers; # Ip -> manager names  my %managers; # Ip -> manager names
   
Line 127  my @adderrors    = ("ok", Line 121  my @adderrors    = ("ok",
     "lcuseradd Password mismatch");      "lcuseradd Password mismatch");
   
   
 #------------------------------------------------------------------------  
 #  
 #   LocalConnection  
 #     Completes the formation of a locally authenticated connection.  
 #     This function will ensure that the 'remote' client is really the  
 #     local host.  If not, the connection is closed, and the function fails.  
 #     If so, initcmd is parsed for the name of a file containing the  
 #     IDEA session key.  The fie is opened, read, deleted and the session  
 #     key returned to the caller.  
 #  
 # Parameters:  
 #   $Socket      - Socket open on client.  
 #   $initcmd     - The full text of the init command.  
 #  
 # Implicit inputs:  
 #    $clientdns  - The DNS name of the remote client.  
 #    $thisserver - Our DNS name.  
 #  
 # Returns:  
 #     IDEA session key on success.  
 #     undef on failure.  
 #  
 sub LocalConnection {  
     my ($Socket, $initcmd) = @_;  
     Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver");  
     if($clientdns ne $thisserver) {  
  &logthis('<font color="red"> LocalConnection rejecting non local: '  
  ."$clientdns ne $thisserver </font>");  
  close $Socket;  
  return undef;  
     }   
     else {  
  chomp($initcmd); # Get rid of \n in filename.  
  my ($init, $type, $name) = split(/:/, $initcmd);  
  Debug(" Init command: $init $type $name ");  
   
  # Require that $init = init, and $type = local:  Otherwise  
  # the caller is insane:  
   
  if(($init ne "init") && ($type ne "local")) {  
     &logthis('<font color = "red"> LocalConnection: caller is insane! '  
      ."init = $init, and type = $type </font>");  
     close($Socket);;  
     return undef;  
   
  }  
  #  Now get the key filename:  
   
  my $IDEAKey = lonlocal::ReadKeyFile($name);  
  return $IDEAKey;  
     }  
 }  
 #------------------------------------------------------------------------------  
 #  
 #  SSLConnection  
 #   Completes the formation of an ssh authenticated connection. The  
 #   socket is promoted to an ssl socket.  If this promotion and the associated  
 #   certificate exchange are successful, the IDEA key is generated and sent  
 #   to the remote peer via the SSL tunnel. The IDEA key is also returned to  
 #   the caller after the SSL tunnel is torn down.  
 #  
 # Parameters:  
 #   Name              Type             Purpose  
 #   $Socket          IO::Socket::INET  Plaintext socket.  
 #  
 # Returns:  
 #    IDEA key on success.  
 #    undef on failure.  
 #  
 sub SSLConnection {  
     my $Socket   = shift;  
   
     Debug("SSLConnection: ");  
     my $KeyFile         = lonssl::KeyFile();  
     if(!$KeyFile) {  
  my $err = lonssl::LastError();  
  &logthis("<font color=\"red\"> CRITICAL"  
  ."Can't get key file $err </font>");  
  return undef;  
     }  
     my ($CACertificate,  
  $Certificate) = lonssl::CertificateFile();  
   
   
     # If any of the key, certificate or certificate authority   
     # certificate filenames are not defined, this can't work.  
   
     if((!$Certificate) || (!$CACertificate)) {  
  my $err = lonssl::LastError();  
  &logthis("<font color=\"red\"> CRITICAL"  
  ."Can't get certificates: $err </font>");  
   
  return undef;  
     }  
     Debug("Key: $KeyFile CA: $CACertificate Cert: $Certificate");  
   
     # Indicate to our peer that we can procede with  
     # a transition to ssl authentication:  
   
     print $Socket "ok:ssl\n";  
   
     Debug("Approving promotion -> ssl");  
     #  And do so:  
   
     my $SSLSocket = lonssl::PromoteServerSocket($Socket,  
  $CACertificate,  
  $Certificate,  
  $KeyFile);  
     if(! ($SSLSocket) ) { # SSL socket promotion failed.  
  my $err = lonssl::LastError();  
  &logthis("<font color=\"red\"> CRITICAL "  
  ."SSL Socket promotion failed: $err </font>");  
  return undef;  
     }  
     Debug("SSL Promotion successful");  
   
     #   
     #  The only thing we'll use the socket for is to send the IDEA key  
     #  to the peer:  
   
     my $Key = lonlocal::CreateCipherKey();  
     print $SSLSocket "$Key\n";  
   
     lonssl::Close($SSLSocket);   
   
     Debug("Key exchange complete: $Key");  
   
     return $Key;  
 }  
 #  
 #     InsecureConnection:   
 #        If insecure connections are allowd,  
 #        exchange a challenge with the client to 'validate' the  
 #        client (not really, but that's the protocol):  
 #        We produce a challenge string that's sent to the client.  
 #        The client must then echo the challenge verbatim to us.  
 #  
 #  Parameter:  
 #      Socket      - Socket open on the client.  
 #  Returns:  
 #      1           - success.  
 #      0           - failure (e.g.mismatch or insecure not allowed).  
 #  
 sub InsecureConnection {  
     my $Socket  =  shift;  
   
     #   Don't even start if insecure connections are not allowed.  
   
     if(! $perlvar{londAllowInsecure}) { # Insecure connections not allowed.  
  return 0;  
     }  
   
     #   Fabricate a challenge string and send it..  
   
     my $challenge = "$$".time; # pid + time.  
     print $Socket "$challenge\n";  
     &status("Waiting for challenge reply");  
   
     my $answer = <$Socket>;  
     $answer    =~s/\W//g;  
     if($challenge eq $answer) {  
  return 1;  
     }   
     else {  
  logthis("<font color='blue'>WARNING client did not respond to challenge</font>");  
  &status("No challenge reqply");  
  return 0;  
     }  
       
   
 }  
   
 #  #
 #   GetCertificate: Given a transaction that requires a certificate,  #   GetCertificate: Given a transaction that requires a certificate,
 #   this function will extract the certificate from the transaction  #   this function will extract the certificate from the transaction
Line 529  sub InstallFile { Line 351  sub InstallFile {
   
     return 1;      return 1;
 }  }
   
   
 #  #
 #   ConfigFileFromSelector: converts a configuration file selector  #   ConfigFileFromSelector: converts a configuration file selector
 #                 (one of host or domain at this point) into a   #                 (one of host or domain at this point) into a 
Line 1044  sub HUPSMAN {                      # sig Line 864  sub HUPSMAN {                      # sig
 #  #
 #    Kill off hashes that describe the host table prior to re-reading it.  #    Kill off hashes that describe the host table prior to re-reading it.
 #    Hashes affected are:  #    Hashes affected are:
 #       %hostid, %hostdom %hostip %hostdns.  #       %hostid, %hostdom %hostip
 #  #
 sub KillHostHashes {  sub KillHostHashes {
     foreach my $key (keys %hostid) {      foreach my $key (keys %hostid) {
Line 1056  sub KillHostHashes { Line 876  sub KillHostHashes {
     foreach my $key (keys %hostip) {      foreach my $key (keys %hostip) {
  delete $hostip{$key};   delete $hostip{$key};
     }      }
     foreach my $key (keys %hostdns) {  
  delete $hostdns{$key};  
     }  
 }  }
 #  #
 #   Read in the host table from file and distribute it into the various hashes:  #   Read in the host table from file and distribute it into the various hashes:
Line 1069  sub KillHostHashes { Line 886  sub KillHostHashes {
 sub ReadHostTable {  sub ReadHostTable {
   
     open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";      open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     my $myloncapaname = $perlvar{'lonHostID'};      
     Debug("My loncapa name is : $myloncapaname");  
     while (my $configline=<CONFIG>) {      while (my $configline=<CONFIG>) {
  if (!($configline =~ /^\s*\#/)) {   if (!($configline =~ /^\s*\#/)) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
     chomp($ip); $ip=~s/\D+$//;      chomp($ip); $ip=~s/\D+$//;
     $hostid{$ip}=$id;         # LonCAPA name of host by IP.      $hostid{$ip}=$id;
     $hostdom{$id}=$domain;    # LonCAPA domain name of host.       $hostdom{$id}=$domain;
     $hostip{$id}=$ip;      # IP address of host.      $hostip{$id}=$ip;
     $hostdns{$name} = $id;    # LonCAPA name of host by DNS.      if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
   
     if ($id eq $perlvar{'lonHostID'}) {   
  Debug("Found me in the host table: $name");  
  $thisserver=$name;   
     }  
  }   }
     }      }
     close(CONFIG);      close(CONFIG);
Line 1219  sub logstatus { Line 1030  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".$clientname."\t".$currenthostid."\t"      print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
  .$status."\t".$lastlog."\t $keymode\n";  
     $fh->close();      $fh->close();
     }      }
     &status("Finished londstatus.txt");      &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."\n$keymode";          print $fh $status."\n".$lastlog."\n".time;
         $fh->close();          $fh->close();
     }      }
     &status("Finished logging");      &status("Finished logging");
Line 1455  sub make_new_child { Line 1265  sub make_new_child {
  &logthis("Unable to determine who caller was, getpeername returned nothing");   &logthis("Unable to determine who caller was, getpeername returned nothing");
     }      }
     if (defined($iaddr)) {      if (defined($iaddr)) {
  $clientip  = inet_ntoa($iaddr);   $clientip=inet_ntoa($iaddr);
  Debug("Connected with $clientip");  
  $clientdns = gethostbyaddr($iaddr, AF_INET);  
  Debug("Connected with $clientdns by name");  
     } else {      } else {
  &logthis("Unable to determine clientip");   &logthis("Unable to determine clinetip");
  $clientip='Unavailable';   $clientip='Unavailable';
     }      }
           
Line 1494  sub make_new_child { Line 1301  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
  # see if we know client and 'check' for spoof IP by ineffective challenge   # see if we know client and check for spoof IP by challenge
   
  ReadManagerTable; # May also be a manager!!   ReadManagerTable; # May also be a manager!!
   
Line 1512  sub make_new_child { Line 1319  sub make_new_child {
     $clientname = $managers{$clientip};      $clientname = $managers{$clientip};
  }   }
  my $clientok;   my $clientok;
   
  if ($clientrec || $ismanager) {   if ($clientrec || $ismanager) {
     &status("Waiting for init from $clientip $clientname");      &status("Waiting for init from $clientip $clientname");
     &logthis('<font color="yellow">INFO: Connection, '.      &logthis('<font color="yellow">INFO: Connection, '.
Line 1520  sub make_new_child { Line 1326  sub make_new_child {
   " ($clientname) connection type = $ConnectionType </font>" );    " ($clientname) connection type = $ConnectionType </font>" );
     &status("Connecting $clientip  ($clientname))");       &status("Connecting $clientip  ($clientname))"); 
     my $remotereq=<$client>;      my $remotereq=<$client>;
     chomp($remotereq);      $remotereq=~s/[^\w:]//g;
     Debug("Got init: $remotereq");  
     my $inikeyword = split(/:/, $remotereq);  
     if ($remotereq =~ /^init/) {      if ($remotereq =~ /^init/) {
  &sethost("sethost:$perlvar{'lonHostID'}");   &sethost("sethost:$perlvar{'lonHostID'}");
  #   my $challenge="$$".time;
  #  If the remote is attempting a local init... give that a try:   print $client "$challenge\n";
  #   &status(
  my ($i, $inittype) = split(/:/, $remotereq);   "Waiting for challenge reply from $clientip ($clientname)"); 
    $remotereq=<$client>;
  # If the connection type is ssl, but I didn't get my   $remotereq=~s/\W//g;
  # certificate files yet, then I'll drop  back to    if ($challenge eq $remotereq) {
  # insecure (if allowed).      $clientok=1;
       print $client "ok\n";
  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") {  
     my $key = LocalConnection($client, $remotereq);  
     if($key) {  
  Debug("Got local key $key");  
  $clientok     = 1;  
  my $cipherkey = pack("H32", $key);  
  $cipher       = new IDEA($cipherkey);  
  print $client "ok:local\n";  
  &logthis('<font color="green"'  
  . "Successful local authentication </font>");  
  $keymode = "local"  
     } else {  
  Debug("Failed to get local key");  
  $clientok = 0;  
  shutdown($client, 3);  
  close $client;  
     }  
  } elsif ($inittype eq "ssl") {  
     my $key = SSLConnection($client);  
     if ($key) {  
  $clientok = 1;  
  my $cipherkey = pack("H32", $key);  
  $cipher       = new IDEA($cipherkey);  
  &logthis('<font color="green">'  
  ."Successfull ssl authentication with $clientname </font>");  
  $keymode = "ssl";  
        
     } else {  
  $clientok = 0;  
  close $client;  
     }  
      
  } else {   } else {
     my $ok = InsecureConnection($client);      &logthis(
     if($ok) {       "<font color='blue'>WARNING: $clientip did not reply challenge</font>");
  $clientok = 1;      &status('No challenge reply '.$clientip);
  &logthis('<font color="green">'  
  ."Successful insecure authentication with $clientname </font>");  
  print $client "ok\n";  
  $keymode = "insecure";  
     } else {  
  &logthis('<font color="yellow">'  
   ."Attempted insecure connection disallowed </font>");  
  close $client;  
  $clientok = 0;  
   
     }  
  }   }
     } else {      } else {
  &logthis(   &logthis(
Line 1602  sub make_new_child { Line 1349  sub make_new_child {
  ."$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) {
 # ---------------- New known client connecting, could mean machine online again  # ---------------- New known client connecting, could mean machine online again
           
Line 3033  sub make_new_child { Line 2778  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 3120  sub make_new_child { Line 2884  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 ($cmd,$cdom) = split(/:/,$userinput);                          my $outcome = &localenroll::run();
                         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,$cdom)=split(/:/,$userinput);                          my ($cmd,$coursecode)=split(/:/,$userinput);
                         my @secs = &localenroll::get_sections($coursecode,$cdom);                          my @secs = &localenroll::get_sections($coursecode);
                         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,$inst_course_id,$owner,$cdom)=split(/:/,$userinput);                          my ($cmd,$course_id,$owner)=split(/:/,$userinput);
                         my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);                          my $outcome = &localenroll::new_course($course_id,$owner);
                         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,$inst_course_id,$cdom)=split(/:/,$userinput);                          my ($cmd,$course_id)=split(/:/,$userinput);
                         my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);                          my $outcome=&localenroll::validate_courseID($course_id);
                         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,$cdom)=split(/:/,$userinput);                          my ($cmd,$authparam)=split(/:/,$userinput);
                         my ($create_passwd,$authchk);                          my ($create_passwd,$authchk) = @_;
                         ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom);                          ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
                         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 3200  sub make_new_child { Line 2963  sub make_new_child {
  }   }
 # -------------------------------------------------------------------- complete  # -------------------------------------------------------------------- complete
  alarm(0);   alarm(0);
  &status('Listening to '.$clientname." ($keymode)");   &status('Listening to '.$clientname);
     }      }
 # --------------------------------------------- client unknown or fishy, refuse  # --------------------------------------------- client unknown or fishy, refuse
  } else {   } else {
Line 3559  sub sethost { Line 3322  sub sethost {
     my (undef,$hostid)=split(/:/,$remotereq);      my (undef,$hostid)=split(/:/,$remotereq);
     if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }      if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
     if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {      if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
  $currenthostid  =$hostid;   $currenthostid=$hostid;
  $currentdomainid=$hostdom{$hostid};   $currentdomainid=$hostdom{$hostid};
  &logthis("Setting hostid to $hostid, and domain to $currentdomainid");   &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {      } else {
Line 3599  sub userload { Line 3362  sub userload {
     return $userloadpercent;      return $userloadpercent;
 }  }
   
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME

Removed from v.1.198  
changed lines
  Added in v.1.199


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