--- loncom/lonnet/perl/lonnet.pm	2007/03/30 18:18:43	1.855
+++ loncom/lonnet/perl/lonnet.pm	2007/06/18 22:52:33	1.892
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.855 2007/03/30 18:18:43 albertel Exp $
+# $Id: lonnet.pm,v 1.892 2007/06/18 22:52:33 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,22 +31,21 @@ package Apache::lonnet;
 
 use strict;
 use LWP::UserAgent();
-use HTTP::Headers;
 use HTTP::Date;
 # use Date::Parse;
-use vars 
-qw(%perlvar %badServerCache %spareid 
-   %pr %prp $memcache %packagetab 
-   %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
-   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
-   $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;
@@ -150,7 +149,7 @@ sub create_connection {
 				     Type    => SOCK_STREAM,
 				     Timeout => 10);
     return 0 if (!$client);
-    print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n");
+    print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
     my $result = <$client>;
     chomp($result);
     return 1 if ($result eq 'done');
@@ -182,7 +181,7 @@ 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);
@@ -215,6 +214,24 @@ sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
+    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")) {
@@ -734,21 +751,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 (defined(&domain($udom,'primary'))) {
-        my $uhome=&domain($udom,'primary');
+    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]);
@@ -756,17 +788,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 (defined(&domain($udom,'primary'))) {
-        my $uhome=&domain($udom,'primary');
+    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}).'&';
@@ -774,7 +818,7 @@ 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");
     }
 }
 
@@ -802,6 +846,16 @@ sub retrieve_inst_usertypes {
     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;
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -1028,7 +1082,10 @@ my $kicks=0;
 my $hits=0;
 sub make_key {
     my ($name,$id) = @_;
-    if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
+    if (length($id) > 65 
+	&& length(&escape($id)) > 200) {
+	$id=length($id).':'.&Digest::MD5::md5_hex($id);
+    }
     return &escape($name.':'.$id);
 }
 
@@ -1075,7 +1132,9 @@ sub do_cache_new {
 	$time=600;
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $memcache->set($id,$setvalue,$time);
+    if (!($memcache->set($id,$setvalue,$time))) {
+	&logthis("caching of id -> $id  failed");
+    }
     # need to make a copy of $value
     #&make_room($id,$value,$debug);
     return $value;
@@ -1516,14 +1575,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);
@@ -1570,7 +1636,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,
@@ -1580,8 +1646,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'};
@@ -1590,16 +1657,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|^(.*)/([^/]+)$|);
@@ -1635,11 +1704,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;
@@ -1647,7 +1733,7 @@ sub finishuserfileupload {
         &logthis('Failed to transfer '.$path.$file.' to host '.$docuhome.
 		 ': '.$fetchresult);
         return '/adm/notfound.html';
-    }    
+    }
 }
 
 sub extract_embedded_items {
@@ -1671,13 +1757,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');
@@ -2069,15 +2158,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)) {
@@ -2095,7 +2194,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;
@@ -2105,7 +2210,7 @@ sub get_my_roles {
             if (!grep(/^\Q$role\E$/,@{$roles})) {
                 next;
             }
-        } 
+        }
 	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
     }
     return %returnhash;
@@ -3049,7 +3154,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;
@@ -3530,9 +3635,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;
@@ -4349,6 +4461,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);
 }
@@ -4357,8 +4475,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;
 }
 
@@ -4388,15 +4516,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);
 }
@@ -5201,7 +5341,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");
     }
@@ -5793,6 +5933,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)=@_;
@@ -5851,7 +5998,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;
@@ -6198,7 +6359,7 @@ sub packages_tab_default {
 	    $do_default=1;
 	} elsif ($pack_type eq 'extension') {
 	    push(@extension,[$package,$pack_type,$pack_part]);
-	} elsif ($pack_part eq $part) {
+	} 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]);
 	}
@@ -6415,13 +6576,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; }
@@ -6917,7 +7083,6 @@ sub getCODE {
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
-
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!$symb) {
 	unless ($symb=$wsymb) { return time; }
@@ -7371,6 +7536,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:;
@@ -7391,6 +7557,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/:/:;
@@ -7450,14 +7618,11 @@ sub machine_ids {
     my ($hostname) = @_;
     $hostname ||= &hostname($perlvar{'lonHostID'});
     my @ids;
-    my %hostname = &all_hostnames();
-    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 {
@@ -7501,7 +7666,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|) {
@@ -7570,46 +7736,60 @@ 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) = @_;
+    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);
-	$dns = $1;
+	$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
 {
@@ -7630,12 +7810,17 @@ sub get_dns {
 		$this_domain{$field} = shift(@elements);
 	    }
 	    $domain{$name} = \%this_domain;
-	    &logthis("Domain.tab: $name ".$domain{$name}{'description'} );
 	}
     }
-    
+
+    sub reset_domain_info {
+	undef($loaded);
+	undef(%domain);
+    }
+
     sub load_domain_tab {
-	&get_dns('/adm/dns/domain',\&parse_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>;
@@ -7665,6 +7850,7 @@ sub get_dns {
     my %hostdom;
     my %libserv;
     my $loaded;
+    my %name_to_host;
 
     sub parse_hosts_tab {
 	my ($file) = @_;
@@ -7676,15 +7862,26 @@ sub get_dns {
 	    $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; }
 	    }
-	    &logthis("Hosts.tab: $name ".$id );
 	}
     }
+    
+    sub reset_hosts_info {
+	&reset_domain_info();
+	&reset_hosts_ip_info();
+	undef(%name_to_host);
+	undef(%hostname);
+	undef(%hostdom);
+	undef(%libserv);
+	undef($loaded);
+    }
 
     sub load_hosts_tab {
-	&get_dns('/adm/dns/hosts',\&parse_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);
@@ -7692,9 +7889,6 @@ sub get_dns {
 	$loaded=1;
     }
 
-    # FIXME: dev server don't want this, production servers _do_ want this
-    #&get_iphost();
-
     sub hostname {
 	&load_hosts_tab() if (!$loaded);
 
@@ -7708,6 +7902,12 @@ sub get_dns {
 	return %hostname;
     }
 
+    sub all_names {
+	&load_hosts_tab() if (!$loaded);
+
+	return %name_to_host;
+    }
+
     sub is_library {
 	&load_hosts_tab() if (!$loaded);
 
@@ -7761,6 +7961,9 @@ sub get_dns {
 
 { 
     my %iphost;
+    my %name_to_ip;
+    my %lonid_to_ip;
+
     sub get_hosts_from_ip {
 	my ($ip) = @_;
 	my %iphosts = &get_iphost();
@@ -7770,17 +7973,48 @@ sub get_dns {
 	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 {
-	if (%iphost) { return %iphost; }
-	my %name_to_ip;
-	my %hostname = &all_hostnames();
-	foreach my $id (keys(%hostname)) {
-	    my $name=$hostname{$id};
+	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;
+	    }
+	}
+	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) {
-		    &logthis("Skipping host $id name $name no IP found");
+		    &logthis("Skipping name $name no IP found");
 		    next;
 		}
 		$ip=inet_ntoa($ip);
@@ -7788,12 +8022,29 @@ sub get_dns {
 	    } else {
 		$ip = $name_to_ip{$name};
 	    }
-	    push(@{$iphost{$ip}},$id);
+	    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],
+				      24*60*60);
+
 	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");
@@ -8125,6 +8376,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
@@ -8154,16 +8415,18 @@ 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 'user', 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
 
@@ -8307,6 +8570,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
@@ -8588,12 +8859,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
 
@@ -8986,3 +9260,4 @@ symblist($mapname,%newhash) : update sym
 =back
 
 =cut
+