[LON-CAPA-cvs] cvs: loncom / lond

banghart lon-capa-cvs@mail.lon-capa.org
Fri, 18 Jun 2004 23:57:17 -0000


This is a MIME encoded message

--banghart1087603037
Content-Type: text/plain

banghart		Fri Jun 18 19:57:17 2004 EDT

  Modified files:              
    /loncom	lond 
  Log:
  
  	added /^portls/ conditional to return portfolio directory listing
  	username/userfiles/portfolio/ 
  
  
--banghart1087603037
Content-Type: text/plain
Content-Disposition: attachment; filename="banghart-20040618195717.txt"

Index: loncom/lond
diff -u loncom/lond:1.198 loncom/lond:1.199
--- loncom/lond:1.198	Thu Jun 17 18:37:52 2004
+++ loncom/lond	Fri Jun 18 19:57:17 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.198 2004/06/17 22:37:52 foxr Exp $
+# $Id: lond,v 1.199 2004/06/18 23:57:17 banghart Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -48,28 +48,23 @@
 use localenroll;
 use File::Copy;
 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 $lastlog='';
 
-my $VERSION='$Revision: 1.198 $'; #' 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 $keymode;
+my $thisserver;
 
 # 
 #   Connection type is:
@@ -80,10 +75,9 @@
 
 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
 
@@ -127,178 +121,6 @@
 		    "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
@@ -529,8 +351,6 @@
 
     return 1;
 }
-
-
 #
 #   ConfigFileFromSelector: converts a configuration file selector
 #                 (one of host or domain at this point) into a 
@@ -1044,7 +864,7 @@
 #
 #    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) {
@@ -1056,9 +876,6 @@
     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:
@@ -1069,21 +886,15 @@
 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);
@@ -1219,14 +1030,13 @@
     my $docdir=$perlvar{'lonDocRoot'};
     {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
-    print $fh $$."\t".$clientname."\t".$currenthostid."\t"
-	.$status."\t".$lastlog."\t $keymode\n";
+    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");
-        print $fh $status."\n".$lastlog."\n".time."\n$keymode";
+        print $fh $status."\n".$lastlog."\n".time;
         $fh->close();
     }
     &status("Finished logging");
@@ -1455,12 +1265,9 @@
 	&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';
     }
     
@@ -1494,7 +1301,7 @@
 # =============================================================================
             # 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!!
 	
@@ -1512,7 +1319,6 @@
 	    $clientname = $managers{$clientip};
 	}
 	my $clientok;
-
 	if ($clientrec || $ismanager) {
 	    &status("Waiting for init from $clientip $clientname");
 	    &logthis('<font color="yellow">INFO: Connection, '.
@@ -1520,81 +1326,22 @@
 		  " ($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 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") {
-		    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;
-		    }
-	   
+		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 with $clientname </font>");
-			print $client "ok\n";
-			$keymode = "insecure";
-		    } 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(
@@ -1602,13 +1349,11 @@
 			 ."$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
 	    
@@ -3033,6 +2778,25 @@
 			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) {
@@ -3120,54 +2884,53 @@
 			print $client "refused\n";
 		    }
 #------------------------------- is auto-enrollment enabled?
-                } elsif ($userinput =~/^autorun:/) {
+                } elsif ($userinput =~/^autorun/) {
                     if (isClient) {
-                        my ($cmd,$cdom) = split(/:/,$userinput);
-                        my $outcome = &localenroll::run($cdom);
+                        my $outcome = &localenroll::run();
                         print $client "$outcome\n";
                     } else {
                         print $client "0\n";
                     }
 #------------------------------- get official sections (for auto-enrollment).
-                } elsif ($userinput =~/^autogetsections:/) {
+                } elsif ($userinput =~/^autogetsections/) {
                     if (isClient) {
-                        my ($cmd,$coursecode,$cdom)=split(/:/,$userinput);
-                        my @secs = &localenroll::get_sections($coursecode,$cdom);
+                        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:/) {
+                } elsif ($userinput =~/^autonewcourse/) {
                     if (isClient) {
-                        my ($cmd,$inst_course_id,$owner,$cdom)=split(/:/,$userinput);
-                        my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
+                        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:/) {
+                } elsif ($userinput =~/^autovalidatecourse/) {
                     if (isClient) {
-                        my ($cmd,$inst_course_id,$cdom)=split(/:/,$userinput);
-                        my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
+                        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:/) {
+                } elsif ($userinput =~/^autocreatepassword/) {
                     if (isClient) {
-                        my ($cmd,$authparam,$cdom)=split(/:/,$userinput);
-                        my ($create_passwd,$authchk);
-                        ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam,$cdom);
+                        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:/) {
+                } elsif ($userinput =~/^autoretrieve/) {
                     if (isClient) {
                         my ($cmd,$filename) = split(/:/,$userinput);
                         my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
@@ -3200,7 +2963,7 @@
 		}
 # -------------------------------------------------------------------- complete
 		alarm(0);
-		&status('Listening to '.$clientname." ($keymode)");
+		&status('Listening to '.$clientname);
 	    }
 # --------------------------------------------- client unknown or fishy, refuse
 	} else {
@@ -3559,7 +3322,7 @@
     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 {
@@ -3599,7 +3362,6 @@
     return $userloadpercent;
 }
 
-
 # ----------------------------------- POD (plain old documentation, CPAN style)
 
 =head1 NAME

--banghart1087603037--