--- loncom/lond	2004/03/22 09:05:11	1.178.2.9
+++ loncom/lond	2004/04/15 11:26:34	1.178.2.16
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.178.2.9 2004/03/22 09:05:11 foxr Exp $
+# $Id: lond,v 1.178.2.16 2004/04/15 11:26:34 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.9 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.16 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
@@ -182,24 +182,24 @@ 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 $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) {
+	    if($logFh) {
 		my $TimeStamp = time;
 		my ($loghead, $logtail) = @_;
-		print $logFH "$loghead:$TimeStamp:$logtail\n";
+		print $logFh "$loghead:$TimeStamp:$logtail\n";
 	    }
 	}
 	return \%hash;		# Return the tied hash.
@@ -229,39 +229,39 @@ sub TieDomainHash {
 #   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;
-  }
-  
+    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;
+    }
+    
 }
 
 #
@@ -725,120 +725,30 @@ sub AuthenticateHandler {
     my $cmd        = shift;
     my $tail       = shift;
     my $client     = shift;
-   
+    
     #  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);
 
-    # 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;
+    my $pwdcorrect = ValidateUser($udom, $uname, $upass);
+    if($pwdcorrect) {
+	Reply( $client, "authorized\n", $userinput);
 	#
-	#   Authenticate against password stored in the internal file.
+	#  Bad credentials: Failed to authorize
 	#
-	Debug("Authenticating via $howpwd");
-	if ($howpwd eq 'internal') {
-	    &Debug("Internal auth");
-	    $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
-	    #
-	    #   Authenticate against the unix password file.
-	    #
-	} 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') { # Not in shadow file.
-		    $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
-		} 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;
-		    $pwdcorrect=!$?;
-		}
-	    }
-	    #
-	    #   Authenticate against a Kerberos 4 server:
-	    #
-	} 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.','.$contentpwd.','.
-				 &Authen::Krb4::get_err_txt($Authen::Krb4::error));
-		    }
-		}
-	    }
-	    #
-	    #   Authenticate against a Kerberos 5 server:
-	    #
-	} 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);
-		$pwdcorrect = ($krbreturn == 1);
-	    } else { 
-		$pwdcorrect=0; 
-	    }
-	    #
-	    #  Finally, the user may have written in an authentication module.
-	    #  in that case, if requested, authenticate against it.
-	    #
-	} elsif ($howpwd eq 'localauth') {
-	    $pwdcorrect=&localauth::localauth($uname,$upass,$contentpwd);
-	}
-	#
-	#   Successfully authorized.
-	#
-	if ($pwdcorrect) {
-	    Reply( $client, "authorized\n", $userinput);
-	    #
-	    #  Bad credentials: Failed to authorize
-	    #
-	} else {
-	    Failure( $client, "non_authorized\n", $userinput);
-	}
-	#  Used to be unknown_user but that allows crackers to 
-	#  distinguish between bad username and bad password so...
-	#  
     } else {
 	Failure( $client, "non_authorized\n", $userinput);
     }
+
     return 1;
 }
 RegisterHandler("auth", \&AuthenticateHandler, 1, 1, 0);
@@ -882,62 +792,44 @@ sub ChangePasswordHandler {
     $upass=&unescape($upass);
     $npass=&unescape($npass);
     &Debug("Trying to change password for $uname");
-    my $realpasswd  = GetAuthType($udom, $uname);
-    if ($realpasswd ne "nouser") {
+
+    # First require that the user can be authenticated with their
+    # old password:
+
+    my $validated = ValidateUser($udom, $uname, $upass);
+    if($validated) {
+	my $realpasswd  = GetAuthType($udom, $uname); # Defined since authd.
+	
 	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);
-		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);
-		}
+	    my $salt=time;
+	    $salt=substr($salt,6,2);
+	    my $ncpass=crypt($npass,$salt);
+	    if(RewritePwFile($udom, $uname, "internal:$ncpass")) {
+		&logthis("Result of password change for "
+			 ."$uname: pwchange_success");
+		Reply($client, "ok\n", $userinput);
 	    } else {
-		Failure($client, "non_authorized\n", $userinput);
+		&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
-	    # 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($?));
-		Reply($client, "$result\n", $userinput);
-	    } else {
-		Reply($client, "non_authorized\n", $userinput);
-	    }
+	    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
@@ -945,12 +837,12 @@ sub ChangePasswordHandler {
 	    #
 	    Reply( $client, "auth_mode_error\n", $userinput);
 	}  
-    } else {
-	#  used to be unknonw user but that gives out too much info..
-	#  so make it the same as if the initial passwd was bad.
-	#
+	
+    }
+    else {
 	Reply( $client, "non_authorized\n", $userinput);
     }
+
     return 1;
 }
 RegisterHandler("passwd", \&ChangePasswordHandler, 1, 1, 0);
@@ -998,6 +890,7 @@ sub AddUserHandler {
 	    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";
@@ -1097,7 +990,7 @@ sub IsHomeHandler {
    
     my ($udom,$uname)=split(/:/,$tail);
     chomp($uname);
-    my $passfile = PasswordPath($udom, $uname);
+    my $passfile = PasswordFilename($udom, $uname);
     if($passfile) {
 	Reply( $client, "found\n", $userinput);
     } else {
@@ -1245,10 +1138,7 @@ sub FetchUserFileHandler {
 }
 RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0);
 #
-#   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??
+#   Authenticate access to a user file. 
 #
 # Parameters:
 #    $cmd      - The command that got us here.
@@ -1308,7 +1198,7 @@ sub UnsubscribeHandler {
 }
 RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0);
 
-#   Subscribe to a resource.
+#   Subscribe to a resource
 #
 # Parameters:
 #    $cmd      - The command that got us here.
@@ -1409,34 +1299,34 @@ sub PutUserProfileEntry {
     my $tail      = shift;
     my $client    = shift;
     my $userinput = "$cmd:$tail";
-
+    
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {
-       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 {
+	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;
+    return 1;
 }
 RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);
 
@@ -1465,31 +1355,31 @@ sub IncrementUserValueHandler {
     if ($namespace ne 'roles') {
         chomp($what);
 	my $hashref = TieUserHash($udom, $uname,
-				      $namespace, &GDBM_WRCREAT(),
-				      "P",$what);
+				  $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);
-      }
+	    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;
 }
@@ -1526,8 +1416,8 @@ sub RolesPutHandler {
     my $namespace='roles';
     chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,
-				  &GDBM_WRCREAT(), "P",
-				  "$exedom:$exeuser:$what");
+			      &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
@@ -1583,25 +1473,25 @@ sub RolesDeleteHandler {
     my $namespace='roles';
     chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,
-				  &GDBM_WRCREAT(), "D",
-				  "$exedom:$exeuser:$what");
-
+			      &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);
+	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 {
+    } else {
         Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
 		 "while attempting rolesdel\n", $userinput);
-     }
+    }
     
     return 1;
 }
@@ -1635,11 +1525,11 @@ sub GetProfileEntry {
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,
-				 &GDBM_READER());
+			      &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.
 	}
@@ -1704,9 +1594,10 @@ sub GetProfileEntryEncrypted {
 		$qresult.="         ";
 		my $encqresult='';
 		for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
-		    $encqresult.= unpack("H16", $cipher->encrypt(substr($qresult,
-									$encidx,
-									8)));
+		    $encqresult.= unpack("H16", 
+					 $cipher->encrypt(substr($qresult,
+								 $encidx,
+								 8)));
 		}
 		Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
 	    } else {
@@ -1723,7 +1614,7 @@ sub GetProfileEntryEncrypted {
     
     return 1;
 }
-RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0);
+RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);
 
 #
 #   Deletes a key in a user profile database.
@@ -1851,7 +1742,7 @@ sub DumpProfileDatabase {
 	# $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)) {
@@ -1954,7 +1845,8 @@ sub DumpWithRegexp {
 }
 RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0);
 
-#  Store an aitem in any database but the roles database.
+#  Store an aitem in any resource meta data(?) or database with
+#  versioning?
 #
 #  Parameters:
 #    $cmd                - Request command keyword.
@@ -2263,6 +2155,7 @@ sub PutCourseIdHandler {
 
     my $userinput = "$cmd:$tail";
 
+    my ($udom, $what) = split(/:/, $tail);
     chomp($what);
     my $now=time;
     my @pairs=split(/\&/,$what);
@@ -2432,9 +2325,9 @@ sub GetIdHandler {
     my $cmd    = shift;
     my $tail   = shift;
     my $client = shift;
-
+    
     my $userinput = "$client:$tail";
-
+    
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
     my @queries=split(/\&/,$what);
@@ -2455,7 +2348,7 @@ sub GetIdHandler {
 	Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
 		"while attempting idget\n",$userinput);
     }
-
+    
     return 1;
 }
 
@@ -2523,7 +2416,7 @@ sub TmpGetHandler {
     my $id        = shift;
     my $client    = shift;
     my $userinput = "$cmd:$id"; 
-
+    
     chomp($id);
     $id=~s/\W/\_/g;
     my $store;
@@ -2558,9 +2451,9 @@ sub TmpDelHandler {
     my $cmd      = shift;
     my $id       = shift;
     my $client   = shift;
-
+    
     my $userinput= "$cmd:$id";
-
+    
     chomp($id);
     $id=~s/\W/\_/g;
     my $execdir=$perlvar{'lonDaemons'};
@@ -2570,7 +2463,7 @@ sub TmpDelHandler {
 	Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
 		 "while attempting tmpdel\n", $userinput);
     }
-
+    
     return 1;
 
 }
@@ -3898,11 +3791,14 @@ sub subsqlreply {
 
 sub propath {
     my ($udom,$uname)=@_;
+    Debug("Propath:$udom:$uname");
     $udom=~s/\W//g;
     $uname=~s/\W//g;
+    Debug("Propath2:$udom:$uname");
     my $subdir=$uname.'__';
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+    Debug("Propath returning $proname");
     return $proname;
 } 
 
@@ -4160,7 +4056,7 @@ sub PasswordPath {
     my $user   = shift;
 
     my $path   = &propath($domain, $user);
-    my $path  .= "/passwd";
+    $path  .= "/passwd";
 
     return $path;
 }
@@ -4179,8 +4075,10 @@ sub PasswordFilename {
     my $domain    = shift;
     my $user      = shift;
 
-    my $path  = PasswordPath($domain, $user);
+    Debug ("PasswordFilename called: dom = $domain user = $user");
 
+    my $path  = PasswordPath($domain, $user);
+    Debug("PasswordFilename got path: $path");
     if(-e $path) {
 	return $path;
     } else {
@@ -4240,6 +4138,135 @@ sub GetAuthType {
     }
 }
 
+#
+#  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 ValidateUser {
+    my $domain  = shift;
+    my $user    = shift;
+    my $password= shift;
+
+    # 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 = GetAuthType($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;
+}
+
+#
+#    Add a line to the subscription list?
+#
 sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;
     my $contents;
@@ -4259,7 +4286,9 @@ sub addline {
     $sh->close();
     return $found;
 }
-
+#
+#    Get chat messages.
+#
 sub getchat {
     my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;
@@ -4284,7 +4313,9 @@ sub getchat {
     }
     return (@participants,@entries);
 }
-
+#
+#   Add a chat message
+#
 sub chatadd {
     my ($cdom,$cname,$newchat)=@_;
     my %hash;
@@ -4455,23 +4486,35 @@ sub make_passwd_file {
 	    print $pf "localauth:$npass\n";
 	}
     } elsif ($umode eq 'unix') {
-	{
-	    my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
-	    {
-		&Debug("Executing external: ".$execpath);
-		&Debug("user  = ".$uname.", Password =". $npass);
-		my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
-		print $se "$uname\n";
-		print $se "$npass\n";
-		print $se "$npass\n";
-	    }
-	    my $useraddok = $?;
-	    if($useraddok > 0) {
-		&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok));
-	    }
-	    my $pf = IO::File->new(">$passfilename");
-	    print $pf "unix:\n";
+	#
+	#  Don't allow the creation of privileged accounts!!! that would
+	#  be real bad!!!
+	#
+	my $uid = getpwnam($uname);
+	if((defined $uid) && ($uid == 0)) {
+	    &logthis(">>>Attempted add of privileged account blocked<<<");
+	    return "no_priv_account_error\n";
 	}
+
+	#
+	my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd";
+	
+	&Debug("Executing external: ".$execpath);
+	&Debug("user  = ".$uname.", Password =". $npass);
+	my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
+	print $se "$uname\n";
+	print $se "$npass\n";
+	print $se "$npass\n";
+	
+	my $useraddok = $?;
+	if($useraddok > 0) {
+	    my $lcstring = lcuseraddstrerror($useraddok);
+	    &logthis("Failed lcuseradd: $lcstring");
+	    return "error: lcuseradd failed: $lcstring\n";
+	}
+	my $pf = IO::File->new(">$passfilename");
+	print $pf "unix:\n";
+ 
     } elsif ($umode eq 'none') {
 	{
 	    my $pf = IO::File->new(">$passfilename");
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>