--- loncom/lond	2004/07/29 22:31:18	1.219
+++ loncom/lond	2004/08/02 11:02:02	1.220
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.219 2004/07/29 22:31:18 foxr Exp $
+# $Id: lond,v 1.220 2004/08/02 11:02:02 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -56,7 +56,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.219 $'; #' stupid emacs
+my $VERSION='$Revision: 1.220 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1361,7 +1361,61 @@ sub edit_table_handler {
 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);
 
 #---------------------------------------------------------------
 #
@@ -1477,97 +1531,8 @@ sub process_request {
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-# ------------------------------------------------------------------------ auth
-    if ($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 ($userinput =~ /^passwd/) { # encoded and client
 	if (($wasenc==1) && isClient) {
 	    my 
 		($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
@@ -3880,6 +3845,132 @@ 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 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 = &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;
+}
+
+
 sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;
     my $contents;