--- loncom/lond	2004/07/27 11:10:47	1.214
+++ loncom/lond	2004/08/18 11:31:50	1.232
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.214 2004/07/27 11:10:47 foxr Exp $
+# $Id: lond,v 1.232 2004/08/18 11:31:50 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -50,13 +50,14 @@ use File::Copy;
 use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
+use Fcntl qw(:flock);
 
-my $DEBUG = 0;		       # Non zero to enable debug log entries.
+my $DEBUG = 1;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.214 $'; #' stupid emacs
+my $VERSION='$Revision: 1.232 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -121,8 +122,10 @@ my @passwderrors = ("ok",
 		   "lcpasswd Cannot set new passwd.",
 		   "lcpasswd Username has invalid characters",
 		   "lcpasswd Invalid characters in password",
-		    "11", "12",
-		    "lcpasswd Password mismatch");
+		   "lcpasswd User already exists", 
+                   "lcpasswd Something went wrong with user addition.",
+		    "lcpasswd Password mismatch",
+		    "lcpasswd Error filename is invalid");
 
 
 #  The array below are lcuseradd error strings.:
@@ -159,8 +162,6 @@ sub ResetStatistics {
     $Failures     = 0;
 }
 
-
-
 #------------------------------------------------------------------------
 #
 #   LocalConnection
@@ -191,8 +192,7 @@ sub LocalConnection {
 		 ."$clientdns ne $thisserver </font>");
 	close $Socket;
 	return undef;
-    } 
-    else {
+    }  else {
 	chomp($initcmd);	# Get rid of \n in filename.
 	my ($init, $type, $name) = split(/:/, $initcmd);
 	Debug(" Init command: $init $type $name ");
@@ -323,8 +323,7 @@ sub InsecureConnection {
     $answer    =~s/\W//g;
     if($challenge eq $answer) {
 	return 1;
-    } 
-    else {
+    } else {
 	logthis("<font color='blue'>WARNING client did not respond to challenge</font>");
 	&status("No challenge reqply");
 	return 0;
@@ -371,7 +370,6 @@ sub isClient {
 #                     - This allows dynamic changes to the manager table
 #                       without the need to signal to the lond.
 #
-
 sub ReadManagerTable {
 
     #   Clean out the old table first..
@@ -653,8 +651,7 @@ sub PushFile {
 	&logthis('<font color="red"> Pushfile: unable to install '
 	 .$tablefile." $! </font>");
 	return "error:$!";
-    }
-    else {
+    } else {
 	&logthis('<font color="green"> Installed new '.$tablefile
 		 ."</font>");
 
@@ -1035,9 +1032,12 @@ sub tie_user_hash {
 
 #--------------------- Request Handlers --------------------------------------------
 #
-#   By convention each request handler registers itself prior to the sub declaration:
+#   By convention each request handler registers itself prior to the sub 
+#   declaration:
 #
 
+#++
+#
 #  Handles ping requests.
 #  Parameters:
 #      $cmd    - the actual keyword that invoked us.
@@ -1062,7 +1062,1642 @@ sub ping_handler {
 }
 &register_handler("ping", \&ping_handler, 0, 1, 1);       # Ping unencoded, client or manager.
 
+#++
+#
+# Handles pong requests.  Pong replies with our current host id, and
+#                         the results of a ping sent to us via our lonc.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $replyfd- File descriptor connected to the client
+#  Implicit Inputs:
+#      $currenthostid - Global variable that carries the name of the host we are
+#                       connected to.
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit.
+#  Side effects:
+#      Reply information is sent to the client.
+
+sub pong_handler {
+    my ($cmd, $tail, $replyfd) = @_;
+
+    my $reply=&reply("ping",$clientname);
+    &Reply( $replyfd, "$currenthostid:$reply\n", "$cmd:$tail"); 
+    return 1;
+}
+&register_handler("pong", \&pong_handler, 0, 1, 1);       # Pong unencoded, client or manager
+
+#++
+#      Called to establish an encrypted session key with the remote client.
+#      Note that with secure lond, in most cases this function is never
+#      invoked.  Instead, the secure session key is established either
+#      via a local file that's locked down tight and only lives for a short
+#      time, or via an ssl tunnel...and is generated from a bunch-o-random
+#      bits from /dev/urandom, rather than the predictable pattern used by
+#      by this sub.  This sub is only used in the old-style insecure
+#      key negotiation.
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $replyfd- File descriptor connected to the client
+#  Implicit Inputs:
+#      $currenthostid - Global variable that carries the name of the host
+#                       known as.
+#      $clientname    - Global variable that carries the name of the hsot we're connected to.
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit.
+#  Implicit Outputs:
+#      Reply information is sent to the client.
+#      $cipher is set with a reference to a new IDEA encryption object.
+#
+sub establish_key_handler {
+    my ($cmd, $tail, $replyfd) = @_;
+
+    my $buildkey=time.$$.int(rand 100000);
+    $buildkey=~tr/1-6/A-F/;
+    $buildkey=int(rand 100000).$buildkey.int(rand 100000);
+    my $key=$currenthostid.$clientname;
+    $key=~tr/a-z/A-Z/;
+    $key=~tr/G-P/0-9/;
+    $key=~tr/Q-Z/0-9/;
+    $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
+    $key=substr($key,0,32);
+    my $cipherkey=pack("H32",$key);
+    $cipher=new IDEA $cipherkey;
+    &Reply($replyfd, "$buildkey\n", "$cmd:$tail"); 
+   
+    return 1;
+
+}
+&register_handler("ekey", \&establish_key_handler, 0, 1,1);
+
+
+#     Handler for the load command.  Returns the current system load average
+#     to the requestor.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $replyfd- File descriptor connected to the client
+#  Implicit Inputs:
+#      $currenthostid - Global variable that carries the name of the host
+#                       known as.
+#      $clientname    - Global variable that carries the name of the hsot we're connected to.
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit.
+#  Side effects:
+#      Reply information is sent to the client.
+sub load_handler {
+    my ($cmd, $tail, $replyfd) = @_;
+
+   # Get the load average from /proc/loadavg and calculate it as a percentage of
+   # the allowed load limit as set by the perl global variable lonLoadLim
+
+    my $loadavg;
+    my $loadfile=IO::File->new('/proc/loadavg');
+   
+    $loadavg=<$loadfile>;
+    $loadavg =~ s/\s.*//g;                      # Extract the first field only.
+   
+    my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
+
+    &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
+   
+    return 1;
+}
+register_handler("load", \&load_handler, 0, 1, 0);
+
+#
+#   Process the userload request.  This sub returns to the client the current
+#  user load average.  It can be invoked either by clients or managers.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $replyfd- File descriptor connected to the client
+#  Implicit Inputs:
+#      $currenthostid - Global variable that carries the name of the host
+#                       known as.
+#      $clientname    - Global variable that carries the name of the hsot we're connected to.
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit
+# Implicit inputs:
+#     whatever the userload() function requires.
+#  Implicit outputs:
+#     the reply is written to the client.
+#
+sub user_load_handler {
+    my ($cmd, $tail, $replyfd) = @_;
+
+    my $userloadpercent=&userload();
+    &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
+    
+    return 1;
+}
+register_handler("userload", \&user_load_handler, 0, 1, 0);
+
+#   Process a request for the authorization type of a user:
+#   (userauth).
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $replyfd- File descriptor connected to the client
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit
+# Implicit outputs:
+#    The user authorization type is written to the client.
+#
+sub user_authorization_type {
+    my ($cmd, $tail, $replyfd) = @_;
+   
+    my $userinput = "$cmd:$tail";
+   
+    #  Pull the domain and username out of the command tail.
+    # and call get_auth_type to determine the authentication type.
+   
+    my ($udom,$uname)=split(/:/,$tail);
+    my $result = &get_auth_type($udom, $uname);
+    if($result eq "nouser") {
+	&Failure( $replyfd, "unknown_user\n", $userinput);
+    } else {
+	#
+	# We only want to pass the second field from get_auth_type
+	# for ^krb.. otherwise we'll be handing out the encrypted
+	# password for internals e.g.
+	#
+	my ($type,$otherinfo) = split(/:/,$result);
+	if($type =~ /^krb/) {
+	    $type = $result;
+	}
+	&Reply( $replyfd, "$type:\n", $userinput);
+    }
+  
+    return 1;
+}
+&register_handler("currentauth", \&user_authorization_type, 1, 1, 0);
+
+#   Process a request by a manager to push a hosts or domain table 
+#   to us.  We pick apart the command and pass it on to the subs
+#   that already exist to do this.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $client - File descriptor connected to the client
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit
+# Implicit Output:
+#    a reply is written to the client.
+
+sub push_file_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    # At this time we only know that the IP of our partner is a valid manager
+    # the code below is a hook to do further authentication (e.g. to resolve
+    # spoofing).
+
+    my $cert = &GetCertificate($userinput);
+    if(&ValidManager($cert)) { 
+
+	# Now presumably we have the bona fides of both the peer host and the
+	# process making the request.
+      
+	my $reply = &PushFile($userinput);
+	&Reply($client, "$reply\n", $userinput);
+
+    } else {
+	&Failure( $client, "refused\n", $userinput);
+    } 
+    return 1;
+}
+&register_handler("pushfile", \&push_file_handler, 1, 0, 1);
+
+
+
+#   Process a reinit request.  Reinit requests that either
+#   lonc or lond be reinitialized so that an updated 
+#   host.tab or domain.tab can be processed.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $client - File descriptor connected to the client
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit
+#  Implicit output:
+#     a reply is sent to the client.
+#
+sub reinit_process_handler {
+    my ($cmd, $tail, $client) = @_;
+   
+    my $userinput = "$cmd:$tail";
+   
+    my $cert = &GetCertificate($userinput);
+    if(&ValidManager($cert)) {
+	chomp($userinput);
+	my $reply = &ReinitProcess($userinput);
+	&Reply( $client,  "$reply\n", $userinput);
+    } else {
+	&Failure( $client, "refused\n", $userinput);
+    }
+    return 1;
+}
+
+&register_handler("reinit", \&reinit_process_handler, 1, 0, 1);
+
+#  Process the editing script for a table edit operation.
+#  the editing operation must be encrypted and requested by
+#  a manager host.
+#
+# Parameters:
+#      $cmd    - the actual keyword that invoked us.
+#      $tail   - the tail of the request that invoked us.
+#      $client - File descriptor connected to the client
+#  Returns:
+#      1       - Ok to continue processing.
+#      0       - Program should exit
+#  Implicit output:
+#     a reply is sent to the client.
+#
+sub edit_table_handler {
+    my ($command, $tail, $client) = @_;
+   
+    my $userinput = "$command:$tail";
+
+    my $cert = &GetCertificate($userinput);
+    if(&ValidManager($cert)) {
+	my($filetype, $script) = split(/:/, $tail);
+	if (($filetype eq "hosts") || 
+	    ($filetype eq "domain")) {
+	    if($script ne "") {
+		&Reply($client,              # BUGBUG - EditFile
+		      &EditFile($userinput), #   could fail.
+		      $userinput);
+	    } else {
+		&Failure($client,"refused\n",$userinput);
+	    }
+	} else {
+	    &Failure($client,"refused\n",$userinput);
+	}
+    } else {
+	&Failure($client,"refused\n",$userinput);
+    }
+    return 1;
+}
+register_handler("edit", \&edit_table_handler, 1, 0, 1);
+
+
+#
+#   Authenticate a user against the LonCAPA authentication
+#   database.  Note that there are several authentication
+#   possibilities:
+#   - unix     - The user can be authenticated against the unix
+#                password file.
+#   - internal - The user can be authenticated against a purely 
+#                internal per user password file.
+#   - kerberos - The user can be authenticated against either a kerb4 or kerb5
+#                ticket granting authority.
+#   - user     - The person tailoring LonCAPA can supply a user authentication
+#                mechanism that is per system.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+#
+sub authenticate_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    
+    #  Regenerate the full input line 
+    
+    my $userinput  = $cmd.":".$tail;
+    
+    #  udom    - User's domain.
+    #  uname   - Username.
+    #  upass   - User's password.
+    
+    my ($udom,$uname,$upass)=split(/:/,$tail);
+    &Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
+    chomp($upass);
+    $upass=&unescape($upass);
+
+    my $pwdcorrect = &validate_user($udom, $uname, $upass);
+    if($pwdcorrect) {
+	&Reply( $client, "authorized\n", $userinput);
+	#
+	#  Bad credentials: Failed to authorize
+	#
+    } else {
+	&Failure( $client, "non_authorized\n", $userinput);
+    }
+
+    return 1;
+}
+
+register_handler("auth", \&authenticate_handler, 1, 1, 0);
+
+#
+#   Change a user's password.  Note that this function is complicated by
+#   the fact that a user may be authenticated in more than one way:
+#   At present, we are not able to change the password for all types of
+#   authentication methods.  Only for:
+#      unix    - unix password or shadow passoword style authentication.
+#      local   - Locally written authentication mechanism.
+#   For now, kerb4 and kerb5 password changes are not supported and result
+#   in an error.
+# FUTURE WORK:
+#    Support kerberos passwd changes?
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+sub change_password_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = $cmd.":".$tail;           # Reconstruct client's string.
+
+    #
+    #  udom  - user's domain.
+    #  uname - Username.
+    #  upass - Current password.
+    #  npass - New password.
+   
+    my ($udom,$uname,$upass,$npass)=split(/:/,$tail);
+
+    $upass=&unescape($upass);
+    $npass=&unescape($npass);
+    &Debug("Trying to change password for $uname");
+
+    # First require that the user can be authenticated with their
+    # old password:
+
+    my $validated = &validate_user($udom, $uname, $upass);
+    if($validated) {
+	my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.
+	
+	my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
+	if ($howpwd eq 'internal') {
+	    &Debug("internal auth");
+	    my $salt=time;
+	    $salt=substr($salt,6,2);
+	    my $ncpass=crypt($npass,$salt);
+	    if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
+		&logthis("Result of password change for "
+			 ."$uname: pwchange_success");
+		&Reply($client, "ok\n", $userinput);
+	    } else {
+		&logthis("Unable to open $uname passwd "               
+			 ."to change password");
+		&Failure( $client, "non_authorized\n",$userinput);
+	    }
+	} elsif ($howpwd eq 'unix') {
+	    # Unix means we have to access /etc/password
+	    &Debug("auth is unix");
+	    my $execdir=$perlvar{'lonDaemons'};
+	    &Debug("Opening lcpasswd pipeline");
+	    my $pf = IO::File->new("|$execdir/lcpasswd > "
+				   ."$perlvar{'lonDaemons'}"
+				   ."/logs/lcpasswd.log");
+	    print $pf "$uname\n$npass\n$npass\n";
+	    close $pf;
+	    my $err = $?;
+	    my $result = ($err>0 ? 'pwchange_failure' : 'ok');
+	    &logthis("Result of password change for $uname: ".
+		     &lcpasswdstrerror($?));
+	    &Reply($client, "$result\n", $userinput);
+	} else {
+	    # this just means that the current password mode is not
+	    # one we know how to change (e.g the kerberos auth modes or
+	    # locally written auth handler).
+	    #
+	    &Failure( $client, "auth_mode_error\n", $userinput);
+	}  
+	
+    } else {
+	&Failure( $client, "non_authorized\n", $userinput);
+    }
+
+    return 1;
+}
+register_handler("passwd", \&change_password_handler, 1, 1, 0);
+
+
+#
+#   Create a new user.  User in this case means a lon-capa user.
+#   The user must either already exist in some authentication realm
+#   like kerberos or the /etc/passwd.  If not, a user completely local to
+#   this loncapa system is created.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+sub add_user_handler {
+
+    my ($cmd, $tail, $client) = @_;
+
+
+    my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
+    my $userinput = $cmd.":".$tail; # Reconstruct the full request line.
+
+    &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname);
+
+
+    if($udom eq $currentdomainid) { # Reject new users for other domains...
+	
+	my $oldumask=umask(0077);
+	chomp($npass);
+	$npass=&unescape($npass);
+	my $passfilename  = &password_path($udom, $uname);
+	&Debug("Password file created will be:".$passfilename);
+	if (-e $passfilename) {
+	    &Failure( $client, "already_exists\n", $userinput);
+	} else {
+	    my @fpparts=split(/\//,$passfilename);
+	    my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
+	    my $fperror='';
+	    for (my $i=3;$i<= ($#fpparts-1);$i++) {
+		$fpnow.='/'.$fpparts[$i]; 
+		unless (-e $fpnow) {
+		    &logthis("mkdir $fpnow");
+		    unless (mkdir($fpnow,0777)) {
+			$fperror="error: ".($!+0)." mkdir failed while attempting "
+			    ."makeuser";
+		    }
+		}
+	    }
+	    unless ($fperror) {
+		my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
+		&Reply($client, $result, $userinput);     #BUGBUG - could be fail
+	    } else {
+		&Failure($client, "$fperror\n", $userinput);
+	    }
+	}
+	umask($oldumask);
+    }  else {
+	&Failure($client, "not_right_domain\n",
+		$userinput);	# Even if we are multihomed.
+    
+    }
+    return 1;
+
+}
+&register_handler("makeuser", \&add_user_handler, 1, 1, 0);
+
+#
+#   Change the authentication method of a user.  Note that this may
+#   also implicitly change the user's password if, for example, the user is
+#   joining an existing authentication realm.  Known authentication realms at
+#   this time are:
+#    internal   - Purely internal password file (only loncapa knows this user)
+#    local      - Institutionally written authentication module.
+#    unix       - Unix user (/etc/passwd with or without /etc/shadow).
+#    kerb4      - kerberos version 4
+#    kerb5      - kerberos version 5
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+#
+sub change_authentication_handler {
+
+    my ($cmd, $tail, $client) = @_;
+   
+    my $userinput  = "$cmd:$tail";              # Reconstruct user input.
+
+    my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
+    &Debug("cmd = ".$cmd." domain= ".$udom."uname =".$uname." umode= ".$umode);
+    if ($udom ne $currentdomainid) {
+	&Failure( $client, "not_right_domain\n", $client);
+    } else {
+	
+	chomp($npass);
+	
+	$npass=&unescape($npass);
+	my $passfilename = &password_path($udom, $uname);
+	if ($passfilename) {	# Not allowed to create a new user!!
+	    my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
+	    &Reply($client, $result, $userinput);
+	} else {	       
+	    &Failure($client, "non_authorized", $userinput); # Fail the user now.
+	}
+    }
+    return 1;
+}
+&register_handler("changeuserauth", \&change_authentication_handler, 1,1, 0);
+
+#
+#   Determines if this is the home server for a user.  The home server
+#   for a user will have his/her lon-capa passwd file.  Therefore all we need
+#   to do is determine if this file exists.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+#
+sub is_home_handler {
+    my ($cmd, $tail, $client) = @_;
+   
+    my $userinput  = "$cmd:$tail";
+   
+    my ($udom,$uname)=split(/:/,$tail);
+    chomp($uname);
+    my $passfile = &password_filename($udom, $uname);
+    if($passfile) {
+	&Reply( $client, "found\n", $userinput);
+    } else {
+	&Failure($client, "not_found\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("home", \&is_home_handler, 0,1,0);
+
+#
+#   Process an update request for a resource?? I think what's going on here is
+#   that a resource has been modified that we hold a subscription to.
+#   If the resource is not local, then we must update, or at least invalidate our
+#   cached copy of the resource. 
+#   FUTURE WORK:
+#      I need to look at this logic carefully.  My druthers would be to follow
+#      typical caching logic, and simple invalidate the cache, drop any subscription
+#      an let the next fetch start the ball rolling again... however that may
+#      actually be more difficult than it looks given the complex web of
+#      proxy servers.
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+# Implicit inputs:
+#    The authentication systems describe above have their own forms of implicit
+#    input into the authentication process that are described above.
+#
+sub update_resource_handler {
+
+    my ($cmd, $tail, $client) = @_;
+   
+    my $userinput = "$cmd:$tail";
+   
+    my $fname= $tail;		# This allows interactive testing
+
+
+    my $ownership=ishome($fname);
+    if ($ownership eq 'not_owner') {
+	if (-e $fname) {
+	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+		$atime,$mtime,$ctime,$blksize,$blocks)=stat($fname);
+	    my $now=time;
+	    my $since=$now-$atime;
+	    if ($since>$perlvar{'lonExpire'}) {
+		my $reply=&reply("unsub:$fname","$clientname");
+		unlink("$fname");
+	    } else {
+		my $transname="$fname.in.transfer";
+		my $remoteurl=&reply("sub:$fname","$clientname");
+		my $response;
+		alarm(120);
+		{
+		    my $ua=new LWP::UserAgent;
+		    my $request=new HTTP::Request('GET',"$remoteurl");
+		    $response=$ua->request($request,$transname);
+		}
+		alarm(0);
+		if ($response->is_error()) {
+		    unlink($transname);
+		    my $message=$response->status_line;
+		    &logthis("LWP GET: $message for $fname ($remoteurl)");
+		} else {
+		    if ($remoteurl!~/\.meta$/) {
+			alarm(120);
+			{
+			    my $ua=new LWP::UserAgent;
+			    my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
+			    my $mresponse=$ua->request($mrequest,$fname.'.meta');
+			    if ($mresponse->is_error()) {
+				unlink($fname.'.meta');
+			    }
+			}
+			alarm(0);
+		    }
+		    rename($transname,$fname);
+		}
+	    }
+	    &Reply( $client, "ok\n", $userinput);
+	} else {
+	    &Failure($client, "not_found\n", $userinput);
+	}
+    } else {
+	&Failure($client, "rejected\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("update", \&update_resource_handler, 0 ,1, 0);
+
+#
+#   Fetch a user file from a remote server to the user's home directory
+#   userfiles subdir.
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub fetch_user_file_handler {
+
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+    my $fname           = $tail;
+    my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
+    my $udir=&propath($udom,$uname).'/userfiles';
+    unless (-e $udir) {
+	mkdir($udir,0770); 
+    }
+    Debug("fetch user file for $fname");
+    if (-e $udir) {
+	$ufile=~s/^[\.\~]+//;
+
+	# IF necessary, create the path right down to the file.
+	# Note that any regular files in the way of this path are
+	# wiped out to deal with some earlier folly of mine.
+
+	my $path = $udir;
+	if ($ufile =~m|(.+)/([^/]+)$|) {
+	    my @parts=split('/',$1);
+	    foreach my $part (@parts) {
+		$path .= '/'.$part;
+		if( -f $path) {
+		    unlink($path);
+		}
+		if ((-e $path)!=1) {
+		    mkdir($path,0770);
+		}
+	    }
+	}
+
+
+	my $destname=$udir.'/'.$ufile;
+	my $transname=$udir.'/'.$ufile.'.in.transit';
+	my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+	my $response;
+	Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
+	alarm(120);
+	{
+	    my $ua=new LWP::UserAgent;
+	    my $request=new HTTP::Request('GET',"$remoteurl");
+	    $response=$ua->request($request,$transname);
+	}
+	alarm(0);
+	if ($response->is_error()) {
+	    unlink($transname);
+	    my $message=$response->status_line;
+	    &logthis("LWP GET: $message for $fname ($remoteurl)");
+	    &Failure($client, "failed\n", $userinput);
+	} else {
+	    Debug("Renaming $transname to $destname");
+	    if (!rename($transname,$destname)) {
+		&logthis("Unable to move $transname to $destname");
+		unlink($transname);
+		&Failure($client, "failed\n", $userinput);
+	    } else {
+		&Reply($client, "ok\n", $userinput);
+	    }
+	}   
+    } else {
+	&Failure($client, "not_home\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("fetchuserfile", \&fetch_user_file_handler, 0, 1, 0);
+
+#
+#   Remove a file from a user's home directory userfiles subdirectory.
+# Parameters:
+#    cmd   - the Lond request keyword that got us here.
+#    tail  - the part of the command past the keyword.
+#    client- File descriptor connected with the client.
+#
+# Returns:
+#    1    - Continue processing.
+
+sub remove_user_file_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my ($fname) = split(/:/, $tail); # Get rid of any tailing :'s lonc may have sent.
+
+    my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
+    if ($ufile =~m|/\.\./|) {
+	# any files paths with /../ in them refuse 
+	# to deal with
+	&Failure($client, "refused\n", "$cmd:$tail");
+    } else {
+	my $udir = &propath($udom,$uname);
+	if (-e $udir) {
+	    my $file=$udir.'/userfiles/'.$ufile;
+	    if (-e $file) {
+		unlink($file);
+		if (-e $file) {
+		    &Failure($client, "failed\n", "$cmd:$tail");
+		} else {
+		    &Reply($client, "ok\n", "$cmd:$tail");
+		}
+	    } else {
+		&Failure($client, "not_found\n", "$cmd:$tail");
+	    }
+	} else {
+	    &Failure($client, "not_home\n", "$cmd:$tail");
+	}
+    }
+    return 1;
+}
+&register_handler("removeuserfile", \&remove_user_file_handler, 0,1,0);
+
+
+#
+#  Authenticate access to a user file by checking the user's 
+#  session token(?)
+#
+# Parameters:
+#   cmd      - The request keyword that dispatched to tus.
+#   tail     - The tail of the request (colon separated parameters).
+#   client   - Filehandle open on the client.
+# Return:
+#    1.
+
+sub token_auth_user_file_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my ($fname, $session) = split(/:/, $tail);
+    
+    chomp($session);
+    my $reply='non_auth';
+    if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
+	     $session.'.id')) {
+	while (my $line=<ENVIN>) {
+	    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
+	}
+	close(ENVIN);
+	&Reply($client, $reply);
+    } else {
+	&Failure($client, "invalid_token\n", "$cmd:$tail");
+    }
+    return 1;
+
+}
+
+&register_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0);
+
+
+#
+#   Unsubscribe from a resource.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub unsubscribe_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput= "$cmd:$tail";
+    
+    my ($fname) = split(/:/,$tail); # Split in case there's extrs.
+
+    &Debug("Unsubscribing $fname");
+    if (-e $fname) {
+	&Debug("Exists");
+	&Reply($client, &unsub($fname,$clientip), $userinput);
+    } else {
+	&Failure($client, "not_found\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("unsub", \&unsubscribe_handler, 0, 1, 0);
+#   Subscribe to a resource
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub subscribe_handler {
+    my ($cmd, $tail, $client)= @_;
+
+    my $userinput  = "$cmd:$tail";
+
+    &Reply( $client, &subscribe($userinput,$clientip), $userinput);
+
+    return 1;
+}
+&register_handler("sub", \&subscribe_handler, 0, 1, 0);
+
+#
+#   Determine the version of a resource (?) Or is it return
+#   the top version of the resource?  Not yet clear from the
+#   code in currentversion.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub current_version_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput= "$cmd:$tail";
+   
+    my $fname   = $tail;
+    &Reply( $client, &currentversion($fname)."\n", $userinput);
+    return 1;
+
+}
+&register_handler("currentversion", \&current_version_handler, 0, 1, 0);
+
+#  Make an entry in a user's activity log.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub activity_log_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput= "$cmd:$tail";
+
+    my ($udom,$uname,$what)=split(/:/,$tail);
+    chomp($what);
+    my $proname=&propath($udom,$uname);
+    my $now=time;
+    my $hfh;
+    if ($hfh=IO::File->new(">>$proname/activity.log")) { 
+	print $hfh "$now:$clientname:$what\n";
+	&Reply( $client, "ok\n", $userinput); 
+    } else {
+	&Failure($client, "error: ".($!+0)." IO::File->new Failed "
+		 ."while attempting log\n", 
+		 $userinput);
+    }
+
+    return 1;
+}
+register_handler("log", \&activity_log_handler, 0, 1, 0);
+
+#
+#   Put a namespace entry in a user profile hash.
+#   My druthers would be for this to be an encrypted interaction too.
+#   anything that might be an inadvertent covert channel about either
+#   user authentication or user personal information....
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub put_user_profile_entry {
+    my ($cmd, $tail, $client)  = @_;
+
+    my $userinput = "$cmd:$tail";
+    
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+	chomp($what);
+	my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				  &GDBM_WRCREAT(),"P",$what);
+	if($hashref) {
+	    my @pairs=split(/\&/,$what);
+	    foreach my $pair (@pairs) {
+		my ($key,$value)=split(/=/,$pair);
+		$hashref->{$key}=$value;
+	    }
+	    if (untie(%$hashref)) {
+		&Reply( $client, "ok\n", $userinput);
+	    } else {
+		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+			"while attempting put\n", 
+			$userinput);
+	    }
+	} else {
+	    &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+		     "while attempting put\n", $userinput);
+	}
+    } else {
+        &Failure( $client, "refused\n", $userinput);
+    }
+    
+    return 1;
+}
+&register_handler("put", \&put_user_profile_entry, 0, 1, 0);
+
+# 
+#   Increment a profile entry in the user history file.
+#   The history contains keyword value pairs.  In this case,
+#   The value itself is a pair of numbers.  The first, the current value
+#   the second an increment that this function applies to the current
+#   value.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub increment_user_value_handler {
+    my ($cmd, $tail, $client) = @_;
+    
+    my $userinput   = "$cmd:$tail";
+    
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+        chomp($what);
+	my $hashref = &tie_user_hash($udom, $uname,
+				     $namespace, &GDBM_WRCREAT(),
+				     "P",$what);
+	if ($hashref) {
+	    my @pairs=split(/\&/,$what);
+	    foreach my $pair (@pairs) {
+		my ($key,$value)=split(/=/,$pair);
+		# We could check that we have a number...
+		if (! defined($value) || $value eq '') {
+		    $value = 1;
+		}
+		$hashref->{$key}+=$value;
+	    }
+	    if (untie(%$hashref)) {
+		&Reply( $client, "ok\n", $userinput);
+	    } else {
+		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+			 "while attempting inc\n", $userinput);
+	    }
+	} else {
+	    &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		     "while attempting inc\n", $userinput);
+	}
+    } else {
+	&Failure($client, "refused\n", $userinput);
+    }
+    
+    return 1;
+}
+&register_handler("inc", \&increment_user_value_handler, 0, 1, 0);
+
+
+#
+#   Put a new role for a user.  Roles are LonCAPA's packaging of permissions.
+#   Each 'role' a user has implies a set of permissions.  Adding a new role
+#   for a person grants the permissions packaged with that role
+#   to that user when the role is selected.
+#
+# Parameters:
+#    $cmd       - The command string (rolesput).
+#    $tail      - The remainder of the request line.  For rolesput this
+#                 consists of a colon separated list that contains:
+#                 The domain and user that is granting the role (logged).
+#                 The domain and user that is getting the role.
+#                 The roles being granted as a set of & separated pairs.
+#                 each pair a key value pair.
+#    $client    - File descriptor connected to the client.
+# Returns:
+#     0         - If the daemon should exit
+#     1         - To continue processing.
+#
+#
+sub roles_put_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput  = "$cmd:$tail";
+
+    my ( $exedom, $exeuser, $udom, $uname,  $what) = split(/:/,$tail);
+    
+
+    my $namespace='roles';
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_WRCREAT(), "P",
+				 "$exedom:$exeuser:$what");
+    #
+    #  Log the attempt to set a role.  The {}'s here ensure that the file 
+    #  handle is open for the minimal amount of time.  Since the flush
+    #  is done on close this improves the chances the log will be an un-
+    #  corrupted ordered thing.
+    if ($hashref) {
+	my @pairs=split(/\&/,$what);
+	foreach my $pair (@pairs) {
+	    my ($key,$value)=split(/=/,$pair);
+	    &manage_permissions($key, $udom, $uname,
+			       &get_auth_type( $udom, $uname));
+	    $hashref->{$key}=$value;
+	}
+	if (untie($hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting rolesput\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting rolesput\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("rolesput", \&roles_put_handler, 1,1,0);  # Encoded client only.
+
+#
+#   Deletes (removes) a role for a user.   This is equivalent to removing
+#  a permissions package associated with the role from the user's profile.
+#
+# Parameters:
+#     $cmd                 - The command (rolesdel)
+#     $tail                - The remainder of the request line. This consists
+#                             of:
+#                             The domain and user requesting the change (logged)
+#                             The domain and user being changed.
+#                             The roles being revoked.  These are shipped to us
+#                             as a bunch of & separated role name keywords.
+#     $client              - The file handle open on the client.
+# Returns:
+#     1                    - Continue processing
+#     0                    - Exit.
+#
+sub roles_delete_handler {
+    my ($cmd, $tail, $client)  = @_;
+
+    my $userinput    = "$cmd:$tail";
+   
+    my ($exedom,$exeuser,$udom,$uname,$what)=split(/:/,$tail);
+    &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom.
+	   "what = ".$what);
+    my $namespace='roles';
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_WRCREAT(), "D",
+				 "$exedom:$exeuser:$what");
+    
+    if ($hashref) {
+	my @rolekeys=split(/\&/,$what);
+	
+	foreach my $key (@rolekeys) {
+	    delete $hashref->{$key};
+	}
+	if (untie(%$hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting rolesdel\n", $userinput);
+	}
+    } else {
+        &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting rolesdel\n", $userinput);
+    }
+    
+    return 1;
+}
+&register_handler("rolesdel", \&roles_delete_handler, 1,1, 0); # Encoded client only
+
+# Unencrypted get from a user's profile database.  See 
+# GetProfileEntryEncrypted for a version that does end-to-end encryption.
+# This function retrieves a keyed item from a specific named database in the
+# user's directory.
+#
+# Parameters:
+#   $cmd             - Command request keyword (get).
+#   $tail            - Tail of the command.  This is a colon separated list
+#                      consisting of the domain and username that uniquely
+#                      identifies the profile,
+#                      The 'namespace' which selects the gdbm file to 
+#                      do the lookup in, 
+#                      & separated list of keys to lookup.  Note that
+#                      the values are returned as an & separated list too.
+#   $client          - File descriptor open on the client.
+# Returns:
+#   1       - Continue processing.
+#   0       - Exit.
+#
+sub get_profile_entry {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput= "$cmd:$tail";
+   
+    my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my @queries=split(/\&/,$what);
+        my $qresult='';
+	
+	for (my $i=0;$i<=$#queries;$i++) {
+	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
+	}
+	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
+	if (untie(%$hashref)) {
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting get\n", $userinput);
+	}
+    } else {
+	if ($!+0 == 2) {               # +0 coerces errno -> number 2 is ENOENT
+	    &Failure($client, "error:No such file or ".
+		    "GDBM reported bad block error\n", $userinput);
+	} else {                        # Some other undifferentiated err.
+	    &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		    "while attempting get\n", $userinput);
+	}
+    }
+    return 1;
+}
+&register_handler("get", \&get_profile_entry, 0,1,0);
+
+#
+#  Process the encrypted get request.  Note that the request is sent
+#  in clear, but the reply is encrypted.  This is a small covert channel:
+#  information about the sensitive keys is given to the snooper.  Just not
+#  information about the values of the sensitive key.  Hmm if I wanted to
+#  know these I'd snoop for the egets. Get the profile item names from them
+#  and then issue a get for them since there's no enforcement of the
+#  requirement of an encrypted get for particular profile items.  If I
+#  were re-doing this, I'd force the request to be encrypted as well as the
+#  reply.  I'd also just enforce encrypted transactions for all gets since
+#  that would prevent any covert channel snooping.
+#
+#  Parameters:
+#     $cmd               - Command keyword of request (eget).
+#     $tail              - Tail of the command.  See GetProfileEntry
#                          for more information about this.
+#     $client            - File open on the client.
+#  Returns:
+#     1      - Continue processing
+#     0      - server should exit.
+sub get_profile_entry_encrypted {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+   
+    my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my @queries=split(/\&/,$what);
+        my $qresult='';
+	for (my $i=0;$i<=$#queries;$i++) {
+	    $qresult.="$hashref->{$queries[$i]}&";
+	}
+	if (untie(%$hashref)) {
+	    $qresult=~s/\&$//;
+	    if ($cipher) {
+		my $cmdlength=length($qresult);
+		$qresult.="         ";
+		my $encqresult='';
+		for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+		    $encqresult.= unpack("H16", 
+					 $cipher->encrypt(substr($qresult,
+								 $encidx,
+								 8)));
+		}
+		&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
+	    } else {
+		&Failure( $client, "error:no_key\n", $userinput);
+	    }
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting eget\n", $userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		"while attempting eget\n", $userinput);
+    }
+    
+    return 1;
+}
+&register_handler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);
+#
+#   Deletes a key in a user profile database.
+#   
+#   Parameters:
+#       $cmd                  - Command keyword (del).
+#       $tail                 - Command tail.  IN this case a colon
+#                               separated list containing:
+#                               The domain and user that identifies uniquely
+#                               the identity of the user.
+#                               The profile namespace (name of the profile
+#                               database file).
+#                               & separated list of keywords to delete.
+#       $client              - File open on client socket.
+# Returns:
+#     1   - Continue processing
+#     0   - Exit server.
+#
+#
+
+sub delete_profile_entry {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "cmd:$tail";
+
+    my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_WRCREAT(),
+				 "D",$what);
+    if ($hashref) {
+        my @keys=split(/\&/,$what);
+	foreach my $key (@keys) {
+	    delete($hashref->{$key});
+	}
+	if (untie(%$hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting del\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting del\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("del", \&delete_profile_entry, 0, 1, 0);
+#
+#  List the set of keys that are defined in a profile database file.
+#  A successful reply from this will contain an & separated list of
+#  the keys. 
+# Parameters:
+#     $cmd              - Command request (keys).
+#     $tail             - Remainder of the request, a colon separated
+#                         list containing domain/user that identifies the
+#                         user being queried, and the database namespace
+#                         (database filename essentially).
+#     $client           - File open on the client.
+#  Returns:
+#    1    - Continue processing.
+#    0    - Exit the server.
+#
+sub get_profile_keys {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace)=split(/:/,$tail);
+    my $qresult='';
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				  &GDBM_READER());
+    if ($hashref) {
+	foreach my $key (keys %$hashref) {
+	    $qresult.="$key&";
+	}
+	if (untie(%$hashref)) {
+	    $qresult=~s/\&$//;
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting keys\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting keys\n", $userinput);
+    }
+   
+    return 1;
+}
+&register_handler("keys", \&get_profile_keys, 0, 1, 0);
+
+#
+#   Dump the contents of a user profile database.
+#   Note that this constitutes a very large covert channel too since
+#   the dump will return sensitive information that is not encrypted.
+#   The naive security assumption is that the session negotiation ensures
+#   our client is trusted and I don't believe that's assured at present.
+#   Sure want badly to go to ssl or tls.  Of course if my peer isn't really
+#   a LonCAPA node they could have negotiated an encryption key too so >sigh<.
+# 
+#  Parameters:
+#     $cmd           - The command request keyword (currentdump).
+#     $tail          - Remainder of the request, consisting of a colon
+#                      separated list that has the domain/username and
+#                      the namespace to dump (database file).
+#     $client        - file open on the remote client.
+# Returns:
+#     1    - Continue processing.
+#     0    - Exit the server.
+#
+sub dump_profile_database {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+   
+    my ($udom,$uname,$namespace) = split(/:/,$tail);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+	# Structure of %data:
+	# $data{$symb}->{$parameter}=$value;
+	# $data{$symb}->{'v.'.$parameter}=$version;
+	# since $parameter will be unescaped, we do not
+ 	# have to worry about silly parameter names...
+	
+        my $qresult='';
+	my %data = ();                     # A hash of anonymous hashes..
+	while (my ($key,$value) = each(%$hashref)) {
+	    my ($v,$symb,$param) = split(/:/,$key);
+	    next if ($v eq 'version' || $symb eq 'keys');
+	    next if (exists($data{$symb}) && 
+		     exists($data{$symb}->{$param}) &&
+		     $data{$symb}->{'v.'.$param} > $v);
+	    $data{$symb}->{$param}=$value;
+	    $data{$symb}->{'v.'.$param}=$v;
+	}
+	if (untie(%$hashref)) {
+	    while (my ($symb,$param_hash) = each(%data)) {
+		while(my ($param,$value) = each (%$param_hash)){
+		    next if ($param =~ /^v\./);       # Ignore versions...
+		    #
+		    #   Just dump the symb=value pairs separated by &
+		    #
+		    $qresult.=$symb.':'.$param.'='.$value.'&';
+		}
+	    }
+	    chop($qresult);
+	    &Reply($client , "$qresult\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting currentdump\n", $userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		"while attempting currentdump\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("currentdump", \&dump_profile_database, 0, 1, 0);
+
+#
+#   Dump a profile database with an optional regular expression
+#   to match against the keys.  In this dump, no effort is made
+#   to separate symb from version information. Presumably the
+#   databases that are dumped by this command are of a different
+#   structure.  Need to look at this and improve the documentation of
+#   both this and the currentdump handler.
+# Parameters:
+#    $cmd                     - The command keyword.
+#    $tail                    - All of the characters after the $cmd:
+#                               These are expected to be a colon
+#                               separated list containing:
+#                               domain/user - identifying the user.
+#                               namespace   - identifying the database.
+#                               regexp      - optional regular expression
+#                                             that is matched against
+#                                             database keywords to do
+#                                             selective dumps.
+#   $client                   - Channel open on the client.
+# Returns:
+#    1    - Continue processing.
+# Side effects:
+#    response is written to $client.
+#
+sub dump_with_regexp {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
+    if (defined($regexp)) {
+	$regexp=&unescape($regexp);
+    } else {
+	$regexp='.';
+    }
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my $qresult='';
+	while (my ($key,$value) = each(%$hashref)) {
+	    if ($regexp eq '.') {
+		$qresult.=$key.'='.$value.'&';
+	    } else {
+		my $unescapeKey = &unescape($key);
+		if (eval('$unescapeKey=~/$regexp/')) {
+		    $qresult.="$key=$value&";
+		}
+	    }
+	}
+	if (untie(%$hashref)) {
+	    chop($qresult);
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting dump\n", $userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		"while attempting dump\n", $userinput);
+    }
+
+    return 1;
+}
+
+&register_handler("dump", \&dump_with_regexp, 0, 1, 0);
+
+#  Store a set of key=value pairs associated with a versioned name.
+#
+#  Parameters:
+#    $cmd                - Request command keyword.
+#    $tail               - Tail of the request.  This is a colon
+#                          separated list containing:
+#                          domain/user - User and authentication domain.
+#                          namespace   - Name of the database being modified
+#                          rid         - Resource keyword to modify.
+#                          what        - new value associated with rid.
+#
+#    $client             - Socket open on the client.
+#
+#
+#  Returns:
+#      1 (keep on processing).
+#  Side-Effects:
+#    Writes to the client
+sub store_handler {
+    my ($cmd, $tail, $client) = @_;
+ 
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+
+	chomp($what);
+	my @pairs=split(/\&/,$what);
+	my $hashref  = &tie_user_hash($udom, $uname, $namespace,
+				       &GDBM_WRCREAT(), "P",
+				       "$rid:$what");
+	if ($hashref) {
+	    my $now = time;
+	    my @previouskeys=split(/&/,$hashref->{"keys:$rid"});
+	    my $key;
+	    $hashref->{"version:$rid"}++;
+	    my $version=$hashref->{"version:$rid"};
+	    my $allkeys=''; 
+	    foreach my $pair (@pairs) {
+		my ($key,$value)=split(/=/,$pair);
+		$allkeys.=$key.':';
+		$hashref->{"$version:$rid:$key"}=$value;
+	    }
+	    $hashref->{"$version:$rid:timestamp"}=$now;
+	    $allkeys.='timestamp';
+	    $hashref->{"$version:keys:$rid"}=$allkeys;
+	    if (untie($hashref)) {
+		&Reply($client, "ok\n", $userinput);
+	    } else {
+		&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+			"while attempting store\n", $userinput);
+	    }
+	} else {
+	    &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		     "while attempting store\n", $userinput);
+	}
+    } else {
+	&Failure($client, "refused\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("store", \&store_handler, 0, 1, 0);
+#
+#  Dump out all versions of a resource that has key=value pairs associated
+# with it for each version.  These resources are built up via the store
+# command.
+#
+#  Parameters:
+#     $cmd               - Command keyword.
+#     $tail              - Remainder of the request which consists of:
+#                          domain/user   - User and auth. domain.
+#                          namespace     - name of resource database.
+#                          rid           - Resource id.
+#    $client             - socket open on the client.
+#
+# Returns:
+#      1  indicating the caller should not yet exit.
+# Side-effects:
+#   Writes a reply to the client.
+#   The reply is a string of the following shape:
+#   version=current&version:keys=k1:k2...&1:k1=v1&1:k2=v2...
+#    Where the 1 above represents version 1.
+#    this continues for all pairs of keys in all versions.
+#
+#
+#    
+#
+sub restore_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";	# Only used for logging purposes.
+
+    my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput);
+    $namespace=~s/\//\_/g;
+    $namespace=~s/\W//g;
+    chomp($rid);
+    my $proname=&propath($udom,$uname);
+    my $qresult='';
+    my %hash;
+    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
+	    &GDBM_READER(),0640)) {
+	my $version=$hash{"version:$rid"};
+	$qresult.="version=$version&";
+	my $scope;
+	for ($scope=1;$scope<=$version;$scope++) {
+	    my $vkeys=$hash{"$scope:keys:$rid"};
+	    my @keys=split(/:/,$vkeys);
+	    my $key;
+	    $qresult.="$scope:keys=$vkeys&";
+	    foreach $key (@keys) {
+		$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
+	    }                                  
+	}
+	if (untie(%hash)) {
+	    $qresult=~s/\&$//;
+	    &Reply( $client, "$qresult\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting restore\n", $userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		"while attempting restore\n", $userinput);
+    }
+  
+    return 1;
+
 
+}
+&register_handler("restore", \&restore_handler, 0,1,0);
+#
+#
 #---------------------------------------------------------------
 #
 #   Getting, decoding and dispatching requests:
@@ -1073,7 +2708,7 @@ sub ping_handler {
 #   Gets a Request message from the client.  The transaction
 #   is defined as a 'line' of text.  We remove the new line
 #   from the text line.  
-#   
+#
 sub get_request {
     my $input = <$client>;
     chomp($input);
@@ -1174,1108 +2809,12 @@ sub process_request {
 
     }    
 
-# ------------------------------------------------------------- Normal commands
-    if ($userinput =~ /^pong/) { # client only
-	if(isClient) {
-	    my $reply=&reply("ping",$clientname);
-	    print $client "$currenthostid:$reply\n"; 
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# ------------------------------------------------------------------------ ekey
-    } elsif ($userinput =~ /^ekey/) { # ok for both clients & mgrs
-	my $buildkey=time.$$.int(rand 100000);
-	$buildkey=~tr/1-6/A-F/;
-	$buildkey=int(rand 100000).$buildkey.int(rand 100000);
-	my $key=$currenthostid.$clientname;
-	$key=~tr/a-z/A-Z/;
-	$key=~tr/G-P/0-9/;
-	$key=~tr/Q-Z/0-9/;
-	$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
-	$key=substr($key,0,32);
-	my $cipherkey=pack("H32",$key);
-	$cipher=new IDEA $cipherkey;
-	print $client "$buildkey\n"; 
-# ------------------------------------------------------------------------ load
-    } elsif ($userinput =~ /^load/) { # client only
-	if (isClient) {
-	    my $loadavg;
-	    {
-		my $loadfile=IO::File->new('/proc/loadavg');
-		$loadavg=<$loadfile>;
-	    }
-	    $loadavg =~ s/\s.*//g;
-	    my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
-	    print $client "$loadpercent\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- userload
-    } elsif ($userinput =~ /^userload/) { # client only
-	if(isClient) {
-	    my $userloadpercent=&userload();
-	    print $client "$userloadpercent\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-#
-#        Transactions requiring encryption:
-#
-# ----------------------------------------------------------------- currentauth
-    } elsif ($userinput =~ /^currentauth/) {
-	if (($wasenc==1)  && isClient) { # Encoded & client only.
-	    my ($cmd,$udom,$uname)=split(/:/,$userinput);
-	    my $result = GetAuthType($udom, $uname);
-	    if($result eq "nouser") {
-		print $client "unknown_user\n";
-	    }
-	    else {
-		print $client "$result\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-#--------------------------------------------------------------------- pushfile
-    } elsif($userinput =~ /^pushfile/) {	# encoded & manager.
-	if(($wasenc == 1) && isManager) {
-	    my $cert = GetCertificate($userinput);
-	    if(ValidManager($cert)) {
-		my $reply = PushFile($userinput);
-		print $client "$reply\n";
-	    } else {
-		print $client "refused\n";
-	    } 
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-#--------------------------------------------------------------------- reinit
-    } elsif($userinput =~ /^reinit/) { # Encoded and manager
-	if (($wasenc == 1) && isManager) {
-	    my $cert = GetCertificate($userinput);
-	    if(ValidManager($cert)) {
-		chomp($userinput);
-		my $reply = ReinitProcess($userinput);
-		print $client  "$reply\n";
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-#------------------------------------------------------------------------- edit
-    } elsif ($userinput =~ /^edit/) {    # encoded and manager:
-	if(($wasenc ==1) && (isManager)) {
-	    my $cert = GetCertificate($userinput);
-	    if(ValidManager($cert)) {
-		my($command, $filetype, $script) = split(/:/, $userinput);
-		if (($filetype eq "hosts") || ($filetype eq "domain")) {
-		    if($script ne "") {
-			Reply($client, EditFile($userinput));
-		    } else {
-			Reply($client,"refused\n",$userinput);
-		    }
-		} else {
-		    Reply($client,"refused\n",$userinput);
-		}
-            } else {
-		Reply($client,"refused\n",$userinput);
-            }
-	} else {
-	    Reply($client,"refused\n",$userinput);
-	}
-# ------------------------------------------------------------------------ auth
-    } elsif ($userinput =~ /^auth/) { # Encoded and client only.
-	if (($wasenc==1) && isClient) {
-	    my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
-	    chomp($upass);
-	    $upass=unescape($upass);
-	    my $proname=propath($udom,$uname);
-	    my $passfilename="$proname/passwd";
-	    if (-e $passfilename) {
-		my $pf = IO::File->new($passfilename);
-		my $realpasswd=<$pf>;
-		chomp($realpasswd);
-		my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
-		my $pwdcorrect=0;
-		if ($howpwd eq 'internal') {
-		    &Debug("Internal auth");
-		    $pwdcorrect=
-			(crypt($upass,$contentpwd) eq $contentpwd);
-		} elsif ($howpwd eq 'unix') {
-		    &Debug("Unix auth");
-		    if((getpwnam($uname))[1] eq "") { #no such user!
-			$pwdcorrect = 0;
-		    } else {
-			$contentpwd=(getpwnam($uname))[1];
-			my $pwauth_path="/usr/local/sbin/pwauth";
-			unless ($contentpwd eq 'x') {
-			    $pwdcorrect=
-				(crypt($upass,$contentpwd) eq 
-				 $contentpwd);
-			}
-			
-			elsif (-e $pwauth_path) {
-			    open PWAUTH, "|$pwauth_path" or
-				die "Cannot invoke authentication";
-			    print PWAUTH "$uname\n$upass\n";
-			    close PWAUTH;
-			    $pwdcorrect=!$?;
-			}
-		    }
-		} elsif ($howpwd eq 'krb4') {
-		    my $null=pack("C",0);
-		    unless ($upass=~/$null/) {
-			my $krb4_error = &Authen::Krb4::get_pw_in_tkt
-			    ($uname,"",$contentpwd,'krbtgt',
-			     $contentpwd,1,$upass);
-			if (!$krb4_error) {
-			    $pwdcorrect = 1;
-			} else { 
-			    $pwdcorrect=0; 
-			    # log error if it is not a bad password
-			    if ($krb4_error != 62) {
-				&logthis('krb4:'.$uname.','.
-					 &Authen::Krb4::get_err_txt($Authen::Krb4::error));
-			    }
-			}
-		    }
-		} elsif ($howpwd eq 'krb5') {
-		    my $null=pack("C",0);
-		    unless ($upass=~/$null/) {
-			my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd);
-			my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd;
-			my $krbserver=&Authen::Krb5::parse_name($krbservice);
-			my $credentials=&Authen::Krb5::cc_default();
-			$credentials->initialize($krbclient);
-			my $krbreturn = 
-			    &Authen::Krb5::get_in_tkt_with_password(
-								    $krbclient,$krbserver,$upass,$credentials);
-#				  unless ($krbreturn) {
-#				      &logthis("Krb5 Error: ".
-#					       &Authen::Krb5::error());
-#				  }
-			$pwdcorrect = ($krbreturn == 1);
-		    } else { $pwdcorrect=0; }
-		} elsif ($howpwd eq 'localauth') {
-		    $pwdcorrect=&localauth::localauth($uname,$upass,
-						      $contentpwd);
-		}
-		if ($pwdcorrect) {
-		    print $client "authorized\n";
-		} else {
-		    print $client "non_authorized\n";
-		}  
-	    } else {
-		print $client "unknown_user\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ---------------------------------------------------------------------- passwd
-    } elsif ($userinput =~ /^passwd/) { # encoded and client
-	if (($wasenc==1) && isClient) {
-	    my 
-		($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
-	    chomp($npass);
-	    $upass=&unescape($upass);
-	    $npass=&unescape($npass);
-	    &Debug("Trying to change password for $uname");
-	    my $proname=propath($udom,$uname);
-	    my $passfilename="$proname/passwd";
-	    if (-e $passfilename) {
-		my $realpasswd;
-		{ my $pf = IO::File->new($passfilename);
-		  $realpasswd=<$pf>; }
-		chomp($realpasswd);
-		my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
-		if ($howpwd eq 'internal') {
-		    &Debug("internal auth");
-		    if (crypt($upass,$contentpwd) eq $contentpwd) {
-			my $salt=time;
-			$salt=substr($salt,6,2);
-			my $ncpass=crypt($npass,$salt);
-			{
-			    my $pf;
-			    if ($pf = IO::File->new(">$passfilename")) {
-				print $pf "internal:$ncpass\n";
-				&logthis("Result of password change for $uname: pwchange_success");
-				print $client "ok\n";
-			    } else {
-				&logthis("Unable to open $uname passwd to change password");
-				print $client "non_authorized\n";
-			    }
-			}             
-			
-		    } else {
-			print $client "non_authorized\n";
-		    }
-		} elsif ($howpwd eq 'unix') {
-		    # Unix means we have to access /etc/password
-		    # one way or another.
-		    # First: Make sure the current password is
-		    #        correct
-		    &Debug("auth is unix");
-		    $contentpwd=(getpwnam($uname))[1];
-		    my $pwdcorrect = "0";
-		    my $pwauth_path="/usr/local/sbin/pwauth";
-		    unless ($contentpwd eq 'x') {
-			$pwdcorrect=
-			    (crypt($upass,$contentpwd) eq $contentpwd);
-		    } elsif (-e $pwauth_path) {
-			open PWAUTH, "|$pwauth_path" or
-			    die "Cannot invoke authentication";
-			print PWAUTH "$uname\n$upass\n";
-			close PWAUTH;
-			&Debug("exited pwauth with $? ($uname,$upass) ");
-			$pwdcorrect=($? == 0);
-		    }
-		    if ($pwdcorrect) {
-			my $execdir=$perlvar{'lonDaemons'};
-			&Debug("Opening lcpasswd pipeline");
-			my $pf = IO::File->new("|$execdir/lcpasswd > $perlvar{'lonDaemons'}/logs/lcpasswd.log");
-			print $pf "$uname\n$npass\n$npass\n";
-			close $pf;
-			my $err = $?;
-			my $result = ($err>0 ? 'pwchange_failure' 
-				      : 'ok');
-			&logthis("Result of password change for $uname: ".
-				 &lcpasswdstrerror($?));
-			print $client "$result\n";
-		    } else {
-			print $client "non_authorized\n";
-		    }
-		} else {
-		    print $client "auth_mode_error\n";
-		}  
-	    } else {
-		print $client "unknown_user\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- makeuser
-    } elsif ($userinput =~ /^makeuser/) { # encoded and client.
-	&Debug("Make user received");
-	my $oldumask=umask(0077);
-	if (($wasenc==1) && isClient) {
-	    my 
-		($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
-	    &Debug("cmd =".$cmd." $udom =".$udom.
-		   " uname=".$uname);
-	    chomp($npass);
-	    $npass=&unescape($npass);
-	    my $proname=propath($udom,$uname);
-	    my $passfilename="$proname/passwd";
-	    &Debug("Password file created will be:".
-		   $passfilename);
-	    if (-e $passfilename) {
-		print $client "already_exists\n";
-	    } elsif ($udom ne $currentdomainid) {
-		print $client "not_right_domain\n";
-	    } else {
-		my @fpparts=split(/\//,$proname);
-		my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
-		my $fperror='';
-		for (my $i=3;$i<=$#fpparts;$i++) {
-		    $fpnow.='/'.$fpparts[$i]; 
-		    unless (-e $fpnow) {
-			unless (mkdir($fpnow,0777)) {
-			    $fperror="error: ".($!+0)
-				." mkdir failed while attempting "
-				."makeuser";
-			}
-		    }
-		}
-		unless ($fperror) {
-		    my $result=&make_passwd_file($uname, $umode,$npass,
-						 $passfilename);
-		    print $client $result;
-		} else {
-		    print $client "$fperror\n";
-		}
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-	umask($oldumask);
-# -------------------------------------------------------------- changeuserauth
-    } elsif ($userinput =~ /^changeuserauth/) { # encoded & client
-	&Debug("Changing authorization");
-	if (($wasenc==1) && isClient) {
-	    my 
-		($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
-	    chomp($npass);
-	    &Debug("cmd = ".$cmd." domain= ".$udom.
-		   "uname =".$uname." umode= ".$umode);
-	    $npass=&unescape($npass);
-	    my $proname=&propath($udom,$uname);
-	    my $passfilename="$proname/passwd";
-	    if ($udom ne $currentdomainid) {
-		print $client "not_right_domain\n";
-	    } else {
-		my $result=&make_passwd_file($uname, $umode,$npass,
-					     $passfilename);
-		print $client $result;
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------ home
-    } elsif ($userinput =~ /^home/) { # client clear or encoded
-	if(isClient) {
-	    my ($cmd,$udom,$uname)=split(/:/,$userinput);
-	    chomp($uname);
-	    my $proname=propath($udom,$uname);
-	    if (-e $proname) {
-		print $client "found\n";
-	    } else {
-		print $client "not_found\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ---------------------------------------------------------------------- update
-    } elsif ($userinput =~ /^update/) { # client clear or encoded.
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    my $ownership=ishome($fname);
-	    if ($ownership eq 'not_owner') {
-		if (-e $fname) {
-		    my ($dev,$ino,$mode,$nlink,
-			$uid,$gid,$rdev,$size,
-			$atime,$mtime,$ctime,
-			$blksize,$blocks)=stat($fname);
-		    my $now=time;
-		    my $since=$now-$atime;
-		    if ($since>$perlvar{'lonExpire'}) {
-			my $reply=
-			    &reply("unsub:$fname","$clientname");
-				    unlink("$fname");
-		    } else {
-			my $transname="$fname.in.transfer";
-			my $remoteurl=
-			    &reply("sub:$fname","$clientname");
-			my $response;
-			{
-			    my $ua=new LWP::UserAgent;
-			    my $request=new HTTP::Request('GET',"$remoteurl");
-			    $response=$ua->request($request,$transname);
-			}
-			if ($response->is_error()) {
-			    unlink($transname);
-			    my $message=$response->status_line;
-			    &logthis(
-				     "LWP GET: $message for $fname ($remoteurl)");
-			} else {
-			    if ($remoteurl!~/\.meta$/) {
-				my $ua=new LWP::UserAgent;
-				my $mrequest=
-				    new HTTP::Request('GET',$remoteurl.'.meta');
-				my $mresponse=
-				    $ua->request($mrequest,$fname.'.meta');
-				if ($mresponse->is_error()) {
-				    unlink($fname.'.meta');
-				}
-			    }
-			    rename($transname,$fname);
-			}
-		    }
-		    print $client "ok\n";
-		} else {
-		    print $client "not_found\n";
-		}
-	    } else {
-		print $client "rejected\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------- fetch a user file from a remote server
-    } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
-	    my $udir=propath($udom,$uname).'/userfiles';
-	    unless (-e $udir) { mkdir($udir,0770); }
-	    if (-e $udir) {
-		$ufile=~s/^[\.\~]+//;
-		my $path = $udir;
-		if ($ufile =~m|(.+)/([^/]+)$|) {
-		    my @parts=split('/',$1);
-		    foreach my $part (@parts) {
-			$path .= '/'.$part;
-			if ((-e $path)!=1) {
-			    mkdir($path,0770);
-			}
-		    }
-		}
-		my $destname=$udir.'/'.$ufile;
-		my $transname=$udir.'/'.$ufile.'.in.transit';
-		my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
-		my $response;
-		{
-		    my $ua=new LWP::UserAgent;
-		    my $request=new HTTP::Request('GET',"$remoteurl");
-		    $response=$ua->request($request,$transname);
-		}
-		if ($response->is_error()) {
-		    unlink($transname);
-		    my $message=$response->status_line;
-		    &logthis("LWP GET: $message for $fname ($remoteurl)");
-		    print $client "failed\n";
-		} else {
-		    if (!rename($transname,$destname)) {
-			&logthis("Unable to move $transname to $destname");
-			unlink($transname);
-			print $client "failed\n";
-		    } else {
-			print $client "ok\n";
-		    }
-		}
-	    } else {
-		print $client "not_home\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# --------------------------------------------------------- remove a user file 
-    } elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc.
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
-	    &logthis("$udom - $uname - $ufile");
-	    if ($ufile =~m|/\.\./|) {
-		# any files paths with /../ in them refuse 
-		# to deal with
-		print $client "refused\n";
-	    } else {
-		my $udir=propath($udom,$uname);
-		if (-e $udir) {
-		    my $file=$udir.'/userfiles/'.$ufile;
-		    if (-e $file) {
-			unlink($file);
-			if (-e $file) {
-			    print $client "failed\n";
-			} else {
-			    print $client "ok\n";
-			}
-		    } else {
-			print $client "not_found\n";
-		    }
-		} else {
-		    print $client "not_home\n";
-		}
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# ------------------------------------------ authenticate access to a user file
-    } elsif ($userinput =~ /^tokenauthuserfile/) { # Client only
-	if(isClient) {
-	    my ($cmd,$fname,$session)=split(/:/,$userinput);
-	    chomp($session);
-	    my $reply='non_auth';
-	    if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
-		     $session.'.id')) {
-		while (my $line=<ENVIN>) {
-		    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
-			    }
-		close(ENVIN);
-		print $client $reply."\n";
-	    } else {
-		print $client "invalid_token\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------- unsubscribe
-    } elsif ($userinput =~ /^unsub/) {
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    if (-e $fname) {
-		print $client &unsub($fname,$clientip);
-	    } else {
-		print $client "not_found\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------- subscribe
-    } elsif ($userinput =~ /^sub/) {
-	if(isClient) {
-	    print $client &subscribe($userinput,$clientip);
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------- current version
-    } elsif ($userinput =~ /^currentversion/) {
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    print $client &currentversion($fname)."\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- log
-    } elsif ($userinput =~ /^log/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    my $proname=propath($udom,$uname);
-	    my $now=time;
-	    {
-		my $hfh;
-		if ($hfh=IO::File->new(">>$proname/activity.log")) { 
-		    print $hfh "$now:$clientname:$what\n";
-		    print $client "ok\n"; 
-		} else {
-		    print $client "error: ".($!+0)
-			." IO::File->new Failed "
-			."while attempting log\n";
-		}
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- put
-    } elsif ($userinput =~ /^put/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput,5);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if ($namespace ne 'roles') {
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		my @pairs=split(/\&/,$what);
-		my %hash;
-		if (tie(%hash,'GDBM_File',
-			"$proname/$namespace.db",
-			&GDBM_WRCREAT(),0640)) {
-		    unless ($namespace=~/^nohist\_/) {
-			my $hfh;
-			if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
-		    }
-		    
-		    foreach my $pair (@pairs) {
-			my ($key,$value)=split(/=/,$pair);
-			$hash{$key}=$value;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) failed ".
-			    "while attempting put\n";
-		    }
-		} else {
-		    print $client "error: ".($!)
-			." tie(GDBM) Failed ".
-			"while attempting put\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------- inc
-    } elsif ($userinput =~ /^inc:/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if ($namespace ne 'roles') {
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		my @pairs=split(/\&/,$what);
-		my %hash;
-		if (tie(%hash,'GDBM_File',
-			"$proname/$namespace.db",
-			&GDBM_WRCREAT(),0640)) {
-		    unless ($namespace=~/^nohist\_/) {
-			my $hfh;
-			if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
-		    }
-		    foreach my $pair (@pairs) {
-			my ($key,$value)=split(/=/,$pair);
-			# We could check that we have a number...
-			if (! defined($value) || $value eq '') {
-			    $value = 1;
-			}
-			$hash{$key}+=$value;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) failed ".
-			    "while attempting inc\n";
-		    }
-		} else {
-		    print $client "error: ".($!)
-			." tie(GDBM) Failed ".
-			"while attempting inc\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- rolesput
-    } elsif ($userinput =~ /^rolesput/) {
-	if(isClient) {
-	    &Debug("rolesput");
-	    if ($wasenc==1) {
-		my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
-		    =split(/:/,$userinput);
-		&Debug("cmd = ".$cmd." exedom= ".$exedom.
-		       "user = ".$exeuser." udom=".$udom.
-		       "what = ".$what);
-		my $namespace='roles';
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		my @pairs=split(/\&/,$what);
-		my %hash;
-		if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-		    {
-			my $hfh;
-			if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-			    print $hfh "P:$now:$exedom:$exeuser:$what\n";
-			}
-		    }
-		    
-		    foreach my $pair (@pairs) {
-			my ($key,$value)=split(/=/,$pair);
-			&ManagePermissions($key, $udom, $uname,
-					   &GetAuthType( $udom, 
-							 $uname));
-			$hash{$key}=$value;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) Failed ".
-			    "while attempting rolesput\n";
-		    }
-		} else {
-		    print $client "error: ".($!+0)
-			." tie(GDBM) Failed ".
-			"while attempting rolesput\n";
-			    }
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- rolesdel
-    } elsif ($userinput =~ /^rolesdel/) {
-	if(isClient) {
-	    &Debug("rolesdel");
-	    if ($wasenc==1) {
-		my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
-		    =split(/:/,$userinput);
-		&Debug("cmd = ".$cmd." exedom= ".$exedom.
-		       "user = ".$exeuser." udom=".$udom.
-		       "what = ".$what);
-		my $namespace='roles';
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		my @rolekeys=split(/\&/,$what);
-		my %hash;
-		if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-		    {
-			my $hfh;
-			if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-			    print $hfh "D:$now:$exedom:$exeuser:$what\n";
-			}
-		    }
-		    foreach my $key (@rolekeys) {
-			delete $hash{$key};
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) Failed ".
-			    "while attempting rolesdel\n";
-		    }
-		} else {
-		    print $client "error: ".($!+0)
-			." tie(GDBM) Failed ".
-			"while attempting rolesdel\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- get
-    } elsif ($userinput =~ /^get/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    chomp($what);
-	    my @queries=split(/\&/,$what);
-	    my $proname=propath($udom,$uname);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-		for (my $i=0;$i<=$#queries;$i++) {
-		    $qresult.="$hash{$queries[$i]}&";
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting get\n";
-		}
-	    } else {
-		if ($!+0 == 2) {
-		    print $client "error:No such file or ".
-			"GDBM reported bad block error\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." tie(GDBM) Failed ".
-			"while attempting get\n";
-		}
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------ eget
-    } elsif ($userinput =~ /^eget/) {
-	if (isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    chomp($what);
-	    my @queries=split(/\&/,$what);
-	    my $proname=propath($udom,$uname);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-		for (my $i=0;$i<=$#queries;$i++) {
-		    $qresult.="$hash{$queries[$i]}&";
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    if ($cipher) {
-			my $cmdlength=length($qresult);
-			$qresult.="         ";
-			my $encqresult='';
-			for 
-			    (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
-				$encqresult.=
-				    unpack("H16",
-					   $cipher->encrypt(substr($qresult,$encidx,8)));
-			    }
-			print $client "enc:$cmdlength:$encqresult\n";
-		    } else {
-			print $client "error:no_key\n";
-		    }
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting eget\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting eget\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- del
-    } elsif ($userinput =~ /^del/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    chomp($what);
-	    my $proname=propath($udom,$uname);
-	    my $now=time;
-	    my @keys=split(/\&/,$what);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-		unless ($namespace=~/^nohist\_/) {
-		    my $hfh;
-		    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "D:$now:$what\n"; }
-		}
-		foreach my $key (@keys) {
-		    delete($hash{$key});
-		}
-		if (untie(%hash)) {
-		    print $client "ok\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting del\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting del\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------ keys
-    } elsif ($userinput =~ /^keys/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    my $proname=propath($udom,$uname);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-		foreach my $key (keys %hash) {
-		    $qresult.="$key&";
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting keys\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting keys\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------- dumpcurrent
-    } elsif ($userinput =~ /^currentdump/) {
-	if (isClient) {
-	    my ($cmd,$udom,$uname,$namespace)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    my $qresult='';
-	    my $proname=propath($udom,$uname);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',
-		    "$proname/$namespace.db",
-		    &GDBM_READER(),0640)) {
-			    # Structure of %data:
-		# $data{$symb}->{$parameter}=$value;
-		# $data{$symb}->{'v.'.$parameter}=$version;
-		# since $parameter will be unescaped, we do not
-		# have to worry about silly parameter names...
-		my %data = ();
-		while (my ($key,$value) = each(%hash)) {
-		    my ($v,$symb,$param) = split(/:/,$key);
-		    next if ($v eq 'version' || $symb eq 'keys');
-		    next if (exists($data{$symb}) && 
-			     exists($data{$symb}->{$param}) &&
-			     $data{$symb}->{'v.'.$param} > $v);
-		    $data{$symb}->{$param}=$value;
-		    $data{$symb}->{'v.'.$param}=$v;
-		}
-		if (untie(%hash)) {
-		    while (my ($symb,$param_hash) = each(%data)) {
-			while(my ($param,$value) = each (%$param_hash)){
-			    next if ($param =~ /^v\./);
-			    $qresult.=$symb.':'.$param.'='.$value.'&';
-			}
-		    }
-		    chop($qresult);
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting currentdump\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting currentdump\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# ------------------------------------------------------------------------ dump
-    } elsif ($userinput =~ /^dump/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$regexp)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if (defined($regexp)) {
-		$regexp=&unescape($regexp);
-	    } else {
-		$regexp='.';
-	    }
-	    my $qresult='';
-	    my $proname=propath($udom,$uname);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-		while (my ($key,$value) = each(%hash)) {
-		    if ($regexp eq '.') {
-			$qresult.=$key.'='.$value.'&';
-		    } else {
-			my $unescapeKey = &unescape($key);
-			if (eval('$unescapeKey=~/$regexp/')) {
-			    $qresult.="$key=$value&";
-			}
-		    }
-		}
-		if (untie(%hash)) {
-		    chop($qresult);
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting dump\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting dump\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------------- store
-    } elsif ($userinput =~ /^store/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$rid,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if ($namespace ne 'roles') {
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		my @pairs=split(/\&/,$what);
-		my %hash;
-		if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-		    unless ($namespace=~/^nohist\_/) {
-			my $hfh;
-			if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {
-			    print $hfh "P:$now:$rid:$what\n";
-			}
-		    }
-		    my @previouskeys=split(/&/,$hash{"keys:$rid"});
-		    my $key;
-		    $hash{"version:$rid"}++;
-		    my $version=$hash{"version:$rid"};
-		    my $allkeys=''; 
-		    foreach my $pair (@pairs) {
-			my ($key,$value)=split(/=/,$pair);
-			$allkeys.=$key.':';
-			$hash{"$version:$rid:$key"}=$value;
-		    }
-		    $hash{"$version:$rid:timestamp"}=$now;
-		    $allkeys.='timestamp';
-		    $hash{"$version:keys:$rid"}=$allkeys;
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) Failed ".
-			    "while attempting store\n";
-				}
-		} else {
-		    print $client "error: ".($!+0)
-			." tie(GDBM) Failed ".
-			"while attempting store\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# --------------------------------------------------------------------- restore
-    } elsif ($userinput =~ /^restore/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$rid)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    chomp($rid);
-	    my $proname=propath($udom,$uname);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-		my $version=$hash{"version:$rid"};
-		$qresult.="version=$version&";
-		my $scope;
-		for ($scope=1;$scope<=$version;$scope++) {
-		    my $vkeys=$hash{"$scope:keys:$rid"};
-		    my @keys=split(/:/,$vkeys);
-		    my $key;
-		    $qresult.="$scope:keys=$vkeys&";
-		    foreach $key (@keys) {
-			$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
-		    }                                  
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting restore\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting restore\n";
-	    }
-	} else  {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
+#------------------- Commands not yet in spearate handlers. --------------
+
+
+
 # -------------------------------------------------------------------- chatsend
-    } elsif ($userinput =~ /^chatsend/) {
+   if ($userinput =~ /^chatsend/) {
 	if(isClient) {
 	    my ($cmd,$cdom,$cnum,$newpost)=split(/\:/,$userinput);
 	    &chatadd($cdom,$cnum,$newpost);
@@ -2326,8 +2865,7 @@ sub process_request {
 		print $store2 "done\n";
 		close $store2;
 		print $client "ok\n";
-	    }
-	    else {
+	    } else {
 		print $client "error: ".($!+0)
 		    ." IO::File->new Failed ".
 		    "while attempting queryreply\n";
@@ -2642,21 +3180,21 @@ sub process_request {
 	return 0;
 	
 # ---------------------------------- set current host/domain
-    } elsif ($userinput =~ /^sethost:/) {
+    } elsif ($userinput =~ /^sethost/) {
 	if (isClient) {
 	    print $client &sethost($userinput)."\n";
 	} else {
 	    print $client "refused\n";
 	}
 #---------------------------------- request file (?) version.
-    } elsif ($userinput =~/^version:/) {
+    } elsif ($userinput =~/^version/) {
 	if (isClient) {
 	    print $client &version($userinput)."\n";
 	} else {
 	    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);
@@ -2665,7 +3203,7 @@ sub process_request {
 	    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);
@@ -2675,7 +3213,7 @@ sub process_request {
 	    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);
@@ -2684,7 +3222,7 @@ sub process_request {
 	    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);
@@ -2693,7 +3231,7 @@ sub process_request {
 	    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);
@@ -2703,7 +3241,7 @@ sub process_request {
 	    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;
@@ -2729,7 +3267,7 @@ sub process_request {
 	    print $client "refused\n";
 	}
 #---------------------  read and retrieve institutional code format (for support form).
-    } elsif ($userinput =~/^autoinstcodeformat:/) {
+    } elsif ($userinput =~/^autoinstcodeformat/) {
 	if (isClient) {
 	    my $reply;
 	    my($cmd,$cdom,$course) = split(/:/,$userinput);
@@ -2841,7 +3379,6 @@ sub register_handler {
    
     $Dispatcher{$request_name} = \@entry;
    
-   
 }
 
 
@@ -2888,7 +3425,6 @@ sub catchexception {
     $server->close();
     die($error);
 }
-
 sub timeout {
     &status("Handling Timeout");
     &logthis("<font color='red'>CRITICAL: TIME OUT ".$$."</font>");
@@ -2896,6 +3432,7 @@ sub timeout {
 }
 # -------------------------------- Set signal handlers to record abnormal exits
 
+
 $SIG{'QUIT'}=\&catchexception;
 $SIG{__DIE__}=\&catchexception;
 
@@ -3096,10 +3633,11 @@ sub checkchildren {
     &logthis('Going to check on the children');
     my $docdir=$perlvar{'lonDocRoot'};
     foreach (sort keys %children) {
-	sleep 1;
+	#sleep 1;
         unless (kill 'USR1' => $_) {
 	    &logthis ('Child '.$_.' is dead');
             &logstatus($$.' is dead');
+	    delete($children{$_});
         } 
     }
     sleep 5;
@@ -3118,6 +3656,7 @@ sub checkchildren {
 	    #my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
 	    #$execdir=$perlvar{'lonDaemons'};
 	    #$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`;
+	    delete($children{$_});
 	    alarm(0);
 	  }
         }
@@ -3125,6 +3664,7 @@ sub checkchildren {
     $SIG{ALRM} = 'DEFAULT';
     $SIG{__DIE__} = \&catchexception;
     &status("Finished checking children");
+    &logthis('Finished Checking children');
 }
 
 # --------------------------------------------------------------------- Logging
@@ -3195,17 +3735,19 @@ sub logstatus {
     &status("Doing logging");
     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";
-    $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";
         $fh->close();
     }
+    &status("Finished $$.txt");
+    {
+	open(LOG,">>$docdir/lon-status/londstatus.txt");
+	flock(LOG,LOCK_EX);
+	print LOG $$."\t".$clientname."\t".$currenthostid."\t"
+	    .$status."\t".$lastlog."\t $keymode\n";
+	flock(DB,LOCK_UN);
+	close(LOG);
+    }
     &status("Finished logging");
 }
 
@@ -3520,8 +4062,7 @@ sub make_new_child {
 			$inittype = ""; # This forces insecure attempt.
 			&logthis("<font color=\"blue\"> Certificates not "
 				 ."installed -- trying insecure auth</font>");
-		    }
-		    else {	# SSL certificates are in place so
+		    } else {	# SSL certificates are in place so
 		    }		# Leave the inittype alone.
 		}
 
@@ -3644,7 +4185,7 @@ sub make_new_child {
 #    user      - Name of the user for which the role is being put.
 #    authtype  - The authentication type associated with the user.
 #
-sub ManagePermissions
+sub manage_permissions
 {
 
     my ($request, $domain, $user, $authtype) = @_;
@@ -3657,17 +4198,89 @@ sub ManagePermissions
 	system("$execdir/lchtmldir $userhome $user $authtype");
     }
 }
+
+
+#
+#  Return the full path of a user password file, whether it exists or not.
+# Parameters:
+#   domain     - Domain in which the password file lives.
+#   user       - name of the user.
+# Returns:
+#    Full passwd path:
+#
+sub password_path {
+    my ($domain, $user) = @_;
+
+
+    my $path   = &propath($domain, $user);
+    $path  .= "/passwd";
+
+    return $path;
+}
+
+#   Password Filename
+#   Returns the path to a passwd file given domain and user... only if
+#  it exists.
+# Parameters:
+#   domain    - Domain in which to search.
+#   user      - username.
+# Returns:
+#   - If the password file exists returns its path.
+#   - If the password file does not exist, returns undefined.
+#
+sub password_filename {
+    my ($domain, $user) = @_;
+
+    Debug ("PasswordFilename called: dom = $domain user = $user");
+
+    my $path  = &password_path($domain, $user);
+    Debug("PasswordFilename got path: $path");
+    if(-e $path) {
+	return $path;
+    } else {
+	return undef;
+    }
+}
+
+#
+#   Rewrite the contents of the user's passwd file.
+#  Parameters:
+#    domain    - domain of the user.
+#    name      - User's name.
+#    contents  - New contents of the file.
+# Returns:
+#   0    - Failed.
+#   1    - Success.
 #
-#   GetAuthType - Determines the authorization type of a user in a domain.
+sub rewrite_password_file {
+    my ($domain, $user, $contents) = @_;
+
+    my $file = &password_filename($domain, $user);
+    if (defined $file) {
+	my $pf = IO::File->new(">$file");
+	if($pf) {
+	    print $pf "$contents\n";
+	    return 1;
+	} else {
+	    return 0;
+	}
+    } else {
+	return 0;
+    }
+
+}
+
+#
+#   get_auth_type - Determines the authorization type of a user in a domain.
 
 #     Returns the authorization type or nouser if there is no such user.
 #
-sub GetAuthType 
+sub get_auth_type 
 {
 
     my ($domain, $user)  = @_;
 
-    Debug("GetAuthType( $domain, $user ) \n");
+    Debug("get_auth_type( $domain, $user ) \n");
     my $proname    = &propath($domain, $user); 
     my $passwdfile = "$proname/passwd";
     if( -e $passwdfile ) {
@@ -3683,13 +4296,132 @@ sub GetAuthType
 	}
 
 	return "$authtype:$availinfo";
-    }
-    else {
+    } else {
 	Debug("Returning nouser");
 	return "nouser";
     }
 }
 
+#
+#  Validate a user given their domain, name and password.  This utility
+#  function is used by both  AuthenticateHandler and ChangePasswordHandler
+#  to validate the login credentials of a user.
+# Parameters:
+#    $domain    - The domain being logged into (this is required due to
+#                 the capability for multihomed systems.
+#    $user      - The name of the user being validated.
+#    $password  - The user's propoposed password.
+#
+# Returns:
+#     1        - The domain,user,pasword triplet corresponds to a valid
+#                user.
+#     0        - The domain,user,password triplet is not a valid user.
+#
+sub validate_user {
+    my ($domain, $user, $password) = @_;
+
+
+    # Why negative ~pi you may well ask?  Well this function is about
+    # authentication, and therefore very important to get right.
+    # I've initialized the flag that determines whether or not I've 
+    # validated correctly to a value it's not supposed to get.
+    # 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.
+
+    my $validated = -3.14159;
+
+    #  How we authenticate is determined by the type of authentication
+    #  the user has been assigned.  If the authentication type is
+    #  "nouser", the user does not exist so we will return 0.
+
+    my $contents = &get_auth_type($domain, $user);
+    my ($howpwd, $contentpwd) = split(/:/, $contents);
+
+    my $null = pack("C",0);	# Used by kerberos auth types.
+
+    if ($howpwd ne 'nouser') {
+
+	if($howpwd eq "internal") { # Encrypted is in local password file.
+	    $validated = (crypt($password, $contentpwd) eq $contentpwd);
+	}
+	elsif ($howpwd eq "unix") { # User is a normal unix user.
+	    $contentpwd = (getpwnam($user))[1];
+	    if($contentpwd) {
+		if($contentpwd eq 'x') { # Shadow password file...
+		    my $pwauth_path = "/usr/local/sbin/pwauth";
+		    open PWAUTH,  "|$pwauth_path" or
+			die "Cannot invoke authentication";
+		    print PWAUTH "$user\n$password\n";
+		    close PWAUTH;
+		    $validated = ! $?;
+
+		} else { 	         # Passwords in /etc/passwd. 
+		    $validated = (crypt($password,
+					$contentpwd) eq $contentpwd);
+		}
+	    } else {
+		$validated = 0;
+	    }
+	}
+	elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain.
+	    if(! ($password =~ /$null/) ) {
+		my $k4error = &Authen::Krb4::get_pw_in_tkt($user,
+							   "",
+							   $contentpwd,,
+							   'krbtgt',
+							   $contentpwd,
+							   1,
+							   $password);
+		if(!$k4error) {
+		    $validated = 1;
+		} else {
+		    $validated = 0;
+		    &logthis('krb4: '.$user.', '.$contentpwd.', '.
+			     &Authen::Krb4::get_err_txt($Authen::Krb4::error));
+		}
+	    } else {
+		$validated = 0; # Password has a match with null.
+	    }
+	} elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.
+	    if(!($password =~ /$null/)) { # Null password not allowed.
+		my $krbclient = &Authen::Krb5::parse_name($user.'@'
+							  .$contentpwd);
+		my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
+		my $krbserver  = &Authen::Krb5::parse_name($krbservice);
+		my $credentials= &Authen::Krb5::cc_default();
+		$credentials->initialize($krbclient);
+		my $krbreturn  = &Authen::KRb5::get_in_tkt_with_password($krbclient,
+									 $krbserver,
+									 $password,
+									 $credentials);
+		$validated = ($krbreturn == 1);
+	    } else {
+		$validated = 0;
+	    }
+	} elsif ($howpwd eq "localauth") { 
+	    #  Authenticate via installation specific authentcation method:
+	    $validated = &localauth::localauth($user, 
+					       $password, 
+					       $contentpwd);
+	} else {			# Unrecognized auth is also bad.
+	    $validated = 0;
+	}
+    } else {
+	$validated = 0;
+    }
+    #
+    #  $validated has the correct stat of the authentication:
+    #
+
+    unless ($validated != -3.14159) {
+	die "ValidateUser - failed to set the value of validated";
+    }
+    return $validated;
+}
+
+
 sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;
     my $contents;
@@ -3935,7 +4667,9 @@ sub make_passwd_file {
 		return "no_priv_account_error\n";
 	    }
 
-	    my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
+	    my $execpath       ="$perlvar{'lonDaemons'}/"."lcuseradd";
+
+	    my $lc_error_file  = $execdir."/tmp/lcuseradd".$$.".status";
 	    {
 		&Debug("Executing external: ".$execpath);
 		&Debug("user  = ".$uname.", Password =". $npass);
@@ -3943,17 +4677,27 @@ sub make_passwd_file {
 		print $se "$uname\n";
 		print $se "$npass\n";
 		print $se "$npass\n";
+		print $se "$lc_error_file\n"; # Status -> unique file.
 	    }
-	    my $useraddok = $?;
+	    my $error = IO::File->new("< $lc_error_file");
+	    my $useraddok = <$error>;
+	    $error->close;
+	    unlink($lc_error_file);
+
+	    chomp $useraddok;
+
 	    if($useraddok > 0) {
-		&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok));
+		my $error_text = &lcuseraddstrerror($useraddok);
+		&logthis("Failed lcuseradd: $error_text");
+		$result = "lcuseradd_failed:$error_text\n";
+	    }  else {
+		my $pf = IO::File->new(">$passfilename");
+		print $pf "unix:\n";
 	    }
-	    my $pf = IO::File->new(">$passfilename");
-	    print $pf "unix:\n";
 	}
     } elsif ($umode eq 'none') {
 	{
-	    my $pf = IO::File->new(">$passfilename");
+	    my $pf = IO::File->new("> $passfilename");
 	    print $pf "none:\n";
 	}
     } else {
@@ -4282,7 +5026,7 @@ Place in B<logs/lond.log>
 
 stores hash in namespace
 
-=item rolesput
+=item rolesputy
 
 put a role into a user's environment