--- loncom/lond 2004/07/27 10:50:37 1.213
+++ 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.213 2004/07/27 10:50:37 foxr Exp $
+# $Id: lond,v 1.224 2004/08/06 10:27:53 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -50,15 +50,16 @@ 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.213 $'; #' stupid emacs
+my $VERSION='$Revision: 1.224 $'; #' stupid emacs
my $remoteVERSION;
-my $currenthostid;
+my $currenthostid="default";
my $currentdomainid;
my $client;
@@ -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
."");
@@ -1032,6 +1032,483 @@ sub tie_user_hash {
}
}
+
+#--------------------- Request Handlers --------------------------------------------
+#
+# By convention each request handler registers itself prior to the sub
+# declaration:
+#
+
+#++
+#
+# Handles ping requests.
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Implicit Inputs:
+# $currenthostid - Global variable that carries the name of the host we are
+# known as.
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit.
+# Side effects:
+# Reply information is sent to the client.
+
+sub ping_handler {
+ my ($cmd, $tail, $client) = @_;
+ Debug("$cmd $tail $client .. $currenthostid:");
+
+ Reply( $client,"$currenthostid\n","$cmd:$tail");
+
+ return 1;
+}
+®ister_handler("ping", \&ping_handler, 0, 1, 1); # Ping unencoded, client or manager.
+
+#++
+#
+# Handles pong requests. Pong replies with our current host id, and
+# the results of a ping sent to us via our lonc.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Implicit Inputs:
+# $currenthostid - Global variable that carries the name of the host we are
+# connected to.
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit.
+# Side effects:
+# Reply information is sent to the client.
+
+sub pong_handler {
+ my ($cmd, $tail, $replyfd) = @_;
+
+ my $reply=&reply("ping",$clientname);
+ &Reply( $replyfd, "$currenthostid:$reply\n", "$cmd:$tail");
+ return 1;
+}
+®ister_handler("pong", \&pong_handler, 0, 1, 1); # Pong unencoded, client or manager
+
+#++
+# Called to establish an encrypted session key with the remote client.
+# Note that with secure lond, in most cases this function is never
+# invoked. Instead, the secure session key is established either
+# via a local file that's locked down tight and only lives for a short
+# time, or via an ssl tunnel...and is generated from a bunch-o-random
+# bits from /dev/urandom, rather than the predictable pattern used by
+# by this sub. This sub is only used in the old-style insecure
+# key negotiation.
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Implicit Inputs:
+# $currenthostid - Global variable that carries the name of the host
+# known as.
+# $clientname - Global variable that carries the name of the hsot we're connected to.
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit.
+# Implicit Outputs:
+# Reply information is sent to the client.
+# $cipher is set with a reference to a new IDEA encryption object.
+#
+sub establish_key_handler {
+ my ($cmd, $tail, $replyfd) = @_;
+
+ my $buildkey=time.$$.int(rand 100000);
+ $buildkey=~tr/1-6/A-F/;
+ $buildkey=int(rand 100000).$buildkey.int(rand 100000);
+ my $key=$currenthostid.$clientname;
+ $key=~tr/a-z/A-Z/;
+ $key=~tr/G-P/0-9/;
+ $key=~tr/Q-Z/0-9/;
+ $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
+ $key=substr($key,0,32);
+ my $cipherkey=pack("H32",$key);
+ $cipher=new IDEA $cipherkey;
+ &Reply($replyfd, "$buildkey\n", "$cmd:$tail");
+
+ return 1;
+
+}
+®ister_handler("ekey", \&establish_key_handler, 0, 1,1);
+
+
+# Handler for the load command. Returns the current system load average
+# to the requestor.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Implicit Inputs:
+# $currenthostid - Global variable that carries the name of the host
+# known as.
+# $clientname - Global variable that carries the name of the hsot we're connected to.
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit.
+# Side effects:
+# Reply information is sent to the client.
+sub load_handler {
+ my ($cmd, $tail, $replyfd) = @_;
+
+ # Get the load average from /proc/loadavg and calculate it as a percentage of
+ # the allowed load limit as set by the perl global variable lonLoadLim
+
+ my $loadavg;
+ my $loadfile=IO::File->new('/proc/loadavg');
+
+ $loadavg=<$loadfile>;
+ $loadavg =~ s/\s.*//g; # Extract the first field only.
+
+ my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
+
+ &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
+
+ return 1;
+}
+register_handler("load", \&load_handler, 0, 1, 0);
+
+#
+# Process the userload request. This sub returns to the client the current
+# user load average. It can be invoked either by clients or managers.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Implicit Inputs:
+# $currenthostid - Global variable that carries the name of the host
+# known as.
+# $clientname - Global variable that carries the name of the hsot we're connected to.
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit
+# Implicit inputs:
+# whatever the userload() function requires.
+# Implicit outputs:
+# the reply is written to the client.
+#
+sub user_load_handler {
+ my ($cmd, $tail, $replyfd) = @_;
+
+ my $userloadpercent=&userload();
+ &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
+
+ return 1;
+}
+register_handler("userload", \&user_load_handler, 0, 1, 0);
+
+# Process a request for the authorization type of a user:
+# (userauth).
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $replyfd- File descriptor connected to the client
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit
+# Implicit outputs:
+# The user authorization type is written to the client.
+#
+sub user_authorization_type {
+ my ($cmd, $tail, $replyfd) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ # Pull the domain and username out of the command tail.
+ # and call get_auth_type to determine the authentication type.
+
+ my ($udom,$uname)=split(/:/,$tail);
+ 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 get_auth_type
+ # for ^krb.. otherwise we'll be handing out the encrypted
+ # password for internals e.g.
+ #
+ my ($type,$otherinfo) = split(/:/,$result);
+ if($type =~ /^krb/) {
+ $type = $result;
+ }
+ &Reply( $replyfd, "$type:\n", $userinput);
+ }
+
+ return 1;
+}
+®ister_handler("currentauth", \&user_authorization_type, 1, 1, 0);
+
+# Process a request by a manager to push a hosts or domain table
+# to us. We pick apart the command and pass it on to the subs
+# that already exist to do this.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $client - File descriptor connected to the client
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit
+# Implicit Output:
+# a reply is written to the client.
+
+sub push_file_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ # At this time we only know that the IP of our partner is a valid manager
+ # the code below is a hook to do further authentication (e.g. to resolve
+ # spoofing).
+
+ my $cert = &GetCertificate($userinput);
+ if(&ValidManager($cert)) {
+
+ # Now presumably we have the bona fides of both the peer host and the
+ # process making the request.
+
+ my $reply = &PushFile($userinput);
+ &Reply($client, "$reply\n", $userinput);
+
+ } else {
+ &Failure( $client, "refused\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("pushfile", \&push_file_handler, 1, 0, 1);
+
+
+
+# Process a reinit request. Reinit requests that either
+# lonc or lond be reinitialized so that an updated
+# host.tab or domain.tab can be processed.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $client - File descriptor connected to the client
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit
+# Implicit output:
+# a reply is sent to the client.
+#
+sub reinit_process_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my $cert = &GetCertificate($userinput);
+ if(&ValidManager($cert)) {
+ chomp($userinput);
+ my $reply = &ReinitProcess($userinput);
+ &Reply( $client, "$reply\n", $userinput);
+ } else {
+ &Failure( $client, "refused\n", $userinput);
+ }
+ return 1;
+}
+
+®ister_handler("reinit", \&reinit_process_handler, 1, 0, 1);
+
+# Process the editing script for a table edit operation.
+# the editing operation must be encrypted and requested by
+# a manager host.
+#
+# Parameters:
+# $cmd - the actual keyword that invoked us.
+# $tail - the tail of the request that invoked us.
+# $client - File descriptor connected to the client
+# Returns:
+# 1 - Ok to continue processing.
+# 0 - Program should exit
+# Implicit output:
+# a reply is sent to the client.
+#
+sub edit_table_handler {
+ my ($command, $tail, $client) = @_;
+
+ my $userinput = "$command:$tail";
+
+ my $cert = &GetCertificate($userinput);
+ if(&ValidManager($cert)) {
+ my($filetype, $script) = split(/:/, $tail);
+ if (($filetype eq "hosts") ||
+ ($filetype eq "domain")) {
+ if($script ne "") {
+ &Reply($client, # BUGBUG - EditFile
+ &EditFile($userinput), # could fail.
+ $userinput);
+ } else {
+ &Failure($client,"refused\n",$userinput);
+ }
+ } else {
+ &Failure($client,"refused\n",$userinput);
+ }
+ } else {
+ &Failure($client,"refused\n",$userinput);
+ }
+ return 1;
+}
+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);
+
+
#---------------------------------------------------------------
#
# Getting, decoding and dispatching requests:
@@ -1096,6 +1573,10 @@ sub process_request {
chomp($command);
chomp($tail);
$tail =~ s/(\r)//; # This helps people debugging with e.g. telnet.
+ $command =~ s/(\r)//; # And this too for parameterless commands.
+ if(!$tail) {
+ $tail =""; # defined but blank.
+ }
&Debug("Command received: $command, encoded = $wasenc");
@@ -1139,301 +1620,12 @@ sub process_request {
}
-# ------------------------------------------------------------- Normal commands
-# ------------------------------------------------------------------------ ping
- if ($userinput =~ /^ping/) { # client only
- if(isClient) {
- print $client "$currenthostid\n";
- } else {
- Reply($client, "refused\n", $userinput);
- }
-# ------------------------------------------------------------------------ pong
- }elsif ($userinput =~ /^pong/) { # client only
- if(isClient) {
- my $reply=&reply("ping",$clientname);
- print $client "$currenthostid:$reply\n";
- } else {
- Reply($client, "refused\n", $userinput);
- }
-# ------------------------------------------------------------------------ ekey
- } elsif ($userinput =~ /^ekey/) { # ok for both clients & mgrs
- my $buildkey=time.$$.int(rand 100000);
- $buildkey=~tr/1-6/A-F/;
- $buildkey=int(rand 100000).$buildkey.int(rand 100000);
- my $key=$currenthostid.$clientname;
- $key=~tr/a-z/A-Z/;
- $key=~tr/G-P/0-9/;
- $key=~tr/Q-Z/0-9/;
- $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
- $key=substr($key,0,32);
- my $cipherkey=pack("H32",$key);
- $cipher=new IDEA $cipherkey;
- print $client "$buildkey\n";
-# ------------------------------------------------------------------------ load
- } elsif ($userinput =~ /^load/) { # client only
- if (isClient) {
- my $loadavg;
- {
- my $loadfile=IO::File->new('/proc/loadavg');
- $loadavg=<$loadfile>;
- }
- $loadavg =~ s/\s.*//g;
- my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
- print $client "$loadpercent\n";
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-# -------------------------------------------------------------------- userload
- } elsif ($userinput =~ /^userload/) { # client only
- if(isClient) {
- my $userloadpercent=&userload();
- print $client "$userloadpercent\n";
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-#
-# Transactions requiring encryption:
-#
-# ----------------------------------------------------------------- currentauth
- } elsif ($userinput =~ /^currentauth/) {
- if (($wasenc==1) && isClient) { # Encoded & client only.
- my ($cmd,$udom,$uname)=split(/:/,$userinput);
- my $result = GetAuthType($udom, $uname);
- if($result eq "nouser") {
- print $client "unknown_user\n";
- }
- else {
- print $client "$result\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-#--------------------------------------------------------------------- pushfile
- } elsif($userinput =~ /^pushfile/) { # encoded & manager.
- if(($wasenc == 1) && isManager) {
- my $cert = GetCertificate($userinput);
- if(ValidManager($cert)) {
- my $reply = PushFile($userinput);
- print $client "$reply\n";
- } else {
- print $client "refused\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-#--------------------------------------------------------------------- reinit
- } elsif($userinput =~ /^reinit/) { # Encoded and manager
- if (($wasenc == 1) && isManager) {
- my $cert = GetCertificate($userinput);
- if(ValidManager($cert)) {
- chomp($userinput);
- my $reply = ReinitProcess($userinput);
- print $client "$reply\n";
- } else {
- print $client "refused\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
- }
-#------------------------------------------------------------------------- edit
- } elsif ($userinput =~ /^edit/) { # encoded and manager:
- if(($wasenc ==1) && (isManager)) {
- my $cert = GetCertificate($userinput);
- if(ValidManager($cert)) {
- my($command, $filetype, $script) = split(/:/, $userinput);
- if (($filetype eq "hosts") || ($filetype eq "domain")) {
- if($script ne "") {
- Reply($client, EditFile($userinput));
- } else {
- Reply($client,"refused\n",$userinput);
- }
- } else {
- Reply($client,"refused\n",$userinput);
- }
- } else {
- Reply($client,"refused\n",$userinput);
- }
- } else {
- Reply($client,"refused\n",$userinput);
- }
-# ------------------------------------------------------------------------ auth
- } elsif ($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);
-
- }
+#------------------- Commands not yet in spearate handlers. --------------
+
+
+
# -------------------------------------------------------------------- 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) {
@@ -1495,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);
@@ -1842,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;
}
@@ -2299,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";
@@ -3069,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;
@@ -3091,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);
}
}
@@ -3098,6 +3291,7 @@ sub checkchildren {
$SIG{ALRM} = 'DEFAULT';
$SIG{__DIE__} = \&catchexception;
&status("Finished checking children");
+ &logthis('Finished Checking children');
}
# --------------------------------------------------------------------- Logging
@@ -3129,17 +3323,11 @@ sub Debug {
# request - Original request from client.
#
sub Reply {
- alarm(120);
- my $fd = shift;
- my $reply = shift;
- my $request = shift;
-
my ($fd, $reply, $request) = @_;
print $fd $reply;
Debug("Request was $request Reply was $reply");
$Transactions++;
- alarm(0);
}
@@ -3174,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");
}
@@ -3499,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.
}
@@ -3636,17 +3825,89 @@ sub ManagePermissions
system("$execdir/lchtmldir $userhome $user $authtype");
}
}
+
+
#
-# GetAuthType - Determines the authorization type of a user in a domain.
+# 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;
+ }
+
+}
+
+#
+# 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 ) {
@@ -3662,13 +3923,132 @@ sub GetAuthType
}
return "$authtype:$availinfo";
- }
- else {
+ } else {
Debug("Returning nouser");
return "nouser";
}
}
+#
+# 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;
@@ -3914,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);
@@ -3922,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 {