--- loncom/lond	2004/09/03 10:13:59	1.248
+++ loncom/lond	2004/09/14 10:27:22	1.254
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.248 2004/09/03 10:13:59 foxr Exp $
+# $Id: lond,v 1.254 2004/09/14 10:27:22 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.248 $'; #' stupid emacs
+my $VERSION='$Revision: 1.254 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -331,8 +331,43 @@ sub InsecureConnection {
     
 
 }
-
 #
+#   Safely execute a command (as long as it's not a shel command and doesn
+#   not require/rely on shell escapes.   The function operates by doing a
+#   a pipe based fork and capturing stdout and stderr  from the pipe.
+#
+# Formal Parameters:
+#     $line                    - A line of text to be executed as a command.
+# Returns:
+#     The output from that command.  If the output is multiline the caller
+#     must know how to split up the output.
+#
+#
+sub execute_command {
+    my ($line)    = @_;
+    my @words     = split(/\s/, $line);	# Bust the command up into words.
+    my $output    = "";
+
+    my $pid = open(CHILD, "-|");
+    
+    if($pid) {			# Parent process
+	Debug("In parent process for execute_command");
+	my @data = <CHILD>;	# Read the child's outupt...
+	close CHILD;
+	foreach my $output_line (@data) {
+	    Debug("Adding $output_line");
+	    $output .= $output_line; # Presumably has a \n on it.
+	}
+
+    } else {			# Child process
+	close (STDERR);
+	open  (STDERR, ">&STDOUT");# Combine stderr, and stdout...
+	exec(@words);		# won't return.
+    }
+    return $output;
+}
+
+
 #   GetCertificate: Given a transaction that requires a certificate,
 #   this function will extract the certificate from the transaction
 #   request.  Note that at this point, the only concept of a certificate
@@ -1013,7 +1048,7 @@ sub tie_user_hash {
 	   $how, 0640)) {
 	# If this is a namespace for which a history is kept,
 	# make the history log entry:    
-	if (($namespace =~/^nohist\_/) && (defined($loghead))) {
+	if (($namespace !~/^nohist\_/) && (defined($loghead))) {
 	    my $args = scalar @_;
 	    Debug(" Opening history: $namespace $args");
 	    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
@@ -1302,13 +1337,33 @@ sub push_file_handler {
 
 sub du_handler {
     my ($cmd, $ududir, $client) = @_;
+    my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
+    my $userinput = "$cmd:$ududir";
+
     if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) {
 	&Failure($client,"refused\n","$cmd:$ududir");
 	return 1;
     }
-    my $duout = `du -ks $ududir 2>/dev/null`;
-    $duout=~s/[^\d]//g; #preserve only the numbers
-    &Reply($client,"$duout\n","$cmd:$ududir");
+    #  Since $ududir could have some nasties in it,
+    #  we will require that ududir is a valid
+    #  directory.  Just in case someone tries to
+    #  slip us a  line like .;(cd /home/httpd rm -rf*)
+    #  etc.
+    #
+    if (-d $ududir) {
+	#  And as Shakespeare would say to make
+	#  assurance double sure, 
+	# use execute_command to ensure that the command is not executed in
+	# a shell that can screw us up.
+
+	my $duout = execute_command("du -ks $ududir");
+	$duout=~s/[^\d]//g; #preserve only the numbers
+	&Reply($client,"$duout\n","$cmd:$ududir");
+    } else {
+
+	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); 
+
+    }
     return 1;
 }
 &register_handler("du", \&du_handler, 0, 1, 0);
@@ -1370,7 +1425,7 @@ sub ls_handler {
 	$ulsout='no_such_dir';
     }
     if ($ulsout eq '') { $ulsout='empty'; }
-    print $client "$ulsout\n";
+    &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
     
     return 1;
 
@@ -1712,7 +1767,7 @@ sub change_authentication_handler {
 	    my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
 	    &Reply($client, $result, $userinput);
 	} else {	       
-	    &Failure($client, "non_authorized", $userinput); # Fail the user now.
+	    &Failure($client, "non_authorized\n", $userinput); # Fail the user now.
 	}
     }
     return 1;
@@ -1939,12 +1994,19 @@ sub remove_user_file_handler {
 	if (-e $udir) {
 	    my $file=$udir.'/userfiles/'.$ufile;
 	    if (-e $file) {
+		#
+		#   If the file is a regular file unlink is fine...
+		#   However it's possible the client wants a dir.
+		#   removed, in which case rmdir is more approprate:
+		#
 	        if (-f $file){
 		    unlink($file);
 		} elsif(-d $file) {
 		    rmdir($file);
 		}
 		if (-e $file) {
+		    #  File is still there after we deleted it ?!?
+
 		    &Failure($client, "failed\n", "$cmd:$tail");
 		} else {
 		    &Reply($client, "ok\n", "$cmd:$tail");
@@ -2063,14 +2125,14 @@ sub token_auth_user_file_handler {
     my ($fname, $session) = split(/:/, $tail);
     
     chomp($session);
-    my $reply='non_auth';
+    my $reply="non_auth\n";
     if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
 	     $session.'.id')) {
 	while (my $line=<ENVIN>) {
-	    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
+	    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; }
 	}
 	close(ENVIN);
-	&Reply($client, $reply);
+	&Reply($client, $reply, "$cmd:$tail");
     } else {
 	&Failure($client, "invalid_token\n", "$cmd:$tail");
     }
@@ -3069,21 +3131,22 @@ sub put_course_id_handler {
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {
 	foreach my $pair (@pairs) {
-	    my ($key,$value)=split(/=/,$pair);
-	    $hashref->{$key}=$value.':'.$now;
+	    my ($key,$descr,$inst_code)=split(/=/,$pair);
+	    $hashref->{$key}=$descr.':'.$inst_code.':'.$now;
 	}
 	if (untie(%$hashref)) {
-	    &Reply($client, "ok\n", $userinput);
+	    &Reply( $client, "ok\n", $userinput);
 	} else {
-	    &Failure( $client, "error: ".($!+0)
+	    &Failure($client, "error: ".($!+0)
 		     ." untie(GDBM) Failed ".
 		     "while attempting courseidput\n", $userinput);
 	}
     } else {
-	&Failure( $client, "error: ".($!+0)
+	&Failure($client, "error: ".($!+0)
 		 ." tie(GDBM) Failed ".
 		 "while attempting courseidput\n", $userinput);
     }
+    
 
     return 1;
 }
@@ -3736,6 +3799,41 @@ sub get_institutional_code_format_handle
 		  0,1,0);
 
 #
+#    Portofolio directory list:
+#
+# Parameters:
+#    cmd     - Command request that got us called.
+#    tail    - the remainder of the command line.  In this case this is a colon
+#              separated list containing the username and domain.
+#              used to locate their portfolio.
+#    client  - Socket openon the client.
+# Returns:
+#    1 indicating processing should continue.
+#
+sub list_portfolio {
+    my ($cmd, $tail, $client) = @_;
+    my ($uname, $udom)        = split(/:/, $tail);
+    my $userinput             = "$cmd:$tail";
+    
+    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";
+    }
+    &Reply( $client, $dirContents."\n", $userinput);
+    
+
+
+    return 1;
+}
+&register_handler("portls", \&list_portfolio, 0,1,0);
+
+#
 #
 #
 #
@@ -3781,7 +3879,7 @@ sub process_request {
 	$userinput = decipher($userinput);
 	$wasenc=1;
 	if(!$userinput) {	# Cipher not defined.
-	    &Failure($client, "error: Encrypted data without negotated key");
+	    &Failure($client, "error: Encrypted data without negotated key\n");
 	    return 0;
 	}
     }
@@ -4989,7 +5087,8 @@ sub validate_user {
     # At the end of this function. I'll ensure that it's not still that
     # value so we don't just wind up returning some accidental value
     # as a result of executing an unforseen code path that
-    # did not set $validated.
+    # did not set $validated.  At the end of valid execution paths,
+    # validated shoule be 1 for success or 0 for failuer.
 
     my $validated = -3.14159;
 
@@ -5077,7 +5176,11 @@ sub validate_user {
     #
 
     unless ($validated != -3.14159) {
-	die "ValidateUser - failed to set the value of validated";
+	#  I >really really< want to know if this happens.
+	#  since it indicates that user authentication is badly
+	#  broken in some code path.
+        #
+	die "ValidateUser - failed to set the value of validated $domain, $user $password";
     }
     return $validated;
 }