--- loncom/lond 2004/06/17 10:15:46 1.195
+++ loncom/lond 2004/06/18 23:57:17 1.199
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.195 2004/06/17 10:15:46 foxr Exp $
+# $Id: lond,v 1.199 2004/06/18 23:57:17 banghart Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,26 +48,23 @@ use localauth;
use localenroll;
use File::Copy;
use LONCAPA::ConfigFileEdit;
-use LONCAPA::lonlocal;
-use LONCAPA::lonssl;
my $DEBUG = 0; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.195 $'; #' stupid emacs
+my $VERSION='$Revision: 1.199 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
my $client;
-my $clientip; # IP address of client.
-my $clientdns; # DNS name of client.
-my $clientname; # LonCAPA name of client.
+my $clientip;
+my $clientname;
my $server;
-my $thisserver; # DNS of us.
+my $thisserver;
#
# Connection type is:
@@ -78,10 +75,9 @@ my $thisserver; # DNS of us.
my $ConnectionType;
-my %hostid; # ID's for hosts in cluster by ip.
-my %hostdom; # LonCAPA domain for hosts in cluster.
-my %hostip; # IPs for hosts in cluster.
-my %hostdns; # ID's of hosts looked up by DNS name.
+my %hostid;
+my %hostdom;
+my %hostip;
my %managers; # Ip -> manager names
@@ -125,178 +121,6 @@ my @adderrors = ("ok",
"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,
# this function will extract the certificate from the transaction
@@ -527,8 +351,6 @@ sub InstallFile {
return 1;
}
-
-
#
# ConfigFileFromSelector: converts a configuration file selector
# (one of host or domain at this point) into a
@@ -1042,7 +864,7 @@ sub HUPSMAN { # sig
#
# Kill off hashes that describe the host table prior to re-reading it.
# Hashes affected are:
-# %hostid, %hostdom %hostip %hostdns.
+# %hostid, %hostdom %hostip
#
sub KillHostHashes {
foreach my $key (keys %hostid) {
@@ -1054,9 +876,6 @@ sub KillHostHashes {
foreach my $key (keys %hostip) {
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:
@@ -1067,21 +886,15 @@ sub KillHostHashes {
sub ReadHostTable {
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>) {
if (!($configline =~ /^\s*\#/)) {
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
chomp($ip); $ip=~s/\D+$//;
- $hostid{$ip}=$id; # LonCAPA name of host by IP.
- $hostdom{$id}=$domain; # LonCAPA domain name of host.
- $hostip{$id}=$ip; # IP address of host.
- $hostdns{$name} = $id; # LonCAPA name of host by DNS.
-
- if ($id eq $perlvar{'lonHostID'}) {
- Debug("Found me in the host table: $name");
- $thisserver=$name;
- }
+ $hostid{$ip}=$id;
+ $hostdom{$id}=$domain;
+ $hostip{$id}=$ip;
+ if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
}
}
close(CONFIG);
@@ -1217,8 +1030,7 @@ sub logstatus {
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";
+ print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
$fh->close();
}
&status("Finished londstatus.txt");
@@ -1453,12 +1265,9 @@ sub make_new_child {
&logthis("Unable to determine who caller was, getpeername returned nothing");
}
if (defined($iaddr)) {
- $clientip = inet_ntoa($iaddr);
- Debug("Connected with $clientip");
- $clientdns = gethostbyaddr($iaddr, AF_INET);
- Debug("Connected with $clientdns by name");
+ $clientip=inet_ntoa($iaddr);
} else {
- &logthis("Unable to determine clientip");
+ &logthis("Unable to determine clinetip");
$clientip='Unavailable';
}
@@ -1492,7 +1301,7 @@ sub make_new_child {
# =============================================================================
# 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!!
@@ -1510,7 +1319,6 @@ sub make_new_child {
$clientname = $managers{$clientip};
}
my $clientok;
-
if ($clientrec || $ismanager) {
&status("Waiting for init from $clientip $clientname");
&logthis('<font color="yellow">INFO: Connection, '.
@@ -1518,59 +1326,22 @@ sub make_new_child {
" ($clientname) connection type = $ConnectionType </font>" );
&status("Connecting $clientip ($clientname))");
my $remotereq=<$client>;
- chomp($remotereq);
- Debug("Got init: $remotereq");
- my $inikeyword = split(/:/, $remotereq);
+ $remotereq=~s/[^\w:]//g;
if ($remotereq =~ /^init/) {
&sethost("sethost:$perlvar{'lonHostID'}");
- #
- # If the remote is attempting a local init... give that a try:
- #
- my ($i, $inittype) = split(/:/, $remotereq);
- 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>");
- } 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;
- }
-
+ my $challenge="$$".time;
+ print $client "$challenge\n";
+ &status(
+ "Waiting for challenge reply from $clientip ($clientname)");
+ $remotereq=<$client>;
+ $remotereq=~s/\W//g;
+ if ($challenge eq $remotereq) {
+ $clientok=1;
+ print $client "ok\n";
} else {
- my $ok = InsecureConnection($client);
- if($ok) {
- $clientok = 1;
- &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;
-
- }
+ &logthis(
+ "<font color='blue'>WARNING: $clientip did not reply challenge</font>");
+ &status('No challenge reply '.$clientip);
}
} else {
&logthis(
@@ -1578,13 +1349,11 @@ sub make_new_child {
."$clientip failed to initialize: >$remotereq< </font>");
&status('No init '.$clientip);
}
-
} else {
&logthis(
"<font color='blue'>WARNING: Unknown client $clientip</font>");
&status('Hung up on '.$clientip);
}
-
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
@@ -3009,6 +2778,25 @@ sub make_new_child {
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
} elsif ($userinput =~ /^ls/) {
if(isClient) {
@@ -3534,7 +3322,7 @@ sub sethost {
my (undef,$hostid)=split(/:/,$remotereq);
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
- $currenthostid =$hostid;
+ $currenthostid=$hostid;
$currentdomainid=$hostdom{$hostid};
&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
} else {
@@ -3574,7 +3362,6 @@ sub userload {
return $userloadpercent;
}
-
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME