--- loncom/lond	2005/01/26 12:13:58	1.276
+++ loncom/lond	2006/05/30 15:39:56	1.331
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.276 2005/01/26 12:13:58 foxr Exp $
+# $Id: lond,v 1.331 2006/05/30 15:39:56 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,12 +31,12 @@
 
 use strict;
 use lib '/home/httpd/lib/perl/';
+use LONCAPA;
 use LONCAPA::Configuration;
 
 use IO::Socket;
 use IO::File;
 #use Apache::File;
-use Symbol;
 use POSIX;
 use Crypt::IDEA;
 use LWP::UserAgent();
@@ -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,14 +59,13 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.276 $'; #' stupid emacs
+my $VERSION='$Revision: 1.331 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
 
 my $client;
 my $clientip;			# IP address of client.
-my $clientdns;			# DNS name of client.
 my $clientname;			# LonCAPA name of client.
 
 my $server;
@@ -87,6 +87,7 @@ my $ConnectionType;
 
 my %hostid;			# ID's for hosts in cluster by ip.
 my %hostdom;			# LonCAPA domain for hosts in cluster.
+my %hostname;			# DNSname -> ID's mapping.
 my %hostip;			# IPs for hosts in cluster.
 my %hostdns;			# ID's of hosts looked up by DNS name.
 
@@ -113,20 +114,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.:
@@ -178,7 +179,6 @@ sub ResetStatistics {
 #   $initcmd     - The full text of the init command.
 #
 # Implicit inputs:
-#    $clientdns  - The DNS name of the remote client.
 #    $thisserver - Our DNS name.
 #
 # Returns:
@@ -187,10 +187,10 @@ sub ResetStatistics {
 #
 sub LocalConnection {
     my ($Socket, $initcmd) = @_;
-    Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver");
-    if($clientdns ne $thisserver) {
+    Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver");
+    if($clientip ne "127.0.0.1") {
 	&logthis('<font color="red"> LocalConnection rejecting non local: '
-		 ."$clientdns ne $thisserver </font>");
+		 ."$clientip ne $thisserver </font>");
 	close $Socket;
 	return undef;
     }  else {
@@ -474,39 +474,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.
@@ -967,105 +939,6 @@ sub EditFile {
     return "ok\n";
 }
 
-#---------------------------------------------------------------
-#
-# Manipulation of hash based databases (factoring out common code
-# for later use as we refactor.
-#
-#  Ties a domain level resource file to a hash.
-#  If requested a history entry is created in the associated hist file.
-#
-#  Parameters:
-#     domain    - Name of the domain in which the resource file lives.
-#     namespace - Name of the hash within that domain.
-#     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
-#     loghead   - Optional parameter, if present a log entry is created
-#                 in the associated history file and this is the first part
-#                  of that entry.
-#     logtail   - Goes along with loghead,  The actual logentry is of the
-#                 form $loghead:<timestamp>:logtail.
-# Returns:
-#    Reference to a hash bound to the db file or alternatively undef
-#    if the tie failed.
-#
-sub tie_domain_hash {
-    my ($domain,$namespace,$how,$loghead,$logtail) = @_;
-    
-    # Filter out any whitespace in the domain name:
-    
-    $domain =~ s/\W//g;
-    
-    # We have enough to go on to tie the hash:
-    
-    my $user_top_dir   = $perlvar{'lonUsersDir'};
-    my $domain_dir     = $user_top_dir."/$domain";
-    my $resource_file  = $domain_dir."/$namespace.db";
-    my %hash;
-    if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {
-	if (defined($loghead)) {	# Need to log the operation.
-	    my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");
-	    if($logFh) {
-		my $timestamp = time;
-		print $logFh "$loghead:$timestamp:$logtail\n";
-	    }
-	    $logFh->close;
-	}
-	return \%hash;		# Return the tied hash.
-    } else {
-	return undef;		# Tie failed.
-    }
-}
-
-#
-#   Ties a user's resource file to a hash.  
-#   If necessary, an appropriate history
-#   log file entry is made as well.
-#   This sub factors out common code from the subs that manipulate
-#   the various gdbm files that keep keyword value pairs.
-# Parameters:
-#   domain       - Name of the domain the user is in.
-#   user         - Name of the 'current user'.
-#   namespace    - Namespace representing the file to tie.
-#   how          - What the tie is done to (e.g. GDBM_WRCREAT().
-#   loghead      - Optional first part of log entry if there may be a
-#                  history file.
-#   what         - Optional tail of log entry if there may be a history
-#                  file.
-# Returns:
-#   hash to which the database is tied.  It's up to the caller to untie.
-#   undef if the has could not be tied.
-#
-sub tie_user_hash {
-    my ($domain,$user,$namespace,$how,$loghead,$what) = @_;
-
-    $namespace=~s/\//\_/g;	# / -> _
-    $namespace=~s/\W//g;		# whitespace eliminated.
-    my $proname     = propath($domain, $user);
-   
-    #  Tie the database.
-    
-    my %hash;
-    if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
-	   $how, 0640)) {
-	# If this is a namespace for which a history is kept,
-	# make the history log entry:    
-	if (($namespace !~/^nohist\_/) && (defined($loghead))) {
-	    my $args = scalar @_;
-	    Debug(" Opening history: $namespace $args");
-	    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
-	    if($hfh) {
-		my $now = time;
-		print $hfh "$loghead:$now:$what\n";
-	    }
-	    $hfh->close;
-	}
-	return \%hash;
-    } else {
-	return undef;
-    }
-    
-}
-
 #   read_profile
 #
 #   Returns a set of specific entries from a user's profile file.
@@ -1096,7 +969,7 @@ sub read_profile {
 	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
 	}
 	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
-	if (untie %$hashref) {
+	if (&untie_user_hash($hashref)) {
 	    return $qresult;
 	} else {
 	    return "error: ".($!+0)." untie (GDBM) Failed";
@@ -1393,24 +1266,27 @@ 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;
 }
 &register_handler("du", \&du_handler, 0, 1, 0);
 
 #
+# The ls_handler routine should be considered obosolete and is retained
+# for communication with legacy servers.  Please see the ls2_handler.
+#
 #   ls  - list the contents of a directory.  For each file in the
 #    selected directory the filename followed by the full output of
 #    the stat function is returned.  The returned info for each
@@ -1427,6 +1303,7 @@ sub du_handler {
 #   The reply is written to  $client.
 #
 sub ls_handler {
+    # obsoleted by ls2_handler
     my ($cmd, $ulsdir, $client) = @_;
 
     my $userinput = "$cmd:$ulsdir";
@@ -1439,14 +1316,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; }
 			}
 		    }
@@ -1473,6 +1351,73 @@ sub ls_handler {
 }
 &register_handler("ls", \&ls_handler, 0, 1, 0);
 
+#
+# Please also see the ls_handler, which this routine obosolets.
+# ls2_handler differs from ls_handler in that it escapes its return 
+# values before concatenating them together with ':'s.
+#
+#   ls2  - list the contents of a directory.  For each file in the
+#    selected directory the filename followed by the full output of
+#    the stat function is returned.  The returned info for each
+#    file are separated by ':'.  The stat fields are separated by &'s.
+# Parameters:
+#    $cmd        - The command that dispatched us (ls).
+#    $ulsdir     - The directory path to list... I'm not sure what this
+#                  is relative as things like ls:. return e.g.
+#                  no_such_dir.
+#    $client     - Socket open on the client.
+# Returns:
+#     1 - indicating that the daemon should not disconnect.
+# Side Effects:
+#   The reply is written to  $client.
+#
+sub ls2_handler {
+    my ($cmd, $ulsdir, $client) = @_;
+
+    my $userinput = "$cmd:$ulsdir";
+
+    my $obs;
+    my $rights;
+    my $ulsout='';
+    my $ulsfn;
+    if (-e $ulsdir) {
+        if(-d $ulsdir) {
+            if (opendir(LSDIR,$ulsdir)) {
+                while ($ulsfn=readdir(LSDIR)) {
+                    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|1)/) { $obs = 1; } 
+                            if($obsolete =~ m|(<copyright>)(default)|) {
+                                $rights = 1;
+                            }
+                        }
+                    }
+                    my $tmp = $ulsfn.'&'.join('&',@ulsstats);
+                    if ($obs    eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                    if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                    $ulsout.= &escape($tmp).':';
+                }
+                closedir(LSDIR);
+            }
+        } else {
+            my @ulsstats=stat($ulsdir);
+            $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+        }
+    } else {
+        $ulsout='no_such_dir';
+   }
+   if ($ulsout eq '') { $ulsout='empty'; }
+   &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+   return 1;
+}
+&register_handler("ls2", \&ls2_handler, 0, 1, 0);
+
 #   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.
@@ -1661,19 +1606,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
@@ -1772,6 +1707,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 {
 
@@ -1791,24 +1729,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.
 	}
@@ -1890,6 +1845,7 @@ sub update_resource_handler {
 	    my $since=$now-$atime;
 	    if ($since>$perlvar{'lonExpire'}) {
 		my $reply=&reply("unsub:$fname","$clientname");
+		&devalidate_meta_cache($fname);
 		unlink("$fname");
 	    } else {
 		my $transname="$fname.in.transfer";
@@ -1920,6 +1876,7 @@ sub update_resource_handler {
 			alarm(0);
 		    }
 		    rename($transname,$fname);
+		    &devalidate_meta_cache($fname);
 		}
 	    }
 	    &Reply( $client, "ok\n", $userinput);
@@ -1933,6 +1890,26 @@ sub update_resource_handler {
 }
 &register_handler("update", \&update_resource_handler, 0 ,1, 0);
 
+sub devalidate_meta_cache {
+    my ($url) = @_;
+    use Cache::Memcached;
+    my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+    $url = &declutter($url);
+    $url =~ s-\.meta$--;
+    my $id = &escape('meta:'.$url);
+    $memcache->delete($id);
+}
+
+sub declutter {
+    my $thisfn=shift;
+    $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
+    $thisfn=~s/^\///;
+    $thisfn=~s|^adm/wrapper/||;
+    $thisfn=~s|^adm/coursedocs/showdoc/||;
+    $thisfn=~s/^res\///;
+    $thisfn=~s/\?.+$//;
+    return $thisfn;
+}
 #
 #   Fetch a user file from a remote server to the user's home directory
 #   userfiles subdir.
@@ -2150,7 +2127,9 @@ sub token_auth_user_file_handler {
     if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
 	     $session.'.id')) {
 	while (my $line=<ENVIN>) {
-	    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; }
+	    my ($envname)=split(/=/,$line,2);
+	    $envname=&unescape($envname);
+	    if ($envname=~ m|^userfile\.\Q$fname\E|) { $reply="ok\n"; }
 	}
 	close(ENVIN);
 	&Reply($client, $reply, "$cmd:$tail");
@@ -2301,7 +2280,7 @@ sub put_user_profile_entry {
 		my ($key,$value)=split(/=/,$pair);
 		$hashref->{$key}=$value;
 	    }
-	    if (untie(%$hashref)) {
+	    if (&untie_user_hash($hashref)) {
 		&Reply( $client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2309,7 +2288,7 @@ sub put_user_profile_entry {
 			$userinput);
 	    }
 	} else {
-	    &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+	    &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
 		     "while attempting put\n", $userinput);
 	}
     } else {
@@ -2320,6 +2299,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: ".($!+0)." 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_user_hash($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,
@@ -2350,13 +2384,19 @@ 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)) {
+	    if (&untie_user_hash($hashref)) {
 		&Reply( $client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2423,7 +2463,7 @@ sub roles_put_handler {
 			       $auth_type);
 	    $hashref->{$key}=$value;
 	}
-	if (untie($hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2474,7 +2514,7 @@ sub roles_delete_handler {
 	foreach my $key (@rolekeys) {
 	    delete $hashref->{$key};
 	}
-	if (untie(%$hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2615,7 +2655,7 @@ sub delete_profile_entry {
 	foreach my $key (@keys) {
 	    delete($hashref->{$key});
 	}
-	if (untie(%$hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2657,7 +2697,7 @@ sub get_profile_keys {
 	foreach my $key (keys %$hashref) {
 	    $qresult.="$key&";
 	}
-	if (untie(%$hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    $qresult=~s/\&$//;
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2718,7 +2758,7 @@ sub dump_profile_database {
 	    $data{$symb}->{$param}=$value;
 	    $data{$symb}->{'v.'.$param}=$v;
 	}
-	if (untie(%$hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    while (my ($symb,$param_hash) = each(%data)) {
 		while(my ($param,$value) = each (%$param_hash)){
 		    next if ($param =~ /^v\./);       # Ignore versions...
@@ -2773,27 +2813,44 @@ sub dump_with_regexp {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
+    my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
     if (defined($regexp)) {
 	$regexp=&unescape($regexp);
     } else {
 	$regexp='.';
     }
+    my ($start,$end);
+    if (defined($range)) {
+	if ($range =~/^(\d+)\-(\d+)$/) {
+	    ($start,$end) = ($1,$2);
+	} elsif ($range =~/^(\d+)$/) {
+	    ($start,$end) = (0,$1);
+	} else {
+	    undef($range);
+	}
+    }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
         my $qresult='';
+	my $count=0;
 	while (my ($key,$value) = each(%$hashref)) {
 	    if ($regexp eq '.') {
+		$count++;
+		if (defined($range) && $count >= $end)   { last; }
+		if (defined($range) && $count <  $start) { next; }
 		$qresult.=$key.'='.$value.'&';
 	    } else {
 		my $unescapeKey = &unescape($key);
 		if (eval('$unescapeKey=~/$regexp/')) {
+		    $count++;
+		    if (defined($range) && $count >= $end)   { last; }
+		    if (defined($range) && $count <  $start) { next; }
 		    $qresult.="$key=$value&";
 		}
 	    }
 	}
-	if (untie(%$hashref)) {
+	if (&untie_user_hash($hashref)) {
 	    chop($qresult);
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2855,7 +2912,7 @@ sub store_handler {
 	    $hashref->{"$version:$rid:timestamp"}=$now;
 	    $allkeys.='timestamp';
 	    $hashref->{"$version:keys:$rid"}=$allkeys;
-	    if (untie($hashref)) {
+	    if (&untie_user_hash($hashref)) {
 		&Reply($client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2873,6 +2930,85 @@ sub store_handler {
 }
 &register_handler("store", \&store_handler, 0, 1, 0);
 
+#  Modify a set of key=value pairs associated with a versioned name.
+#
+#  Parameters:
+#    $cmd                - Request command keyword.
+#    $tail               - Tail of the request.  This is a colon
+#                          separated list containing:
+#                          domain/user - User and authentication domain.
+#                          namespace   - Name of the database being modified
+#                          rid         - Resource keyword to modify.
+#                          v           - Version item to modify
+#                          what        - new value associated with rid.
+#
+#    $client             - Socket open on the client.
+#
+#
+#  Returns:
+#      1 (keep on processing).
+#  Side-Effects:
+#    Writes to the client
+sub putstore_handler {
+    my ($cmd, $tail, $client) = @_;
+ 
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace,$rid,$v,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+
+	chomp($what);
+	my $hashref  = &tie_user_hash($udom, $uname, $namespace,
+				       &GDBM_WRCREAT(), "M",
+				       "$rid:$v:$what");
+	if ($hashref) {
+	    my $now = time;
+	    my %data = &hash_extract($what);
+	    my @allkeys;
+	    while (my($key,$value) = each(%data)) {
+		push(@allkeys,$key);
+		$hashref->{"$v:$rid:$key"} = $value;
+	    }
+	    my $allkeys = join(':',@allkeys);
+	    $hashref->{"$v:keys:$rid"}=$allkeys;
+
+	    if (&untie_user_hash($hashref)) {
+		&Reply($client, "ok\n", $userinput);
+	    } else {
+		&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+			"while attempting store\n", $userinput);
+	    }
+	} else {
+	    &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		     "while attempting store\n", $userinput);
+	}
+    } else {
+	&Failure($client, "refused\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("putstore", \&putstore_handler, 0, 1, 0);
+
+sub hash_extract {
+    my ($str)=@_;
+    my %hash;
+    foreach my $pair (split(/\&/,$str)) {
+	my ($key,$value)=split(/=/,$pair);
+	$hash{$key}=$value;
+    }
+    return (%hash);
+}
+sub hash_to_str {
+    my ($hash_ref)=@_;
+    my $str;
+    foreach my $key (keys(%$hash_ref)) {
+	$str.=$key.'='.$hash_ref->{$key}.'&';
+    }
+    $str=~s/\&$//;
+    return $str;
+}
+
 #
 #  Dump out all versions of a resource that has key=value pairs associated
 # with it for each version.  These resources are built up via the store
@@ -2907,24 +3043,22 @@ sub restore_handler {
     $namespace=~s/\//\_/g;
     $namespace=~s/\W//g;
     chomp($rid);
-    my $proname=&propath($udom,$uname);
     my $qresult='';
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
-	    &GDBM_READER(),0640)) {
-	my $version=$hash{"version:$rid"};
+    my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
+    if ($hashref) {
+	my $version=$hashref->{"version:$rid"};
 	$qresult.="version=$version&";
 	my $scope;
 	for ($scope=1;$scope<=$version;$scope++) {
-	    my $vkeys=$hash{"$scope:keys:$rid"};
+	    my $vkeys=$hashref->{"$scope:keys:$rid"};
 	    my @keys=split(/:/,$vkeys);
 	    my $key;
 	    $qresult.="$scope:keys=$vkeys&";
 	    foreach $key (@keys) {
-		$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
+		$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
 	    }                                  
 	}
-	if (untie(%hash)) {
+	if (&untie_user_hash($hashref)) {
 	    $qresult=~s/\&$//;
 	    &Reply( $client, "$qresult\n", $userinput);
 	} else {
@@ -2943,15 +3077,17 @@ sub restore_handler {
 &register_handler("restore", \&restore_handler, 0,1,0);
 
 #
-#   Add a chat message to to a discussion board.
+#   Add a chat message to a synchronous discussion board.
 #
 # Parameters:
 #    $cmd                - Request keyword.
 #    $tail               - Tail of the command. A colon separated list
 #                          containing:
 #                          cdom    - Domain on which the chat board lives
-#                          cnum    - Identifier of the discussion group.
-#                          post    - Body of the posting.
+#                          cnum    - Course containing the chat board.
+#                          newpost - Body of the posting.
+#                          group   - Optional group, if chat board is only 
+#                                    accessible in a group within the course 
 #   $client              - Socket open on the client.
 # Returns:
 #   1    - Indicating caller should keep on processing.
@@ -2966,8 +3102,8 @@ sub send_chat_handler {
     
     my $userinput = "$cmd:$tail";
 
-    my ($cdom,$cnum,$newpost)=split(/\:/,$tail);
-    &chat_add($cdom,$cnum,$newpost);
+    my ($cdom,$cnum,$newpost,$group)=split(/\:/,$tail);
+    &chat_add($cdom,$cnum,$newpost,$group);
     &Reply($client, "ok\n", $userinput);
 
     return 1;
@@ -2975,7 +3111,7 @@ sub send_chat_handler {
 &register_handler("chatsend", \&send_chat_handler, 0, 1, 0);
 
 #
-#   Retrieve the set of chat messagss from a discussion board.
+#   Retrieve the set of chat messages from a discussion board.
 #
 #  Parameters:
 #    $cmd             - Command keyword that initiated the request.
@@ -2985,6 +3121,8 @@ sub send_chat_handler {
 #                       chat id        - Discussion thread(?)
 #                       domain/user    - Authentication domain and username
 #                                        of the requesting person.
+#                       group          - Optional course group containing
+#                                        the board.      
 #   $client           - Socket open on the client program.
 # Returns:
 #    1     - continue processing
@@ -2997,9 +3135,9 @@ sub retrieve_chat_handler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($cdom,$cnum,$udom,$uname)=split(/\:/,$tail);
+    my ($cdom,$cnum,$udom,$uname,$group)=split(/\:/,$tail);
     my $reply='';
-    foreach (&get_chat($cdom,$cnum,$udom,$uname)) {
+    foreach (&get_chat($cdom,$cnum,$udom,$uname,$group)) {
 	$reply.=&escape($_).':';
     }
     $reply=~s/\:$//;
@@ -3157,7 +3295,7 @@ sub put_course_id_handler {
             }
 	    $hashref->{$key}=$courseinfo.':'.$now;
 	}
-	if (untie(%$hashref)) {
+	if (&untie_domain_hash($hashref)) {
 	    &Reply( $client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)
@@ -3212,7 +3350,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 {
@@ -3228,6 +3366,11 @@ sub dump_course_id_handler {
     } else {
         $ownerfilter='.';
     }
+    if (defined($coursefilter)) {
+        $coursefilter=&unescape($coursefilter);
+    } else {
+        $coursefilter='.';
+    }
 
     unless (defined($since)) { $since=0; }
     my $qresult='';
@@ -3258,11 +3401,17 @@ 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.'&';
             }
 	}
-	if (untie(%$hashref)) {
+	if (&untie_domain_hash($hashref)) {
 	    chop($qresult);
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -3311,7 +3460,7 @@ sub put_id_handler {
 	    my ($key,$value)=split(/=/,$pair);
 	    $hashref->{$key}=$value;
 	}
-	if (untie(%$hashref)) {
+	if (&untie_domain_hash($hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3360,7 +3509,7 @@ sub get_id_handler {
 	for (my $i=0;$i<=$#queries;$i++) {
 	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (untie(%$hashref)) {
+	if (&untie_domain_hash($hashref)) {
 	    $qresult=~s/\&$//;
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -3377,6 +3526,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_domain_hash($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_domain_hash($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_domain_hash($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_domain_hash($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.
@@ -3855,6 +4256,83 @@ sub get_institutional_code_format_handle
 &register_handler("autoinstcodeformat",
 		  \&get_institutional_code_format_handler,0,1,0);
 
+# Get domain specific conditions for import of student photographs to a course
+#
+# Retrieves information from photo_permission subroutine in localenroll.
+# Returns outcome (ok) if no processing errors, and whether course owner is 
+# required to accept conditions of use (yes/no).
+#
+#    
+sub photo_permission_handler {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my $cdom = $tail;
+    my ($perm_reqd,$conditions);
+    my $outcome;
+    eval {
+	local($SIG{__DIE__})='DEFAULT';
+	$outcome = &localenroll::photo_permission($cdom,\$perm_reqd,
+						  \$conditions);
+    };
+    if (!$@) {
+	&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n",
+	       $userinput);
+    } else {
+	&Failure($client,"unknown_cmd\n",$userinput);
+    }
+    return 1;
+}
+&register_handler("autophotopermission",\&photo_permission_handler,0,1,0);
+
+#
+# Checks if student photo is available for a user in the domain, in the user's
+# directory (in /userfiles/internal/studentphoto.jpg).
+# Uses localstudentphoto:fetch() to ensure there is an up to date copy of
+# the student's photo.   
+
+sub photo_check_handler {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my ($udom,$uname,$pid) = split(/:/,$tail);
+    $udom = &unescape($udom);
+    $uname = &unescape($uname);
+    $pid = &unescape($pid);
+    my $path=&propath($udom,$uname).'/userfiles/internal/';
+    if (!-e $path) {
+        &mkpath($path);
+    }
+    my $response;
+    my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response);
+    $result .= ':'.$response;
+    &Reply($client, &escape($result)."\n",$userinput);
+    return 1;
+}
+&register_handler("autophotocheck",\&photo_check_handler,0,1,0);
+
+#
+# Retrieve information from localenroll about whether to provide a button     
+# for users who have enbled import of student photos to initiate an 
+# update of photo files for registered students. Also include 
+# comment to display alongside button.  
+
+sub photo_choice_handler {
+    my ($cmd, $tail, $client) = @_;
+    my $userinput             = "$cmd:$tail";
+    my $cdom                  = &unescape($tail);
+    my ($update,$comment);
+    eval {
+	local($SIG{__DIE__})='DEFAULT';
+	($update,$comment)    = &localenroll::manager_photo_update($cdom);
+    };
+    if (!$@) {
+	&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput);
+    } else {
+	&Failure($client,"unknown_cmd\n",$userinput);
+    }
+    return 1;
+}
+&register_handler("autophotochoice",\&photo_choice_handler,0,1,0);
+
 #
 # Gets a student's photo to exist (in the correct image type) in the user's 
 # directory.
@@ -3867,24 +4345,36 @@ sub get_institutional_code_format_handle
 #    $client  - The socket open on the client.
 # Returns:
 #    1 - continue processing.
+
 sub student_photo_handler {
     my ($cmd, $tail, $client) = @_;
-    my ($domain,$uname,$type) = split(/:/, $tail);
+    my ($domain,$uname,$ext,$type) = split(/:/, $tail);
 
-    my $path=&propath($domain,$uname).
-	'/userfiles/internal/studentphoto.'.$type;
-    if (-e $path) {
+    my $path=&propath($domain,$uname). '/userfiles/internal/';
+    my $filename = 'studentphoto.'.$ext;
+    if ($type eq 'thumbnail') {
+        $filename = 'studentphoto_tn.'.$ext;
+    }
+    if (-e $path.$filename) {
 	&Reply($client,"ok\n","$cmd:$tail");
 	return 1;
     }
     &mkpath($path);
-    my $file=&localstudentphoto::fetch($domain,$uname);
+    my $file;
+    if ($type eq 'thumbnail') {
+	eval {
+	    local($SIG{__DIE__})='DEFAULT';
+	    $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
+	};
+    } else {
+        $file=&localstudentphoto::fetch($domain,$uname);
+    }
     if (!$file) {
 	&Failure($client,"unavailable\n","$cmd:$tail");
 	return 1;
     }
-    if (!-e $path) { &convert_photo($file,$path); }
-    if (-e $path) {
+    if (!-e $path.$filename) { &convert_photo($file,$path.$filename); }
+    if (-e $path.$filename) {
 	&Reply($client,"ok\n","$cmd:$tail");
 	return 1;
     }
@@ -3945,6 +4435,22 @@ sub process_request {
                                 # fix all the userinput -> user_input.
     my $wasenc    = 0;		# True if request was encrypted.
 # ------------------------------------------------------------ See if encrypted
+    # for command
+    # sethost:<server>
+    # <command>:<args>
+    #   we just send it to the processor
+    # for
+    # sethost:<server>:<command>:<args>
+    #  we do the implict set host and then do the command
+    if ($userinput =~ /^sethost:/) {
+	(my $cmd,my $newid,$userinput) = split(':',$userinput,3);
+	if (defined($userinput)) {
+	    &sethost("$cmd:$newid");
+	} else {
+	    $userinput = "$cmd:$newid";
+	}
+    }
+
     if ($userinput =~ /^enc/) {
 	$userinput = decipher($userinput);
 	$wasenc=1;
@@ -4280,13 +4786,27 @@ 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*\#/)) {
-	    my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
-	    chomp($ip); $ip=~s/\D+$//;
+	if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
+	    my ($id,$domain,$role,$name)=split(/:/,$configline);
+	    $name=~s/\s//g;
+	    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};
+	    }
 	    $hostid{$ip}=$id;         # LonCAPA name of host by IP.
 	    $hostdom{$id}=$domain;    # LonCAPA domain name of host. 
-	    $hostip{$id}=$ip;	      # IP address of host.
+	    $hostname{$id}=$name;     # LonCAPA name -> DNS name
+	    $hostip{$id}=$ip;         # IP address of host.
 	    $hostdns{$name} = $id;    # LonCAPA name of host by DNS.
 
 	    if ($id eq $perlvar{'lonHostID'}) { 
@@ -4423,8 +4943,6 @@ sub Reply {
     Debug("Request was $request  Reply was $reply");
 
     $Transactions++;
-
-
 }
 
 
@@ -4496,22 +5014,6 @@ sub status {
     $0='lond: '.$what.' '.$local;
 }
 
-# -------------------------------------------------------- Escape Special Chars
-
-sub escape {
-    my $str=shift;
-    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
-    return $str;
-}
-
-# ----------------------------------------------------- Un-Escape Special Chars
-
-sub unescape {
-    my $str=shift;
-    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-    return $str;
-}
-
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
@@ -4538,12 +5040,12 @@ sub reconlonc {
 
 sub subreply {
     my ($cmd,$server)=@_;
-    my $peerfile="$perlvar{'lonSockDir'}/$server";
+    my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                       Type    => SOCK_STREAM,
                                       Timeout => 10)
        or return "con_lost";
-    print $sclient "$cmd\n";
+    print $sclient "sethost:$server:$cmd\n";
     my $answer=<$sclient>;
     chomp($answer);
     if (!$answer) { $answer="con_lost"; }
@@ -4559,7 +5061,7 @@ sub reply {
 	$answer=subreply("ping",$server);
         if ($answer ne $server) {
 	    &logthis("sub reply: answer != server answer is $answer, server is $server");
-           &reconlonc("$perlvar{'lonSockDir'}/$server");
+           &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server});
         }
         $answer=subreply($cmd,$server);
     }
@@ -4586,25 +5088,13 @@ sub sub_sql_reply {
                                       Type    => SOCK_STREAM,
                                       Timeout => 10)
        or return "con_lost";
-    print $sclient "$cmd\n";
+    print $sclient "$cmd:$currentdomainid\n";
     my $answer=<$sclient>;
     chomp($answer);
     if (!$answer) { $answer="con_lost"; }
     return $answer;
 }
 
-# -------------------------------------------- Return path to profile directory
-
-sub propath {
-    my ($udom,$uname)=@_;
-    $udom=~s/\W//g;
-    $uname=~s/\W//g;
-    my $subdir=$uname.'__';
-    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
-    return $proname;
-} 
-
 # --------------------------------------- Is this the home server of an author?
 
 sub ishome {
@@ -4652,6 +5142,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
@@ -4698,8 +5190,6 @@ sub make_new_child {
     if (defined($iaddr)) {
 	$clientip  = inet_ntoa($iaddr);
 	Debug("Connected with $clientip");
-	$clientdns = gethostbyaddr($iaddr, AF_INET);
-	Debug("Connected with $clientdns by name");
     } else {
 	&logthis("Unable to determine clientip");
 	$clientip='Unavailable';
@@ -4729,7 +5219,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');
 # =============================================================================
@@ -4739,18 +5231,23 @@ sub make_new_child {
 
 	ReadManagerTable;	# May also be a manager!!
 	
-	my $clientrec=($hostid{$clientip}     ne undef);
-	my $ismanager=($managers{$clientip}    ne undef);
+	my $outsideip=$clientip;
+	if ($clientip eq '127.0.0.1') {
+	    $outsideip=$hostip{$perlvar{'lonHostID'}};
+	}
+
+	my $clientrec=($hostid{$outsideip}     ne undef);
+	my $ismanager=($managers{$outsideip}    ne undef);
 	$clientname  = "[unknonwn]";
 	if($clientrec) {	# Establish client type.
 	    $ConnectionType = "client";
-	    $clientname = $hostid{$clientip};
+	    $clientname = $hostid{$outsideip};
 	    if($ismanager) {
 		$ConnectionType = "both";
 	    }
 	} else {
 	    $ConnectionType = "manager";
-	    $clientname = $managers{$clientip};
+	    $clientname = $managers{$outsideip};
 	}
 	my $clientok;
 
@@ -4858,7 +5355,7 @@ sub make_new_child {
 		    # no need to try to do recon's to myself
 		    next;
 		}
-		&reconlonc("$perlvar{'lonSockDir'}/$id");
+		&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id});
 	    }
 	    &logthis("<font color='green'>Established connection: $clientname</font>");
 	    &status('Will listen to '.$clientname);
@@ -4914,8 +5411,11 @@ sub is_author {
 
     #  Author role should show up as a key /domain/_au
 
-    my $key   = "/$domain/_au";
-    my $value = $hashref->{$key};
+    my $key    = "/$domain/_au";
+    my $value;
+    if (defined($hashref)) {
+	$value = $hashref->{$key};
+    }
 
     if(defined($value)) {
 	&Debug("$user @ $domain is an author");
@@ -4934,16 +5434,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");
@@ -5191,39 +5688,51 @@ sub addline {
 }
 
 sub get_chat {
-    my ($cdom,$cname,$udom,$uname)=@_;
-    my %hash;
-    my $proname=&propath($cdom,$cname);
+    my ($cdom,$cname,$udom,$uname,$group)=@_;
+
     my @entries=();
-    if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
-	    &GDBM_READER(),0640)) {
-	@entries=map { $_.':'.$hash{$_} } sort keys %hash;
-	untie %hash;
+    my $namespace = 'nohist_chatroom';
+    my $namespace_inroom = 'nohist_inchatroom';
+    if (defined($group)) {
+        $namespace .= '_'.$group;
+        $namespace_inroom .= '_'.$group;
+    }
+    my $hashref = &tie_user_hash($cdom, $cname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
+	&untie_user_hash($hashref);
     }
     my @participants=();
     my $cutoff=time-60;
-    if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
-	    &GDBM_WRCREAT(),0640)) {
-        $hash{$uname.':'.$udom}=time;
-        foreach (sort keys %hash) {
-	    if ($hash{$_}>$cutoff) {
-		$participants[$#participants+1]='active_participant:'.$_;
+    $hashref = &tie_user_hash($cdom, $cname, $namespace_inroom,
+			      &GDBM_WRCREAT());
+    if ($hashref) {
+        $hashref->{$uname.':'.$udom}=time;
+        foreach my $user (sort(keys(%$hashref))) {
+	    if ($hashref->{$user}>$cutoff) {
+		push(@participants, 'active_participant:'.$user);
             }
         }
-        untie %hash;
+        &untie_user_hash($hashref);
     }
     return (@participants,@entries);
 }
 
 sub chat_add {
-    my ($cdom,$cname,$newchat)=@_;
-    my %hash;
-    my $proname=&propath($cdom,$cname);
+    my ($cdom,$cname,$newchat,$group)=@_;
     my @entries=();
     my $time=time;
-    if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
-	    &GDBM_WRCREAT(),0640)) {
-	@entries=map { $_.':'.$hash{$_} } sort keys %hash;
+    my $namespace = 'nohist_chatroom';
+    my $logfile = 'chatroom.log';
+    if (defined($group)) {
+        $namespace .= '_'.$group;
+        $logfile = 'chatroom_'.$group.'.log';
+    }
+    my $hashref = &tie_user_hash($cdom, $cname, $namespace,
+				 &GDBM_WRCREAT());
+    if ($hashref) {
+	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
 	my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
 	my ($thentime,$idnum)=split(/\_/,$lastid);
 	my $newid=$time.'_000000';
@@ -5233,21 +5742,22 @@ sub chat_add {
 	    $idnum=substr('000000'.$idnum,-6,6);
 	    $newid=$time.'_'.$idnum;
 	}
-	$hash{$newid}=$newchat;
+	$hashref->{$newid}=$newchat;
 	my $expired=$time-3600;
-	foreach (keys %hash) {
-	    my ($thistime)=($_=~/(\d+)\_/);
+	foreach my $comment (keys(%$hashref)) {
+	    my ($thistime) = ($comment=~/(\d+)\_/);
 	    if ($thistime<$expired) {
-		delete $hash{$_};
+		delete $hashref->{$comment};
 	    }
 	}
-	untie %hash;
-    }
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname/chatroom.log")) { 
-	    print $hfh "$time:".&unescape($newchat)."\n";
+	{
+	    my $proname=&propath($cdom,$cname);
+	    if (open(CHATLOG,">>$proname/$logfile")) { 
+		print CHATLOG ("$time:".&unescape($newchat)."\n");
+	    }
+	    close(CHATLOG);
 	}
+	&untie_user_hash($hashref);
     }
 }
 
@@ -5336,7 +5846,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?
@@ -5380,6 +5890,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)=@_;
@@ -5439,24 +5978,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') {
@@ -5482,6 +6027,11 @@ sub convert_photo {
 sub sethost {
     my ($remotereq) = @_;
     my (undef,$hostid)=split(/:/,$remotereq);
+    # ignore sethost if we are already correct
+    if ($hostid eq $currenthostid) {
+	return 'ok';
+    }
+
     if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
     if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
 	$currenthostid  =$hostid;
@@ -5907,7 +6457,6 @@ to the client, and the connection is clo
 IO::Socket
 IO::File
 Apache::File
-Symbol
 POSIX
 Crypt::IDEA
 LWP::UserAgent()
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>