--- loncom/lond 2004/08/02 11:02:02 1.220
+++ loncom/lond 2004/08/06 10:27:53 1.224
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.220 2004/08/02 11:02:02 foxr Exp $
+# $Id: lond,v 1.224 2004/08/06 10:27:53 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.220 $'; #' stupid emacs
+my $VERSION='$Revision: 1.224 $'; #' 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.:
@@ -191,8 +194,7 @@ sub LocalConnection {
."$clientdns ne $thisserver ");
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 +325,7 @@ sub InsecureConnection {
$answer =~s/\W//g;
if($challenge eq $answer) {
return 1;
- }
- else {
+ } else {
logthis("WARNING client did not respond to challenge");
&status("No challenge reqply");
return 0;
@@ -653,8 +654,7 @@ sub PushFile {
&logthis(' Pushfile: unable to install '
.$tablefile." $! ");
return "error:$!";
- }
- else {
+ } else {
&logthis(' Installed new '.$tablefile
."");
@@ -1223,15 +1223,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.
#
@@ -1239,7 +1239,7 @@ sub user_authorization_type {
if($type =~ /^krb/) {
$type = $result;
}
- &Reply( $replyfd, "$type\n", $userinput);
+ &Reply( $replyfd, "$type:\n", $userinput);
}
return 1;
@@ -1417,6 +1417,98 @@ 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:
@@ -1531,91 +1623,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) {
@@ -1677,7 +1687,7 @@ sub process_request {
} else {
my $result=&make_passwd_file($uname, $umode,$npass,
$passfilename);
- print $client $result;
+ Reply($client, $result, $userinput);
}
} else {
Reply($client, "refused\n", $userinput);
@@ -2024,7 +2034,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;
}
@@ -2481,8 +2491,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";
@@ -3251,10 +3260,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;
@@ -3273,6 +3283,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);
}
}
@@ -3280,6 +3291,7 @@ sub checkchildren {
$SIG{ALRM} = 'DEFAULT';
$SIG{__DIE__} = \&catchexception;
&status("Finished checking children");
+ &logthis('Finished Checking children');
}
# --------------------------------------------------------------------- Logging
@@ -3350,17 +3362,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");
}
@@ -3675,8 +3689,7 @@ sub make_new_child {
$inittype = ""; # This forces insecure attempt.
&logthis(" Certificates not "
."installed -- trying insecure auth");
- }
- else { # SSL certificates are in place so
+ } else { # SSL certificates are in place so
} # Leave the inittype alone.
}
@@ -3812,17 +3825,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 ) {
@@ -3838,8 +3923,7 @@ sub GetAuthType
}
return "$authtype:$availinfo";
- }
- else {
+ } else {
Debug("Returning nouser");
return "nouser";
}
@@ -3879,7 +3963,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.
@@ -3919,18 +4003,15 @@ sub validate_user {
$password);
if(!$k4error) {
$validated = 1;
- }
- else {
+ } else {
$validated = 0;
&logthis('krb4: '.$user.', '.$contentpwd.', '.
&Authen::Krb4::get_err_txt($Authen::Krb4::error));
}
- }
- else {
+ } else {
$validated = 0; # Password has a match with null.
}
- }
- elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.
+ } 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);
@@ -3943,18 +4024,15 @@ sub validate_user {
$password,
$credentials);
$validated = ($krbreturn == 1);
- }
- else {
+ } else {
$validated = 0;
}
- }
- elsif ($howpwd eq "localauth") {
+ } elsif ($howpwd eq "localauth") {
# Authenticate via installation specific authentcation method:
$validated = &localauth::localauth($user,
$password,
$contentpwd);
- }
- else { # Unrecognized auth is also bad.
+ } else { # Unrecognized auth is also bad.
$validated = 0;
}
} else {
@@ -4216,7 +4294,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);
@@ -4224,17 +4304,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 {