--- loncom/lonnet/perl/lonnet.pm	2007/02/18 01:51:20	1.833
+++ loncom/lonnet/perl/lonnet.pm	2007/10/03 21:59:13	1.919
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.833 2007/02/18 01:51:20 albertel Exp $
+# $Id: lonnet.pm,v 1.919 2007/10/03 21:59:13 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,24 +31,21 @@ package Apache::lonnet;
 
 use strict;
 use LWP::UserAgent();
-use HTTP::Headers;
 use HTTP::Date;
 # use Date::Parse;
-use vars 
-qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom 
-   %libserv %pr %prp $memcache %packagetab 
-   %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
-   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
-   %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary
-   $tmpdir $_64bit %env);
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
+            $_64bit %env);
+
+my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
+    %userrolehash, $processmarker, $dumpcount, %coursedombuf,
+    %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
+    %courseownerbuf, %coursetypebuf);
 
 use IO::Socket;
 use GDBM_File;
 use HTML::LCParser;
-use HTML::Parser;
 use Fcntl qw(:flock);
-use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
+use Storable qw(thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );
 use Cache::Memcached;
 use Digest::MD5;
@@ -146,10 +143,24 @@ sub logperm {
     return 1;
 }
 
+sub create_connection {
+    my ($hostname,$lonid) = @_;
+    my $client=IO::Socket::UNIX->new(Peer    => $perlvar{'lonSockCreate'},
+				     Type    => SOCK_STREAM,
+				     Timeout => 10);
+    return 0 if (!$client);
+    print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
+    my $result = <$client>;
+    chomp($result);
+    return 1 if ($result eq 'done');
+    return 0;
+}
+
+
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
-    my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
+    my $peerfile="$perlvar{'lonSockDir'}/".&hostname($server);
     #
     #  With loncnew process trimming, there's a timing hole between lonc server
     #  process exit and the master server picking up the listen on the AF_UNIX
@@ -170,10 +181,12 @@ sub subreply {
 	$client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
 				      Type    => SOCK_STREAM,
 				      Timeout => 10);
-	if($client) {
+	if ($client) {
 	    last;		# Connected!
+	} else {
+	    &create_connection(&hostname($server),$server);
 	}
-	sleep(1);		# Try again later if failed connection.
+        sleep(1);		# Try again later if failed connection.
     }
     my $answer;
     if ($client) {
@@ -189,7 +202,7 @@ sub subreply {
 
 sub reply {
     my ($cmd,$server)=@_;
-    unless (defined($hostname{$server})) { return 'no_such_host'; }
+    unless (defined(&hostname($server))) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=\"blue\">WARNING:".
@@ -201,8 +214,25 @@ sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
-    my $peerfile=shift;
-    &logthis("Trying to reconnect for $peerfile");
+    my ($lonid) = @_;
+    my $hostname = &hostname($lonid);
+    if ($lonid) {
+	my $peerfile="$perlvar{'lonSockDir'}/$hostname";
+	if ($hostname && -e $peerfile) {
+	    &logthis("Trying to reconnect lonc for $lonid ($hostname)");
+	    my $client=IO::Socket::UNIX->new(Peer    => $peerfile,
+					     Type    => SOCK_STREAM,
+					     Timeout => 10);
+	    if ($client) {
+		print $client ("reset_retries\n");
+		my $answer=<$client>;
+		#reset just this one.
+	    }
+	}
+	return;
+    }
+
+    &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {
 	my $loncpid=<$fh>;
@@ -211,19 +241,13 @@ sub reconlonc {
 	    &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;
             sleep 1;
-            if (-e "$peerfile") { return; }
-            &logthis("$peerfile still not there, give it another try");
-            sleep 5;
-            if (-e "$peerfile") { return; }
-            &logthis(
-  "<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>");
-        } else {
+         } else {
 	    &logthis(
                "<font color=\"blue\">WARNING:".
                " lonc at pid $loncpid not responding, giving up</font>");
         }
     } else {
-     &logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
+	&logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
     }
 }
 
@@ -231,7 +255,7 @@ sub reconlonc {
 
 sub critical {
     my ($cmd,$server)=@_;
-    unless ($hostname{$server}) {
+    unless (&hostname($server)) {
         &logthis("<font color=\"blue\">WARNING:".
                " Critical message to unknown server ($server)</font>");
         return 'no_such_host';
@@ -296,7 +320,10 @@ sub convert_and_load_session_env {
     my ($lonidsdir,$handle)=@_;
     my @profile;
     {
-	open(my $idf,"$lonidsdir/$handle.id");
+	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return 0;
+	}
 	flock($idf,LOCK_SH);
 	@profile=<$idf>;
 	close($idf);
@@ -335,7 +362,10 @@ sub transfer_profile_to_env {
 
     my $convert;
     {
-    	open(my $idf,"$lonidsdir/$handle.id");
+    	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return;
+	}
 	flock($idf,LOCK_SH);
 	if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
 		&GDBM_READER(),0640)) {
@@ -367,6 +397,34 @@ sub transfer_profile_to_env {
     }
 }
 
+# ---------------------------------------------------- Check for valid session 
+sub check_for_valid_session {
+    my ($r) = @_;
+    my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+    my $lonid=$cookies{'lonID'};
+    return undef if (!$lonid);
+
+    my $handle=&LONCAPA::clean_handle($lonid->value);
+    my $lonidsdir=$r->dir_config('lonIDsDir');
+    return undef if (!-e "$lonidsdir/$handle.id");
+
+    my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+    return undef if (!$opened);
+
+    flock($idf,LOCK_SH);
+    my %disk_env;
+    if (!tie(%disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+	    &GDBM_READER(),0640)) {
+	return undef;	
+    }
+
+    if (!defined($disk_env{'user.name'})
+	|| !defined($disk_env{'user.domain'})) {
+	return undef;
+    }
+    return $handle;
+}
+
 sub timed_flock {
     my ($file,$lock_type) = @_;
     my $failed=0;
@@ -401,8 +459,9 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
@@ -422,16 +481,17 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
 	    if ($key=~/^$delthis/) { 
-                delete($env{$key});
-                delete($disk_env{$key});
-            }
+		delete($env{$key});
+		delete($disk_env{$key});
+	    }
 	}
 	untie(%disk_env);
     }
@@ -524,7 +584,7 @@ sub spareserver {
     }
 
     if (!$want_server_name) {
-	$spare_server="http://$hostname{$spare_server}";
+	$spare_server="http://".&hostname($spare_server);
     }
     return $spare_server;
 }
@@ -558,6 +618,27 @@ sub compare_server_load {
     }
     return ($spare_server,$lowest_load);
 }
+
+# --------------------------- ask offload servers if user already has a session
+sub find_existing_session {
+    my ($udom,$uname) = @_;
+    foreach my $try_server (@{ $spareid{'primary'} },
+			    @{ $spareid{'default'} }) {
+	return $try_server if (&has_user_session($try_server, $udom, $uname));
+    }
+    return;
+}
+
+# -------------------------------- ask if server already has a session for user
+sub has_user_session {
+    my ($lonid,$udom,$uname) = @_;
+    my $result = &reply(join(':','userhassession',
+			     map {&escape($_)} ($udom,$uname)),$lonid);
+    return 1 if ($result eq 'ok');
+
+    return 0;
+}
+
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
@@ -615,9 +696,15 @@ sub authenticate {
     my ($uname,$upass,$udom)=@_;
     $upass=&escape($upass);
     $uname= &LONCAPA::clean_username($uname);
-    my $uhome=&homeserver($uname,$udom);
-    if (!$uhome) {
-	&logthis("User $uname at $udom is unknown in authenticate");
+    my $uhome=&homeserver($uname,$udom,1);
+    if ((!$uhome) || ($uhome eq 'no_host')) {
+# Maybe the machine was offline and only re-appeared again recently?
+        &reconlonc();
+# One more
+	my $uhome=&homeserver($uname,$udom,1);
+	if ((!$uhome) || ($uhome eq 'no_host')) {
+	    &logthis("User $uname at $udom is unknown in authenticate");
+	}
 	return 'no_host';
     }
     my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome);
@@ -641,18 +728,19 @@ sub homeserver {
     my $index="$uname:$udom";
 
     if (exists($homecache{$index})) { return $homecache{$index}; }
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
+
+    my %servers = &get_servers($udom,'library');
+    foreach my $tryserver (keys(%servers)) {
         next if ($ignoreBadCache ne 'true' && 
 		 exists($badServerCache{$tryserver}));
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("home:$udom:$uname",$tryserver);
-           if ($answer eq 'found') { 
-	       return $homecache{$index}=$tryserver;
-           } elsif ($answer eq 'no_host') {
-	       $badServerCache{$tryserver}=1;
-           }
-       }
+
+	my $answer=reply("home:$udom:$uname",$tryserver);
+	if ($answer eq 'found') {
+	    delete($badServerCache{$tryserver}); 
+	    return $homecache{$index}=$tryserver;
+	} elsif ($answer eq 'no_host') {
+	    $badServerCache{$tryserver}=1;
+	}
     }    
     return 'no_host';
 }
@@ -663,24 +751,22 @@ sub idget {
     my ($udom,@ids)=@_;
     my %returnhash=();
     
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-       if ($hostdom{$tryserver} eq $udom) {
-	  my $idlist=join('&',@ids);
-          $idlist=~tr/A-Z/a-z/; 
-	  my $reply=&reply("idget:$udom:".$idlist,$tryserver);
-          my @answer=();
-          if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
-	      @answer=split(/\&/,$reply);
-          }                    ;
-          my $i;
-          for ($i=0;$i<=$#ids;$i++) {
-              if ($answer[$i]) {
-		  $returnhash{$ids[$i]}=$answer[$i];
-              } 
-          }
-       }
-    }    
+    my %servers = &get_servers($udom,'library');
+    foreach my $tryserver (keys(%servers)) {
+	my $idlist=join('&',@ids);
+	$idlist=~tr/A-Z/a-z/; 
+	my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	my @answer=();
+	if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
+	    @answer=split(/\&/,$reply);
+	}                    ;
+	my $i;
+	for ($i=0;$i<=$#ids;$i++) {
+	    if ($answer[$i]) {
+		$returnhash{$ids[$i]}=$answer[$i];
+	    } 
+	}
+    } 
     return %returnhash;
 }
 
@@ -722,21 +808,36 @@ sub idput {
 # ------------------------------------------- get items from domain db files   
 
 sub get_dom {
-    my ($namespace,$storearr,$udom)=@_;
+    my ($namespace,$storearr,$udom,$uhome)=@_;
     my $items='';
     foreach my $item (@$storearr) {
         $items.=&escape($item).'&';
     }
     $items=~s/\&$//;
-    if (!$udom) { $udom=$env{'user.domain'}; }
-    if (exists($domain_primary{$udom})) {
-        my $uhome=$domain_primary{$udom};
+    if (!$udom) {
+        $udom=$env{'user.domain'};
+        if (defined(&domain($udom,'primary'))) {
+            $uhome=&domain($udom,'primary');
+        } else {
+            undef($uhome);
+        }
+    } else {
+        if (!$uhome) {
+            if (defined(&domain($udom,'primary'))) {
+                $uhome=&domain($udom,'primary');
+            }
+        }
+    }
+    if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        my %returnhash;
+        if ($rep eq '' || $rep =~ /^error: 2 /) {
+            return %returnhash;
+        }
         my @pairs=split(/\&/,$rep);
         if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
             return @pairs;
         }
-        my %returnhash=();
         my $i=0;
         foreach my $item (@$storearr) {
             $returnhash{$item}=&thaw_unescape($pairs[$i]);
@@ -744,17 +845,29 @@ sub get_dom {
         }
         return %returnhash;
     } else {
-        &logthis("get_dom failed - no primary domain server for $udom");
+        &logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)");
     }
 }
 
 # -------------------------------------------- put items in domain db files 
 
 sub put_dom {
-    my ($namespace,$storehash,$udom)=@_;
-    if (!$udom) { $udom=$env{'user.domain'}; }
-    if (exists($domain_primary{$udom})) {
-        my $uhome=$domain_primary{$udom};
+    my ($namespace,$storehash,$udom,$uhome)=@_;
+    if (!$udom) {
+        $udom=$env{'user.domain'};
+        if (defined(&domain($udom,'primary'))) {
+            $uhome=&domain($udom,'primary');
+        } else {
+            undef($uhome);
+        }
+    } else {
+        if (!$uhome) {
+            if (defined(&domain($udom,'primary'))) {
+                $uhome=&domain($udom,'primary');
+            }
+        }
+    } 
+    if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $items='';
         foreach my $item (keys(%$storehash)) {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
@@ -762,8 +875,230 @@ sub put_dom {
         $items=~s/\&$//;
         return &reply("putdom:$udom:$namespace:$items",$uhome);
     } else {
-        &logthis("put_dom failed - no primary domain server for $udom");
+        &logthis("put_dom failed - no homeserver and/or domain");
+    }
+}
+
+sub retrieve_inst_usertypes {
+    my ($udom) = @_;
+    my (%returnhash,@order);
+    if (defined(&domain($udom,'primary'))) {
+        my $uhome=&domain($udom,'primary');
+        my $rep=&reply("inst_usertypes:$udom",$uhome);
+        my ($hashitems,$orderitems) = split(/:/,$rep); 
+        my @pairs=split(/\&/,$hashitems);
+        foreach my $item (@pairs) {
+            my ($key,$value)=split(/=/,$item,2);
+            $key = &unescape($key);
+            next if ($key =~ /^error: 2 /);
+            $returnhash{$key}=&thaw_unescape($value);
+        }
+        my @esc_order = split(/\&/,$orderitems);
+        foreach my $item (@esc_order) {
+            push(@order,&unescape($item));
+        }
+    } else {
+        &logthis("get_dom failed - no primary domain server for $udom");
+    }
+    return (\%returnhash,\@order);
+}
+
+sub is_domainimage {
+    my ($url) = @_;
+    if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+-) {
+        if (&domain($1) ne '') {
+            return '1';
+        }
+    }
+    return;
+}
+
+sub inst_directory_query {
+    my ($srch) = @_;
+    my $udom = $srch->{'srchdomain'};
+    my %results;
+    my $homeserver = &domain($udom,'primary');
+    my $outcome;
+    if ($homeserver ne '') {
+	my $queryid=&reply("querysend:instdirsearch:".
+			   &escape($srch->{'srchby'}).':'.
+			   &escape($srch->{'srchterm'}).':'.
+			   &escape($srch->{'srchtype'}),$homeserver);
+	my $host=&hostname($homeserver);
+	if ($queryid !~/^\Q$host\E\_/) {
+	    &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+	    return;
+	}
+	my $response = &get_query_reply($queryid);
+	my $maxtries = 5;
+	my $tries = 1;
+	while (($response=~/^timeout/) && ($tries < $maxtries)) {
+	    $response = &get_query_reply($queryid);
+	    $tries ++;
+	}
+
+        if (!&error($response) && $response ne 'refused') {
+            if ($response eq 'unavailable') {
+                $outcome = $response;
+            } else {
+                $outcome = 'ok';
+                my @matches = split(/\n/,$response);
+                foreach my $match (@matches) {
+                    my ($key,$value) = split(/=/,$match);
+                    $results{&unescape($key).':'.$udom} = &thaw_unescape($value);
+                }
+            }
+        }
+    }
+    return ($outcome,%results);
+}
+
+sub usersearch {
+    my ($srch) = @_;
+    my $dom = $srch->{'srchdomain'};
+    my %results;
+    my %libserv = &all_library();
+    my $query = 'usersearch';
+    foreach my $tryserver (keys(%libserv)) {
+        if (&host_domain($tryserver) eq $dom) {
+            my $host=&hostname($tryserver);
+            my $queryid=
+                &reply("querysend:".&escape($query).':'.
+                       &escape($srch->{'srchby'}).':'.
+                       &escape($srch->{'srchtype'}).':'.
+                       &escape($srch->{'srchterm'}),$tryserver);
+            if ($queryid !~/^\Q$host\E\_/) {
+                &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);
+                next;
+            }
+            my $reply = &get_query_reply($queryid);
+            my $maxtries = 1;
+            my $tries = 1;
+            while (($reply=~/^timeout/) && ($tries < $maxtries)) {
+                $reply = &get_query_reply($queryid);
+                $tries ++;
+            }
+            if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
+                &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
+            } else {
+                my @matches;
+                if ($reply =~ /\n/) {
+                    @matches = split(/\n/,$reply);
+                } else {
+                    @matches = split(/\&/,$reply);
+                }
+                foreach my $match (@matches) {
+                    my ($uname,$udom,%userhash);
+                    foreach my $entry (split(/:/,$match)) {
+                        my ($key,$value) =
+                            map {&unescape($_);} split(/=/,$entry);
+                        $userhash{$key} = $value;
+                        if ($key eq 'username') {
+                            $uname = $value;
+                        } elsif ($key eq 'domain') {
+                            $udom = $value;
+                        }
+                    }
+                    $results{$uname.':'.$udom} = \%userhash;
+                }
+            }
+        }
+    }
+    return %results;
+}
+
+sub get_instuser {
+    my ($udom,$uname,$id) = @_;
+    my $homeserver = &domain($udom,'primary');
+    my ($outcome,%results);
+    if ($homeserver ne '') {
+        my $queryid=&reply("querysend:getinstuser:".&escape($uname).':'.
+                           &escape($id).':'.&escape($udom),$homeserver);
+        my $host=&hostname($homeserver);
+        if ($queryid !~/^\Q$host\E\_/) {
+            &logthis('get_instuser invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+            return;
+        }
+        my $response = &get_query_reply($queryid);
+        my $maxtries = 5;
+        my $tries = 1;
+        while (($response=~/^timeout/) && ($tries < $maxtries)) {
+            $response = &get_query_reply($queryid);
+            $tries ++;
+        }
+        if (!&error($response) && $response ne 'refused') {
+            if ($response eq 'unavailable') {
+                $outcome = $response;
+            } else {
+                $outcome = 'ok';
+                my @matches = split(/\n/,$response);
+                foreach my $match (@matches) {
+                    my ($key,$value) = split(/=/,$match);
+                    $results{&unescape($key)} = &thaw_unescape($value);
+                }
+            }
+        }
     }
+    my %userinfo;
+    if (ref($results{$uname}) eq 'HASH') {
+        %userinfo = %{$results{$uname}};
+    } 
+    return ($outcome,%userinfo);
+}
+
+sub inst_rulecheck {
+    my ($udom,$uname,$rules) = @_;
+    my %returnhash;
+    if ($udom ne '') {
+        if (ref($rules) eq 'ARRAY') {
+            @{$rules} = map {&escape($_);} (@{$rules});
+            my $rulestr = join(':',@{$rules});
+            my $homeserver=&domain($udom,'primary');
+            if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+                my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'.
+                                              &escape($uname).':'.$rulestr,
+                                              $homeserver));
+                if ($response ne 'refused') {
+                    my @pairs=split(/\&/,$response);
+                    foreach my $item (@pairs) {
+                        my ($key,$value)=split(/=/,$item,2);
+                        $key = &unescape($key);
+                        next if ($key =~ /^error: 2 /);
+                        $returnhash{$key}=&thaw_unescape($value);
+                    }
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
+sub inst_userrules {
+    my ($udom) = @_;
+    my (%ruleshash,@ruleorder);
+    if ($udom ne '') {
+        my $homeserver=&domain($udom,'primary');
+        if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+            my $response=&reply('instuserrules:'.&escape($udom),
+                                 $homeserver);
+            if (($response ne 'refused') && ($response ne 'error') && 
+                ($response ne 'no_such_host')) {
+                my ($hashitems,$orderitems) = split(/:/,$response);
+                my @pairs=split(/\&/,$hashitems);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/=/,$item,2);
+                    $key = &unescape($key);
+                    next if ($key =~ /^error: 2 /);
+                    $ruleshash{$key}=&thaw_unescape($value);
+                }
+                my @esc_order = split(/\&/,$orderitems);
+                foreach my $item (@esc_order) {
+                    push(@ruleorder,&unescape($item));
+                }
+            }
+        }
+    }
+    return (\%ruleshash,\@ruleorder);
 }
 
 # --------------------------------------------------- Assign a key to a student
@@ -990,10 +1325,19 @@ my %remembered;
 my %accessed;
 my $kicks=0;
 my $hits=0;
+sub make_key {
+    my ($name,$id) = @_;
+    if (length($id) > 65 
+	&& length(&escape($id)) > 200) {
+	$id=length($id).':'.&Digest::MD5::md5_hex($id);
+    }
+    return &escape($name.':'.$id);
+}
+
 sub devalidate_cache_new {
     my ($name,$id,$debug) = @_;
     if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     $memcache->delete($id);
     delete($remembered{$id});
     delete($accessed{$id});
@@ -1001,7 +1345,7 @@ sub devalidate_cache_new {
 
 sub is_cached_new {
     my ($name,$id,$debug) = @_;
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     if (exists($remembered{$id})) {
 	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
 	$accessed{$id}=[&gettimeofday()];
@@ -1024,7 +1368,7 @@ sub is_cached_new {
 
 sub do_cache_new {
     my ($name,$id,$value,$time,$debug) = @_;
-    $id=&escape($name.':'.$id);
+    $id=&make_key($name,$id);
     my $setvalue=$value;
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
@@ -1033,15 +1377,21 @@ sub do_cache_new {
 	$time=600;
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $memcache->set($id,$setvalue,$time);
+    my $result = $memcache->set($id,$setvalue,$time);
+    if (! $result) {
+	&logthis("caching of id -> $id  failed");
+	$memcache->disconnect_all();
+    }
     # need to make a copy of $value
-    #&make_room($id,$value,$debug);
+    &make_room($id,$value,$debug);
     return $value;
 }
 
 sub make_room {
     my ($id,$value,$debug)=@_;
-    $remembered{$id}=$value;
+
+    $remembered{$id}= (ref($value)) ? &Storable::dclone($value)
+                                    : $value;
     if ($to_remember<0) { return; }
     $accessed{$id}=[&gettimeofday()];
     if (scalar(keys(%remembered)) <= $to_remember) { return; }
@@ -1295,7 +1645,7 @@ sub ssi {
     my $request;
 
     $form{'no_update_last_known'}=1;
-
+    &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
@@ -1474,14 +1824,21 @@ sub clean_filename {
 #        $coursedoc - if true up to the current course
 #                     if false
 #        $subdir - directory in userfile to store the file into
-#        $parser, $allfiles, $codebase - unknown
-#
+#        $parser - instruction to parse file for objects ($parser = parse)    
+#        $allfiles - reference to hash for embedded objects
+#        $codebase - reference to hash for codebase of java objects
+#        $desuname - username for permanent storage of uploaded file
+#        $dsetudom - domain for permanaent storage of uploaded file
+#        $thumbwidth - width (pixels) of thumbnail to make for uploaded image 
+#        $thumbheight - height (pixels) of thumbnail to make for uploaded image
+# 
 # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse
 
 
 sub userfileupload {
-    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_;
+    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,
+        $destudom,$thumbwidth,$thumbheight)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
@@ -1528,7 +1885,7 @@ sub userfileupload {
         if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
             return &finishuserfileupload($docuname,$docudom,
 					 $formname,$fname,$parser,$allfiles,
-					 $codebase);
+					 $codebase,$thumbwidth,$thumbheight);
         } else {
             $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,
@@ -1538,8 +1895,9 @@ sub userfileupload {
     } elsif (defined($destuname)) {
         my $docuname=$destuname;
         my $docudom=$destudom;
-	return &finishuserfileupload($docuname,$docudom,$formname,
-				     $fname,$parser,$allfiles,$codebase);
+	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
+				     $parser,$allfiles,$codebase,
+                                     $thumbwidth,$thumbheight);
         
     } else {
         my $docuname=$env{'user.name'};
@@ -1548,16 +1906,18 @@ sub userfileupload {
             $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
             $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
         }
-	return &finishuserfileupload($docuname,$docudom,$formname,
-				     $fname,$parser,$allfiles,$codebase);
+	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
+				     $parser,$allfiles,$codebase,
+                                     $thumbwidth,$thumbheight);
     }
 }
 
 sub finishuserfileupload {
-    my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_;
+    my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase,
+        $thumbwidth,$thumbheight) = @_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
-    my ($fnamepath,$file);
+    my ($fnamepath,$file,$fetchthumb);
     $file=$fname;
     if ($fname=~m|/|) {
         ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
@@ -1593,11 +1953,28 @@ sub finishuserfileupload {
 		     ' for embedded media: '.$parse_result); 
         }
     }
+    if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
+        my $input = $filepath.'/'.$file;
+        my $output = $filepath.'/'.'tn-'.$file;
+        my $thumbsize = $thumbwidth.'x'.$thumbheight;
+        system("convert -sample $thumbsize $input $output");
+        if (-e $filepath.'/'.'tn-'.$file) {
+            $fetchthumb  = 1; 
+        }
+    }
+ 
 # Notify homeserver to grep it
 #
     my $docuhome=&homeserver($docuname,$docudom);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
+        if ($fetchthumb) {
+            my $thumbresult= &reply('fetchuserfile:'.$path.'tn-'.$file,$docuhome);
+            if ($thumbresult ne 'ok') {
+                &logthis('Failed to transfer '.$path.'tn-'.$file.' to host '.
+                         $docuhome.': '.$thumbresult);
+            }
+        }
 #
 # Return the URL to it
         return '/uploaded/'.$path.$file;
@@ -1605,7 +1982,7 @@ sub finishuserfileupload {
         &logthis('Failed to transfer '.$path.$file.' to host '.$docuhome.
 		 ': '.$fetchresult);
         return '/adm/notfound.html';
-    }    
+    }
 }
 
 sub extract_embedded_items {
@@ -1629,13 +2006,16 @@ sub extract_embedded_items {
     while (my $t=$p->get_token()) {
 	if ($t->[0] eq 'S') {
 	    my ($tagname, $attr) = ($t->[1],$t->[2]);
-	    push (@state, $tagname);
+	    push(@state, $tagname);
             if (lc($tagname) eq 'allow') {
                 &add_filetype($allfiles,$attr->{'src'},'src');
             }
 	    if (lc($tagname) eq 'img') {
 		&add_filetype($allfiles,$attr->{'src'},'src');
 	    }
+	    if (lc($tagname) eq 'a') {
+		&add_filetype($allfiles,$attr->{'href'},'href');
+	    }
             if (lc($tagname) eq 'script') {
                 if ($attr->{'archive'} =~ /\.jar$/i) {
                     &add_filetype($allfiles,$attr->{'archive'},'archive');
@@ -1805,22 +2185,20 @@ sub flushcourselogs {
                delete $courselogs{$crsid};
             }
         }
-        if ($courseidbuffer{$coursehombuf{$crsid}}) {
-           $courseidbuffer{$coursehombuf{$crsid}}.='&'.
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        } else {
-           $courseidbuffer{$coursehombuf{$crsid}}=
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        }
+        $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = (
+            'description' => &escape($coursedescrbuf{$crsid}),
+            'instcode'    => &escape($courseinstcodebuf{$crsid}),
+            'type'        => &escape($coursetypebuf{$crsid}),
+            'owner'       => &escape($courseownerbuf{$crsid}),
+        );
     }
 #
 # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse
 #
-    foreach my $crsid (keys(%courseidbuffer)) {
-        &courseidput($hostdom{$crsid},$courseidbuffer{$crsid},$crsid);
+    foreach my $crs_home (keys(%courseidbuffer)) {
+        my $response = &courseidput(&host_domain($crs_home),
+                                    $courseidbuffer{$crs_home},$crs_home);
     }
 #
 # File accesses
@@ -1876,7 +2254,7 @@ sub flushcourselogs {
 #
     my %domrolebuffer = ();
     foreach my $entry (keys %domainrolehash) {
-        my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;
+        my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
         if ($domrolebuffer{$rudom}) {
             $domrolebuffer{$rudom}.='&'.&escape($entry).
                       '='.&escape($domainrolehash{$entry});
@@ -1887,13 +2265,12 @@ sub flushcourselogs {
         delete $domainrolehash{$entry};
     }
     foreach my $dom (keys(%domrolebuffer)) {
-        foreach my $tryserver (keys %libserv) {
-            if ($hostdom{$tryserver} eq $dom) {
-                unless (&reply('domroleput:'.$dom.':'.
-                  $domrolebuffer{$dom},$tryserver) eq 'ok') {
-                    &logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
-                }
-            }
+	my %servers = &get_servers($dom,'library');
+	foreach my $tryserver (keys(%servers)) {
+	    unless (&reply('domroleput:'.$dom.':'.
+			   $domrolebuffer{$dom},$tryserver) eq 'ok') {
+		&logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
+	    }
         }
     }
     $dumpcount++;
@@ -1982,6 +2359,14 @@ sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;
     }
+    if (($env{'request.role'} =~ /dc\./) &&
+	(($trole=~/^au/) || ($trole=~/^in/) ||
+	 ($trole=~/^cc/) || ($trole=~/^ep/) ||
+	 ($trole=~/^cr/) || ($trole=~/^ta/))) {
+       $userrolehash
+         {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
+                    =$tend.':'.$tstart;
+    }
     if (($trole=~/^dc/) || ($trole=~/^ad/) ||
         ($trole=~/^li/) || ($trole=~/^li/) ||
         ($trole=~/^au/) || ($trole=~/^dg/) ||
@@ -2027,15 +2412,25 @@ sub get_course_adv_roles {
 }
 
 sub get_my_roles {
-    my ($uname,$udom,$types,$roles,$roledoms)=@_;
+    my ($uname,$udom,$context,$types,$roles,$roledoms)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
-    my %dumphash=
+    my %dumphash;
+    if ($context eq 'userroles') { 
+        %dumphash = &dump('roles',$udom,$uname);
+    } else {
+        %dumphash=
             &dump('nohist_userroles',$udom,$uname);
+    }
     my %returnhash=();
     my $now=time;
     foreach my $entry (keys(%dumphash)) {
-	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
+        my ($role,$tend,$tstart);
+        if ($context eq 'userroles') {
+	    ($role,$tend,$tstart)=split(/_/,$dumphash{$entry});
+        } else {
+            ($tend,$tstart)=split(/\:/,$dumphash{$entry});
+        }
         if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';
         if (($tend) && ($tend<$now)) {
@@ -2053,7 +2448,13 @@ sub get_my_roles {
                 next;
             }
         }
-        my ($role,$username,$domain,$section)=split(/\:/,$entry);
+        my ($rolecode,$username,$domain,$section,$area);
+        if ($context eq 'userroles') {
+            ($area,$rolecode) = split(/_/,$entry);
+            (undef,$domain,$username,$section) = split(/\//,$area);
+        } else {
+            ($role,$username,$domain,$section) = split(/\:/,$entry);
+        }
         if (ref($roledoms) eq 'ARRAY') {
             if (!grep(/^\Q$domain\E$/,@{$roledoms})) {
                 next;
@@ -2063,7 +2464,7 @@ sub get_my_roles {
             if (!grep(/^\Q$role\E$/,@{$roles})) {
                 next;
             }
-        } 
+        }
 	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
     }
     return %returnhash;
@@ -2075,7 +2476,7 @@ sub get_my_roles {
 
 sub postannounce {
     my ($server,$text)=@_;
-    unless (&allowed('psa',$hostdom{$server})) { return 'refused'; }
+    unless (&allowed('psa',&host_domain($server))) { return 'refused'; }
     unless ($text=~/\w/) { $text=''; }
     return &reply('setannounce:'.&escape($text),$server);
 }
@@ -2103,26 +2504,65 @@ sub getannounce {
 #
 
 sub courseidput {
-    my ($domain,$what,$coursehome)=@_;
-    return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    my ($domain,$storehash,$coursehome)=@_;
+    my $items='';
+    my $now = time;
+    foreach my $item (keys(%$storehash)) {
+        $storehash->{$item}{'lasttime'} = $now;
+        $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
+    }
+    $items=~s/\&$//;
+    my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome);
+    if ($outcome eq 'unknown_cmd') {
+        my $what;
+        foreach my $cid (keys(%$storehash)) {
+            $what .= &escape($cid).'=';
+            foreach my $item ('description','instcode','owner','type') {
+                $what .= $storehash->{$item}.':';
+            }
+            $what =~ s/\:$/&/;
+        }
+        $what =~ s/\&$//;  
+        return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    } else {
+        return $outcome;
+    }
 }
 
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
-    my %returnhash=();
-    unless ($domfilter) { $domfilter=''; }
-    foreach my $tryserver (keys %libserv) {
-        if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
-	    if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
-	        foreach my $line (
-                 split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
-			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
-                               $tryserver))) {
-		    my ($key,$value)=split(/\=/,$line,2);
-                    if (($key) && ($value)) {
-		        $returnhash{&unescape($key)}=$value;
-                    }
+    my $as_hash = 1;
+    my %returnhash;
+    if (!$domfilter) { $domfilter=''; }
+    my %libserv = &all_library();
+    foreach my $tryserver (keys(%libserv)) {
+        if ( (  $hostidflag == 1 
+	        && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) 
+	     || (!defined($hostidflag)) ) {
+
+	    if (($domfilter eq '') ||
+		(&host_domain($tryserver) eq $domfilter)) {
+                my $rep = 
+                  &reply('courseiddump:'.&host_domain($tryserver).':'.
+                         $sincefilter.':'.&escape($descfilter).':'.
+                         &escape($instcodefilter).':'.&escape($ownerfilter).
+                         ':'.&escape($coursefilter).':'.&escape($typefilter).
+                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver); 
+                my @pairs=split(/\&/,$rep);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/\=/,$item,2);
+                    $key = &unescape($key);
+                    next if ($key =~ /^error: 2 /);
+                    my $result = &thaw_unescape($value);
+                    if (ref($result) eq 'HASH') {
+                        $returnhash{$key}=$result;
+                    } else {
+                        my @responses = split(/:/,$result);
+                        my @items = ('description','instcode','owner','type');
+                        for (my $i=0; $i<@responses; $i++) {
+                            $returnhash{$key}{$items[$i]} = $responses[$i];
+                        }
+                    } 
                 }
             }
         }
@@ -2143,12 +2583,13 @@ sub dcmailput {
 sub dcmaildump {
     my ($dom,$startdate,$enddate,$senders) = @_;
     my %returnhash=();
-    if (exists($domain_primary{$dom})) {
+
+    if (defined(&domain($dom,'primary'))) {
         my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
                                                          &escape($enddate).':';
 	my @esc_senders=map { &escape($_)} @$senders;
 	$cmd.=&escape(join('&',@esc_senders));
-	foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+	foreach my $line (split(/\&/,&reply($cmd,&domain($dom,'primary')))) {
             my ($key,$value) = split(/\=/,$line,2);
             if (($key) && ($value)) {
                 $returnhash{&unescape($key)} = &unescape($value);
@@ -2169,19 +2610,19 @@ sub get_domain_roles {
     }
     my $rolelist = join(':',@{$roles});
     my %personnel = ();
-    foreach my $tryserver (keys(%libserv)) {
-        if ($hostdom{$tryserver} eq $dom) {
-            %{$personnel{$tryserver}}=();
-            foreach my $line (
-                split(/\&/,&reply('domrolesdump:'.$dom.':'.
-                   &escape($startdate).':'.&escape($enddate).':'.
-                   &escape($rolelist), $tryserver))) {
-                my ($key,$value) = split(/\=/,$line,2);
-                if (($key) && ($value)) {
-                    $personnel{$tryserver}{&unescape($key)} = &unescape($value);
-                }
-            }
-        }
+
+    my %servers = &get_servers($dom,'library');
+    foreach my $tryserver (keys(%servers)) {
+	%{$personnel{$tryserver}}=();
+	foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'.
+					    &escape($startdate).':'.
+					    &escape($enddate).':'.
+					    &escape($rolelist), $tryserver))) {
+	    my ($key,$value) = split(/\=/,$line,2);
+	    if (($key) && ($value)) {
+		$personnel{$tryserver}{&unescape($key)} = &unescape($value);
+	    }
+	}
     }
     return %personnel;
 }
@@ -2271,7 +2712,7 @@ sub checkin {
     my $now=time;
     my ($ta,$tb,$lonhost)=split(/\*/,$token);
     $lonhost=~tr/A-Z/a-z/;
-    my $dtoken=$ta.'_'.$hostname{$lonhost}.'_'.$tb;
+    my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
     $dtoken=~s/\W/\_/g;
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
@@ -2940,7 +3381,7 @@ sub custom_roleprivs {
     my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
     my $homsvr=homeserver($rauthor,$rdomain);
-    if ($hostname{$homsvr} ne '') {
+    if (&hostname($homsvr) ne '') {
         my ($rdummy,$roledef)=
             &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
         if (($rdummy ne 'con_lost') && ($roledef ne '')) {
@@ -3001,7 +3442,7 @@ sub set_userprivs {
     if (keys(%{$allgroups}) > 0) {
         foreach my $role (keys %{$allroles}) {
             my ($trole,$area,$sec,$extendedarea);
-            if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) {
+            if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
                 $trole = $1;
                 $area = $2;
                 $sec = $3;
@@ -3482,9 +3923,16 @@ sub get_portfolio_access {
             }
             if (@users > 0) {
                 foreach my $userkey (@users) {
-                    if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) {
-                        return 'ok';
-                    }
+                    if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') {
+                        foreach my $item (@{$access_hash->{$userkey}{'users'}}) {
+                            if (ref($item) eq 'HASH') {
+                                if (($item->{'uname'} eq $env{'user.name'}) &&
+                                    ($item->{'udom'} eq $env{'user.domain'})) {
+                                    return 'ok';
+                                }
+                            }
+                        }
+                    } 
                 }
             }
             my %roleshash;
@@ -3644,26 +4092,40 @@ sub customaccess {
     $ucrs = &LONCAPA::clean_username($ucrs);
     my $access=0;
     foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
-	my ($effect,$realm,$role)=split(/\:/,$right);
-        if ($role) {
-	   if ($role ne $urole) { next; }
-        }
-        foreach my $scope (split(/\s*\,\s*/,$realm)) {
-            my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
-            if ($tdom) {
-		if ($tdom ne $udom) { next; }
-            }
-            if ($tcrs) {
-		if ($tcrs ne $ucrs) { next; }
-            }
-            if ($tsec) {
-		if ($tsec ne $usec) { next; }
-            }
-            $access=($effect eq 'allow');
-            last;
-        }
-	if ($realm eq '' && $role eq '') {
-            $access=($effect eq 'allow');
+	my ($effect,$realm,$role,$type)=split(/\:/,$right);
+	if ($type eq 'user') {
+	    foreach my $scope (split(/\s*\,\s*/,$realm)) {
+		my ($tdom,$tuname)=split(m{/},$scope);
+		if ($tdom) {
+		    if ($tdom ne $env{'user.domain'}) { next; }
+		}
+		if ($tuname) {
+		    if ($tuname ne $env{'user.name'}) { next; }
+		}
+		$access=($effect eq 'allow');
+		last;
+	    }
+	} else {
+	    if ($role) {
+		if ($role ne $urole) { next; }
+	    }
+	    foreach my $scope (split(/\s*\,\s*/,$realm)) {
+		my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
+		if ($tdom) {
+		    if ($tdom ne $udom) { next; }
+		}
+		if ($tcrs) {
+		    if ($tcrs ne $ucrs) { next; }
+		}
+		if ($tsec) {
+		    if ($tsec ne $usec) { next; }
+		}
+		$access=($effect eq 'allow');
+		last;
+	    }
+	    if ($realm eq '' && $role eq '') {
+		$access=($effect eq 'allow');
+	    }
 	}
     }
     return $access;
@@ -4148,6 +4610,7 @@ sub definerole {
 sub metadata_query {
     my ($query,$custom,$customshow,$server_array)=@_;
     my %rhash;
+    my %libserv = &all_library();
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
@@ -4171,7 +4634,7 @@ sub log_query {
     my ($uname,$udom,$query,%filters)=@_;
     my $uhome=&homeserver($uname,$udom);
     if ($uhome eq 'no_host') { return 'error: no_host'; }
-    my $uhost=$hostname{$uhome};
+    my $uhost=&hostname($uhome);
     my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys(%filters)));
     my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
                        $uhome);
@@ -4191,6 +4654,23 @@ sub update_portfolio_table {
     return $reply;
 }
 
+# -------------------------- Update MySQL allusers table
+
+sub update_allusers_table {
+    my ($uname,$udom,$names) = @_;
+    my $homeserver = &homeserver($uname,$udom);
+    my $queryid=
+        &reply('querysend:allusers:'.&escape($uname).':'.&escape($udom).':'.
+               'lastname='.&escape($names->{'lastname'}).'%%'.
+               'firstname='.&escape($names->{'firstname'}).'%%'.
+               'middlename='.&escape($names->{'middlename'}).'%%'.
+               'generation='.&escape($names->{'generation'}).'%%'.
+               'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
+               'id='.&escape($names->{'id'}),$homeserver);
+    my $reply = &get_query_reply($queryid);
+    return $reply;
+}
+
 # ------- Request retrieval of institutional classlists for course(s)
 
 sub fetch_enrollment_query {
@@ -4203,7 +4683,7 @@ sub fetch_enrollment_query {
     } else {
         $homeserver = &homeserver($cnum,$dom);
     }
-    my $host=$hostname{$homeserver};
+    my $host=&hostname($homeserver);
     my $cmd = '';
     foreach my $affiliate (keys %{$affiliatesref}) {
         $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
@@ -4225,7 +4705,7 @@ sub fetch_enrollment_query {
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {
-        my @responses = split/:/,$reply;
+        my @responses = split(/:/,$reply);
         if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach my $line (@responses) {
                 my ($key,$value) = split(/=/,$line,2);
@@ -4268,8 +4748,8 @@ sub get_query_reply {
 	sleep 2;
         if (-e $replyfile.'.end') {
 	    if (open(my $fh,$replyfile)) {
-               $reply.=<$fh>;
-               close($fh);
+		$reply = join('',<$fh>);
+		close($fh);
 	   } else { return 'error: reply_file_error'; }
            return &unescape($reply);
 	}
@@ -4300,6 +4780,12 @@ sub courselog_query {
 }
 
 sub userlog_query {
+#
+# possible filters:
+# action: log check role
+# start: timestamp
+# end: timestamp
+#
     my ($uname,$udom,%filters)=@_;
     return &log_query($uname,$udom,'userlog',%filters);
 }
@@ -4308,8 +4794,18 @@ sub userlog_query {
 
 sub auto_run {
     my ($cnum,$cdom) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my $response = &reply('autorun:'.$cdom,$homeserver);
+    my $response = 0;
+    my $settings;
+    my %domconfig = &get_dom('configuration',['autoenroll'],$cdom);
+    if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+        $settings = $domconfig{'autoenroll'};
+        if ($settings->{'run'} eq '1') {
+            $response = 1;
+        }
+    } else {
+        my $homeserver = &homeserver($cnum,$cdom);
+        $response = &reply('autorun:'.$cdom,$homeserver);
+    }
     return $response;
 }
 
@@ -4319,7 +4815,7 @@ sub auto_get_sections {
     my @secs = ();
     my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {
-        @secs = split/:/,$response;
+        @secs = split(/:/,$response);
     }
     return @secs;
 }
@@ -4339,15 +4835,27 @@ sub auto_validate_courseID {
 }
 
 sub auto_create_password {
-    my ($cnum,$cdom,$authparam) = @_;
-    my $homeserver = &homeserver($cnum,$cdom); 
+    my ($cnum,$cdom,$authparam,$udom) = @_;
+    my ($homeserver,$response);
     my $create_passwd = 0;
     my $authchk = '';
-    my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
-    if ($response eq 'refused') {
-        $authchk = 'refused';
+    if ($udom =~ /^$match_domain$/) {
+        $homeserver = &domain($udom,'primary');
+    }
+    if ($homeserver eq '') {
+        if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+            $homeserver = &homeserver($cnum,$cdom);
+        }
+    }
+    if ($homeserver eq '') {
+        $authchk = 'nodomain';
     } else {
-        ($authparam,$create_passwd,$authchk) = split/:/,$response;
+        $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
+        if ($response eq 'refused') {
+            $authchk = 'refused';
+        } else {
+            ($authparam,$create_passwd,$authchk) = split(/:/,$response);
+        }
     }
     return ($authparam,$create_passwd,$authchk);
 }
@@ -4394,7 +4902,7 @@ sub auto_photochoice {
 sub auto_photoupdate {
     my ($affiliatesref,$dom,$cnum,$photo) = @_;
     my $homeserver = &homeserver($cnum,$dom);
-    my $host=$hostname{$homeserver};
+    my $host=&hostname($homeserver);
     my $cmd = '';
     my $maxtries = 1;
     foreach my $affiliate (keys(%{$affiliatesref})) {
@@ -4434,12 +4942,11 @@ sub auto_instcode_format {
     my $courses = '';
     my @homeservers;
     if ($caller eq 'global') {
-        foreach my $tryserver (keys(%libserv)) {
-            if ($hostdom{$tryserver} eq $codedom) {
-                if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
-                    push(@homeservers,$tryserver);
-                }
-            }
+	my %servers = &get_servers($codedom,'library');
+	foreach my $tryserver (keys(%servers)) {
+	    if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+		push(@homeservers,$tryserver);
+	    }
         }
     } else {
         push(@homeservers,&homeserver($caller,$codedom));
@@ -4455,7 +4962,7 @@ sub auto_instcode_format {
         $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {
             my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = 
-		split/:/,$response;
+		split(/:/,$response);
             %{$codes} = (%{$codes},&str2hash($codes_str));
             push(@{$codetitles},&str2array($codetitles_str));
             %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));
@@ -4473,42 +4980,44 @@ sub auto_instcode_format {
 sub auto_instcode_defaults {
     my ($domain,$returnhash,$code_order) = @_;
     my @homeservers;
-    foreach my $tryserver (keys(%libserv)) {
-        if ($hostdom{$tryserver} eq $domain) {
-            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
-                push(@homeservers,$tryserver);
-            }
-        }
+
+    my %servers = &get_servers($domain,'library');
+    foreach my $tryserver (keys(%servers)) {
+	if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+	    push(@homeservers,$tryserver);
+	}
     }
-    my $ok_response = 0;
+
     my $response;
-    while (@homeservers > 0 && $ok_response == 0) {
-        my $server = shift(@homeservers);
+    foreach my $server (@homeservers) {
         $response=&reply('autoinstcodedefaults:'.$domain,$server);
-        if ($response !~ /(con_lost|error|no_such_host|refused)/) {
-            foreach my $pair (split(/\&/,$response)) {
-                my ($name,$value)=split(/\=/,$pair);
-                if ($name eq 'code_order') {
-                    @{$code_order} = split(/\&/,&unescape($value));
-                } else {
-                    $returnhash->{&unescape($name)}=&unescape($value);
-                }
-            }
-            $ok_response = 1;
-        }
-    }
-    if ($ok_response) {
-        return 'ok';
-    } else {
-        return $response;
+        next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+	
+	foreach my $pair (split(/\&/,$response)) {
+	    my ($name,$value)=split(/\=/,$pair);
+	    if ($name eq 'code_order') {
+		@{$code_order} = split(/\&/,&unescape($value));
+	    } else {
+		$returnhash->{&unescape($name)}=&unescape($value);
+	    }
+	}
+	return 'ok';
     }
+
+    return $response;
 } 
 
 sub auto_validate_class_sec {
-    my ($cdom,$cnum,$owner,$inst_class) = @_;
+    my ($cdom,$cnum,$owners,$inst_class) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
+    my $ownerlist;
+    if (ref($owners) eq 'ARRAY') {
+        $ownerlist = join(',',@{$owners});
+    } else {
+        $ownerlist = $owners;
+    }
     my $response=&reply('autovalidateclass_sec:'.$inst_class.':'.
-                        &escape($owner).':'.$cdom,$homeserver);
+                        &escape($ownerlist).':'.$cdom,$homeserver);
     return $response;
 }
 
@@ -4794,21 +5303,19 @@ sub modifyuser {
     if (($uhome eq 'no_host') && 
 	(($umode && $upass) || ($umode eq 'localauth'))) {
         my $unhome='';
-        if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { 
+        if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { 
             $unhome = $desiredhome;
 	} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {
 	    $unhome=$env{'course.'.$env{'request.course.id'}.'.home'};
         } else { # load balancing routine for determining $unhome
-            my $tryserver;
             my $loadm=10000000;
-            foreach $tryserver (keys %libserv) {
-	       if ($hostdom{$tryserver} eq $udom) {
-                  my $answer=reply('load',$tryserver);
-                  if (($answer=~/\d+/) && ($answer<$loadm)) {
-		      $loadm=$answer;
-                      $unhome=$tryserver;
-                  }
-	       }
+	    my %servers = &get_servers($udom,'library');
+	    foreach my $tryserver (keys(%servers)) {
+		my $answer=reply('load',$tryserver);
+		if (($answer=~/\d+/) && ($answer<$loadm)) {
+		    $loadm=$answer;
+		    $unhome=$tryserver;
+		}
 	    }
         }
         if (($unhome eq '') || ($unhome eq 'no_host')) {
@@ -4841,7 +5348,8 @@ sub modifyuser {
     }
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
-		   ['firstname','middlename','lastname','generation'],
+		   ['firstname','middlename','lastname','generation','id',
+                    'permanentemail'],
 		   $udom,$uname);
     my %names;
     if ($tmp[0] =~ m/^error:.*/) { 
@@ -4863,8 +5371,10 @@ sub modifyuser {
 			   $names{'critnotification'} = $email;
 			   $names{'permanentemail'} = $email; }
     }
+    if ($uid) { $names{'id'}  = $uid; }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
+    my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
@@ -5023,7 +5533,7 @@ sub createcourse {
    }
 # ------------------------------------------------ Check supplied server name
     $course_server = $env{'user.homeserver'} if (! defined($course_server));
-    if (! exists($libserv{$course_server})) {
+    if (! &is_library($course_server)) {
         return 'error:bad server name '.$course_server;
     }
 # ------------------------------------------------------------- Make the course
@@ -5036,9 +5546,15 @@ sub createcourse {
     }
 # ----------------------------------------------------------------- Course made
 # log existence
-    &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
-                 ':'.&escape($inst_code).':'.&escape($course_owner).':'.
-                  &escape($crstype),$uhome);
+    my $newcourse = {
+                    $udom.'_'.$uname => {
+                                     description => &escape($description),
+                                     inst_code   => &escape($inst_code),
+                                     owner       => &escape($course_owner),
+                                     type        => &escape($crstype),
+                                                },
+                    };
+    &courseidput($udom,$newcourse);
     &flushcourselogs();
 # set toplevel url
     my $topurl=$url;
@@ -5069,7 +5585,7 @@ ENDINITMAP
 sub is_course {
     my ($cdom,$cnum) = @_;
     my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.');
+				undef,'.',undef,1);
     if (exists($courses{$cdom.'_'.$cnum})) {
         return 1;
     }
@@ -5159,7 +5675,7 @@ sub save_selected_files {
     my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);
-    open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
+    open (OUT, '>'.$tmpdir.$filename);
     foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");
     }
@@ -5556,28 +6072,27 @@ sub dirlist {
             return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {
             my %allusers;
-            foreach my $tryserver (keys(%libserv)) {
-                if($hostdom{$tryserver} eq $udom) {
-                    my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
-					 $udom, $tryserver);
-                    my @listing_results;
-                    if ($listing eq 'unknown_cmd') {
-                        $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
-					  $udom, $tryserver);
-                        @listing_results = split(/:/,$listing);
-                    } else {
-                        @listing_results =
-                            map { &unescape($_); } split(/:/,$listing);
-                    }
-                    if ($listing_results[0] ne 'no_such_dir' && 
-                        $listing_results[0] ne 'empty'       &&
-                        $listing_results[0] ne 'con_lost') {
-                        foreach my $line (@listing_results) {
-                            my ($entry) = split(/&/,$line,2);
-                            $allusers{$entry} = 1;
-                        }
-                    }
-                }
+	    my %servers = &get_servers($udom,'library');
+	    foreach my $tryserver (keys(%servers)) {
+		my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+				     $udom, $tryserver);
+		my @listing_results;
+		if ($listing eq 'unknown_cmd') {
+		    $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+				      $udom, $tryserver);
+		    @listing_results = split(/:/,$listing);
+		} else {
+		    @listing_results =
+			map { &unescape($_); } split(/:/,$listing);
+		}
+		if ($listing_results[0] ne 'no_such_dir' && 
+		    $listing_results[0] ne 'empty'       &&
+		    $listing_results[0] ne 'con_lost') {
+		    foreach my $line (@listing_results) {
+			my ($entry) = split(/&/,$line,2);
+			$allusers{$entry} = 1;
+		    }
+		}
             }
             my $alluserstr='';
             foreach my $user (sort(keys(%allusers))) {
@@ -5589,18 +6104,12 @@ sub dirlist {
             return ('missing user name');
         }
     } elsif(!defined($alternateDirectoryRoot)) {
-        my $tryserver;
-        my %alldom=();
-        foreach $tryserver (keys(%libserv)) {
-            $alldom{$hostdom{$tryserver}}=1;
-        }
-        my $alldomstr='';
-        foreach my $domain (sort(keys(%alldom))) {
-            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';
-        }
-        $alldomstr=~s/:$//;
-        return split(/:/,$alldomstr);       
-    } else {
+        my @all_domains = sort(&all_domains());
+         foreach my $domain (@all_domains) {
+             $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
+         }
+         return @all_domains;
+     } else {
         return ('missing domain');
     }
 }
@@ -5758,6 +6267,13 @@ sub devalidatecourseresdata {
 
 
 # --------------------------------------------------- Course Resourcedata Query
+#
+#  Parameters:
+#      $coursenum    - Number of the course.
+#      $coursedomain - Domain at which the course was created.
+#  Returns:
+#     A hash of the course parameters along (I think) with timestamps
+#     and version info.
 
 sub get_courseresdata {
     my ($coursenum,$coursedomain)=@_;
@@ -5816,7 +6332,21 @@ sub get_userresdata {
     }
     return $tmp;
 }
-
+#----------------------------------------------- resdata - return resource data
+#  Purpose:
+#    Return resource data for either users or for a course.
+#  Parameters:
+#     $name      - Course/user name.
+#     $domain    - Name of the domain the user/course is registered on.
+#     $type      - Type of thing $name is (must be 'course' or 'user'
+#     @which     - Array of names of resources desired.
+#  Returns:
+#     The value of the first reasource in @which that is found in the
+#     resource hash.
+#  Exceptional Conditions:
+#     If the $type passed in is not valid (not the string 'course' or 
+#     'user', an undefined  reference is returned.
+#     If none of the resources are found, an undef is returned
 sub resdata {
     my ($name,$domain,$type,@which)=@_;
     my $result;
@@ -5994,6 +6524,12 @@ sub EXT {
 	    my ($map) = &decode_symb($symbparm);
 	    return &symbread($map);
 	}
+	if ($space eq 'filename') {
+	    if ($symbparm) {
+		return &clutter((&decode_symb($symbparm))[2]);
+	    }
+	    return &hreflocation('',$env{'request.filename'});
+	}
 
 	my ($section, $group, @groups);
 	my ($courselevelm,$courselevel);
@@ -6163,7 +6699,8 @@ sub packages_tab_default {
 	    $do_default=1;
 	} elsif ($pack_type eq 'extension') {
 	    push(@extension,[$package,$pack_type,$pack_part]);
-	} else {
+	} elsif ($pack_part eq $part || $pack_type eq 'part') {
+	    # only look at packages defaults for packages that this id is
 	    push(@specifics,[$package,$pack_type,$pack_part]);
 	}
     }
@@ -6366,10 +6903,11 @@ sub metadata {
 		 # only ws inside the tag, and not in default, so use default
 		 # as value
 			    $metaentry{':'.$unikey}=$default;
-			} else {
-		  # either something interesting inside the tag or default
-                  # uninteresting
+			} elsif ( $internaltext =~ /\S/ ) {
+		  # something interesting inside the tag
 			    $metaentry{':'.$unikey}=$internaltext;
+			} else {
+		  # no interesting values, don't set a default
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -6379,13 +6917,18 @@ sub metadata {
 	    }
 	}
 	my ($extension) = ($uri =~ /\.(\w+)$/);
+	$extension = lc($extension);
+	if ($extension eq 'htm') { $extension='html'; }
+
 	foreach my $key (keys(%packagetab)) {
 	    #no specific packages #how's our extension
 	    if ($key!~/^extension_\Q$extension\E&/) { next; }
 	    &metadata_create_package_def($uri,$key,'extension_'.$extension,
 					 \%metathesekeys);
 	}
-	if (!exists($metaentry{':packages'})) {
+
+	if (!exists($metaentry{':packages'})
+	    || $packagetab{"import_defaults&extension_$extension"}) {
 	    foreach my $key (keys(%packagetab)) {
 		#no specific packages well let's get default then
 		if ($key!~/^default&/) { next; }
@@ -6504,12 +7047,15 @@ sub gettitle {
 	}
 	my ($map,$resid,$url)=&decode_symb($symb);
 	my $title='';
-	my %bighash;
-	if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
-		&GDBM_READER(),0640)) {
-	    my $mapid=$bighash{'map_pc_'.&clutter($map)};
-	    $title=$bighash{'title_'.$mapid.'.'.$resid};
-	    untie %bighash;
+	if (!$map && $resid == 0 && $url =~/default\.sequence$/) {
+	    $title = $env{'course.'.$env{'request.course.id'}.'.description'};
+	} else {
+	    if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
+		    &GDBM_READER(),0640)) {
+		my $mapid=$bighash{'map_pc_'.&clutter($map)};
+		$title=$bighash{'title_'.$mapid.'.'.$resid};
+		untie(%bighash);
+	    }
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
@@ -6881,9 +7427,8 @@ sub getCODE {
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
-
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
-    if (!$symb) {
+    if (!defined($symb)) {
 	unless ($symb=$wsymb) { return time; }
     }
     if (!$courseid) { $courseid=$wcourseid; }
@@ -7085,13 +7630,14 @@ sub setup_random_from_rndseed {
 }
 
 sub latest_receipt_algorithm_id {
-    return 'receipt2';
+    return 'receipt3';
 }
 
 sub recunique {
     my $fucourseid=shift;
     my $unique;
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
+	$env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
 	$unique=$env{"course.$fucourseid.internal.encseed"};
     } else {
 	$unique=$perlvar{'lonReceipt'};
@@ -7102,7 +7648,8 @@ sub recunique {
 sub recprefix {
     my $fucourseid=shift;
     my $prefix;
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2'||
+	$env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
 	$prefix=$env{"course.$fucourseid.internal.encpref"};
     } else {
 	$prefix=$perlvar{'lonHostID'};
@@ -7112,15 +7659,23 @@ sub recprefix {
 
 sub ireceipt {
     my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;
+
+    my $return =&recprefix($fucourseid).'-';
+
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt3' ||
+	$env{'request.state'} eq 'construct') {
+	$return .= (&digest("$funame,$fudom,$fucourseid,$fusymb,$part")%10000);
+	return $return;
+    }
+
     my $cuname=unpack("%32C*",$funame);
     my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=&recunique($fucourseid);
     my $cpart=unpack("%32S*",$part);
-    my $return =&recprefix($fucourseid).'-';
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
-	$env{'request.state'} eq 'construct') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+
 	#&logthis("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname)." and ".($cpart%$cudom));
 			       
 	$return.= ($cunique%$cuname+
@@ -7252,7 +7807,7 @@ sub repcopy_userfile {
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    $request=new HTTP::Request('GET','http://'.$hostname{&homeserver($cnum,$cdom)}.'/raw/'.$uri);
+    $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);
 # did it work?
     if ($response->is_error()) {
@@ -7275,7 +7830,7 @@ sub tokenwrapper {
     if ($udom && $uname && $file) {
 	$file=~s|(\?\.*)*$||;
         &appenv("userfile.$udom/$uname/$file" => $env{'request.course.id'});
-        return 'http://'.$hostname{ &homeserver($uname,$udom)}.'/'.$uri.
+        return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -7290,7 +7845,7 @@ sub tokenwrapper {
 sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
-    $uri = 'http://'.$hostname{ &homeserver($cnum,$cdom)}.'/raw/'.$uri;
+    $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri;
     my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request($reqtype,$uri);
     my $response=$ua->request($request);
@@ -7325,6 +7880,7 @@ sub filelocation {
 	$file=~s-^/adm/wrapper/-/-;
 	$file=~s-^/adm/coursedocs/showdoc/-/-;
     }
+
     if ($file=~m:^/~:) { # is a contruction space reference
         $location = $file;
         $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
@@ -7345,6 +7901,8 @@ sub filelocation {
   	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
   	      $udom.'/'.$uname.'/'.$filename;
         }
+    } elsif ($file =~ m-^/adm/-) {
+	$location = $perlvar{'lonDocRoot'}.'/'.$file;
     } else {
         $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
         $file=~s:^/res/:/:;
@@ -7376,31 +7934,42 @@ sub hreflocation {
 	$file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
 	    -/uploaded/$1/$2/-x;
     }
+    if ($file=~ m{^/userfiles/}) {
+	$file =~ s{^/userfiles/}{/uploaded/};
+    }
     return $file;
 }
 
 sub current_machine_domains {
-    my $hostname=$hostname{$perlvar{'lonHostID'}};
+    return &machine_domains(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_domains {
+    my ($hostname) = @_;
     my @domains;
+    my %hostname = &all_hostnames();
     while( my($id, $name) = each(%hostname)) {
 #	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
-	    push(@domains,$hostdom{$id});
+	    push(@domains,&host_domain($id));
 	}
     }
     return @domains;
 }
 
 sub current_machine_ids {
-    my $hostname=$hostname{$perlvar{'lonHostID'}};
+    return &machine_ids(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_ids {
+    my ($hostname) = @_;
+    $hostname ||= &hostname($perlvar{'lonHostID'});
     my @ids;
-    while( my($id, $name) = each(%hostname)) {
-#	&logthis("-$id-$name-$hostname-");
-	if ($hostname eq $name) {
-	    push(@ids,$id);
-	}
+    my %name_to_host = &all_names();
+    if (ref($name_to_host{$hostname}) eq 'ARRAY') {
+	return @{ $name_to_host{$hostname} };
     }
-    return @ids;
+    return;
 }
 
 sub additional_machine_domains {
@@ -7444,7 +8013,8 @@ sub declutter {
 
 sub clutter {
     my $thisfn='/'.&declutter(shift);
-    unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
+    if ($thisfn !~ m{^/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)/}
+	|| $thisfn =~ m{^/adm/(includes|pages)} ) { 
        $thisfn='/res'.$thisfn; 
     }
     if ($thisfn !~m|/adm|) {
@@ -7513,104 +8083,332 @@ sub correct_line_ends {
 sub goodbye {
    &logthis("Starting Shut down");
 #not converted to using infrastruture and probably shouldn't be
-   &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache))));
+   &logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache))));
 #converted
 #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
-   &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));
-#   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
-#   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
+   &logthis(sprintf("%-20s is %s",'%homecache',length(&nfreeze(\%homecache))));
+#   &logthis(sprintf("%-20s is %s",'%titlecache',length(&nfreeze(\%titlecache))));
+#   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&nfreeze(\%courseresdatacache))));
 #1.1 only
-#   &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));
-#   &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache))));
-#   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));
-#   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));
-   &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
+#   &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&nfreeze(\%userresdatacache))));
+#   &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&nfreeze(\%getsectioncache))));
+#   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&nfreeze(\%courseresversioncache))));
+#   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&nfreeze(\%resversioncache))));
+   &logthis(sprintf("%-20s is %s",'%remembered',length(&nfreeze(\%remembered))));
    &logthis(sprintf("%-20s is %s",'kicks',$kicks));
    &logthis(sprintf("%-20s is %s",'hits',$hits));
    &flushcourselogs();
    &logthis("Shutting down");
 }
 
-BEGIN {
-# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
-    unless ($readit) {
-{
-    my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf');
-    %perlvar = (%perlvar,%{$configvars});
-}
+sub get_dns {
+    my ($url,$func,$ignore_cache) = @_;
+    if (!$ignore_cache) {
+	my ($content,$cached)=
+	    &Apache::lonnet::is_cached_new('dns',$url);
+	if ($cached) {
+	    &$func($content);
+	    return;
+	}
+    }
 
+    my %alldns;
+    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+    foreach my $dns (<$config>) {
+	next if ($dns !~ /^\^(\S*)/x);
+	$alldns{$1} = 1;
+    }
+    while (%alldns) {
+	my ($dns) = keys(%alldns);
+	delete($alldns{$dns});
+	my $ua=new LWP::UserAgent;
+	my $request=new HTTP::Request('GET',"http://$dns$url");
+	my $response=$ua->request($request);
+	next if ($response->is_error());
+	my @content = split("\n",$response->content);
+	&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
+	&$func(\@content);
+	return;
+    }
+    close($config);
+    my $which = (split('/',$url))[3];
+    &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
+    open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
+    my @content = <$config>;
+    &$func(\@content);
+    return;
+}
 # ------------------------------------------------------------ Read domain file
 {
-    %domaindescription = ();
-    %domain_auth_def = ();
-    %domain_auth_arg_def = ();
-    my $fh;
-    if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
-	while (my $line = <$fh>) {
-           next if ($line =~ /^(\#|\s*$)/);
-#           next if /^\#/;
-           chomp $line;
-           my ($domain, $domain_description, $def_auth, $def_auth_arg,
-	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);
-	   $domain_auth_def{$domain}=$def_auth;
-           $domain_auth_arg_def{$domain}=$def_auth_arg;
-	   $domaindescription{$domain}=$domain_description;
-	   $domain_lang_def{$domain}=$def_lang;
-	   $domain_city{$domain}=$city;
-	   $domain_longi{$domain}=$longi;
-	   $domain_lati{$domain}=$lati;
-           $domain_primary{$domain}=$primary;
+    my $loaded;
+    my %domain;
 
- #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
-#          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
+    sub parse_domain_tab {
+	my ($lines) = @_;
+	foreach my $line (@$lines) {
+	    next if ($line =~ /^(\#|\s*$ )/x);
+
+	    chomp($line);
+	    my ($name,@elements) = split(/:/,$line,9);
+	    my %this_domain;
+	    foreach my $field ('description', 'auth_def', 'auth_arg_def',
+			       'lang_def', 'city', 'longi', 'lati',
+			       'primary') {
+		$this_domain{$field} = shift(@elements);
+	    }
+	    $domain{$name} = \%this_domain;
 	}
     }
-    close ($fh);
+
+    sub reset_domain_info {
+	undef($loaded);
+	undef(%domain);
+    }
+
+    sub load_domain_tab {
+	my ($ignore_cache) = @_;
+	&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache);
+	my $fh;
+	if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
+	    my @lines = <$fh>;
+	    &parse_domain_tab(\@lines);
+	}
+	close($fh);
+	$loaded = 1;
+    }
+
+    sub domain {
+	&load_domain_tab() if (!$loaded);
+
+	my ($name,$what) = @_;
+	return if ( !exists($domain{$name}) );
+
+	if (!$what) {
+	    return $domain{$name}{'description'};
+	}
+	return $domain{$name}{$what};
+    }
 }
 
 
 # ------------------------------------------------------------- Read hosts file
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+    my %hostname;
+    my %hostdom;
+    my %libserv;
+    my $loaded;
+    my %name_to_host;
+
+    sub parse_hosts_tab {
+	my ($file) = @_;
+	foreach my $configline (@$file) {
+	    next if ($configline =~ /^(\#|\s*$ )/x);
+	    next if ($configline =~ /^\^/);
+	    chomp($configline);
+	    my ($id,$domain,$role,$name)=split(/:/,$configline);
+	    $name=~s/\s//g;
+	    if ($id && $domain && $role && $name) {
+		$hostname{$id}=$name;
+		push(@{$name_to_host{$name}}, $id);
+		$hostdom{$id}=$domain;
+		if ($role eq 'library') { $libserv{$id}=$name; }
+	    }
+	}
+    }
+    
+    sub reset_hosts_info {
+	&purge_remembered();
+	&reset_domain_info();
+	&reset_hosts_ip_info();
+	undef(%name_to_host);
+	undef(%hostname);
+	undef(%hostdom);
+	undef(%libserv);
+	undef($loaded);
+    }
 
-    while (my $configline=<$config>) {
-       next if ($configline =~ /^(\#|\s*$)/);
-       chomp($configline);
-       my ($id,$domain,$role,$name)=split(/:/,$configline);
-       $name=~s/\s//g;
-       if ($id && $domain && $role && $name) {
-	 $hostname{$id}=$name;
-	 $hostdom{$id}=$domain;
-	 if ($role eq 'library') { $libserv{$id}=$name; }
-       }
+    sub load_hosts_tab {
+	my ($ignore_cache) = @_;
+	&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache);
+	open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+	my @config = <$config>;
+	&parse_hosts_tab(\@config);
+	close($config);
+	$loaded=1;
+    }
+
+    sub hostname {
+	&load_hosts_tab() if (!$loaded);
+
+	my ($lonid) = @_;
+	return $hostname{$lonid};
+    }
+
+    sub all_hostnames {
+	&load_hosts_tab() if (!$loaded);
+
+	return %hostname;
+    }
+
+    sub all_names {
+	&load_hosts_tab() if (!$loaded);
+
+	return %name_to_host;
+    }
+
+    sub is_library {
+	&load_hosts_tab() if (!$loaded);
+
+	return exists($libserv{$_[0]});
+    }
+
+    sub all_library {
+	&load_hosts_tab() if (!$loaded);
+
+	return %libserv;
+    }
+
+    sub get_servers {
+	&load_hosts_tab() if (!$loaded);
+
+	my ($domain,$type) = @_;
+	my %possible_hosts = ($type eq 'library') ? %libserv
+	                                          : %hostname;
+	my %result;
+	if (ref($domain) eq 'ARRAY') {
+	    while ( my ($host,$hostname) = each(%possible_hosts)) {
+		if (grep(/^\Q$hostdom{$host}\E$/,@$domain)) {
+		    $result{$host} = $hostname;
+		}
+	    }
+	} else {
+	    while ( my ($host,$hostname) = each(%possible_hosts)) {
+		if ($hostdom{$host} eq $domain) {
+		    $result{$host} = $hostname;
+		}
+	    }
+	}
+	return %result;
+    }
+
+    sub host_domain {
+	&load_hosts_tab() if (!$loaded);
+
+	my ($lonid) = @_;
+	return $hostdom{$lonid};
+    }
+
+    sub all_domains {
+	&load_hosts_tab() if (!$loaded);
+
+	my %seen;
+	my @uniq = grep(!$seen{$_}++, values(%hostdom));
+	return @uniq;
     }
-    close($config);
-    # FIXME: dev server don't want this, production servers _do_ want this
-    #&get_iphost();
 }
 
-sub get_iphost {
-    if (%iphost) { return %iphost; }
+{ 
+    my %iphost;
     my %name_to_ip;
-    foreach my $id (keys(%hostname)) {
-	my $name=$hostname{$id};
-	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");
-		next;
+    my %lonid_to_ip;
+
+    sub get_hosts_from_ip {
+	my ($ip) = @_;
+	my %iphosts = &get_iphost();
+	if (ref($iphosts{$ip})) {
+	    return @{$iphosts{$ip}};
+	}
+	return;
+    }
+    
+    sub reset_hosts_ip_info {
+	undef(%iphost);
+	undef(%name_to_ip);
+	undef(%lonid_to_ip);
+    }
+
+    sub get_host_ip {
+	my ($lonid) = @_;
+	if (exists($lonid_to_ip{$lonid})) {
+	    return $lonid_to_ip{$lonid};
+	}
+	my $name=&hostname($lonid);
+   	my $ip = gethostbyname($name);
+	return if (!$ip || length($ip) ne 4);
+	$ip=inet_ntoa($ip);
+	$name_to_ip{$name}   = $ip;
+	$lonid_to_ip{$lonid} = $ip;
+	return $ip;
+    }
+    
+    sub get_iphost {
+	my ($ignore_cache) = @_;
+
+	if (!$ignore_cache) {
+	    if (%iphost) {
+		return %iphost;
+	    }
+	    my ($ip_info,$cached)=
+		&Apache::lonnet::is_cached_new('iphost','iphost');
+	    if ($cached) {
+		%iphost      = %{$ip_info->[0]};
+		%name_to_ip  = %{$ip_info->[1]};
+		%lonid_to_ip = %{$ip_info->[2]};
+		return %iphost;
 	    }
-	    $ip=inet_ntoa($ip);
-	    $name_to_ip{$name} = $ip;
-	} else {
-	    $ip = $name_to_ip{$name};
 	}
-	push(@{$iphost{$ip}},$id);
+
+	# get yesterday's info for fallback
+	my %old_name_to_ip;
+	my ($ip_info,$cached)=
+	    &Apache::lonnet::is_cached_new('iphost','iphost');
+	if ($cached) {
+	    %old_name_to_ip = %{$ip_info->[1]};
+	}
+
+	my %name_to_host = &all_names();
+	foreach my $name (keys(%name_to_host)) {
+	    my $ip;
+	    if (!exists($name_to_ip{$name})) {
+		$ip = gethostbyname($name);
+		if (!$ip || length($ip) ne 4) {
+		    if (defined($old_name_to_ip{$name})) {
+			$ip = $old_name_to_ip{$name};
+			&logthis("Can't find $name defaulting to old $ip");
+		    } else {
+			&logthis("Name $name no IP found");
+			next;
+		    }
+		} else {
+		    $ip=inet_ntoa($ip);
+		}
+		$name_to_ip{$name} = $ip;
+	    } else {
+		$ip = $name_to_ip{$name};
+	    }
+	    foreach my $id (@{ $name_to_host{$name} }) {
+		$lonid_to_ip{$id} = $ip;
+	    }
+	    push(@{$iphost{$ip}},@{$name_to_host{$name}});
+	}
+	&Apache::lonnet::do_cache_new('iphost','iphost',
+				      [\%iphost,\%name_to_ip,\%lonid_to_ip],
+				      48*60*60);
+
+	return %iphost;
     }
-    return %iphost;
 }
 
+BEGIN {
+
+# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
+    unless ($readit) {
+{
+    my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf');
+    %perlvar = (%perlvar,%{$configvars});
+}
+
+
 # ------------------------------------------------------ Read spare server file
 {
     open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
@@ -7942,6 +8740,16 @@ X<userenvironment()>
 B<userenvironment($udom,$uname,@what)>: gets the values of the keys
 passed in @what from the requested user's environment, returns a hash
 
+=item * 
+X<userlog_query()>
+B<userlog_query($uname,$udom,%filters)>: retrieves data from a user's
+activity.log file. %filters defines filters applied when parsing the
+log file. These can be start or end timestamps, or the type of action
+- log to look for Login or Logout events, check for Checkin or
+Checkout, role for role selection. The response is in the form
+timestamp1:hostid1:event1&timestamp2:hostid2:event2 where events are
+escaped strings of the action recorded in the activity.log file.
+
 =back
 
 =head2 User Roles
@@ -7971,7 +8779,19 @@ explanation of a user role term
 
 =item *
 
-get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are optional.  Returns a hash of a user's roles, with keys set to colon-sparated $uname,$udom,and $role, and value set to colon-separated start and end times for the role. If no username and domain are specified, will default to current user/domain. Types, roles, and roledoms are references to arrays, of role statuses (active, future or previous), roles (e.g., cc,in, st etc.) and domains of the roles which can be used to restrict the list if roles reported. If no array ref is provided for types, will default to return only active roles.  
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
+All arguments are optional. Returns a hash of a roles, either for
+co-author/assistant author roles for a user's Construction Space
+(default), or if $context is 'userroles', roles for the user himself,
+In the hash, keys are set to colon-sparated $uname,$udom,and $role,
+and value is set to colon-separated start and end times for the role.
+If no username and domain are specified, will default to current
+user/domain. Types, roles, and roledoms are references to arrays,
+of role statuses (active, future or previous), roles 
+(e.g., cc,in, st etc.) and domains of the roles which can be used
+to restrict the list of roles reported. If no array ref is 
+provided for types, will default to return only active roles.
+
 =back
 
 =head2 User Modification
@@ -8114,6 +8934,14 @@ setting for a specific $type, where $typ
 @what should be a list of parameters to ask about. This routine caches
 answers for 5 minutes.
 
+=item *
+
+get_courseresdata($courseid, $domain) : dump the entire course resource
+data base, returning a hash that is keyed by the resource name and has
+values that are the resource value.  I believe that the timestamps and
+versions are also returned.
+
+
 =back
 
 =head2 Course Modification
@@ -8395,12 +9223,15 @@ critical subroutine
 
 =item *
 
-get_dom($namespace,$storearr,$udomain) : returns hash with keys from array
-reference filled in from namespace found in domain level on primary domain server ($udomain is optional)
+get_dom($namespace,$storearr,$udom,$uhome) : returns hash with keys from
+array reference filled in from namespace found in domain level on either
+specified domain server ($uhome) or primary domain server ($udom and $uhome are optional).
 
 =item *
 
-put_dom($namespace,$storehash,$udomain) :  stores hash in namespace at domain level on primary domain server ($udomain is optional)
+put_dom($namespace,$storehash,$udom,$uhome) :  stores hash in namespace at 
+domain level either on specified domain server ($uhome) or primary domain 
+server ($udom and $uhome are optional)
 
 =back
 
@@ -8793,3 +9624,4 @@ symblist($mapname,%newhash) : update sym
 =back
 
 =cut
+