--- loncom/lond	2006/02/09 20:48:40	1.318.2.3
+++ loncom/lond	2008/02/21 16:04:19	1.395
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.318.2.3 2006/02/09 20:48:40 albertel Exp $
+# $Id: lond,v 1.395 2008/02/21 16:04:19 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,37 +31,35 @@
 
 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();
+use Digest::MD5 qw(md5_hex);
 use GDBM_File;
 use Authen::Krb4;
 use Authen::Krb5;
-use lib '/home/httpd/lib/perl/';
 use localauth;
 use localenroll;
 use localstudentphoto;
 use File::Copy;
 use File::Find;
-use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
-use Symbol;
+use Apache::lonnet;
 
 my $DEBUG = 0;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
-my $lond_max_wait_time = 13;
 
-my $VERSION='$Revision: 1.318.2.3 $'; #' stupid emacs
+my $VERSION='$Revision: 1.395 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -71,7 +69,6 @@ my $clientip;			# IP address of client.
 my $clientname;			# LonCAPA name of client.
 
 my $server;
-my $thisserver;			# DNS of us.
 
 my $keymode;
 
@@ -87,12 +84,6 @@ my $tmpsnum = 0;		# Id of tmpputs.
 
 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.
-
 my %managers;			# Ip -> manager names
 
 my %perlvar;			# Will have the apache conf defined perl vars.
@@ -144,7 +135,7 @@ my @adderrors    = ("ok",
 		    "lcuseradd Unable to make www member of users's group",
 		    "lcuseradd Unable to su to root",
 		    "lcuseradd Unable to set password",
-		    "lcuseradd Usrname has invalid characters",
+		    "lcuseradd Username has invalid characters",
 		    "lcuseradd Password has an invalid character",
 		    "lcuseradd User already exists",
 		    "lcuseradd Could not add user.",
@@ -180,19 +171,16 @@ sub ResetStatistics {
 #   $Socket      - Socket open on client.
 #   $initcmd     - The full text of the init command.
 #
-# Implicit inputs:
-#    $thisserver - Our DNS name.
-#
 # Returns:
 #     IDEA session key on success.
 #     undef on failure.
 #
 sub LocalConnection {
     my ($Socket, $initcmd) = @_;
-    Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver");
+    Debug("Attempting local connection: $initcmd client: $clientip");
     if($clientip ne "127.0.0.1") {
 	&logthis('<font color="red"> LocalConnection rejecting non local: '
-		 ."$clientip ne $thisserver </font>");
+		 ."$clientip ne 127.0.0.1 </font>");
 	close $Socket;
 	return undef;
     }  else {
@@ -426,7 +414,7 @@ sub ReadManagerTable {
       if ($host =~ "^#") {                  # Comment line.
          next;
       }
-      if (!defined $hostip{$host}) { # This is a non cluster member
+      if (!defined &Apache::lonnet::get_host_ip($host)) { # This is a non cluster member
 	    #  The entry is of the form:
 	    #    cluname:hostname
 	    #  cluname - A 'cluster hostname' is needed in order to negotiate
@@ -444,7 +432,7 @@ sub ReadManagerTable {
          }
       } else {
          logthis('<font color="green"> existing host'." $host</font>\n");
-         $managers{$hostip{$host}} = $host;  # Use info from cluster tab if clumemeber
+         $managers{&Apache::lonnet::get_host_ip($host)} = $host;  # Use info from cluster tab if clumemeber
       }
    }
 }
@@ -505,30 +493,30 @@ sub AdjustHostContents {
     my $adjusted;
     my $me        = $perlvar{'lonHostID'};
 
- foreach my $line (split(/\n/,$contents)) {
+    foreach my $line (split(/\n/,$contents)) {
 	if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) {
 	    chomp($line);
 	    my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);
 	    if ($id eq $me) {
-          my $ip = gethostbyname($name);
-          my $ipnew = inet_ntoa($ip);
-         $ip = $ipnew;
+		my $ip = gethostbyname($name);
+		my $ipnew = inet_ntoa($ip);
+		$ip = $ipnew;
 		#  Reconstruct the host line and append to adjusted:
 		
-		   my $newline = "$id:$domain:$role:$name:$ip";
-		   if($maxcon ne "") { # Not all hosts have loncnew tuning params
-		     $newline .= ":$maxcon:$idleto:$mincon";
-		   }
-		   $adjusted .= $newline."\n";
+		my $newline = "$id:$domain:$role:$name:$ip";
+		if($maxcon ne "") { # Not all hosts have loncnew tuning params
+		    $newline .= ":$maxcon:$idleto:$mincon";
+		}
+		$adjusted .= $newline."\n";
 		
-      } else {		# Not me, pass unmodified.
-		   $adjusted .= $line."\n";
-      }
+	    } else {		# Not me, pass unmodified.
+		$adjusted .= $line."\n";
+	    }
 	} else {                  # Blank or comment never re-written.
 	    $adjusted .= $line."\n";	# Pass blanks and comments as is.
 	}
- }
- return $adjusted;
+    }
+    return $adjusted;
 }
 #
 #   InstallFile: Called to install an administrative file:
@@ -837,16 +825,14 @@ sub AdjustOurHost {
     #   Use the config line to get my hostname.
     #   Use gethostbyname to translate that into an IP address.
     #
-    my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
-    my $BinaryIp = gethostbyname($name);
-    my $ip       = inet_ntoa($ip);
+    my ($id,$domain,$role,$name,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
     #
     #  Reassemble the config line from the elements in the list.
     #  Note that if the loncnew items were not present before, they will
     #  be now even if they would be empty
     #
     my $newConfigLine = $id;
-    foreach my $item ($domain, $role, $name, $ip, $maxcon, $idleto, $mincon) {
+    foreach my $item ($domain, $role, $name, $maxcon, $idleto, $mincon) {
 	$newConfigLine .= ":".$item;
     }
     #  Replace the line:
@@ -892,11 +878,11 @@ sub EditFile {
 
     #  Split the command into it's pieces:  edit:filetype:script
 
-    my ($request, $filetype, $script) = split(/:/, $request,3);	# : in script
+    my ($cmd, $filetype, $script) = split(/:/, $request,3);	# : in script
 
     #  Check the pre-coditions for success:
 
-    if($request != "edit") {	# Something is amiss afoot alack.
+    if($cmd != "edit") {	# Something is amiss afoot alack.
 	return "error:edit request detected, but request != 'edit'\n";
     }
     if( ($filetype ne "hosts")  &&
@@ -941,169 +927,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";
-    return &_locking_hash_tie($resource_file,$namespace,$how,$loghead,$logtail);
-}
-
-sub untie_domain_hash {
-    return &_locking_hash_untie(@_);
-}
-#
-#   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);
-
-    my $file_prefix="$proname/$namespace";
-    return &_locking_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
-}
-
-sub untie_user_hash {
-    return &_locking_hash_untie(@_);
-}
-
-# internal routines that handle the actual tieing and untieing process
-
-sub _do_hash_tie {
-    my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-    my %hash;
-    if(tie(%hash, 'GDBM_File', "$file_prefix.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: $file_prefix $args");
-	    my $hfh = IO::File->new(">>$file_prefix.hist"); 
-	    if($hfh) {
-		my $now = time;
-		print $hfh "$loghead:$now:$what\n";
-	    }
-	    $hfh->close;
-	}
-	return \%hash;
-    } else {
-	return undef;
-    }
-}
-
-sub _do_hash_untie {
-    my ($hashref) = @_;
-    my $result = untie(%$hashref);
-    return $result;
-}
-
-{
-    my $sym;
-
-    sub _locking_hash_tie {
-	my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-
-	my ($lock);
-    
-	if ($how eq &GDBM_READER()) {
-	    $lock=LOCK_SH;
-	    $how=$how|&GDBM_NOLOCK();
-	    #if the db doesn't exist we can't read from it
-	    if (! -e "$file_prefix.db") {
-		$! = 2;
-		return undef;
-	    }
-	} elsif ($how eq &GDBM_WRCREAT()) {
-	    $lock=LOCK_EX;
-	    $how=$how|&GDBM_NOLOCK();
-	    if (! -e "$file_prefix.db") {
-		# doesn't exist but we need it to in order to successfully
-                # lock it so bring it into existance
-		open(TOUCH,">>$file_prefix.db");
-		close(TOUCH);
-	    }
-	} else {
-	    &logthis("Unknown method $how for $file_prefix");
-	    die();
-	}
-    
-	$sym=&Symbol::gensym();
-	open($sym,"$file_prefix.db");
-	my $failed=0;
-	eval {
-	    local $SIG{__DIE__}='DEFAULT';
-	    local $SIG{ALRM}=sub { 
-		$failed=1;
-		die("failed lock");
-	    };
-	    alarm($lond_max_wait_time);
-	    flock($sym,$lock);
-	    alarm(0);
-	};
-	if ($failed) {
-	    $! = 100; # throwing error # 100
-	    return undef;
-	}
-	return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
-    }
-
-    sub _locking_hash_untie {
-	my ($hashref) = @_;
-	my $result = untie(%$hashref);
-	flock($sym,LOCK_UN);
-	close($sym);
-	undef($sym);
-	return $result;
-    }
-}
-
 #   read_profile
 #
 #   Returns a set of specific entries from a user's profile file.
@@ -1173,7 +996,7 @@ sub ping_handler {
     my ($cmd, $tail, $client) = @_;
     Debug("$cmd $tail $client .. $currenthostid:");
    
-    Reply( $client,"$currenthostid\n","$cmd:$tail");
+    Reply( $client,\$currenthostid,"$cmd:$tail");
    
     return 1;
 }
@@ -1199,7 +1022,7 @@ sub ping_handler {
 sub pong_handler {
     my ($cmd, $tail, $replyfd) = @_;
 
-    my $reply=&reply("ping",$clientname);
+    my $reply=&Apache::lonnet::reply("ping",$clientname);
     &Reply( $replyfd, "$currenthostid:$reply\n", "$cmd:$tail"); 
     return 1;
 }
@@ -1243,7 +1066,7 @@ sub establish_key_handler {
     $key=substr($key,0,32);
     my $cipherkey=pack("H32",$key);
     $cipher=new IDEA $cipherkey;
-    &Reply($replyfd, "$buildkey\n", "$cmd:$tail"); 
+    &Reply($replyfd, \$buildkey, "$cmd:$tail"); 
    
     return 1;
 
@@ -1280,7 +1103,7 @@ sub load_handler {
    
     my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
 
-    &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
+    &Reply( $replyfd, \$loadpercent, "$cmd:$tail");
    
     return 1;
 }
@@ -1309,8 +1132,8 @@ sub load_handler {
 sub user_load_handler {
     my ($cmd, $tail, $replyfd) = @_;
 
-    my $userloadpercent=&userload();
-    &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
+    my $userloadpercent=&Apache::lonnet::userload();
+    &Reply($replyfd, \$userloadpercent, "$cmd:$tail");
     
     return 1;
 }
@@ -1353,7 +1176,7 @@ sub user_authorization_type {
 	} else {
             $type .= ':';
         }
-	&Reply( $replyfd, "$type\n", $userinput);
+	&Reply( $replyfd, \$type, $userinput);
     }
   
     return 1;
@@ -1389,7 +1212,7 @@ sub push_file_handler {
 	# process making the request.
       
 	my $reply = &PushFile($userinput);
-	&Reply($client, "$reply\n", $userinput);
+	&Reply($client, \$reply, $userinput);
 
     } else {
 	&Failure( $client, "refused\n", $userinput);
@@ -1417,7 +1240,7 @@ sub push_file_handler {
 #
 sub du_handler {
     my ($cmd, $ududir, $client) = @_;
-    my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
+    ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
     my $userinput = "$cmd:$ududir";
 
     if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) {
@@ -1435,12 +1258,13 @@ sub du_handler {
 	my $code=sub { 
 	    if ($_=~/\.\d+\./) { return;} 
 	    if ($_=~/\.meta$/) { return;}
+	    if (-d $_)         { return;}
 	    $total_size+=(stat($_))[7];
 	};
 	chdir($ududir);
 	find($code,$ududir);
 	$total_size=int($total_size/1024);
-	&Reply($client,"$total_size\n","$cmd:$ududir");
+	&Reply($client,\$total_size,"$cmd:$ududir");
     } else {
 	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); 
     }
@@ -1509,7 +1333,7 @@ sub ls_handler {
 	$ulsout='no_such_dir';
     }
     if ($ulsout eq '') { $ulsout='empty'; }
-    &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+    &Reply($client, \$ulsout, $userinput); # This supports debug logging.
     
     return 1;
 
@@ -1578,7 +1402,7 @@ sub ls2_handler {
         $ulsout='no_such_dir';
    }
    if ($ulsout eq '') { $ulsout='empty'; }
-   &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+   &Reply($client, \$ulsout, $userinput); # This supports debug logging.
    return 1;
 }
 &register_handler("ls2", \&ls2_handler, 0, 1, 0);
@@ -1606,7 +1430,7 @@ sub reinit_process_handler {
     if(&ValidManager($cert)) {
 	chomp($userinput);
 	my $reply = &ReinitProcess($userinput);
-	&Reply( $client,  "$reply\n", $userinput);
+	&Reply( $client,  \$reply, $userinput);
     } else {
 	&Failure( $client, "refused\n", $userinput);
     }
@@ -1690,13 +1514,16 @@ sub authenticate_handler {
     #  udom    - User's domain.
     #  uname   - Username.
     #  upass   - User's password.
+    #  defauthtype - Default authentication types for the domain
+    #  defautharg - Default authentication arg for the domain
     
-    my ($udom,$uname,$upass)=split(/:/,$tail);
+    my ($udom,$uname,$upass,$defauthtype,$defautharg)=split(/:/,$tail);
     &Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
     chomp($upass);
     $upass=&unescape($upass);
 
-    my $pwdcorrect = &validate_user($udom, $uname, $upass);
+    my $pwdcorrect = &validate_user($udom,$uname,$upass,$defauthtype,
+                                    $defautharg);
     if($pwdcorrect) {
 	&Reply( $client, "authorized\n", $userinput);
 	#
@@ -1741,17 +1568,24 @@ sub change_password_handler {
     #  uname - Username.
     #  upass - Current password.
     #  npass - New password.
+    #  context - Context in which this was called 
+    #            (preferences or reset_by_email).
    
-    my ($udom,$uname,$upass,$npass)=split(/:/,$tail);
+    my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail);
 
     $upass=&unescape($upass);
     $npass=&unescape($npass);
     &Debug("Trying to change password for $uname");
 
     # First require that the user can be authenticated with their
-    # old password:
-
-    my $validated = &validate_user($udom, $uname, $upass);
+    # old password unless context was 'reset_by_email':
+    
+    my $validated;
+    if ($context eq 'reset_by_email') {
+        $validated = 1;
+    } else {
+        $validated = &validate_user($udom, $uname, $upass);
+    }
     if($validated) {
 	my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.
 	
@@ -1770,11 +1604,11 @@ sub change_password_handler {
 			 ."to change password");
 		&Failure( $client, "non_authorized\n",$userinput);
 	    }
-	} elsif ($howpwd eq 'unix') {
+	} elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') {
 	    my $result = &change_unix_password($uname, $npass);
 	    &logthis("Result of password change for $uname: ".
 		     $result);
-	    &Reply($client, "$result\n", $userinput);
+	    &Reply($client, \$result, $userinput);
 	} else {
 	    # this just means that the current password mode is not
 	    # one we know how to change (e.g the kerberos auth modes or
@@ -1835,9 +1669,9 @@ sub add_user_handler {
 	    }
 	    unless ($fperror) {
 		my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
-		&Reply($client, $result, $userinput);     #BUGBUG - could be fail
+		&Reply($client,\$result, $userinput);     #BUGBUG - could be fail
 	    } else {
-		&Failure($client, "$fperror\n", $userinput);
+		&Failure($client, \$fperror, $userinput);
 	    }
 	}
 	umask($oldumask);
@@ -1904,9 +1738,9 @@ sub change_authentication_handler {
 		my $result = &change_unix_password($uname, $npass);
 		&logthis("Result of password change for $uname: ".$result);
 		if ($result eq "ok") {
-		    &Reply($client, "$result\n")
+		    &Reply($client, \$result);
 		} else {
-		    &Failure($client, "$result\n");
+		    &Failure($client, \$result);
 		}
 	    } else {
 		my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
@@ -1925,7 +1759,7 @@ sub change_authentication_handler {
 			&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
 		    }
 		}
-		&Reply($client, $result, $userinput);
+		&Reply($client, \$result, $userinput);
 	    }
 	       
 
@@ -2009,12 +1843,13 @@ sub update_resource_handler {
 	    my $now=time;
 	    my $since=$now-$atime;
 	    if ($since>$perlvar{'lonExpire'}) {
-		my $reply=&reply("unsub:$fname","$clientname");
+		my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
 		&devalidate_meta_cache($fname);
 		unlink("$fname");
+		unlink("$fname.meta");
 	    } else {
 		my $transname="$fname.in.transfer";
-		my $remoteurl=&reply("sub:$fname","$clientname");
+		my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
 		my $response;
 		alarm(120);
 		{
@@ -2059,22 +1894,12 @@ sub devalidate_meta_cache {
     my ($url) = @_;
     use Cache::Memcached;
     my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
-    $url = &declutter($url);
+    $url = &Apache::lonnet::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.
@@ -2273,6 +2098,37 @@ sub rename_user_file_handler {
 &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
 
 #
+#  Checks if the specified user has an active session on the server
+#  return ok if so, not_found if not
+#
+# Parameters:
+#   cmd      - The request keyword that dispatched to tus.
+#   tail     - The tail of the request (colon separated parameters).
+#   client   - Filehandle open on the client.
+# Return:
+#    1.
+sub user_has_session_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
+    
+    &logthis("Looking for $udom $uname");
+    opendir(DIR,$perlvar{'lonIDsDir'});
+    my $filename;
+    while ($filename=readdir(DIR)) {
+	last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/);
+    }
+    if ($filename) {
+	&Reply($client, "ok\n", "$cmd:$tail");
+    } else {
+	&Failure($client, "not_found\n", "$cmd:$tail");
+    }
+    return 1;
+
+}
+&register_handler("userhassession", \&user_has_session_handler, 0,1,0);
+
+#
 #  Authenticate access to a user file by checking that the token the user's 
 #  passed also exists in their session file
 #
@@ -2288,14 +2144,24 @@ sub token_auth_user_file_handler {
     my ($fname, $session) = split(/:/, $tail);
     
     chomp($session);
-    my $reply="non_auth\n";
-    if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
-	     $session.'.id')) {
-	while (my $line=<ENVIN>) {
-	    if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; }
+    my $reply="non_auth";
+    my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';
+    if (open(ENVIN,"$file")) {
+	flock(ENVIN,LOCK_SH);
+	tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);
+	if (exists($disk_env{"userfile.$fname"})) {
+	    $reply="ok";
+	} else {
+	    foreach my $envname (keys(%disk_env)) {
+		if ($envname=~ m|^userfile\.\Q$fname\E|) {
+		    $reply="ok";
+		    last;
+		}
+	    }
 	}
+	untie(%disk_env);
 	close(ENVIN);
-	&Reply($client, $reply, "$cmd:$tail");
+	&Reply($client, \$reply, "$cmd:$tail");
     } else {
 	&Failure($client, "invalid_token\n", "$cmd:$tail");
     }
@@ -2355,13 +2221,13 @@ sub subscribe_handler {
 &register_handler("sub", \&subscribe_handler, 0, 1, 0);
 
 #
-#   Determine the version of a resource (?) Or is it return
-#   the top version of the resource?  Not yet clear from the
-#   code in currentversion.
+#   Determine the latest version of a resource (it looks for the highest
+#   past version and then returns that +1)
 #
 # Parameters:
 #    $cmd      - The command that got us here.
 #    $tail     - Tail of the command (remaining parameters).
+#                 (Should consist of an absolute path to a file)
 #    $client   - File descriptor connected to client.
 # Returns
 #     0        - Requested to exit, caller should shut down.
@@ -2719,10 +2585,11 @@ sub get_profile_entry {
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
 
+
     my $replystring = read_profile($udom, $uname, $namespace, $what);
     my ($first) = split(/:/,$replystring);
     if($first ne "error") {
-	&Reply($client, "$replystring\n", $userinput);
+	&Reply($client, \$replystring, $userinput);
     } else {
 	&Failure($client, $replystring." while attempting get\n", $userinput);
     }
@@ -2756,7 +2623,7 @@ sub get_profile_entry_encrypted {
 
     my $userinput = "$cmd:$tail";
    
-    my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
+    my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
     my $qresult = read_profile($udom, $uname, $namespace, $what);
     my ($first) = split(/:/, $qresult);
@@ -2862,7 +2729,7 @@ sub get_profile_keys {
 	}
 	if (&untie_user_hash($hashref)) {
 	    $qresult=~s/\&$//;
-	    &Reply($client, "$qresult\n", $userinput);
+	    &Reply($client, \$qresult, $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
 		    "while attempting keys\n", $userinput);
@@ -2915,22 +2782,11 @@ sub dump_profile_database {
 	while (my ($key,$value) = each(%$hashref)) {
 	    my ($v,$symb,$param) = split(/:/,$key);
 	    next if ($v eq 'version' || $symb eq 'keys');
-	    if (!defined($param)) {
-		foreach my $pair (split(/\&/,$value)) {
-		    my ($param,$value)=split(/=/,$pair);
-		    next if (exists($data{$symb}) && 
-			     exists($data{$symb}->{$param}) &&
-			     $data{$symb}->{'v.'.$param} > $v);
-		    $data{$symb}->{$param}=$value;
-		    $data{$symb}->{'v.'.$param}=$v;
-		}
-	    } else {
-		next if (exists($data{$symb}) && 
-			 exists($data{$symb}->{$param}) &&
-			 $data{$symb}->{'v.'.$param} > $v);
-		$data{$symb}->{$param}=$value;
-		$data{$symb}->{'v.'.$param}=$v;
-	    }
+	    next if (exists($data{$symb}) && 
+		     exists($data{$symb}->{$param}) &&
+		     $data{$symb}->{'v.'.$param} > $v);
+	    $data{$symb}->{$param}=$value;
+	    $data{$symb}->{'v.'.$param}=$v;
 	}
 	if (&untie_user_hash($hashref)) {
 	    while (my ($symb,$param_hash) = each(%data)) {
@@ -2943,7 +2799,7 @@ sub dump_profile_database {
 		}
 	    }
 	    chop($qresult);
-	    &Reply($client , "$qresult\n", $userinput);
+	    &Reply($client , \$qresult, $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
 		     "while attempting currentdump\n", $userinput);
@@ -3026,7 +2882,7 @@ sub dump_with_regexp {
 	}
 	if (&untie_user_hash($hashref)) {
 	    chop($qresult);
-	    &Reply($client, "$qresult\n", $userinput);
+	    &Reply($client, \$qresult, $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
 		     "while attempting dump\n", $userinput);
@@ -3079,10 +2935,11 @@ sub store_handler {
 	    my $version=$hashref->{"version:$rid"};
 	    my $allkeys=''; 
 	    foreach my $pair (@pairs) {
-		my ($key)=split(/=/,$pair);
+		my ($key,$value)=split(/=/,$pair);
 		$allkeys.=$key.':';
+		$hashref->{"$version:$rid:$key"}=$value;
 	    }
-	    $hashref->{"$version:$rid"}=$what."\&timestamp=$now";
+	    $hashref->{"$version:$rid:timestamp"}=$now;
 	    $allkeys.='timestamp';
 	    $hashref->{"$version:keys:$rid"}=$allkeys;
 	    if (&untie_user_hash($hashref)) {
@@ -3103,6 +2960,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
@@ -3132,10 +3068,10 @@ sub restore_handler {
     my ($cmd, $tail, $client) = @_;
 
     my $userinput = "$cmd:$tail";	# Only used for logging purposes.
-
-    my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput);
+    my ($udom,$uname,$namespace,$rid) = split(/:/,$tail);
     $namespace=~s/\//\_/g;
-    $namespace=~s/\W//g;
+    $namespace = &LONCAPA::clean_username($namespace);
+
     chomp($rid);
     my $qresult='';
     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
@@ -3148,21 +3084,13 @@ sub restore_handler {
 	    my @keys=split(/:/,$vkeys);
 	    my $key;
 	    $qresult.="$scope:keys=$vkeys&";
-	    if (exists($hashref->{"$scope:$rid"})) {
-		my $what=$hashref->{"$scope:$rid"};
-		foreach my $pair (split(/\&/,$hashref->{"$scope:$rid"})) {
-		    my ($key,$value)=split(/=/,$pair);
-		    $qresult.="$scope:".$pair."&";
-		}
-	    } else {
-		foreach $key (@keys) {
-		    $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
-		}
-	    }
+	    foreach $key (@keys) {
+		$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
+	    }                                  
 	}
 	if (&untie_user_hash($hashref)) {
 	    $qresult=~s/\&$//;
-	    &Reply( $client, "$qresult\n", $userinput);
+	    &Reply( $client, \$qresult, $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
 		    "while attempting restore\n", $userinput);
@@ -3179,15 +3107,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.
@@ -3202,8 +3132,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;
@@ -3211,7 +3141,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.
@@ -3221,6 +3151,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
@@ -3233,13 +3165,13 @@ 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/\:$//;
-    &Reply($client, $reply."\n", $userinput);
+    &Reply($client, \$reply, $userinput);
 
 
     return 1;
@@ -3312,7 +3244,7 @@ sub reply_query_handler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($cmd,$id,$reply)=split(/:/,$userinput); 
+    my ($id,$reply)=split(/:/,$tail); 
     my $store;
     my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new(">$execdir/tmp/$id")) {
@@ -3376,22 +3308,39 @@ sub put_course_id_handler {
 	foreach my $pair (@pairs) {
             my ($key,$courseinfo) = split(/=/,$pair,2);
             $courseinfo =~ s/=/:/g;
-
-            my @current_items = split(/:/,$hashref->{$key});
+            if (defined($hashref->{$key})) {
+                my $value = &Apache::lonnet::thaw_unescape($hashref->{$key});
+                if (ref($value) eq 'HASH') {
+                    my @items = ('description','inst_code','owner','type');
+                    my @new_items = split(/:/,$courseinfo,-1);
+                    my %storehash; 
+                    for (my $i=0; $i<@new_items; $i++) {
+                        $storehash{$items[$i]} = &unescape($new_items[$i]);
+                    }
+                    $hashref->{$key} = 
+                        &Apache::lonnet::freeze_escape(\%storehash);
+                    my $unesc_key = &unescape($key);
+                    $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+                    next;
+                }
+            }
+            my @current_items = split(/:/,$hashref->{$key},-1);
             shift(@current_items); # remove description
             pop(@current_items);   # remove last access
             my $numcurrent = scalar(@current_items);
-
-            my @new_items = split(/:/,$courseinfo);
+            if ($numcurrent > 3) {
+                $numcurrent = 3;
+            }
+            my @new_items = split(/:/,$courseinfo,-1);
             my $numnew = scalar(@new_items);
             if ($numcurrent > 0) {
-                if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier
-                    $courseinfo .= ':'.join(':',@current_items);
-                } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X
-                    $courseinfo .= ':'.$current_items[$numcurrent-1];
+                if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 
+                    for (my $j=$numcurrent-$numnew; $j>=0; $j--) {
+                        $courseinfo .= ':'.$current_items[$numcurrent-$j-1];
+                    }
                 }
             }
-	    $hashref->{$key}=$courseinfo.':'.$now;
+            $hashref->{$key}=$courseinfo.':'.$now;
 	}
 	if (&untie_domain_hash($hashref)) {
 	    &Reply( $client, "ok\n", $userinput);
@@ -3405,12 +3354,54 @@ sub put_course_id_handler {
 		 ." tie(GDBM) Failed ".
 		 "while attempting courseidput\n", $userinput);
     }
-    
 
     return 1;
 }
 &register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);
 
+sub put_course_id_hash_handler {
+    my ($cmd, $tail, $client) = @_;
+    my $userinput = "$cmd:$tail";
+    my ($udom,$mode,$what) = split(/:/, $tail,3);
+    chomp($what);
+    my $now=time;
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+        foreach my $pair (@pairs) {
+            my ($key,$value)=split(/=/,$pair);
+            my $unesc_key = &unescape($key);
+            if ($mode ne 'timeonly') {
+                if (!defined($hashref->{&escape('lasttime:'.$unesc_key)})) {
+                    my $curritems = &Apache::lonnet::thaw_unescape($key); 
+                    if (ref($curritems) ne 'HASH') {
+                        my @current_items = split(/:/,$hashref->{$key},-1);
+                        my $lasttime = pop(@current_items);
+                        $hashref->{&escape('lasttime:'.$unesc_key)} = $lasttime;
+                    } else {
+                        $hashref->{&escape('lasttime:'.$unesc_key)} = '';
+                    }
+                } 
+                $hashref->{$key} = $value;
+            }
+            if ($mode ne 'notime') {
+                $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+            }
+        }
+        if (&untie_domain_hash($hashref)) {
+            &Reply($client, "ok\n", $userinput);
+        } else {
+            &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                     "while attempting courseidputhash\n", $userinput);
+        }
+    } else {
+        &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                  "while attempting courseidputhash\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0);
+
 #  Retrieves the value of a course id resource keyword pattern
 #  defined since a starting date.  Both the starting date and the
 #  keyword pattern are optional.  If the starting date is not supplied it
@@ -3432,12 +3423,20 @@ sub put_course_id_handler {
 #                 institutional code - optional supplied code to filter 
 #                            the dump. Only courses with an institutional code 
 #                            that match the supplied code will be returned.
-#                 owner    - optional supplied username of owner to filter
-#                            the dump.  Only courses for which the course 
-#                            owner matches the supplied username will be
-#                            returned. Implicit assumption that owner
-#                            is a user in the domain in which the
-#                            course database is defined.
+#                 owner    - optional supplied username and domain of owner to
+#                            filter the dump.  Only courses for which the course
+#                            owner matches the supplied username and/or domain
+#                            will be returned. Pre-2.2.0 legacy entries from 
+#                            nohist_courseiddump will only contain usernames.
+#                 type     - optional parameter for selection 
+#                 regexp_ok - if true, allow the supplied institutional code
+#                            filter to behave as a regular expression.  
+#                 rtn_as_hash - whether to return the information available for
+#                            each matched item as a frozen hash of all 
+#                            key, value pairs in the item's hash, or as a 
+#                            colon-separated list of (in order) description,
+#                            institutional code, and course owner.
+#    
 #     $client  - The socket open on the client.
 # Returns:
 #    1     - Continue processing.
@@ -3445,10 +3444,10 @@ sub put_course_id_handler {
 #   a reply is written to $client.
 sub dump_course_id_handler {
     my ($cmd, $tail, $client) = @_;
-
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail);
+    my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
+        $typefilter,$regexp_ok,$rtn_as_hash) =split(/:/,$tail);
     if (defined($description)) {
 	$description=&unescape($description);
     } else {
@@ -3459,59 +3458,179 @@ sub dump_course_id_handler {
     } else {
         $instcodefilter='.';
     }
+    my ($ownerunamefilter,$ownerdomfilter);
     if (defined($ownerfilter)) {
         $ownerfilter=&unescape($ownerfilter);
+        if ($ownerfilter ne '.' && defined($ownerfilter)) {
+            if ($ownerfilter =~ /^([^:]*):([^:]*)$/) {
+                 $ownerunamefilter = $1;
+                 $ownerdomfilter = $2;
+            } else {
+                $ownerunamefilter = $ownerfilter;
+                $ownerdomfilter = '';
+            }
+        }
     } else {
         $ownerfilter='.';
     }
+
     if (defined($coursefilter)) {
         $coursefilter=&unescape($coursefilter);
     } else {
         $coursefilter='.';
     }
-
-    unless (defined($since)) { $since=0; }
+    if (defined($typefilter)) {
+        $typefilter=&unescape($typefilter);
+    } else {
+        $typefilter='.';
+    }
+    if (defined($regexp_ok)) {
+        $regexp_ok=&unescape($regexp_ok);
+    }
+    my $unpack = 1;
+    if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
+        $typefilter eq '.') {
+        $unpack = 0;
+    }
+    if (!defined($since)) { $since=0; }
     my $qresult='';
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {
 	while (my ($key,$value) = each(%$hashref)) {
-	    my ($descr,$lasttime,$inst_code,$owner);
-            my @courseitems = split(/:/,$value);
-            $lasttime = pop(@courseitems);
-	    ($descr,$inst_code,$owner)=@courseitems;
-	    if ($lasttime<$since) { next; }
+            my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,%unesc_val);
+            $unesc_key = &unescape($key);
+            if ($unesc_key =~ /^lasttime:/) {
+                next;
+            } else {
+                $lasttime_key = &escape('lasttime:'.$unesc_key);
+            }
+            if ($hashref->{$lasttime_key} ne '') {
+                $lasttime = $hashref->{$lasttime_key};
+                next if ($lasttime<$since);
+            }
+            my $items = &Apache::lonnet::thaw_unescape($value);
+            if (ref($items) eq 'HASH') {
+                $is_hash =  1;
+                if ($unpack || !$rtn_as_hash) {
+                    $unesc_val{'descr'} = $items->{'description'};
+                    $unesc_val{'inst_code'} = $items->{'inst_code'};
+                    $unesc_val{'owner'} = $items->{'owner'};
+                    $unesc_val{'type'} = $items->{'type'};
+                }
+            } else {
+                $is_hash =  0;
+                my @courseitems = split(/:/,$value);
+                $lasttime = pop(@courseitems);
+                next if ($lasttime<$since);
+	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
+            }
             my $match = 1;
-	    unless ($description eq '.') {
-		my $unescapeDescr = &unescape($descr);
-		unless (eval('$unescapeDescr=~/\Q$description\E/i')) {
+	    if ($description ne '.') {
+                if (!$is_hash) {
+                    $unesc_val{'descr'} = &unescape($val{'descr'});
+                }
+                if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
                     $match = 0;
-		}
+                }
             }
-            unless ($instcodefilter eq '.' || !defined($instcodefilter)) {
-                my $unescapeInstcode = &unescape($inst_code);
-                unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {
-                    $match = 0;
+            if ($instcodefilter ne '.') {
+                if (!$is_hash) {
+                    $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
+                }
+                if ($regexp_ok) {
+                    if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
+                        $match = 0;
+                    }
+                } else {
+                    if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
+                        $match = 0;
+                    }
                 }
 	    }
-            unless ($ownerfilter eq '.' || !defined($ownerfilter)) {
-                my $unescapeOwner = &unescape($owner);
-                unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) {
-                    $match = 0;
+            if ($ownerfilter ne '.') {
+                if (!$is_hash) {
+                    $unesc_val{'owner'} = &unescape($val{'owner'});
+                }
+                if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
+                    if ($unesc_val{'owner'} =~ /:/) {
+                        if (eval{$unesc_val{'owner'} !~ 
+                             /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
+                            $match = 0;
+                        } 
+                    } else {
+                        if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
+                            $match = 0;
+                        }
+                    }
+                } elsif ($ownerunamefilter ne '') {
+                    if ($unesc_val{'owner'} =~ /:/) {
+                        if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
+                             $match = 0;
+                        }
+                    } else {
+                        if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
+                            $match = 0;
+                        }
+                    }
+                } elsif ($ownerdomfilter ne '') {
+                    if ($unesc_val{'owner'} =~ /:/) {
+                        if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
+                             $match = 0;
+                        }
+                    } else {
+                        if ($ownerdomfilter ne $udom) {
+                            $match = 0;
+                        }
+                    }
                 }
             }
-            unless ($coursefilter eq '.' || !defined($coursefilter)) {
-                my $unescapeCourse = &unescape($key);
-                unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
+            if ($coursefilter ne '.') {
+                if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
                     $match = 0;
                 }
             }
+            if ($typefilter ne '.') {
+                if (!$is_hash) {
+                    $unesc_val{'type'} = &unescape($val{'type'});
+                }
+                if ($unesc_val{'type'} eq '') {
+                    if ($typefilter ne 'Course') {
+                        $match = 0;
+                    }
+                } else {
+                    if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
+                        $match = 0;
+                    }
+                }
+            }
             if ($match == 1) {
-                $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
+                if ($rtn_as_hash) {
+                    if ($is_hash) {
+                        $qresult.=$key.'='.$value.'&';
+                    } else {
+                        my %rtnhash = ( 'description' => &unescape($val{'descr'}),
+                                        'inst_code' => &unescape($val{'inst_code'}),
+                                        'owner'     => &unescape($val{'owner'}),
+                                        'type'      => &unescape($val{'type'}),
+                                      );
+                        my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
+                        $qresult.=$key.'='.$items.'&';
+                    }
+                } else {
+                    if ($is_hash) {
+                        $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
+                                    &escape($unesc_val{'inst_code'}).':'.
+                                    &escape($unesc_val{'owner'}).'&';
+                    } else {
+                        $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
+                                    ':'.$val{'owner'}.'&';
+                    }
+                }
             }
 	}
 	if (&untie_domain_hash($hashref)) {
 	    chop($qresult);
-	    &Reply($client, "$qresult\n", $userinput);
+	    &Reply($client, \$qresult, $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
 		    "while attempting courseiddump\n", $userinput);
@@ -3520,11 +3639,102 @@ sub dump_course_id_handler {
 	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
 		"while attempting courseiddump\n", $userinput);
     }
+    return 1;
+}
+&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
+
+#
+# Puts an unencrypted entry in a namespace db file at the domain level 
+#
+# 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.
+#  Side effects:
+#     reply is written to $client.
+#
+sub put_domain_handler {
+    my ($cmd,$tail,$client) = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$namespace,$what) =split(/:/,$tail,3);
+    chomp($what);
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),
+                                   "P", $what);
+    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 putdom\n", $userinput);
+        }
+    } else {
+        &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                  "while attempting putdom\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("putdom", \&put_domain_handler, 0, 1, 0);
+
+# Unencrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+#   $cmd             - Command request keyword (get).
+#   $tail            - Tail of the command.  This is a colon separated list
+#                      consisting of the domain and the 'namespace' 
+#                      which selects the gdbm file to do the lookup in,
+#                      & separated list of keys to lookup.  Note that
+#                      the values are returned as an & separated list too.
+#   $client          - File descriptor open on the client.
+# Returns:
+#   1       - Continue processing.
+#   0       - Exit.
+#  Side effects:
+#     reply is written to $client.
+#
 
+sub get_domain_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$client:$tail";
+
+    my ($udom,$namespace,$what)=split(/:/,$tail,3);
+    chomp($what);
+    my @queries=split(/\&/,$what);
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
+    if ($hashref) {
+        for (my $i=0;$i<=$#queries;$i++) {
+            $qresult.="$hashref->{$queries[$i]}&";
+        }
+        if (&untie_domain_hash($hashref)) {
+            $qresult=~s/\&$//;
+            &Reply($client, \$qresult, $userinput);
+        } else {
+            &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+                      "while attempting getdom\n",$userinput);
+        }
+    } else {
+        &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+                 "while attempting getdom\n",$userinput);
+    }
 
     return 1;
 }
-&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
+&register_handler("getdom", \&get_domain_handler, 0, 1, 0);
+
 
 #
 #  Puts an id to a domains id database. 
@@ -3609,7 +3819,7 @@ sub get_id_handler {
 	}
 	if (&untie_domain_hash($hashref)) {
 	    $qresult=~s/\&$//;
-	    &Reply($client, "$qresult\n", $userinput);
+	    &Reply($client, \$qresult, $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
 		      "while attempting idget\n",$userinput);
@@ -3733,7 +3943,7 @@ sub dump_dcmail_handler {
         }
         if (&untie_domain_hash($hashref)) {
             chop($qresult);
-            &Reply($client, "$qresult\n", $userinput);
+            &Reply($client, \$qresult, $userinput);
         } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                     "while attempting dcmaildump\n", $userinput);
@@ -3851,7 +4061,7 @@ sub dump_domainroles_handler {
                 }
             }
             unless (@roles < 1) {
-                unless (grep/^$trole$/,@roles) {
+                unless (grep/^\Q$trole\E$/,@roles) {
                     $match = 0;
                 }
             }
@@ -3861,7 +4071,7 @@ sub dump_domainroles_handler {
         }
         if (&untie_domain_hash($hashref)) {
             chop($qresult);
-            &Reply($client, "$qresult\n", $userinput);
+            &Reply($client, \$qresult, $userinput);
         } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                     "while attempting domrolesdump\n", $userinput);
@@ -3897,17 +4107,25 @@ sub tmp_put_handler {
 
     my $userinput = "$cmd:$what";	# Reconstruct for logging.
 
-
-    my $store;
+    my ($record,$context) = split(/:/,$what);
+    if ($context ne '') {
+        chomp($context);
+        $context = &unescape($context);
+    }
+    my ($id,$store);
     $tmpsnum++;
-    my $id=$$.'_'.$clientip.'_'.$tmpsnum;
+    if ($context eq 'resetpw') {
+        $id = &md5_hex(&md5_hex(time.{}.rand().$$));
+    } else {
+        $id = $$.'_'.$clientip.'_'.$tmpsnum;
+    }
     $id=~s/\W/\_/g;
-    $what=~s/\n//g;
+    $record=~s/\n//g;
     my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
-	print $store $what;
+	print $store $record;
 	close $store;
-	&Reply($client, "$id\n", $userinput);
+	&Reply($client, \$id, $userinput);
     } else {
 	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
 		  "while attempting tmpput\n", $userinput);
@@ -3941,7 +4159,7 @@ sub tmp_get_handler {
     my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
 	my $reply=<$store>;
-	&Reply( $client, "$reply\n", $userinput);
+	&Reply( $client, \$reply, $userinput);
 	close $store;
     } else {
 	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
@@ -4122,9 +4340,10 @@ sub enrollment_enabled_handler {
     my $userinput = $cmd.":".$tail; # For logging purposes.
 
     
-    my $cdom = split(/:/, $tail);   # Domain we're asking about.
+    my ($cdom) = split(/:/, $tail, 2);   # Domain we're asking about.
+
     my $outcome  = &localenroll::run($cdom);
-    &Reply($client, "$outcome\n", $userinput);
+    &Reply($client, \$outcome, $userinput);
 
     return 1;
 }
@@ -4151,7 +4370,7 @@ sub get_sections_handler {
     my @secs = &localenroll::get_sections($coursecode,$cdom);
     my $seclist = &escape(join(':',@secs));
 
-    &Reply($client, "$seclist\n", $userinput);
+    &Reply($client, \$seclist, $userinput);
     
 
     return 1;
@@ -4178,8 +4397,9 @@ sub validate_course_owner_handler {
     my $userinput = "$cmd:$tail";
     my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);
 
+    $owner = &unescape($owner);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
-    &Reply($client, "$outcome\n", $userinput);
+    &Reply($client, \$outcome, $userinput);
 
 
 
@@ -4210,7 +4430,7 @@ sub validate_course_section_handler {
     my ($inst_course_id, $cdom) = split(/:/, $tail);
 
     my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
-    &Reply($client, "$outcome\n", $userinput);
+    &Reply($client, \$outcome, $userinput);
 
 
     return 1;
@@ -4218,16 +4438,47 @@ sub validate_course_section_handler {
 &register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);
 
 #
-#   Create a password for a new auto-enrollment user.
-#   I think/guess, this password allows access to the institutions 
-#   AIS class list server/services.  Stuart can correct this comment
-#   when he finds out how wrong I am.
+#   Validate course owner's access to enrollment data for specific class section. 
+#   
 #
 # Formal Parameters:
 #    $cmd     - The command request that got us dispatched.
 #    $tail    - The tail of the command.   In this case this is a colon separated
 #               set of words that will be split into:
-#               $authparam - An authentication parameter (username??).
+#               $inst_class  - Institutional code for the specific class section   
+#               $courseowner - The escaped username:domain of the course owner 
+#               $cdom        - The domain of the course from the institution's
+#                              point of view.
+#    $client  - The socket open on the client.
+# Returns:
+#    1 - continue processing.
+#
+
+sub validate_class_access_handler {
+    my ($cmd, $tail, $client) = @_;
+    my $userinput = "$cmd:$tail";
+    my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
+    my $owners = &unescape($ownerlist);
+    my $outcome;
+    eval {
+	local($SIG{__DIE__})='DEFAULT';
+	$outcome=&localenroll::check_section($inst_class,$owners,$cdom);
+    };
+    &Reply($client,\$outcome, $userinput);
+
+    return 1;
+}
+&register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
+
+#
+#   Create a password for a new LON-CAPA user added by auto-enrollment.
+#   Only used for case where authentication method for new user is localauth
+#
+# Formal Parameters:
+#    $cmd     - The command request that got us dispatched.
+#    $tail    - The tail of the command.   In this case this is a colon separated
+#               set of words that will be split into:
+#               $authparam - An authentication parameter (localauth parameter).
 #               $cdom      - The domain of the course from the institution's
 #                            point of view.
 #    $client  - The socket open on the client.
@@ -4334,10 +4585,10 @@ sub get_institutional_code_format_handle
 						    \%cat_titles,
 						    \%cat_order);
     if ($formatreply eq 'ok') {
-	my $codes_str = &hash2str(%codes);
-	my $codetitles_str = &array2str(@codetitles);
-	my $cat_titles_str = &hash2str(%cat_titles);
-	my $cat_order_str = &hash2str(%cat_order);
+	my $codes_str = &Apache::lonnet::hash2str(%codes);
+	my $codetitles_str = &Apache::lonnet::array2str(@codetitles);
+	my $cat_titles_str = &Apache::lonnet::hash2str(%cat_titles);
+	my $cat_order_str = &Apache::lonnet::hash2str(%cat_order);
 	&Reply($client,
 	       $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'
 	       .$cat_order_str."\n",
@@ -4354,6 +4605,164 @@ sub get_institutional_code_format_handle
 &register_handler("autoinstcodeformat",
 		  \&get_institutional_code_format_handler,0,1,0);
 
+sub get_institutional_defaults_handler {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+
+    my $dom = $tail;
+    my %defaults_hash;
+    my @code_order;
+    my $outcome;
+    eval {
+        local($SIG{__DIE__})='DEFAULT';
+        $outcome = &localenroll::instcode_defaults($dom,\%defaults_hash,
+                                                   \@code_order);
+    };
+    if (!$@) {
+        if ($outcome eq 'ok') {
+            my $result='';
+            while (my ($key,$value) = each(%defaults_hash)) {
+                $result.=&escape($key).'='.&escape($value).'&';
+            }
+            $result .= 'code_order='.&escape(join('&',@code_order));
+            &Reply($client,\$result,$userinput);
+        } else {
+            &Reply($client,"error\n", $userinput);
+        }
+    } else {
+        &Failure($client,"unknown_cmd\n",$userinput);
+    }
+}
+&register_handler("autoinstcodedefaults",
+                  \&get_institutional_defaults_handler,0,1,0);
+
+sub get_institutional_user_rules {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my $dom = &unescape($tail);
+    my (%rules_hash,@rules_order);
+    my $outcome;
+    eval {
+        local($SIG{__DIE__})='DEFAULT';
+        $outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order);
+    };
+    if (!$@) {
+        if ($outcome eq 'ok') {
+            my $result;
+            foreach my $key (keys(%rules_hash)) {
+                $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+            }
+            $result =~ s/\&$//;
+            $result .= ':';
+            if (@rules_order > 0) {
+                foreach my $item (@rules_order) {
+                    $result .= &escape($item).'&';
+                }
+            }
+            $result =~ s/\&$//;
+            &Reply($client,\$result,$userinput);
+        } else {
+            &Reply($client,"error\n", $userinput);
+        }
+    } else {
+        &Failure($client,"unknown_cmd\n",$userinput);
+    }
+}
+&register_handler("instuserrules",\&get_institutional_user_rules,0,1,0);
+
+sub get_institutional_id_rules {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my $dom = &unescape($tail);
+    my (%rules_hash,@rules_order);
+    my $outcome;
+    eval {
+        local($SIG{__DIE__})='DEFAULT';
+        $outcome = &localenroll::id_rules($dom,\%rules_hash,\@rules_order);
+    };
+    if (!$@) {
+        if ($outcome eq 'ok') {
+            my $result;
+            foreach my $key (keys(%rules_hash)) {
+                $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+            }
+            $result =~ s/\&$//;
+            $result .= ':';
+            if (@rules_order > 0) {
+                foreach my $item (@rules_order) {
+                    $result .= &escape($item).'&';
+                }
+            }
+            $result =~ s/\&$//;
+            &Reply($client,\$result,$userinput);
+        } else {
+            &Reply($client,"error\n", $userinput);
+        }
+    } else {
+        &Failure($client,"unknown_cmd\n",$userinput);
+    }
+}
+&register_handler("instidrules",\&get_institutional_id_rules,0,1,0);
+
+
+sub institutional_username_check {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my %rulecheck;
+    my $outcome;
+    my ($udom,$uname,@rules) = split(/:/,$tail);
+    $udom = &unescape($udom);
+    $uname = &unescape($uname);
+    @rules = map {&unescape($_);} (@rules);
+    eval {
+        local($SIG{__DIE__})='DEFAULT';
+        $outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck);
+    };
+    if (!$@) {
+        if ($outcome eq 'ok') {
+            my $result='';
+            foreach my $key (keys(%rulecheck)) {
+                $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+            }
+            &Reply($client,\$result,$userinput);
+        } else {
+            &Reply($client,"error\n", $userinput);
+        }
+    } else {
+        &Failure($client,"unknown_cmd\n",$userinput);
+    }
+}
+&register_handler("instrulecheck",\&institutional_username_check,0,1,0);
+
+sub institutional_id_check {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+    my %rulecheck;
+    my $outcome;
+    my ($udom,$id,@rules) = split(/:/,$tail);
+    $udom = &unescape($udom);
+    $id = &unescape($id);
+    @rules = map {&unescape($_);} (@rules);
+    eval {
+        local($SIG{__DIE__})='DEFAULT';
+        $outcome = &localenroll::id_check($udom,$id,\@rules,\%rulecheck);
+    };
+    if (!$@) {
+        if ($outcome eq 'ok') {
+            my $result='';
+            foreach my $key (keys(%rulecheck)) {
+                $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+            }
+            &Reply($client,\$result,$userinput);
+        } else {
+            &Reply($client,"error\n", $userinput);
+        }
+    } else {
+        &Failure($client,"unknown_cmd\n",$userinput);
+    }
+}
+&register_handler("instidrulecheck",\&institutional_id_check,0,1,0);
+
 # Get domain specific conditions for import of student photographs to a course
 #
 # Retrieves information from photo_permission subroutine in localenroll.
@@ -4366,10 +4775,19 @@ sub photo_permission_handler {
     my $userinput               = "$cmd:$tail";
     my $cdom = $tail;
     my ($perm_reqd,$conditions);
-    my $outcome = &localenroll::photo_permission($cdom,\$perm_reqd,
-						 \$conditions);
-    &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n",
-	   $userinput);
+    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);
 
@@ -4394,6 +4812,7 @@ sub photo_check_handler {
     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);
 
@@ -4407,8 +4826,17 @@ sub photo_choice_handler {
     my ($cmd, $tail, $client) = @_;
     my $userinput             = "$cmd:$tail";
     my $cdom                  = &unescape($tail);
-    my ($update,$comment) = &localenroll::manager_photo_update($cdom);
-    &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput);
+    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);
 
@@ -4441,7 +4869,10 @@ sub student_photo_handler {
     &mkpath($path);
     my $file;
     if ($type eq 'thumbnail') {
-        $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
+	eval {
+	    local($SIG{__DIE__})='DEFAULT';
+	    $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
+	};
     } else {
         $file=&localstudentphoto::fetch($domain,$uname);
     }
@@ -4459,6 +4890,35 @@ sub student_photo_handler {
 }
 &register_handler("studentphoto", \&student_photo_handler, 0, 1, 0);
 
+sub inst_usertypes_handler {
+    my ($cmd, $domain, $client) = @_;
+    my $res;
+    my $userinput = $cmd.":".$domain; # For logging purposes.
+    my (%typeshash,@order,$result);
+    eval {
+	local($SIG{__DIE__})='DEFAULT';
+	$result=&localenroll::inst_usertypes($domain,\%typeshash,\@order);
+    };
+    if ($result eq 'ok') {
+        if (keys(%typeshash) > 0) {
+            foreach my $key (keys(%typeshash)) {
+                $res.=&escape($key).'='.&escape($typeshash{$key}).'&';
+            }
+        }
+        $res=~s/\&$//;
+        $res .= ':';
+        if (@order > 0) {
+            foreach my $item (@order) {
+                $res .= &escape($item).'&';
+            }
+        }
+        $res=~s/\&$//;
+    }
+    &Reply($client, \$res, $userinput);
+    return 1;
+}
+&register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
+
 # mkpath makes all directories for a file, expects an absolute path with a
 # file or a trailing / if just a dir is passed
 # returns 1 on success 0 on failure
@@ -4511,6 +4971,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;
@@ -4706,7 +5182,7 @@ sub catchexception {
     $SIG{__DIE__}='DEFAULT';
     &status("Catching exception");
     &logthis("<font color='red'>CRITICAL: "
-     ."ABNORMAL EXIT. Child $$ for server $thisserver died through "
+     ."ABNORMAL EXIT. Child $$ for server ".$perlvar{'lonHostID'}." died through "
      ."a crash with this error msg->[$error]</font>");
     &logthis('Famous last words: '.$status.' - '.$lastlog);
     if ($client) { print $client "error: $error\n"; }
@@ -4817,67 +5293,6 @@ sub HUPSMAN {                      # sig
 }
 
 #
-#    Kill off hashes that describe the host table prior to re-reading it.
-#    Hashes affected are:
-#       %hostid, %hostdom %hostip %hostdns.
-#
-sub KillHostHashes {
-    foreach my $key (keys %hostid) {
-	delete $hostid{$key};
-    }
-    foreach my $key (keys %hostdom) {
-	delete $hostdom{$key};
-    }
-    foreach my $key (keys %hostip) {
-	delete $hostip{$key};
-    }
-    foreach my $key (keys %hostdns) {
-	delete $hostdns{$key};
-    }
-}
-#
-#   Read in the host table from file and distribute it into the various hashes:
-#
-#    - %hostid  -  Indexed by IP, the loncapa hostname.
-#    - %hostdom -  Indexed by  loncapa hostname, the domain.
-#    - %hostip  -  Indexed by hostid, the Ip address of the host.
-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;
-	    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. 
-	    $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'}) { 
-		Debug("Found me in the host table: $name");
-		$thisserver=$name; 
-	    }
-	}
-    }
-    close(CONFIG);
-}
-#
 #  Reload the Apache daemon's state.
 #  This is done by invoking /home/httpd/perl/apachereload
 #  a setuid perl script that can be root for us to do this job.
@@ -4908,13 +5323,12 @@ sub UpdateHosts {
     #  either dropped or changed hosts.  Note that the re-read of the table
     #  will take care of new and changed hosts as connections come into being.
 
+    &Apache::lonnet::reset_hosts_info();
 
-    KillHostHashes;
-    ReadHostTable;
-
-    foreach my $child (keys %children) {
+    foreach my $child (keys(%children)) {
 	my $childip = $children{$child};
-	if(!$hostid{$childip}) {
+	if ($childip ne '127.0.0.1'
+	    && !defined(&Apache::lonnet::get_hosts_from_ip($childip))) {
 	    logthis('<font color="blue"> UpdateHosts killing child '
 		    ." $child for ip $childip </font>");
 	    kill('INT', $child);
@@ -4999,9 +5413,14 @@ sub Debug {
 #
 sub Reply {
     my ($fd, $reply, $request) = @_;
-    print $fd $reply;
-    Debug("Request was $request  Reply was $reply");
-
+    if (ref($reply)) {
+	print $fd $$reply;
+	print $fd "\n";
+	if ($DEBUG) { Debug("Request was $request  Reply was $$reply"); }
+    } else {
+	print $fd $reply;
+	if ($DEBUG) { Debug("Request was $request  Reply was $reply"); }
+    }
     $Transactions++;
 }
 
@@ -5074,79 +5493,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 {
-    my $peerfile=shift;
-    &logthis("Trying to reconnect for $peerfile");
-    my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
-    if (my $fh=IO::File->new("$loncfile")) {
-	my $loncpid=<$fh>;
-        chomp($loncpid);
-        if (kill 0 => $loncpid) {
-	    &logthis("lonc at pid $loncpid responding, sending USR1");
-            kill USR1 => $loncpid;
-        } else {
-	    &logthis(
-              "<font color='red'>CRITICAL: "
-             ."lonc at pid $loncpid not responding, giving up</font>");
-        }
-    } else {
-      &logthis('<font color="red">CRITICAL: lonc not running, giving up</font>');
-    }
-}
-
-# -------------------------------------------------- Non-critical communication
-
-sub subreply {
-    my ($cmd,$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 "sethost:$server:$cmd\n";
-    my $answer=<$sclient>;
-    chomp($answer);
-    if (!$answer) { $answer="con_lost"; }
-    return $answer;
-}
-
-sub reply {
-  my ($cmd,$server)=@_;
-  my $answer;
-  if ($server ne $currenthostid) { 
-    $answer=subreply($cmd,$server);
-    if ($answer eq 'con_lost') {
-	$answer=subreply("ping",$server);
-        if ($answer ne $server) {
-	    &logthis("sub reply: answer != server answer is $answer, server is $server");
-           &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server});
-        }
-        $answer=subreply($cmd,$server);
-    }
-  } else {
-    $answer='self_reply';
-  } 
-  return $answer;
-}
-
 # -------------------------------------------------------------- Talk to lonsql
 
 sub sql_reply {
@@ -5164,25 +5510,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 {
@@ -5227,8 +5561,7 @@ $SIG{USR1} = \&checkchildren;
 $SIG{USR2} = \&UpdateHosts;
 
 #  Read the host hashes:
-
-ReadHostTable;
+&Apache::lonnet::load_hosts_tab();
 
 my $dist=`$perlvar{'lonDaemons'}/distprobe`;
 
@@ -5307,7 +5640,8 @@ sub make_new_child {
 #        my $tmpsnum=0;            # Now global
 #---------------------------------------------------- kerberos 5 initialization
         &Authen::Krb5::init_context();
-	unless (($dist eq 'fedora4') || ($dist eq 'suse9.3')) {
+	unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||  
+		($dist eq 'fedora6') || ($dist eq 'suse9.3')) {
 	    &Authen::Krb5::init_ets();
 	}
 
@@ -5317,19 +5651,17 @@ sub make_new_child {
 # -----------------------------------------------------------------------------
 	# see if we know client and 'check' for spoof IP by ineffective challenge
 
-	ReadManagerTable;	# May also be a manager!!
-	
 	my $outsideip=$clientip;
 	if ($clientip eq '127.0.0.1') {
-	    $outsideip=$hostip{$perlvar{'lonHostID'}};
+	    $outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
 	}
 
-	my $clientrec=($hostid{$outsideip}     ne undef);
+	my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
 	my $ismanager=($managers{$outsideip}    ne undef);
 	$clientname  = "[unknonwn]";
 	if($clientrec) {	# Establish client type.
 	    $ConnectionType = "client";
-	    $clientname = $hostid{$outsideip};
+	    $clientname = (&Apache::lonnet::get_hosts_from_ip($outsideip))[-1];
 	    if($ismanager) {
 		$ConnectionType = "both";
 	    }
@@ -5348,7 +5680,7 @@ sub make_new_child {
 	    my $remotereq=<$client>;
 	    chomp($remotereq);
 	    Debug("Got init: $remotereq");
-	    my $inikeyword = split(/:/, $remotereq);
+
 	    if ($remotereq =~ /^init/) {
 		&sethost("sethost:$perlvar{'lonHostID'}");
 		#
@@ -5436,14 +5768,9 @@ sub make_new_child {
  
 	if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again
-	    
-	    foreach my $id (keys(%hostip)) {
-		if ($hostip{$id} ne $clientip ||
-		    $hostip{$currenthostid} eq $clientip) {
-		    # no need to try to do recon's to myself
-		    next;
-		}
-		&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id});
+	    if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip 
+		&& $clientip ne '127.0.0.1') {
+		&Apache::lonnet::reconlonc($clientname);
 	    }
 	    &logthis("<font color='green'>Established connection: $clientname</font>");
 	    &status('Will listen to '.$clientname);
@@ -5499,8 +5826,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");
@@ -5643,8 +5973,7 @@ sub get_auth_type
 #     0        - The domain,user,password triplet is not a valid user.
 #
 sub validate_user {
-    my ($domain, $user, $password) = @_;
-
+    my ($domain, $user, $password, $defauthtype, $defautharg) = @_;
 
     # Why negative ~pi you may well ask?  Well this function is about
     # authentication, and therefore very important to get right.
@@ -5667,8 +5996,17 @@ sub validate_user {
 
     my $null = pack("C",0);	# Used by kerberos auth types.
 
+    if ($howpwd eq 'nouser') {
+        if ($defauthtype eq 'localauth') {
+            $howpwd = $defauthtype;
+            $contentpwd = $defautharg;
+        } elsif ((($defauthtype eq 'krb4') || ($defauthtype eq 'krb5')) &&
+             ($defautharg ne '')) {
+            $howpwd = $defauthtype;
+            $contentpwd = $defautharg; 
+        }
+    } 
     if ($howpwd ne 'nouser') {
-
 	if($howpwd eq "internal") { # Encrypted is in local password file.
 	    $validated = (crypt($password, $contentpwd) eq $contentpwd);
 	}
@@ -5717,12 +6055,24 @@ sub validate_user {
 		my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
 		my $krbserver  = &Authen::Krb5::parse_name($krbservice);
 		my $credentials= &Authen::Krb5::cc_default();
-		$credentials->initialize($krbclient);
-		my $krbreturn  = &Authen::Krb5::get_in_tkt_with_password($krbclient,
-									 $krbserver,
-									 $password,
-									 $credentials);
-		$validated = ($krbreturn == 1);
+		$credentials->initialize(&Authen::Krb5::parse_name($user.'@'
+                                                                 .$contentpwd));
+                my $krbreturn;
+                if (exists(&Authen::Krb5::get_init_creds_password)) {
+                    $krbreturn = 
+                        &Authen::Krb5::get_init_creds_password($krbclient,$password,
+                                                               $krbservice);
+                    $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds');
+                } else {
+		    $krbreturn  = 
+                        &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
+		 						$password,$credentials);
+		    $validated = ($krbreturn == 1);
+                }
+		if (!$validated) {
+		    &logthis('krb5: '.$user.', '.$contentpwd.', '.
+			     &Authen::Krb5::error());
+		}
 	    } else {
 		$validated = 0;
 	    }
@@ -5730,7 +6080,12 @@ sub validate_user {
 	    #  Authenticate via installation specific authentcation method:
 	    $validated = &localauth::localauth($user, 
 					       $password, 
-					       $contentpwd);
+					       $contentpwd,
+					       $domain);
+	    if ($validated < 0) {
+		&logthis("localauth for $contentpwd $user:$domain returned a $validated");
+		$validated = 0;
+	    }
 	} else {			# Unrecognized auth is also bad.
 	    $validated = 0;
 	}
@@ -5756,8 +6111,7 @@ sub addline {
     my ($fname,$hostid,$ip,$newline)=@_;
     my $contents;
     my $found=0;
-    my $expr='^'.$hostid.':'.$ip.':';
-    $expr =~ s/\./\\\./g;
+    my $expr='^'.quotemeta($hostid).':'.quotemeta($ip).':';
     my $sh;
     if ($sh=IO::File->new("$fname.subscription")) {
 	while (my $subline=<$sh>) {
@@ -5773,10 +6127,16 @@ sub addline {
 }
 
 sub get_chat {
-    my ($cdom,$cname,$udom,$uname)=@_;
+    my ($cdom,$cname,$udom,$uname,$group)=@_;
 
     my @entries=();
-    my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
+    my $namespace = 'nohist_chatroom';
+    my $namespace_inroom = 'nohist_inchatroom';
+    if ($group ne '') {
+        $namespace .= '_'.$group;
+        $namespace_inroom .= '_'.$group;
+    }
+    my $hashref = &tie_user_hash($cdom, $cname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
 	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
@@ -5784,7 +6144,7 @@ sub get_chat {
     }
     my @participants=();
     my $cutoff=time-60;
-    $hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom',
+    $hashref = &tie_user_hash($cdom, $cname, $namespace_inroom,
 			      &GDBM_WRCREAT());
     if ($hashref) {
         $hashref->{$uname.':'.$udom}=time;
@@ -5799,10 +6159,16 @@ sub get_chat {
 }
 
 sub chat_add {
-    my ($cdom,$cname,$newchat)=@_;
+    my ($cdom,$cname,$newchat,$group)=@_;
     my @entries=();
     my $time=time;
-    my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
+    my $namespace = 'nohist_chatroom';
+    my $logfile = 'chatroom.log';
+    if ($group ne '') {
+        $namespace .= '_'.$group;
+        $logfile = 'chatroom_'.$group.'.log';
+    }
+    my $hashref = &tie_user_hash($cdom, $cname, $namespace,
 				 &GDBM_WRCREAT());
     if ($hashref) {
 	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
@@ -5825,7 +6191,7 @@ sub chat_add {
 	}
 	{
 	    my $proname=&propath($cdom,$cname);
-	    if (open(CHATLOG,">>$proname/chatroom.log")) { 
+	    if (open(CHATLOG,">>$proname/$logfile")) { 
 		print CHATLOG ("$time:".&unescape($newchat)."\n");
 	    }
 	    close(CHATLOG);
@@ -5952,7 +6318,7 @@ sub subscribe {
                 # the metadata
 		unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
 		$fname=~s/\/home\/httpd\/html\/res/raw/;
-		$fname="http://$thisserver/".$fname;
+		$fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
 		$result="$fname\n";
 	    }
 	} else {
@@ -5995,7 +6361,7 @@ sub change_unix_password {
 
 sub make_passwd_file {
     my ($uname, $umode,$npass,$passfilename)=@_;
-    my $result="ok\n";
+    my $result="ok";
     if ($umode eq 'krb4' or $umode eq 'krb5') {
 	{
 	    my $pf = IO::File->new(">$passfilename");
@@ -6063,7 +6429,7 @@ sub make_passwd_file {
 		if($useraddok > 0) {
 		    my $error_text = &lcuseraddstrerror($useraddok);
 		    &logthis("Failed lcuseradd: $error_text");
-		    $result = "lcuseradd_failed:$error_text\n";
+		    $result = "lcuseradd_failed:$error_text";
 		}  else {
 		    my $pf = IO::File->new(">$passfilename");
 		    if($pf) {
@@ -6087,7 +6453,7 @@ sub make_passwd_file {
 	    }
 	}
     } else {
-	$result="auth_mode_error\n";
+	$result="auth_mode_error";
     }
     return $result;
 }
@@ -6100,10 +6466,16 @@ 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}) {
+    if (&Apache::lonnet::get_host_ip($perlvar{'lonHostID'}) 
+	eq &Apache::lonnet::get_host_ip($hostid)) {
 	$currenthostid  =$hostid;
-	$currentdomainid=$hostdom{$hostid};
+	$currentdomainid=&Apache::lonnet::host_domain($hostid);
 	&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {
 	&logthis("Requested host id $hostid not an alias of ".
@@ -6119,96 +6491,6 @@ sub version {
     return "version:$VERSION";
 }
 
-#There is a copy of this in lonnet.pm
-sub userload {
-    my $numusers=0;
-    {
-	opendir(LONIDS,$perlvar{'lonIDsDir'});
-	my $filename;
-	my $curtime=time;
-	while ($filename=readdir(LONIDS)) {
-	    if ($filename eq '.' || $filename eq '..') {next;}
-	    my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
-	    if ($curtime-$mtime < 1800) { $numusers++; }
-	}
-	closedir(LONIDS);
-    }
-    my $userloadpercent=0;
-    my $maxuserload=$perlvar{'lonUserLoadLim'};
-    if ($maxuserload) {
-	$userloadpercent=100*$numusers/$maxuserload;
-    }
-    $userloadpercent=sprintf("%.2f",$userloadpercent);
-    return $userloadpercent;
-}
-
-# Routines for serializing arrays and hashes (copies from lonnet)
-
-sub array2str {
-  my (@array) = @_;
-  my $result=&arrayref2str(\@array);
-  $result=~s/^__ARRAY_REF__//;
-  $result=~s/__END_ARRAY_REF__$//;
-  return $result;
-}
-                                                                                 
-sub arrayref2str {
-  my ($arrayref) = @_;
-  my $result='__ARRAY_REF__';
-  foreach my $elem (@$arrayref) {
-    if(ref($elem) eq 'ARRAY') {
-      $result.=&arrayref2str($elem).'&';
-    } elsif(ref($elem) eq 'HASH') {
-      $result.=&hashref2str($elem).'&';
-    } elsif(ref($elem)) {
-      #print("Got a ref of ".(ref($elem))." skipping.");
-    } else {
-      $result.=&escape($elem).'&';
-    }
-  }
-  $result=~s/\&$//;
-  $result .= '__END_ARRAY_REF__';
-  return $result;
-}
-                                                                                 
-sub hash2str {
-  my (%hash) = @_;
-  my $result=&hashref2str(\%hash);
-  $result=~s/^__HASH_REF__//;
-  $result=~s/__END_HASH_REF__$//;
-  return $result;
-}
-                                                                                 
-sub hashref2str {
-  my ($hashref)=@_;
-  my $result='__HASH_REF__';
-  foreach (sort(keys(%$hashref))) {
-    if (ref($_) eq 'ARRAY') {
-      $result.=&arrayref2str($_).'=';
-    } elsif (ref($_) eq 'HASH') {
-      $result.=&hashref2str($_).'=';
-    } elsif (ref($_)) {
-      $result.='=';
-      #print("Got a ref of ".(ref($_))." skipping.");
-    } else {
-        if ($_) {$result.=&escape($_).'=';} else { last; }
-    }
-
-    if(ref($hashref->{$_}) eq 'ARRAY') {
-      $result.=&arrayref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_}) eq 'HASH') {
-      $result.=&hashref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_})) {
-       $result.='&';
-      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
-    } else {
-      $result.=&escape($hashref->{$_}).'&';
-    }
-  }
-  $result=~s/\&$//;
-  $result .= '__END_HASH_REF__';
-  return $result;
-}
 
 # ----------------------------------- POD (plain old documentation, CPAN style)
 
@@ -6525,7 +6807,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>