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

Diff for /loncom/lond between versions 1.195 and 1.199

version 1.195, 2004/06/17 10:15:46 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 = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
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;
   
 #   # 
 #   Connection type is:  #   Connection type is:
Line 78  my $thisserver;   # DNS of us. Line 75  my $thisserver;   # DNS of us.
   
 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 125  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 527  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 1042  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 1054  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 1067  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 1217  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."\n";  
     $fh->close();      $fh->close();
     }      }
     &status("Finished londstatus.txt");      &status("Finished londstatus.txt");
Line 1453  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 1492  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 1510  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 1518  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)"); 
  if($inittype eq "local") {   $remotereq=<$client>;
     my $key = LocalConnection($client, $remotereq);   $remotereq=~s/\W//g;
     if($key) {   if ($challenge eq $remotereq) {
  Debug("Got local key $key");      $clientok=1;
  $clientok     = 1;      print $client "ok\n";
  my $cipherkey = pack("H32", $key);  
  $cipher       = new IDEA($cipherkey);  
  print $client "ok:local\n";  
  &logthis('<font color="green"'  
  . "Successful local authentication </font>");  
     } 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 </font>");  
        
     } 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 </font>");  
  print $client "ok\n";  
     } else {  
  &logthis('<font color="yellow">'  
   ."Attempted insecure connection disallowed </font>");  
  close $client;  
  $clientok = 0;  
   
     }  
  }   }
     } else {      } else {
  &logthis(   &logthis(
Line 1578  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 3009  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 3534  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 3574  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.195  
changed lines
  Added in v.1.199

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