--- loncom/lond 2004/07/29 22:31:18 1.219 +++ 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.219 2004/07/29 22:31:18 foxr Exp $ +# $Id: lond,v 1.222 2004/08/04 21:11:16 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.219 $'; #' stupid emacs +my $VERSION='$Revision: 1.222 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1223,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. # @@ -1239,7 +1240,7 @@ sub user_authorization_type { if($type =~ /^krb/) { $type = $result; } - &Reply( $replyfd, "$type\n", $userinput); + &Reply( $replyfd, "$type:\n", $userinput); } return 1; @@ -1361,6 +1362,153 @@ 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); + +# +# 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); #--------------------------------------------------------------- @@ -1477,180 +1625,9 @@ 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 (($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) { @@ -2059,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; } @@ -3286,10 +3263,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; @@ -3308,6 +3286,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); } } @@ -3315,6 +3294,7 @@ sub checkchildren { $SIG{ALRM} = 'DEFAULT'; $SIG{__DIE__} = \&catchexception; &status("Finished checking children"); + &logthis('Finished Checking children'); } # --------------------------------------------------------------------- Logging @@ -3385,17 +3365,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"); } @@ -3847,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; + } +} + # -# GetAuthType - Determines the authorization type of a user in a domain. +# 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; + } + +} + +# +# 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 ) { @@ -3880,6 +3934,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 = &get_auth_type($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;