--- loncom/lond	2004/08/02 20:59:46	1.221
+++ loncom/lond	2004/08/04 21:11:16	1.222
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.221 2004/08/02 20:59:46 albertel Exp $
+# $Id: lond,v 1.222 2004/08/04 21:11:16 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,12 +52,12 @@ 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.221 $'; #' stupid emacs
+my $VERSION='$Revision: 1.222 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1224,15 +1224,15 @@ sub user_authorization_type {
     my $userinput = "$cmd:$tail";
    
     #  Pull the domain and username out of the command tail.
-    # and call GetAuthType to determine the authentication type.
+    # and call get_auth_type to determine the authentication type.
    
     my ($udom,$uname)=split(/:/,$tail);
-    my $result = &GetAuthType($udom, $uname);
+    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 GetAuthType
+	# 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.
 	#
@@ -1240,7 +1240,7 @@ sub user_authorization_type {
 	if($type =~ /^krb/) {
 	    $type = $result;
 	}
-	&Reply( $replyfd, "$type\n", $userinput);
+	&Reply( $replyfd, "$type:\n", $userinput);
     }
   
     return 1;
@@ -1418,6 +1418,99 @@ sub authenticate_handler {
 
 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);
+
+
 #---------------------------------------------------------------
 #
 #   Getting, decoding and dispatching requests:
@@ -1532,91 +1625,9 @@ sub process_request {
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-# ---------------------------------------------------------------------- passwd
-    if ($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.
+    if ($userinput =~ /^makeuser/) { # encoded and client.
 	&Debug("Make user received");
 	my $oldumask=umask(0077);
 	if (($wasenc==1) && isClient) {
@@ -2025,7 +2036,7 @@ sub process_request {
 		    foreach my $pair (@pairs) {
 			my ($key,$value)=split(/=/,$pair);
 			&ManagePermissions($key, $udom, $uname,
-					   &GetAuthType( $udom, 
+					   &get_auth_type( $udom, 
 							 $uname));
 			$hash{$key}=$value;
 		    }
@@ -3818,17 +3829,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.
+#
+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;
+    }
+
+}
+
 #
-#   GetAuthType - Determines the authorization type of a user in a domain.
+#   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 ) {
@@ -3885,7 +3968,7 @@ sub validate_user {
     #  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 $contents = &get_auth_type($domain, $user);
     my ($howpwd, $contentpwd) = split(/:/, $contents);
 
     my $null = pack("C",0);	# Used by kerberos auth types.