--- loncom/lond	2005/03/03 23:21:51	1.280
+++ loncom/lond	2005/12/10 00:46:23	1.304
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.280 2005/03/03 23:21:51 matthew Exp $
+# $Id: lond,v 1.304 2005/12/10 00:46:23 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -48,6 +48,7 @@ use localauth;
 use localenroll;
 use localstudentphoto;
 use File::Copy;
+use File::Find;
 use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
@@ -58,7 +59,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.280 $'; #' stupid emacs
+my $VERSION='$Revision: 1.304 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -112,20 +113,20 @@ my %Dispatcher;
 #
 my $lastpwderror    = 13;		# Largest error number from lcpasswd.
 my @passwderrors = ("ok",
-		   "lcpasswd must be run as user 'www'",
-		   "lcpasswd got incorrect number of arguments",
-		   "lcpasswd did not get the right nubmer of input text lines",
-		   "lcpasswd too many simultaneous pwd changes in progress",
-		   "lcpasswd User does not exist.",
-		   "lcpasswd Incorrect current passwd",
-		   "lcpasswd Unable to su to root.",
-		   "lcpasswd Cannot set new passwd.",
-		   "lcpasswd Username has invalid characters",
-		   "lcpasswd Invalid characters in password",
-		   "lcpasswd User already exists", 
-                   "lcpasswd Something went wrong with user addition.",
-		    "lcpasswd Password mismatch",
-		    "lcpasswd Error filename is invalid");
+		   "pwchange_failure - lcpasswd must be run as user 'www'",
+		   "pwchange_failure - lcpasswd got incorrect number of arguments",
+		   "pwchange_failure - lcpasswd did not get the right nubmer of input text lines",
+		   "pwchange_failure - lcpasswd too many simultaneous pwd changes in progress",
+		   "pwchange_failure - lcpasswd User does not exist.",
+		   "pwchange_failure - lcpasswd Incorrect current passwd",
+		   "pwchange_failure - lcpasswd Unable to su to root.",
+		   "pwchange_failure - lcpasswd Cannot set new passwd.",
+		   "pwchange_failure - lcpasswd Username has invalid characters",
+		   "pwchange_failure - lcpasswd Invalid characters in password",
+		   "pwchange_failure - lcpasswd User already exists", 
+                   "pwchange_failure - lcpasswd Something went wrong with user addition.",
+		   "pwchange_failure - lcpasswd Password mismatch",
+		   "pwchange_failure - lcpasswd Error filename is invalid");
 
 
 #  The array below are lcuseradd error strings.:
@@ -472,39 +473,11 @@ sub CopyFile {
 
     my ($oldfile, $newfile) = @_;
 
-    #  The file must exist:
-
-    if(-e $oldfile) {
-
-	 # Read the old file.
-
-	my $oldfh = IO::File->new("< $oldfile");
-	if(!$oldfh) {
-	    return 0;
-	}
-	my @contents = <$oldfh>;  # Suck in the entire file.
-
-	# write the backup file:
-
-	my $newfh = IO::File->new("> $newfile");
-	if(!(defined $newfh)){
-	    return 0;
-	}
-	my $lines = scalar @contents;
-	for (my $i =0; $i < $lines; $i++) {
-	    print $newfh ($contents[$i]);
-	}
-
-	$oldfh->close;
-	$newfh->close;
-
-	chmod(0660, $newfile);
-
-	return 1;
-	    
-    } else {
-	return 0;
+    if (! copy($oldfile,$newfile)) {
+        return 0;
     }
+    chmod(0660, $newfile);
+    return 1;
 }
 #
 #  Host files are passed out with externally visible host IPs.
@@ -1391,18 +1364,18 @@ sub du_handler {
     #  etc.
     #
     if (-d $ududir) {
-	#  And as Shakespeare would say to make
-	#  assurance double sure, 
-	# use execute_command to ensure that the command is not executed in
-	# a shell that can screw us up.
-
-	my $duout = execute_command("du -ks $ududir");
-	$duout=~s/[^\d]//g; #preserve only the numbers
-	&Reply($client,"$duout\n","$cmd:$ududir");
+	my $total_size=0;
+	my $code=sub { 
+	    if ($_=~/\.\d+\./) { return;} 
+	    if ($_=~/\.meta$/) { return;}
+	    $total_size+=(stat($_))[7];
+	};
+	chdir($ududir);
+	find($code,$ududir);
+	$total_size=int($total_size/1024);
+	&Reply($client,"$total_size\n","$cmd:$ududir");
     } else {
-
 	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); 
-
     }
     return 1;
 }
@@ -1441,14 +1414,15 @@ sub ls_handler {
 	if(-d $ulsdir) {
 	    if (opendir(LSDIR,$ulsdir)) {
 		while ($ulsfn=readdir(LSDIR)) {
-		    undef $obs, $rights; 
+		    undef($obs);
+		    undef($rights); 
 		    my @ulsstats=stat($ulsdir.'/'.$ulsfn);
 		    #We do some obsolete checking here
 		    if(-e $ulsdir.'/'.$ulsfn.".meta") { 
 			open(FILE, $ulsdir.'/'.$ulsfn.".meta");
 			my @obsolete=<FILE>;
 			foreach my $obsolete (@obsolete) {
-			    if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
+			    if($obsolete =~ m/(<obsolete>)(on|1)/) { $obs = 1; } 
 			    if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; }
 			}
 		    }
@@ -1508,14 +1482,15 @@ sub ls2_handler {
         if(-d $ulsdir) {
             if (opendir(LSDIR,$ulsdir)) {
                 while ($ulsfn=readdir(LSDIR)) {
-                    undef $obs, $rights; 
+                    undef($obs);
+		    undef($rights); 
                     my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                     #We do some obsolete checking here
                     if(-e $ulsdir.'/'.$ulsfn.".meta") { 
                         open(FILE, $ulsdir.'/'.$ulsfn.".meta");
                         my @obsolete=<FILE>;
                         foreach my $obsolete (@obsolete) {
-                            if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
+                            if($obsolete =~ m/(<obsolete>)(on|1)/) { $obs = 1; } 
                             if($obsolete =~ m|(<copyright>)(default)|) {
                                 $rights = 1;
                             }
@@ -1729,19 +1704,9 @@ sub change_password_handler {
 		&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');
+	    my $result = &change_unix_password($uname, $npass);
 	    &logthis("Result of password change for $uname: ".
-		     &lcpasswdstrerror($?));
+		     $result);
 	    &Reply($client, "$result\n", $userinput);
 	} else {
 	    # this just means that the current password mode is not
@@ -1840,6 +1805,9 @@ sub add_user_handler {
 # Implicit inputs:
 #    The authentication systems describe above have their own forms of implicit
 #    input into the authentication process that are described above.
+# NOTE:
+#   This is also used to change the authentication credential values (e.g. passwd).
+#   
 #
 sub change_authentication_handler {
 
@@ -1859,24 +1827,41 @@ sub change_authentication_handler {
 	my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.
 	my $passfilename = &password_path($udom, $uname);
 	if ($passfilename) {	# Not allowed to create a new user!!
-	    my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
-	    #
-	    #  If the current auth mode is internal, and the old auth mode was
-	    #  unix, or krb*,  and the user is an author for this domain,
-	    #  re-run manage_permissions for that role in order to be able
-	    #  to take ownership of the construction space back to www:www
-	    #
-
-	    if( (($oldauth =~ /^unix/) && ($umode eq "internal")) ||
-		(($oldauth =~ /^internal/) && ($umode eq "unix")) ) { 
-		if(&is_author($udom, $uname)) {
-		    &Debug(" Need to manage author permissions...");
-		    &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
+	    # If just changing the unix passwd. need to arrange to run
+	    # passwd since otherwise make_passwd_file will run
+	    # lcuseradd which fails if an account already exists
+	    # (to prevent an unscrupulous LONCAPA admin from stealing
+	    # an existing account by overwriting it as a LonCAPA account).
+
+	    if(($oldauth =~/^unix/) && ($umode eq "unix")) {
+		my $result = &change_unix_password($uname, $npass);
+		&logthis("Result of password change for $uname: ".$result);
+		if ($result eq "ok") {
+		    &Reply($client, "$result\n")
+		} else {
+		    &Failure($client, "$result\n");
+		}
+	    } else {
+		my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
+		#
+		#  If the current auth mode is internal, and the old auth mode was
+		#  unix, or krb*,  and the user is an author for this domain,
+		#  re-run manage_permissions for that role in order to be able
+		#  to take ownership of the construction space back to www:www
+		#
+		
+		
+		if( (($oldauth =~ /^unix/) && ($umode eq "internal")) ||
+		    (($oldauth =~ /^internal/) && ($umode eq "unix")) ) { 
+		    if(&is_author($udom, $uname)) {
+			&Debug(" Need to manage author permissions...");
+			&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
+		    }
 		}
+		&Reply($client, $result, $userinput);
 	    }
 	       
 
-	    &Reply($client, $result, $userinput);
 	} else {	       
 	    &Failure($client, "non_authorized\n", $userinput); # Fail the user now.
 	}
@@ -1988,6 +1973,13 @@ sub update_resource_handler {
 			alarm(0);
 		    }
 		    rename($transname,$fname);
+		    use Cache::Memcached;
+		    my $memcache=
+			new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+		    my $url=$fname;
+		    $url=~s-^/home/httpd/html--;
+		    my $id=&escape('meta:'.$url);
+		    $memcache->delete($id);
 		}
 	    }
 	    &Reply( $client, "ok\n", $userinput);
@@ -2388,6 +2380,61 @@ sub put_user_profile_entry {
 }
 &register_handler("put", \&put_user_profile_entry, 0, 1, 0);
 
+#   Put a piece of new data in hash, returns error if entry already 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.
+#
+sub newput_user_profile_entry {
+    my ($cmd, $tail, $client)  = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4);
+    if ($namespace eq 'roles') {
+        &Failure( $client, "refused\n", $userinput);
+	return 1;
+    }
+
+    chomp($what);
+
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_WRCREAT(),"N",$what);
+    if(!$hashref) {
+	&Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+		  "while attempting put\n", $userinput);
+	return 1;
+    }
+
+    my @pairs=split(/\&/,$what);
+    foreach my $pair (@pairs) {
+	my ($key,$value)=split(/=/,$pair);
+	if (exists($hashref->{$key})) {
+	    &Failure($client, "key_exists: ".$key."\n",$userinput);
+	    return 1;
+	}
+    }
+
+    foreach my $pair (@pairs) {
+	my ($key,$value)=split(/=/,$pair);
+	$hashref->{$key}=$value;
+    }
+
+    if (untie(%$hashref)) {
+	&Reply( $client, "ok\n", $userinput);
+    } else {
+	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+		 "while attempting put\n", 
+		 $userinput);
+    }
+    return 1;
+}
+&register_handler("newput", \&newput_user_profile_entry, 0, 1, 0);
+
 # 
 #   Increment a profile entry in the user history file.
 #   The history contains keyword value pairs.  In this case,
@@ -2418,11 +2465,17 @@ sub increment_user_value_handler {
 	    my @pairs=split(/\&/,$what);
 	    foreach my $pair (@pairs) {
 		my ($key,$value)=split(/=/,$pair);
+                $value = &unescape($value);
 		# We could check that we have a number...
 		if (! defined($value) || $value eq '') {
 		    $value = 1;
 		}
 		$hashref->{$key}+=$value;
+                if ($namespace eq 'nohist_resourcetracker') {
+                    if ($hashref->{$key} < 0) {
+                        $hashref->{$key} = 0;
+                    }
+                }
 	    }
 	    if (untie(%$hashref)) {
 		&Reply( $client, "ok\n", $userinput);
@@ -3280,7 +3333,7 @@ sub dump_course_id_handler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$since,$description,$instcodefilter,$ownerfilter) =split(/:/,$tail);
+    my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail);
     if (defined($description)) {
 	$description=&unescape($description);
     } else {
@@ -3296,6 +3349,11 @@ sub dump_course_id_handler {
     } else {
         $ownerfilter='.';
     }
+    if (defined($coursefilter)) {
+        $coursefilter=&unescape($coursefilter);
+    } else {
+        $coursefilter='.';
+    }
 
     unless (defined($since)) { $since=0; }
     my $qresult='';
@@ -3326,6 +3384,12 @@ sub dump_course_id_handler {
                     $match = 0;
                 }
             }
+            unless ($coursefilter eq '.' || !defined($coursefilter)) {
+                my $unescapeCourse = &unescape($key);
+                unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
+                    $match = 0;
+                }
+            }
             if ($match == 1) {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
             }
@@ -3445,6 +3509,258 @@ sub get_id_handler {
 &register_handler("idget", \&get_id_handler, 0, 1, 0);
 
 #
+# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database 
+#
+# Parameters
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose dcmail we are recording
+#               email    Consists of key=value pair 
+#                        where key is unique msgid
+#                        and value is message (in XML)
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects
+#     reply is written to $client.
+#
+sub put_dcmail_handler {
+    my ($cmd,$tail,$client) = @_;
+    my $userinput = "$cmd:$tail";
+                                                                                
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
+    if ($hashref) {
+        my ($key,$value)=split(/=/,$what);
+        $hashref->{$key}=$value;
+    }
+    if (untie(%$hashref)) {
+        &Reply($client, "ok\n", $userinput);
+    } else {
+        &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                 "while attempting dcmailput\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("dcmailput", \&put_dcmail_handler, 0, 1, 0);
+
+#
+# Retrieves broadcast e-mail from nohist_dcmail database
+# Returns to client an & separated list of key=value pairs,
+# where key is msgid and value is message information.
+#
+# Parameters
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose dcmail table we dump
+#               startfilter - beginning of time window 
+#               endfilter - end of time window
+#               sendersfilter - & separated list of username:domain 
+#                 for senders to search for.
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects
+#     reply (& separated list of msgid=messageinfo pairs) is 
+#     written to $client.
+#
+sub dump_dcmail_handler {
+    my ($cmd, $tail, $client) = @_;
+                                                                                
+    my $userinput = "$cmd:$tail";
+    my ($udom,$startfilter,$endfilter,$sendersfilter) = split(/:/,$tail);
+    chomp($sendersfilter);
+    my @senders = ();
+    if (defined($startfilter)) {
+        $startfilter=&unescape($startfilter);
+    } else {
+        $startfilter='.';
+    }
+    if (defined($endfilter)) {
+        $endfilter=&unescape($endfilter);
+    } else {
+        $endfilter='.';
+    }
+    if (defined($sendersfilter)) {
+        $sendersfilter=&unescape($sendersfilter);
+	@senders = map { &unescape($_) } split(/\&/,$sendersfilter);
+    }
+
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
+    if ($hashref) {
+        while (my ($key,$value) = each(%$hashref)) {
+            my $match = 1;
+            my ($timestamp,$subj,$uname,$udom) = 
+		split(/:/,&unescape(&unescape($key)),5); # yes, twice really
+            $subj = &unescape($subj);
+            unless ($startfilter eq '.' || !defined($startfilter)) {
+                if ($timestamp < $startfilter) {
+                    $match = 0;
+                }
+            }
+            unless ($endfilter eq '.' || !defined($endfilter)) {
+                if ($timestamp > $endfilter) {
+                    $match = 0;
+                }
+            }
+            unless (@senders < 1) {
+                unless (grep/^$uname:$udom$/,@senders) {
+                    $match = 0;
+                }
+            }
+            if ($match == 1) {
+                $qresult.=$key.'='.$value.'&';
+            }
+        }
+        if (untie(%$hashref)) {
+            chop($qresult);
+            &Reply($client, "$qresult\n", $userinput);
+        } else {
+            &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                    "while attempting dcmaildump\n", $userinput);
+        }
+    } else {
+        &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+                "while attempting dcmaildump\n", $userinput);
+    }
+    return 1;
+}
+
+&register_handler("dcmaildump", \&dump_dcmail_handler, 0, 1, 0);
+
+#
+# Puts domain roles in nohist_domainroles database
+#
+# Parameters
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose roles we are recording  
+#               role -   Consists of key=value pair
+#                        where key is unique role
+#                        and value is start/end date information
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects
+#     reply is written to $client.
+#
+
+sub put_domainroles_handler {
+    my ($cmd,$tail,$client) = @_;
+
+    my $userinput = "$cmd:$tail";
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
+    if ($hashref) {
+        foreach my $pair (@pairs) {
+            my ($key,$value)=split(/=/,$pair);
+            $hashref->{$key}=$value;
+        }
+        if (untie(%$hashref)) {
+            &Reply($client, "ok\n", $userinput);
+        } else {
+            &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                     "while attempting domroleput\n", $userinput);
+        }
+    } else {
+        &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                  "while attempting domroleput\n", $userinput);
+    }
+                                                                                  
+    return 1;
+}
+
+&register_handler("domroleput", \&put_domainroles_handler, 0, 1, 0);
+
+#
+# Retrieves domain roles from nohist_domainroles database
+# Returns to client an & separated list of key=value pairs,
+# where key is role and value is start and end date information.
+#
+# Parameters
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose domain roles table we dump
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects
+#     reply (& separated list of role=start/end info pairs) is
+#     written to $client.
+#
+sub dump_domainroles_handler {
+    my ($cmd, $tail, $client) = @_;
+                                                                                           
+    my $userinput = "$cmd:$tail";
+    my ($udom,$startfilter,$endfilter,$rolesfilter) = split(/:/,$tail);
+    chomp($rolesfilter);
+    my @roles = ();
+    if (defined($startfilter)) {
+        $startfilter=&unescape($startfilter);
+    } else {
+        $startfilter='.';
+    }
+    if (defined($endfilter)) {
+        $endfilter=&unescape($endfilter);
+    } else {
+        $endfilter='.';
+    }
+    if (defined($rolesfilter)) {
+        $rolesfilter=&unescape($rolesfilter);
+	@roles = split(/\&/,$rolesfilter);
+    }
+                                                                                           
+    my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
+    if ($hashref) {
+        my $qresult = '';
+        while (my ($key,$value) = each(%$hashref)) {
+            my $match = 1;
+            my ($start,$end) = split(/:/,&unescape($value));
+            my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));
+            unless ($startfilter eq '.' || !defined($startfilter)) {
+                if ($start >= $startfilter) {
+                    $match = 0;
+                }
+            }
+            unless ($endfilter eq '.' || !defined($endfilter)) {
+                if ($end <= $endfilter) {
+                    $match = 0;
+                }
+            }
+            unless (@roles < 1) {
+                unless (grep/^$trole$/,@roles) {
+                    $match = 0;
+                }
+            }
+            if ($match == 1) {
+                $qresult.=$key.'='.$value.'&';
+            }
+        }
+        if (untie(%$hashref)) {
+            chop($qresult);
+            &Reply($client, "$qresult\n", $userinput);
+        } else {
+            &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                    "while attempting domrolesdump\n", $userinput);
+        }
+    } else {
+        &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+                "while attempting domrolesdump\n", $userinput);
+    }
+    return 1;
+}
+
+&register_handler("domrolesdump", \&dump_domainroles_handler, 0, 1, 0);
+
+
 #  Process the tmpput command I'm not sure what this does.. Seems to
 #  create a file in the lonDaemons/tmp directory of the form $id.tmp
 # where Id is the client's ip concatenated with a sequence number.
@@ -4348,16 +4664,23 @@ sub ReadHostTable {
     open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     my $myloncapaname = $perlvar{'lonHostID'};
     Debug("My loncapa name is : $myloncapaname");
+    my %name_to_ip;
     while (my $configline=<CONFIG>) {
 	if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
 	    my ($id,$domain,$role,$name)=split(/:/,$configline);
 	    $name=~s/\s//g;
-	    my $ip = gethostbyname($name);
-	    if (length($ip) ne 4) {
-		&logthis("Skipping host $id name $name no IP $ip found\n");
-		next;
+	    my $ip;
+	    if (!exists($name_to_ip{$name})) {
+		$ip = gethostbyname($name);
+		if (!$ip || length($ip) ne 4) {
+		    &logthis("Skipping host $id name $name no IP found\n");
+		    next;
+		}
+		$ip=inet_ntoa($ip);
+		$name_to_ip{$name} = $ip;
+	    } else {
+		$ip = $name_to_ip{$name};
 	    }
-	    $ip=inet_ntoa($ip);
 	    $hostid{$ip}=$id;         # LonCAPA name of host by IP.
 	    $hostdom{$id}=$domain;    # LonCAPA domain name of host. 
 	    $hostip{$id}=$ip;         # IP address of host.
@@ -4497,8 +4820,6 @@ sub Reply {
     Debug("Request was $request  Reply was $reply");
 
     $Transactions++;
-
-
 }
 
 
@@ -4726,6 +5047,8 @@ $SIG{USR2} = \&UpdateHosts;
 
 ReadHostTable;
 
+my $dist=`$perlvar{'lonDaemons'}/distprobe`;
+
 # --------------------------------------------------------------
 #   Accept connections.  When a connection comes in, it is validated
 #   and if good, a child process is created to process transactions
@@ -4801,7 +5124,9 @@ sub make_new_child {
 #        my $tmpsnum=0;            # Now global
 #---------------------------------------------------- kerberos 5 initialization
         &Authen::Krb5::init_context();
-        &Authen::Krb5::init_ets();
+	unless (($dist eq 'fedora4') || ($dist eq 'suse9.3')) {
+	    &Authen::Krb5::init_ets();
+	}
 
 	&status('Accepted connection');
 # =============================================================================
@@ -5011,16 +5336,13 @@ sub is_author {
 #    user      - Name of the user for which the role is being put.
 #    authtype  - The authentication type associated with the user.
 #
-sub manage_permissions
-{
-
-
+sub manage_permissions {
     my ($request, $domain, $user, $authtype) = @_;
 
     &Debug("manage_permissions: $request $domain $user $authtype");
 
     # See if the request is of the form /$domain/_au
-    if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
+    if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...
 	my $execdir = $perlvar{'lonDaemons'};
 	my $userhome= "/home/$user" ;
 	&logthis("system $execdir/lchtmldir $userhome $user $authtype");
@@ -5413,7 +5735,7 @@ sub thisversion {
 sub subscribe {
     my ($userinput,$clientip)=@_;
     my $result;
-    my ($cmd,$fname)=split(/:/,$userinput);
+    my ($cmd,$fname)=split(/:/,$userinput,2);
     my $ownership=&ishome($fname);
     if ($ownership eq 'owner') {
 # explitly asking for the current version?
@@ -5457,6 +5779,35 @@ sub subscribe {
     }
     return $result;
 }
+#  Change the passwd of a unix user.  The caller must have
+#  first verified that the user is a loncapa user.
+#
+# Parameters:
+#    user      - Unix user name to change.
+#    pass      - New password for the user.
+# Returns:
+#    ok    - if success
+#    other - Some meaningfule error message string.
+# NOTE:
+#    invokes a setuid script to change the passwd.
+sub change_unix_password {
+    my ($user, $pass) = @_;
+
+    &Debug("change_unix_password");
+    my $execdir=$perlvar{'lonDaemons'};
+    &Debug("Opening lcpasswd pipeline");
+    my $pf = IO::File->new("|$execdir/lcpasswd > "
+			   ."$perlvar{'lonDaemons'}"
+			   ."/logs/lcpasswd.log");
+    print $pf "$user\n$pass\n$pass\n";
+    close $pf;
+    my $err = $?;
+    return ($err < @passwderrors) ? $passwderrors[$err] : 
+	"pwchange_falure - unknown error";
+
+    
+}
+
 
 sub make_passwd_file {
     my ($uname, $umode,$npass,$passfilename)=@_;
@@ -5516,24 +5867,30 @@ sub make_passwd_file {
 		print $se "$npass\n";
 		print $se "$lc_error_file\n"; # Status -> unique file.
 	    }
-	    my $error = IO::File->new("< $lc_error_file");
-	    my $useraddok = <$error>;
-	    $error->close;
-	    unlink($lc_error_file);
-
-	    chomp $useraddok;
-
-	    if($useraddok > 0) {
-		my $error_text = &lcuseraddstrerror($useraddok);
-		&logthis("Failed lcuseradd: $error_text");
-		$result = "lcuseradd_failed:$error_text\n";
-	    }  else {
-		my $pf = IO::File->new(">$passfilename");
-		if($pf) {
-		    print $pf "unix:\n";
-		} else {
-		    $result = "pass_file_failed_error";
+	    if (-r $lc_error_file) {
+		&Debug("Opening error file: $lc_error_file");
+		my $error = IO::File->new("< $lc_error_file");
+		my $useraddok = <$error>;
+		$error->close;
+		unlink($lc_error_file);
+		
+		chomp $useraddok;
+	
+		if($useraddok > 0) {
+		    my $error_text = &lcuseraddstrerror($useraddok);
+		    &logthis("Failed lcuseradd: $error_text");
+		    $result = "lcuseradd_failed:$error_text\n";
+		}  else {
+		    my $pf = IO::File->new(">$passfilename");
+		    if($pf) {
+			print $pf "unix:\n";
+		    } else {
+			$result = "pass_file_failed_error";
+		    }
 		}
+	    }  else {
+		&Debug("Could not locate lcuseradd error: $lc_error_file");
+		$result="bug_lcuseradd_no_output_file";
 	    }
 	}
     } elsif ($umode eq 'none') {