--- loncom/lond 2004/08/04 21:11:16 1.222
+++ loncom/lond 2004/08/09 10:34:18 1.225
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.222 2004/08/04 21:11:16 foxr Exp $
+# $Id: lond,v 1.225 2004/08/09 10:34:18 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 = 1; # Non zero to enable debug log entries.
+my $DEBUG = 0; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.222 $'; #' stupid emacs
+my $VERSION='$Revision: 1.225 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -122,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.:
@@ -192,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 ");
@@ -324,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;
@@ -654,8 +654,7 @@ sub PushFile {
&logthis(' Pushfile: unable to install '
.$tablefile." $! ");
return "error:$!";
- }
- else {
+ } else {
&logthis(' Installed new '.$tablefile
."");
@@ -1501,8 +1500,7 @@ sub change_password_handler {
&Failure( $client, "auth_mode_error\n", $userinput);
}
- }
- else {
+ } else {
&Failure( $client, "non_authorized\n", $userinput);
}
@@ -1511,6 +1509,295 @@ sub change_password_handler {
register_handler("passwd", \&change_password_handler, 1, 1, 0);
+#
+# Create a new user. User in this case means a lon-capa user.
+# The user must either already exist in some authentication realm
+# like kerberos or the /etc/passwd. If not, a user completely local to
+# this loncapa system is created.
+#
+# 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 add_user_handler {
+
+ my ($cmd, $tail, $client) = @_;
+
+
+ my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
+ my $userinput = $cmd.":".$tail; # Reconstruct the full request line.
+
+ &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname);
+
+
+ if($udom eq $currentdomainid) { # Reject new users for other domains...
+
+ my $oldumask=umask(0077);
+ chomp($npass);
+ $npass=&unescape($npass);
+ my $passfilename = &password_path($udom, $uname);
+ &Debug("Password file created will be:".$passfilename);
+ if (-e $passfilename) {
+ &Failure( $client, "already_exists\n", $userinput);
+ } else {
+ my @fpparts=split(/\//,$passfilename);
+ my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
+ my $fperror='';
+ for (my $i=3;$i<= ($#fpparts-1);$i++) {
+ $fpnow.='/'.$fpparts[$i];
+ unless (-e $fpnow) {
+ &logthis("mkdir $fpnow");
+ unless (mkdir($fpnow,0777)) {
+ $fperror="error: ".($!+0)." mkdir failed while attempting "
+ ."makeuser";
+ }
+ }
+ }
+ unless ($fperror) {
+ my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
+ &Reply($client, $result, $userinput); #BUGBUG - could be fail
+ } else {
+ &Failure($client, "$fperror\n", $userinput);
+ }
+ }
+ umask($oldumask);
+ } else {
+ &Failure($client, "not_right_domain\n",
+ $userinput); # Even if we are multihomed.
+
+ }
+ return 1;
+
+}
+®ister_handler("makeuser", \&add_user_handler, 1, 1, 0);
+
+#
+# Change the authentication method of a user. Note that this may
+# also implicitly change the user's password if, for example, the user is
+# joining an existing authentication realm. Known authentication realms at
+# this time are:
+# internal - Purely internal password file (only loncapa knows this user)
+# local - Institutionally written authentication module.
+# unix - Unix user (/etc/passwd with or without /etc/shadow).
+# kerb4 - kerberos version 4
+# kerb5 - kerberos version 5
+#
+# 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_authentication_handler {
+
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail"; # Reconstruct user input.
+
+ my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
+ &Debug("cmd = ".$cmd." domain= ".$udom."uname =".$uname." umode= ".$umode);
+ if ($udom ne $currentdomainid) {
+ &Failure( $client, "not_right_domain\n", $client);
+ } else {
+
+ chomp($npass);
+
+ $npass=&unescape($npass);
+ my $passfilename = &password_path($udom, $uname);
+ if ($passfilename) { # Not allowed to create a new user!!
+ my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
+ &Reply($client, $result, $userinput);
+ } else {
+ &Failure($client, "non_authorized", $userinput); # Fail the user now.
+ }
+ }
+ return 1;
+}
+®ister_handler("changeuserauth", \&change_authentication_handler, 1,1, 0);
+
+#
+# Determines if this is the home server for a user. The home server
+# for a user will have his/her lon-capa passwd file. Therefore all we need
+# to do is determine if this file exists.
+#
+# 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 is_home_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($udom,$uname)=split(/:/,$tail);
+ chomp($uname);
+ my $passfile = &password_filename($udom, $uname);
+ if($passfile) {
+ &Reply( $client, "found\n", $userinput);
+ } else {
+ &Failure($client, "not_found\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("home", \&is_home_handler, 0,1,0);
+
+#
+# Process an update request for a resource?? I think what's going on here is
+# that a resource has been modified that we hold a subscription to.
+# If the resource is not local, then we must update, or at least invalidate our
+# cached copy of the resource.
+# FUTURE WORK:
+# I need to look at this logic carefully. My druthers would be to follow
+# typical caching logic, and simple invalidate the cache, drop any subscription
+# an let the next fetch start the ball rolling again... however that may
+# actually be more difficult than it looks given the complex web of
+# proxy servers.
+# 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 update_resource_handler {
+
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my $fname= $tail; # This allows interactive testing
+
+
+ my $ownership=ishome($fname);
+ if ($ownership eq 'not_owner') {
+ if (-e $fname) {
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname);
+ my $now=time;
+ my $since=$now-$atime;
+ if ($since>$perlvar{'lonExpire'}) {
+ my $reply=&reply("unsub:$fname","$clientname");
+ unlink("$fname");
+ } else {
+ my $transname="$fname.in.transfer";
+ my $remoteurl=&reply("sub:$fname","$clientname");
+ my $response;
+ alarm(120);
+ {
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',"$remoteurl");
+ $response=$ua->request($request,$transname);
+ }
+ alarm(0);
+ if ($response->is_error()) {
+ unlink($transname);
+ my $message=$response->status_line;
+ &logthis("LWP GET: $message for $fname ($remoteurl)");
+ } else {
+ if ($remoteurl!~/\.meta$/) {
+ alarm(120);
+ {
+ my $ua=new LWP::UserAgent;
+ my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
+ my $mresponse=$ua->request($mrequest,$fname.'.meta');
+ if ($mresponse->is_error()) {
+ unlink($fname.'.meta');
+ }
+ }
+ alarm(0);
+ }
+ rename($transname,$fname);
+ }
+ }
+ &Reply( $client, "ok\n", $userinput);
+ } else {
+ &Failure($client, "not_found\n", $userinput);
+ }
+ } else {
+ &Failure($client, "rejected\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("update", \&update_resource_handler, 0 ,1, 0);
+
+#
+# Fetch a user file from a remote server:
+# 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.
+#
+sub fetch_user_file_handler {
+
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+ my $fname = $tail;
+ my ($udom,$uname,$ufile)=split(/\//,$fname);
+ my $udir=&propath($udom,$uname).'/userfiles';
+ unless (-e $udir) {
+ mkdir($udir,0770);
+ }
+ if (-e $udir) {
+ $ufile=~s/^[\.\~]+//;
+ $ufile=~s/\///g;
+ my $destname=$udir.'/'.$ufile;
+ my $transname=$udir.'/'.$ufile.'.in.transit';
+ my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+ my $response;
+ alarm(120);
+ {
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',"$remoteurl");
+ $response=$ua->request($request,$transname);
+ }
+ alarm(0);
+ if ($response->is_error()) {
+ unlink($transname);
+ my $message=$response->status_line;
+ &logthis("LWP GET: $message for $fname ($remoteurl)");
+ &Failure($client, "failed\n", $userinput);
+ } else {
+ if (!rename($transname,$destname)) {
+ &logthis("Unable to move $transname to $destname");
+ unlink($transname);
+ &Failure($client, "failed\n", $userinput);
+ } else {
+ &Reply($client, "ok\n", $userinput);
+ }
+ }
+ } else {
+ &Failure($client, "not_home\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("fetchuserfile", \&fetch_user_file_handler, 0, 1, 0);
+
#---------------------------------------------------------------
#
# Getting, decoding and dispatching requests:
@@ -1525,7 +1812,7 @@ register_handler("passwd", \&change_pass
sub get_request {
my $input = <$client>;
chomp($input);
-
+j
Debug("get_request: Request = $input\n");
&status('Processing '.$clientname.':'.$input);
@@ -1625,198 +1912,8 @@ sub process_request {
#------------------- Commands not yet in spearate handlers. --------------
-
-# -------------------------------------------------------------------- makeuser
- if ($userinput =~ /^makeuser/) { # encoded and client.
- &Debug("Make user received");
- my $oldumask=umask(0077);
- if (($wasenc==1) && isClient) {
- my
- ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
- &Debug("cmd =".$cmd." $udom =".$udom.
- " uname=".$uname);
- chomp($npass);
- $npass=&unescape($npass);
- my $proname=propath($udom,$uname);
- my $passfilename="$proname/passwd";
- &Debug("Password file created will be:".
- $passfilename);
- if (-e $passfilename) {
- print $client "already_exists\n";
- } elsif ($udom ne $currentdomainid) {
- print $client "not_right_domain\n";
- } else {
- my @fpparts=split(/\//,$proname);
- my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
- my $fperror='';
- for (my $i=3;$i<=$#fpparts;$i++) {
- $fpnow.='/'.$fpparts[$i];
- unless (-e $fpnow) {
- unless (mkdir($fpnow,0777)) {
- $fperror="error: ".($!+0)
- ." mkdir failed while attempting "
- ."makeuser";
- }
- }
- }
- unless ($fperror) {
- my $result=&make_passwd_file($uname, $umode,$npass,
- $passfilename);
- print $client $result;
- } else {
- print $client "$fperror\n";
- }
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
- umask($oldumask);
-# -------------------------------------------------------------- changeuserauth
- } elsif ($userinput =~ /^changeuserauth/) { # encoded & client
- &Debug("Changing authorization");
- if (($wasenc==1) && isClient) {
- my
- ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
- chomp($npass);
- &Debug("cmd = ".$cmd." domain= ".$udom.
- "uname =".$uname." umode= ".$umode);
- $npass=&unescape($npass);
- my $proname=&propath($udom,$uname);
- my $passfilename="$proname/passwd";
- if ($udom ne $currentdomainid) {
- print $client "not_right_domain\n";
- } else {
- my $result=&make_passwd_file($uname, $umode,$npass,
- $passfilename);
- print $client $result;
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-# ------------------------------------------------------------------------ home
- } elsif ($userinput =~ /^home/) { # client clear or encoded
- if(isClient) {
- my ($cmd,$udom,$uname)=split(/:/,$userinput);
- chomp($uname);
- my $proname=propath($udom,$uname);
- if (-e $proname) {
- print $client "found\n";
- } else {
- print $client "not_found\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-# ---------------------------------------------------------------------- update
- } elsif ($userinput =~ /^update/) { # client clear or encoded.
- if(isClient) {
- my ($cmd,$fname)=split(/:/,$userinput);
- my $ownership=ishome($fname);
- if ($ownership eq 'not_owner') {
- if (-e $fname) {
- my ($dev,$ino,$mode,$nlink,
- $uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,
- $blksize,$blocks)=stat($fname);
- my $now=time;
- my $since=$now-$atime;
- if ($since>$perlvar{'lonExpire'}) {
- my $reply=
- &reply("unsub:$fname","$clientname");
- unlink("$fname");
- } else {
- my $transname="$fname.in.transfer";
- my $remoteurl=
- &reply("sub:$fname","$clientname");
- my $response;
- {
- my $ua=new LWP::UserAgent;
- my $request=new HTTP::Request('GET',"$remoteurl");
- $response=$ua->request($request,$transname);
- }
- if ($response->is_error()) {
- unlink($transname);
- my $message=$response->status_line;
- &logthis(
- "LWP GET: $message for $fname ($remoteurl)");
- } else {
- if ($remoteurl!~/\.meta$/) {
- my $ua=new LWP::UserAgent;
- my $mrequest=
- new HTTP::Request('GET',$remoteurl.'.meta');
- my $mresponse=
- $ua->request($mrequest,$fname.'.meta');
- if ($mresponse->is_error()) {
- unlink($fname.'.meta');
- }
- }
- rename($transname,$fname);
- }
- }
- print $client "ok\n";
- } else {
- print $client "not_found\n";
- }
- } else {
- print $client "rejected\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
-
- }
-# -------------------------------------- fetch a user file from a remote server
- } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
- if(isClient) {
- my ($cmd,$fname)=split(/:/,$userinput);
- my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
- my $udir=propath($udom,$uname).'/userfiles';
- unless (-e $udir) { mkdir($udir,0770); }
- if (-e $udir) {
- $ufile=~s/^[\.\~]+//;
- my $path = $udir;
- if ($ufile =~m|(.+)/([^/]+)$|) {
- my @parts=split('/',$1);
- foreach my $part (@parts) {
- $path .= '/'.$part;
- if ((-e $path)!=1) {
- mkdir($path,0770);
- }
- }
- }
- my $destname=$udir.'/'.$ufile;
- my $transname=$udir.'/'.$ufile.'.in.transit';
- my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
- my $response;
- {
- my $ua=new LWP::UserAgent;
- my $request=new HTTP::Request('GET',"$remoteurl");
- $response=$ua->request($request,$transname);
- }
- if ($response->is_error()) {
- unlink($transname);
- my $message=$response->status_line;
- &logthis("LWP GET: $message for $fname ($remoteurl)");
- print $client "failed\n";
- } else {
- if (!rename($transname,$destname)) {
- &logthis("Unable to move $transname to $destname");
- unlink($transname);
- print $client "failed\n";
- } else {
- print $client "ok\n";
- }
- }
- } else {
- print $client "not_home\n";
- }
- } else {
- Reply($client, "refused\n", $userinput);
- }
# --------------------------------------------------------- remove a user file
- } elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc.
+ if ($userinput =~ /^removeuserfile/) { # Client clear or enc.
if(isClient) {
my ($cmd,$fname)=split(/:/,$userinput);
my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
@@ -2493,8 +2590,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";
@@ -3692,8 +3788,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.
}
@@ -3927,8 +4022,7 @@ sub get_auth_type
}
return "$authtype:$availinfo";
- }
- else {
+ } else {
Debug("Returning nouser");
return "nouser";
}
@@ -4008,18 +4102,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);
@@ -4032,18 +4123,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 {
@@ -4305,7 +4393,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);
@@ -4313,17 +4403,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 {