--- loncom/lond	2004/02/24 16:51:40	1.178.2.4
+++ loncom/lond	2004/03/22 09:05:11	1.178.2.9
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.178.2.4 2004/02/24 16:51:40 albertel Exp $
+# $Id: lond,v 1.178.2.9 2004/03/22 09:05:11 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -53,7 +53,7 @@ my $DEBUG = 1;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.178.2.4 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.9 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
@@ -161,7 +161,108 @@ sub isManager {
 sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }
+#
+#  Ties a domain level resource file to a hash.
+#  If requested a history entry is created in the associated hist file.
+#
+#  Parameters:
+#     domain    - Name of the domain in which the resource file lives.
+#     namespace - Name of the hash within that domain.
+#     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
+#     loghead   - Optional parameter, if present a log entry is created
+#                 in the associated history file and this is the first part
+#                  of that entry.
+#     logtail   - Goes along with loghead,  The actual logentry is of the
+#                 form $loghead:<timestamp>:logtail.
+# Returns:
+#    Reference to a hash bound to the db file or alternatively undef
+#    if the tie failed.
+#
+sub TieDomainHash {
+    my $domain    = shift;
+    my $namespace = shift;
+    my $how       = shift;
+
+    # Filter out any whitespace in the domain name:
 
+    $domain =~ s/\W//g;
+
+    # We have enough to go on to tie the hash:
+
+    my $UserTopDir   = $perlvar('lonUsersDir');
+    my $DomainDir    = $UserTopDir."/$domain";
+    my $ResourceFile = $DomainDir."/$namespace.db";
+    my %hash;
+    if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
+	if (scalar @_) {	# Need to log the operation.
+	    my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
+	    if($logFH) {
+		my $TimeStamp = time;
+		my ($loghead, $logtail) = @_;
+		print $logFH "$loghead:$TimeStamp:$logtail\n";
+	    }
+	}
+	return \%hash;		# Return the tied hash.
+    }
+    else {
+	return undef;		# Tie failed.
+    }
+}
+
+#
+#   Ties a user's resource file to a hash.  
+#   If necessary, an appropriate history
+#   log file entry is made as well.
+#   This sub factors out common code from the subs that manipulate
+#   the various gdbm files that keep keyword value pairs.
+# Parameters:
+#   domain       - Name of the domain the user is in.
+#   user         - Name of the 'current user'.
+#   namespace    - Namespace representing the file to tie.
+#   how          - What the tie is done to (e.g. GDBM_WRCREAT().
+#   loghead      - Optional first part of log entry if there may be a
+#                  history file.
+#   what         - Optional tail of log entry if there may be a history
+#                  file.
+# Returns:
+#   hash to which the database is tied.  It's up to the caller to untie.
+#   undef if the has could not be tied.
+#
+sub TieUserHash {
+  my $domain      = shift;
+  my $user        = shift;
+  my $namespace   = shift;
+  my $how         = shift;
+
+  $namespace=~s/\//\_/g;	# / -> _
+  $namespace=~s/\W//g;		# whitespace eliminated.
+  my $proname     = propath($domain, $user);
+
+  # If this is a namespace for which a history is kept,
+  # make the history log entry:
+
+
+  unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {
+    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
+    if($hfh) {
+      my $now = time;
+      my $loghead  = shift;
+      my $what    = shift;
+      print $hfh "$loghead:$now:$what\n";
+    }
+  }
+  #  Tie the database.
+
+  my %hash;
+  if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db",
+	 $how, 0640)) {
+    return \%hash;
+  }
+  else {
+    return undef;
+  }
+  
+}
 
 #
 #   Get a Request:
@@ -460,7 +561,16 @@ sub UserAuthorizationType {
     if($result eq "nouser") {
 	Failure( $replyfd, "unknown_user\n", $userinput);
     } else {
-	Reply( $replyfd, "$result\n", $userinput);
+	#
+	# We only want to pass the second field from GetAuthType
+	# 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;
@@ -628,17 +738,11 @@ sub AuthenticateHandler {
     Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
     chomp($upass);
     $upass=unescape($upass);
-    my $proname=propath($udom,$uname);
-    my $passfilename="$proname/passwd";
-   
-    #   The user's 'personal' loncapa passworrd file describes how to authenticate:
-   
-    if (-e $passfilename) {
-	Debug("Located password file: $passfilename");
 
-	my $pf = IO::File->new($passfilename);
-	my $realpasswd=<$pf>;
-	chomp($realpasswd);
+    # Fetch the user authentication information:
+   
+    my $realpasswd = GetAuthType($udom, $uname);
+    if($realpasswd ne "nouser") { # nouser means no passwd file.
 	my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
 	my $pwdcorrect=0;
 	#
@@ -658,10 +762,10 @@ sub AuthenticateHandler {
 	    } else {
 		$contentpwd=(getpwnam($uname))[1];
 		my $pwauth_path="/usr/local/sbin/pwauth";
-		unless ($contentpwd eq 'x') {
+		unless ($contentpwd eq 'x') { # Not in shadow file.
 		    $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
-		} elsif (-e $pwauth_path) {
-		    open PWAUTH, "|$pwauth_path" or
+		} elsif (-e $pwauth_path) { # In shadow file so
+		    open PWAUTH, "|$pwauth_path" or # use external program
 			die "Cannot invoke authentication";
 		    print PWAUTH "$uname\n$upass\n";
 		    close PWAUTH;
@@ -729,14 +833,11 @@ sub AuthenticateHandler {
 	} else {
 	    Failure( $client, "non_authorized\n", $userinput);
 	}
-	#
-	#  User bad... note it may be bad security practice to
-	#  differntiate to the caller a bad user from a bad
-	#  passwd... since that supplies covert channel information
-	#  (you have a good user but bad password e.g.) to guessers.
-	#
+	#  Used to be unknown_user but that allows crackers to 
+	#  distinguish between bad username and bad password so...
+	#  
     } else {
-	Failure( $client, "unknown_user\n", $userinput);
+	Failure( $client, "non_authorized\n", $userinput);
     }
     return 1;
 }
@@ -781,15 +882,8 @@ sub ChangePasswordHandler {
     $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 $realpasswd  = GetAuthType($udom, $uname);
+    if ($realpasswd ne "nouser") {
 	my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
 	if ($howpwd eq 'internal') {
 	    &Debug("internal auth");
@@ -797,19 +891,15 @@ sub ChangePasswordHandler {
 		my $salt=time;
 		$salt=substr($salt,6,2);
 		my $ncpass=crypt($npass,$salt);
-		{
-		    my $pf = IO::File->new(">$passfilename");
-		    if ($pf) {
-			print $pf "internal:$ncpass\n";
-			&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);
-		    }
-		}             
+		if(RewritePwFile($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);
+		}
 	    } else {
 		Failure($client, "non_authorized\n", $userinput);
 	    }
@@ -849,10 +939,17 @@ sub ChangePasswordHandler {
 		Reply($client, "non_authorized\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).
+	    #
 	    Reply( $client, "auth_mode_error\n", $userinput);
 	}  
     } else {
-	Reply( $client, "unknown_user\n", $userinput);
+	#  used to be unknonw user but that gives out too much info..
+	#  so make it the same as if the initial passwd was bad.
+	#
+	Reply( $client, "non_authorized\n", $userinput);
     }
     return 1;
 }
@@ -878,42 +975,48 @@ sub AddUserHandler {
     my $cmd     = shift;
     my $tail    = shift;
     my $client  = shift;
-    
-    my $userinput = $cmd.":".$tail;   
 
-    my $oldumask=umask(0077);
     my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
+    my $userinput = $cmd.":".$tail; # Reconstruct the full request line.
+
     &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) {
-	Failure( $client, "already_exists\n", $userinput);
-    } elsif ($udom ne $currentdomainid) {
-	Failure($client, "not_right_domain\n", $userinput);
-    } 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";
+
+
+    if($udom eq $currentdomainid) { # Reject new users for other domains...
+	
+	my $oldumask=umask(0077);
+	chomp($npass);
+	$npass=&unescape($npass);
+	my $passfilename  = PasswordPath($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) {
+		    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);
+	    }
 	}
-	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.
+    
     }
-    umask($oldumask);
     return 1;
 
 }
@@ -949,16 +1052,21 @@ sub ChangeAuthenticationHandler {
     my $userinput  = "$cmd:$tail";              # Reconstruct user input.
 
     my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
-    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) {
 	Failure( $client, "not_right_domain\n", $client);
     } else {
-	my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
-	Reply($client, $result, $userinput);
+	
+	chomp($npass);
+	
+	$npass=&unescape($npass);
+	my $passfilename = PasswordPath($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;
 }
@@ -989,8 +1097,8 @@ sub IsHomeHandler {
    
     my ($udom,$uname)=split(/:/,$tail);
     chomp($uname);
-    my $proname=propath($udom,$uname);
-    if (-e $proname) {
+    my $passfile = PasswordPath($udom, $uname);
+    if($passfile) {
 	Reply( $client, "found\n", $userinput);
     } else {
 	Failure($client, "not_found\n", $userinput);
@@ -1139,7 +1247,8 @@ RegisterHandler("fetchuserfile", \&Fetch
 #
 #   Authenticate access to a user file.  Question?   The token for athentication
 #   is allowed to be sent as cleartext is this really what we want?  This token
-#   represents the user's session id.  Once it is forged does this allow too much access??
+#   represents the user's session id.  Once it is forged does this allow too much 
+#   access??
 #
 # Parameters:
 #    $cmd      - The command that got us here.
@@ -1149,9 +1258,9 @@ RegisterHandler("fetchuserfile", \&Fetch
 #     0        - Requested to exit, caller should shut down.
 #     1        - Continue processing.
 sub AuthenticateUserFileAccess {
-    my $cmd   = shift;
-    my $tail    = shift;
-    my $client = shift;
+    my $cmd       = shift;
+    my $tail      = shift;
+    my $client    = shift;
     my $userinput = "$cmd:$tail";
 
     my ($fname,$session)=split(/:/,$tail);
@@ -1273,7 +1382,7 @@ sub ActivityLogEntryHandler {
 	print $hfh "$now:$clientname:$what\n";
 	Reply( $client, "ok\n", $userinput); 
     } else {
-	Reply($client, "error: ".($!+0)." IO::File->new Failed "
+	Failure($client, "error: ".($!+0)." IO::File->new Failed "
 	      ."while attempting log\n", 
 	      $userinput);
     }
@@ -1302,42 +1411,32 @@ sub PutUserProfileEntry {
     my $userinput = "$cmd:$tail";
 
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
-    $namespace=~s/\//\_/g;
-    $namespace=~s/\W//g;
     if ($namespace ne 'roles') {
-	chomp($what);
-	my $proname=propath($udom,$uname);
-	my $now=time;
-	unless ($namespace=~/^nohist\_/) {
-	    my $hfh;
-	    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-		print $hfh "P:$now:$what\n"; 
-	    }
-	}
-	my @pairs=split(/\&/,$what);
-	my %hash;
-	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
-		&GDBM_WRCREAT(),0640)) {
-	    foreach my $pair (@pairs) {
-		my ($key,$value)=split(/=/,$pair);
-		$hash{$key}=$value;
-	    }
-	    if (untie(%hash)) {
-		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;
+       chomp($what);
+       my $hashref = TieUserHash($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;
 }
 RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);
 
@@ -1360,47 +1459,38 @@ sub IncrementUserValueHandler {
     my $cmd         = shift;
     my $tail        = shift;
     my $client      = shift;
-    my $userinput   = shift;
+    my $userinput   = "$cmd:$tail";
 
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
-    $namespace=~s/\//\_/g;
-    $namespace=~s/\W//g;
     if ($namespace ne 'roles') {
-	chomp($what);
-	my $proname=propath($udom,$uname);
-	my $now=time;
-	unless ($namespace=~/^nohist\_/) {
-	    my $hfh;
-	    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-		print $hfh "P:$now:$what\n";
-	    }
-	}
-	my @pairs=split(/\&/,$what);
-	my %hash;
-	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),
-		0640)) {
-	    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)) {
-		Reply( $client, "ok\n", $userinput);
-	    } else {
-		Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
-			"while attempting put\n", $userinput);
-	    }
-	} else {
-	    Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-		    "while attempting put\n", $userinput);
-	}
-    } else {
-	Failure($client, "refused\n", $userinput);
-    }
-
+        chomp($what);
+	my $hashref = TieUserHash($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;
 }
 RegisterHandler("inc", \&IncrementUserValueHandler, 0, 1, 0);
@@ -1435,29 +1525,23 @@ sub RolesPutHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $proname=propath($udom,$uname);
-    my $now=time;
+    my $hashref = TieUserHash($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.
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-	    print $hfh "P:$now:$exedom:$exeuser:$what\n";
-	}
-    }
-    my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_WRCREAT(),0640)) {
+    if ($hashref) {
+	my @pairs=split(/\&/,$what);
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-            &ManagePermissions($key, $udom, $uname,
-                               &GetAuthType( $udom, $uname));
-            $hash{$key}=$value;
+	    &ManagePermissions($key, $udom, $uname,
+			       &GetAuthType( $udom, $uname));
+	    $hashref->{$key}=$value;
 	}
-	if (untie(%hash)) {
+	if (untie($hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -1498,36 +1582,26 @@ sub RolesDeleteHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $proname=propath($udom,$uname);
-    my $now=time;
-    #
-    #   Log the attempt. This {}'ing is done to ensure that the
-    #   logfile is flushed and closed as quickly as possible.  Hopefully
-    #   this preserves both time ordering and reduces the probability that
-    #   messages will be interleaved.
-    #
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-	    print $hfh "D:$now:$exedom:$exeuser:$what\n";
-	}
-    }
-    my @rolekeys=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_WRCREAT(),0640)) {
-	foreach my $key (@rolekeys) {
-	    delete $hash{$key};
-	}
-	if (untie(%hash)) {
-	    Reply($client, "ok\n", $userinput);
+    my $hashref = TieUserHash($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);
+	   Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting rolesdel\n", $userinput);
 	}
-    } else {
-	Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+     } else {
+        Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
 		 "while attempting rolesdel\n", $userinput);
-    }
+     }
     
     return 1;
 }
@@ -1559,19 +1633,18 @@ sub GetProfileEntry {
     my $userinput= "$cmd:$tail";
    
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
-    $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)) {
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my @queries=split(/\&/,$what);
+        my $qresult='';
+
 	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hash{$queries[$i]}&";    # Presumably failure gives empty string.
+	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
 	}
-	if (untie(%hash)) {
-	    $qresult=~s/\&$//;              # Remove trailing & from last lookup.
+	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
+	if (untie(%$hashref)) {
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
 	    Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -1615,18 +1688,16 @@ sub GetProfileEntryEncrypted {
     my $userinput = "$cmd:$tail";
    
     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)) {
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+				  &GDBM_READER());
+    if ($hashref) {
+        my @queries=split(/\&/,$what);
+        my $qresult='';
 	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hash{$queries[$i]}&";
+	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    if ($cipher) {
 		my $cmdlength=length($qresult);
@@ -1672,31 +1743,24 @@ RegisterHandler("eget", \&GetProfileEncr
 #     0   - Exit server.
 #
 #
-sub DeletProfileEntry {
+
+sub DeleteProfileEntry {
     my $cmd      = shift;
     my $tail     = shift;
     my $client   = shift;
     my $userinput = "cmd:$tail";
 
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
-    $namespace=~s/\//\_/g;
-    $namespace=~s/\W//g;
     chomp($what);
-    my $proname=propath($udom,$uname);
-    my $now=time;
-    unless ($namespace=~/^nohist\_/) {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
-	    print $hfh "D:$now:$what\n"; 
-	}
-    }
-    my @keys=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+				  &GDBM_WRCREAT(),
+				  "D",$what);
+    if ($hashref) {
+        my @keys=split(/\&/,$what);
 	foreach my $key (@keys) {
-	    delete($hash{$key});
+	    delete($hashref->{$key});
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -1731,16 +1795,14 @@ sub GetProfileKeys {
     my $userinput = "$cmd:$tail";
 
     my ($udom,$uname,$namespace)=split(/:/,$tail);
-    $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) {
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+				  &GDBM_READER());
+    if ($hashref) {
+	foreach my $key (keys %$hashref) {
 	    $qresult.="$key&";
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -1781,19 +1843,18 @@ sub DumpProfileDatabase {
     my $userinput = "$cmd:$tail";
    
     my ($udom,$uname,$namespace) = split(/:/,$tail);
-    $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)) {
+    my $hashref = TieUserHash($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...
+ 	# have to worry about silly parameter names...
+
+        my $qresult='';
 	my %data = ();                     # A hash of anonymous hashes..
-	while (my ($key,$value) = each(%hash)) {
+	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}) && 
@@ -1802,7 +1863,7 @@ sub DumpProfileDatabase {
 	    $data{$symb}->{$param}=$value;
 	    $data{$symb}->{'v.'.$param}=$v;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    while (my ($symb,$param_hash) = each(%data)) {
 		while(my ($param,$value) = each (%$param_hash)){
 		    next if ($param =~ /^v\./);       # Ignore versions...
@@ -1858,20 +1919,16 @@ sub DumpWithRegexp {
     my $userinput = "$cmd:$tail";
 
     my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
-    $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)) {
-	study($regexp);
-	while (my ($key,$value) = each(%hash)) {
+    my $hashref =TieUserHash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my $qresult='';
+	while (my ($key,$value) = each(%$hashref)) {
 	    if ($regexp eq '.') {
 		$qresult.=$key.'='.$value.'&';
 	    } else {
@@ -1881,7 +1938,7 @@ sub DumpWithRegexp {
 		}
 	    }
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -1923,36 +1980,29 @@ sub StoreHandler {
     my $userinput = "$cmd:$tail";
 
     my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);
-    $namespace=~s/\//\_/g;
-    $namespace=~s/\W//g;
     if ($namespace ne 'roles') {
+
 	chomp($what);
-	my $proname=propath($udom,$uname);
-	my $now=time;
-	unless ($namespace=~/^nohist\_/) {
-	    my $hfh;
-	    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {
-		print $hfh "P:$now:$rid:$what\n"; 
-	    }
-	}
 	my @pairs=split(/\&/,$what);
-	my %hash;
-	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
-		&GDBM_WRCREAT(),0640)) {
-	    my @previouskeys=split(/&/,$hash{"keys:$rid"});
+	my $hashref  = TieUserHash($udom, $uname, $namespace,
+				       &GDBM_WRCREAT(), "P",
+				       "$rid:$what");
+	if ($hashref) {
+	    my $now = time;
+	    my @previouskeys=split(/&/,$hashref->{"keys:$rid"});
 	    my $key;
-	    $hash{"version:$rid"}++;
-	    my $version=$hash{"version:$rid"};
+	    $hashref->{"version:$rid"}++;
+	    my $version=$hashref->{"version:$rid"};
 	    my $allkeys=''; 
 	    foreach my $pair (@pairs) {
 		my ($key,$value)=split(/=/,$pair);
 		$allkeys.=$key.':';
-		$hash{"$version:$rid:$key"}=$value;
+		$hashref->{"$version:$rid:$key"}=$value;
 	    }
-	    $hash{"$version:$rid:timestamp"}=$now;
+	    $hashref->{"$version:$rid:timestamp"}=$now;
 	    $allkeys.='timestamp';
-	    $hash{"$version:keys:$rid"}=$allkeys;
-	    if (untie(%hash)) {
+	    $hashref->{"$version:keys:$rid"}=$allkeys;
+	    if (untie($hashref)) {
 		Reply($client, "ok\n", $userinput);
 	    } else {
 		Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2029,7 +2079,7 @@ sub RestoreHandler {
 
 
 }
-RegisterHandler("restor", \&RestoreHandler, 0,1,0);
+RegisterHandler("restore", \&RestoreHandler, 0,1,0);
 
 #
 #   Add a chat message to to a discussion board.
@@ -2213,20 +2263,17 @@ sub PutCourseIdHandler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname=
-	"$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
     my $now=time;
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value.':'.$now;
+	    $hashref->{$key}=$value.':'.$now;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure( $client, "error: ".($!+0)
@@ -2281,10 +2328,10 @@ sub DumpCourseIdHandler {
     }
     unless (defined($since)) { $since=0; }
     my $qresult='';
-    my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-	while (my ($key,$value) = each(%hash)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+	while (my ($key,$value) = each(%$hashref)) {
 	    my ($descr,$lasttime)=split(/\:/,$value);
 	    if ($lasttime<$since) { 
 		next; 
@@ -2298,7 +2345,7 @@ sub DumpCourseIdHandler {
 		}
 	    }
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2339,23 +2386,15 @@ sub PutIdHandler {
 
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-    my $now=time;
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname.hist")) { 
-	    print $hfh "P:$now:$what\n"; 
-	}
-    }
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(),
+				"P", $what);
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value;
+	    $hashref->{$key}=$value;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2398,16 +2437,14 @@ sub GetIdHandler {
 
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
     my @queries=split(/\&/,$what);
     my $qresult='';
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_READER());
+    if ($hashref) {
 	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hash{$queries[$i]}&";
+	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -4109,6 +4146,77 @@ 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 PasswordPath {
+    my $domain = shift;
+    my $user   = shift;
+
+    my $path   = &propath($domain, $user);
+    my $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 PasswordFilename {
+    my $domain    = shift;
+    my $user      = shift;
+
+    my $path  = PasswordPath($domain, $user);
+
+    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.
+#
+sub RewritePwFile {
+    my $domain   = shift;
+    my $user     = shift;
+    my $contents = shift;
+
+    my $file = PasswordFilename($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;
+    }
+
+}
 #
 #   GetAuthType - Determines the authorization type of a user in a domain.
 
@@ -4119,21 +4227,13 @@ sub GetAuthType {
     my $user   = shift;
 
     Debug("GetAuthType( $domain, $user ) \n");
-    my $proname    = &propath($domain, $user); 
-    my $passwdfile = "$proname/passwd";
-    if( -e $passwdfile ) {
+    my $passwdfile = PasswordFilename($domain, $user);
+    if( defined $passwdfile ) {
 	my $pf = IO::File->new($passwdfile);
 	my $realpassword = <$pf>;
 	chomp($realpassword);
 	Debug("Password info = $realpassword\n");
-	my ($authtype, $contentpwd) = split(/:/, $realpassword);
-	Debug("Authtype = $authtype, content = $contentpwd\n");
-	my $availinfo = '';
-	if($authtype eq 'krb4' or $authtype eq 'krb5') {
-	    $availinfo = $contentpwd;
-	}
-
-	return "$authtype:$availinfo";
+	return $realpassword;
     } else {
 	Debug("Returning nouser");
 	return "nouser";