--- loncom/lond	2004/08/06 10:27:53	1.224
+++ 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.224 2004/08/06 10:27:53 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.224 $'; #' stupid emacs
+my $VERSION='$Revision: 1.225 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1509,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;
+
+}
+&register_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;
+}
+&register_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;
+}
+&register_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;
+}
+&register_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;
+}
+&register_handler("fetchuserfile", \&fetch_user_file_handler, 0, 1, 0);
+
 #---------------------------------------------------------------
 #
 #   Getting, decoding and dispatching requests:
@@ -1523,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);
@@ -1623,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);
-		Reply($client, $result, $userinput);
-	    }
-	} 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|^([^/]+)/([^/]+)/(.+)$|);