--- loncom/lonnet/perl/lonnet.pm	2001/07/26 18:15:39	1.130
+++ loncom/lonnet/perl/lonnet.pm	2001/10/06 20:57:45	1.162
@@ -40,15 +40,27 @@
 #                    : returns hash for this symb, all args are optional
 #                      if they aren't given they will be derived from the 
 #                      current enviroment
-# eget(namesp,array) : returns hash with keys from array filled in from namesp
-# get(namesp,array)  : returns hash with keys from array filled in from namesp
-# del(namesp,array)  : deletes keys out of array from namesp
-# put(namesp,hash)   : stores hash in namesp
-# cput(namesp,hash)  : critical put
+#
+#
+# for the next 6 functions udom and uname are optional
+#         if supplied they use udom as the domain and uname
+#         as the username for the function (supply a courseid
+#         for the uname if you want a course database)
+#         if not supplied it uses %ENV and looks at 
+#         user. attribute for the values
+#
+# eget(namesp,arrayref,udom,uname)
+#                    : returns hash with keys from array  reference filled
+#                      in from namesp (encrypts the return communication)
+# get(namesp,arrayref,udom,uname)
+#                    : returns hash with keys from array  reference filled
+#                      in from namesp
 # dump(namesp,udom,uname) : dumps the complete namespace into a hash
-#                           if supplied uses udom as the domain and uname
-#                           as the username for the dump (supply a courseid
-#                           for the uname if you want a course database)
+# del(namesp,array,udom,uname)  : deletes keys out of array from namesp
+# put(namesp,hash,udom,uname)   : stores hash in namesp
+# cput(namesp,hash,udom,uname)  : critical put
+#
+#
 # ssi(url,hash)      : does a complete request cycle on url to localhost, posts
 #                      hash
 # coursedescription(id) : returns and caches course description for id
@@ -60,7 +72,12 @@
 # EXT(name)          : value of a variable
 # symblist(map,hash) : Updates symbolic storage links
 # symbread([filename]) : returns the data handle (filename optional)
-# rndseed()          : returns a random seed 
+# rndseed([symb,courseid,domain,uname])
+#                    : returns a random seed, all arguments are optional,
+#                      if they aren't sent it use the environment to derive
+#                      them
+#                      Note: if symb isn't sent and it can't get one from
+#                      &symbread it will use the current time as it's return
 # receipt()          : returns a receipt to be given out to users 
 # getfile(filename)  : returns the contents of filename, or a -1 if it can't
 #                      be found, replicates and subscribes to the file
@@ -101,6 +118,7 @@
 # 05/01,06/01,09/01 Gerd Kortemeyer
 # 09/01 Guy Albertelli
 # 09/01,10/01,11/01 Gerd Kortemeyer
+# YEAR=2001
 # 02/27/01 Scott Harrison
 # 3/2 Gerd Kortemeyer
 # 3/15,3/19 Scott Harrison
@@ -109,7 +127,10 @@
 # 5/26,5/28 Gerd Kortemeyer
 # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer
-#
+# July Guy Albertelli
+# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
+# 10/2 Gerd Kortemeyer
+# 10/5 Scott Harrison
 
 package Apache::lonnet;
 
@@ -118,7 +139,7 @@ use Apache::File;
 use LWP::UserAgent();
 use HTTP::Headers;
 use vars 
-qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache);
+qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs);
 use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
@@ -263,7 +284,8 @@ sub appenv {
     map {
 	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
             &logthis("<font color=blue>WARNING: ".
-                "Attempt to modify environment ".$_." to ".$newenv{$_});
+                "Attempt to modify environment ".$_." to ".$newenv{$_}
+                .'</font>');
 	    delete($newenv{$_});
         } else {
             $ENV{$_}=$newenv{$_};
@@ -646,6 +668,142 @@ sub log {
     return critical("log:$dom:$nam:$what",$hom);
 }
 
+# ------------------------------------------------------------------ Course Log
+
+sub flushcourselogs {
+    &logthis('Flushing course log buffers');
+    map {
+        my $crsid=$_;
+        if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'.
+		          $ENV{'course.'.$crsid.'.num'}.':'.
+		           &escape($courselogs{$crsid}),
+		          $ENV{'course.'.$crsid.'.home'}) eq 'ok') {
+	    delete $courselogs{$crsid};
+        } else {
+            &logthis('Failed to flush log buffer for '.$crsid);
+            if (length($courselogs{$crsid})>40000) {
+               &logthis("<font color=blue>WARNING: Buffer for ".$crsid.
+                        " exceeded maximum size, deleting.</font>");
+               delete $courselogs{$crsid};
+            }
+        }        
+    } keys %courselogs;
+}
+
+sub courselog {
+    my $what=shift;
+    $what=time.':'.$what;
+    unless ($ENV{'request.course.id'}) { return ''; }
+    if (defined $courselogs{$ENV{'request.course.id'}}) {
+	$courselogs{$ENV{'request.course.id'}}.='&'.$what;
+    } else {
+	$courselogs{$ENV{'request.course.id'}}.=$what;
+    }
+    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+	&flushcourselogs();
+    }
+}
+
+sub courseacclog {
+    my $fnsymb=shift;
+    unless ($ENV{'request.course.id'}) { return ''; }
+    my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
+    if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {
+	map {
+            if ($_=~/^form\.(.*)/) {
+		$what.=':'.$1.'='.$ENV{$_};
+            }
+        } keys %ENV;
+    }
+    &courselog($what);
+}
+
+# ----------------------------------------------------------- Check out an item
+
+sub checkout {
+    my ($symb,$tuname,$tudom,$tcrsid)=@_;
+    my $now=time;
+    my $lonhost=$perlvar{'lonHostID'};
+    my $infostr=&escape(
+                 $tuname.'&'.
+                 $tudom.'&'.
+                 $tcrsid.'&'.
+                 $symb.'&'.
+		 $now.'&'.$ENV{'REMOTE_ADDR'});
+    my $token=&reply('tmpput:'.$infostr,$lonhost);
+    if ($token=~/^error\:/) { 
+        &logthis("<font color=blue>WARNING: ".
+                "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
+                 "</font>");
+        return ''; 
+    }
+
+    $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
+    $token=~tr/a-z/A-Z/;
+
+    my %infohash=('resource.0.outtoken' => $token,
+                  'resource.0.checkouttime' => $now,
+                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
+
+    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+       return '';
+    } else {
+        &logthis("<font color=blue>WARNING: ".
+                "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
+                 "</font>");
+    }    
+
+    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+                         &escape('Checkout '.$infostr.' - '.
+                                                 $token)) ne 'ok') {
+	return '';
+    } else {
+        &logthis("<font color=blue>WARNING: ".
+                "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
+                 "</font>");
+    }
+    return $token;
+}
+
+# ------------------------------------------------------------ Check in an item
+
+sub checkin {
+    my $token=shift;
+    my $now=time;
+    my ($ta,$tb,$lonhost)=split(/\*/,$token);
+    $lonhost=~tr/A-Z/a-z/;
+    my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;
+    $dtoken=~s/\W/\_/g;
+    my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
+                 split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
+
+    unless (($tuname) && ($tudom)) {
+        &logthis('Check in '.$token.' ('.$dtoken.') failed');
+        return '';
+    }
+    
+    unless (&allowed('mgr',$tcrsid)) {
+        &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
+                 $ENV{'user.name'}.' - '.$ENV{'user.domain'});
+        return '';
+    }
+
+    my %infohash=('resource.0.intoken' => $token,
+                  'resource.0.checkintime' => $now,
+                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
+
+    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+       return '';
+    }    
+
+    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+                         &escape('Checkin - '.$token)) ne 'ok') {
+	return '';
+    }
+
+    return ($symb,$tuname,$tudom,$tcrsid);    
+}
+
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -671,22 +829,18 @@ sub devalidate {
     if ($cid) {
 	my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
         my $status=
-          &reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'.
-                        $ENV{'course.'.$cid.'.num'}.
-	                ':nohist_calculatedsheets:'.
-                        &escape($key.'studentcalc:'),
-                        $ENV{'course.'.$cid.'.home'})
-          .' '.
-          &reply('del:'.$ENV{'user.domain'}.':'.
-                        $ENV{'user.name'}.
-		        ':nohist_calculatedsheets_'.$cid.':'.
-                        &escape($key.'assesscalc:'.$symb),
-                        $ENV{'user.home'});
+	    &del('nohist_calculatedsheet',
+		 [$key.'studentcalc'],
+		 $ENV{'course.'.$cid.'.domain'},
+		 $ENV{'course.'.$cid.'.num'})
+		.' '.
+	    &del('nohist_calculatedsheets_'.$cid,
+		 [$key.'assesscalc:'.$symb]);
         unless ($status eq 'ok ok') {
            &logthis('Could not devalidate spreadsheet '.
                     $ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
 		    $symb.': '.$status);
-        } 
+        }
     }
 }
 
@@ -887,7 +1041,7 @@ sub rolesinit {
         my $author=0;
         map {
             %thesepriv=();
-            if ($_!~/^st/) { $adv=1; }
+            if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
             if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             map {
                 if ($_ ne '') {
@@ -915,35 +1069,41 @@ sub rolesinit {
 # --------------------------------------------------------------- get interface
 
 sub get {
-   my ($namespace,@storearr)=@_;
+   my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
    map {
        $items.=escape($_).'&';
-   } @storearr;
+   } @$storearr;
    $items=~s/\&$//;
- my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
-                 $ENV{'user.home'});
+   if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+   if (!$uname) { $uname=$ENV{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+
+   my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
    my @pairs=split(/\&/,$rep);
    my %returnhash=();
    my $i=0;
    map {
       $returnhash{$_}=unescape($pairs[$i]);
       $i++;
-   } @storearr;
+   } @$storearr;
    return %returnhash;
 }
 
 # --------------------------------------------------------------- del interface
 
 sub del {
-   my ($namespace,@storearr)=@_;
+   my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
    map {
        $items.=escape($_).'&';
-   } @storearr;
+   } @$storearr;
    $items=~s/\&$//;
-   return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
-                 $ENV{'user.home'});
+   if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+   if (!$uname) { $uname=$ENV{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+
+   return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # -------------------------------------------------------------- dump interface
@@ -966,48 +1126,53 @@ sub dump {
 # --------------------------------------------------------------- put interface
 
 sub put {
-   my ($namespace,%storehash)=@_;
+   my ($namespace,$storehash,$udomain,$uname)=@_;
+   if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+   if (!$uname) { $uname=$ENV{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
    my $items='';
    map {
-       $items.=escape($_).'='.escape($storehash{$_}).'&';
-   } keys %storehash;
+       $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
+   } keys %$storehash;
    $items=~s/\&$//;
-   return reply("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
-                 $ENV{'user.home'});
+   return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # ------------------------------------------------------ critical put interface
 
 sub cput {
-   my ($namespace,%storehash)=@_;
+   my ($namespace,$storehash,$udomain,$uname)=@_;
+   if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+   if (!$uname) { $uname=$ENV{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
    my $items='';
    map {
-       $items.=escape($_).'='.escape($storehash{$_}).'&';
-   } keys %storehash;
+       $items.=escape($_).'='.escape($$storehash{$_}).'&';
+   } keys %$storehash;
    $items=~s/\&$//;
-   return critical
-           ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
-                 $ENV{'user.home'});
+   return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # -------------------------------------------------------------- eget interface
 
 sub eget {
-   my ($namespace,@storearr)=@_;
+   my ($namespace,$storearr,$udomain,$uname)=@_;
    my $items='';
    map {
        $items.=escape($_).'&';
-   } @storearr;
+   } @$storearr;
    $items=~s/\&$//;
- my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
-                 $ENV{'user.home'});
+   if (!$udomain) { $udomain=$ENV{'user.domain'}; }
+   if (!$uname) { $uname=$ENV{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+   my $rep=&reply("eget:$udomain:$uname:$namespace:$items",$uhome);
    my @pairs=split(/\&/,$rep);
    my %returnhash=();
    my $i=0;
    map {
       $returnhash{$_}=unescape($pairs[$i]);
       $i++;
-   } @storearr;
+   } @$storearr;
    return %returnhash;
 }
 
@@ -1015,6 +1180,8 @@ sub eget {
 
 sub allowed {
     my ($priv,$uri)=@_;
+
+    my $orguri=$uri;
     $uri=&declutter($uri);
 
 # Free bre access to adm and meta resources
@@ -1023,6 +1190,12 @@ sub allowed {
 	return 'F';
     }
 
+# Free bre to public access
+
+    if ($priv eq 'bre') {
+	if (&metadata($uri,'copyright') eq 'public') { return 'F'; }
+    }
+
     my $thisallowed='';
     my $statecond=0;
     my $courseprivid='';
@@ -1088,16 +1261,28 @@ sub allowed {
            }
        }
        
-       if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
-	  my $refuri=$ENV{'HTTP_REFERER'};
-          $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
-          $refuri=&declutter($refuri);
+       if ($checkreferer) {
+	  my $refuri=$ENV{'httpref.'.$orguri};
+
+            unless ($refuri) {
+                map {
+		    if ($_=~/^httpref\..*\*/) {
+			my $pattern=$_;
+                        $pattern=~s/^httpref\.\/res\///;
+                        $pattern=~s/\*/\[\^\/\]\+/g;
+                        $pattern=~s/\//\\\//g;
+                        if ($orguri=~/$pattern/) {
+			    $refuri=$ENV{$_};
+                        }
+                    }
+                } keys %ENV;
+            }
+         if ($refuri) { 
+	  $refuri=&declutter($refuri);
           my @uriparts=split(/\//,$refuri);
           my $filename=$uriparts[$#uriparts];
           my $pathname=$refuri;
           $pathname=~s/\/$filename$//;
-          my @filenameparts=split(/\./,$uri);
-          if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {
             if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
               /\&$filename\:([\d\|]+)\&/) {
               my $refstatecond=$1;
@@ -1107,8 +1292,8 @@ sub allowed {
                   $uri=$refuri;
                   $statecond=$refstatecond;
               }
-            }
           }
+        }
        }
    }
 
@@ -1416,27 +1601,20 @@ sub modifyuser {
        }
     }
 # -------------------------------------------------------------- Add names, etc
-    my $names=&reply('get:'.$udom.':'.$uname.
-                     ':environment:firstname&middlename&lastname&generation',
-                     $uhome);
-    my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names);
-    if ($first)  { $efirst  = &escape($first); }
-    if ($middle) { $emiddle = &escape($middle); }
-    if ($last)   { $elast   = &escape($last); }
-    if ($gene)   { $egene   = &escape($gene); }
-    my $reply=&reply('put:'.$udom.':'.$uname.
-           ':environment:firstname='.$efirst.
-                      '&middlename='.$emiddle.
-                        '&lastname='.$elast.
-                      '&generation='.$egene,$uhome);
-    if ($reply ne 'ok') {
-	return 'error: '.$reply;
-    }
+    my %names=&get('environment',
+		   ['firstname','middlename','lastname','generation'],
+		   $udom,$uname);
+    if ($first)  { $names{'firstname'}  = $first; }
+    if ($middle) { $names{'middlename'} = $middle; }
+    if ($last)   { $names{'lastname'}   = $last; }
+    if ($gene)   { $names{'generation'} = $gene; }
+    my $reply = &put('environment', \%names, $udom,$uname);
+    if ($reply ne 'ok') { return 'error: '.$reply; }
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
 	     $last.', '.$gene.' by '.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});
-    return 'ok'; 
+    return 'ok';
 }
 
 # -------------------------------------------------------------- Modify student
@@ -1457,7 +1635,7 @@ sub modifystudent {
 	return 'error: no such user';
     }
 # -------------------------------------------------- Add student to course list
-    my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+    $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                       &escape($uname.':'.$udom).'='.
                       &escape($end.':'.$start),
@@ -1522,7 +1700,7 @@ sub createcourse {
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
                       $ENV{'user.home'});
     unless ($reply eq 'ok') { return 'error: '.$reply; }
-    my $uhome=&homeserver($uname,$udom);
+    $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such course';
     }
@@ -1661,7 +1839,7 @@ sub condval {
 # --------------------------------------------------------- Value of a Variable
 
 sub EXT {
-    my $varname=shift;
+    my ($varname,$symbparm)=@_;
     unless ($varname) { return ''; }
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
@@ -1705,7 +1883,7 @@ sub EXT {
 # ---------------------------------------------------- Any other user namespace
         } else {
             my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
-            my %reply=&get($space,$item);
+            my %reply=&get($space,[$item]);
             return $reply{$item};
         }
     } elsif ($realm eq 'request') {
@@ -1722,8 +1900,17 @@ sub EXT {
                               $spacequalifierrest};
     } elsif ($realm eq 'resource') {
        if ($ENV{'request.course.id'}) {
+
+#	   print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
+
+
 # ----------------------------------------------------- Cascading lookup scheme
-         my $symbp=&symbread();
+         my $symbp;
+         if ($symbparm) {
+            $symbp=$symbparm;
+	 } else {
+            $symbp=&symbread();
+         }            
          my $mapp=(split(/\_\_\_/,$symbp))[0];
 
          my $symbparm=$symbp.'.'.$spacequalifierrest;
@@ -1748,7 +1935,7 @@ sub EXT {
 
 # ----------------------------------------------------------- first, check user
          my %resourcedata=get('resourcedata',
-                           ($courselevelr,$courselevelm,$courselevel));
+                           [$courselevelr,$courselevelm,$courselevel]);
          if (($resourcedata{$courselevelr}!~/^error\:/) &&
              ($resourcedata{$courselevelr}!~/^con_lost/)) {
 
@@ -1811,6 +1998,21 @@ sub EXT {
                                          'parameter_'.$spacequalifierrest);
       if ($metadata) { return $metadata; }
 
+# ------------------------------------------------------------------ Cascade up
+
+      unless ($space eq '0') {
+          my ($part,$id)=split(/\_/,$space);
+          if ($id) {
+	      my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+                                   $symbparm);
+              if ($partgeneral) { return $partgeneral; }
+          } else {
+              my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
+                                       $symbparm);
+              if ($resourcegeneral) { return $resourcegeneral; }
+          }
+      }
+
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment
@@ -1833,25 +2035,59 @@ sub metadata {
     my $filename=$uri;
     $uri=~s/\.meta$//;
     unless ($metacache{$uri.':keys'}) {
+        my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
         my $parser=HTML::TokeParser->new(\$metastring);
         my $token;
+        undef %metathesekeys;
         while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {
+	     if (defined($token->[2]->{'package'})) {
+	      my $package=$token->[2]->{'package'};
+	      my $keyroot='';
+              if (defined($token->[2]->{'part'})) { 
+                 $keyroot.='_'.$token->[2]->{'part'}; 
+	      }
+              if (defined($token->[2]->{'id'})) { 
+                 $keyroot.='_'.$token->[2]->{'id'}; 
+	      }
+              if ($metacache{$uri.':packages'}) {
+                 $metacache{$uri.':packages'}.=','.$package.$keyroot;
+              } else {
+                 $metacache{$uri.':packages'}=$package.$keyroot;
+	      }
+              map {
+		  if ($_=~/^$package\&/) {
+		      my ($pack,$name,$subp)=split(/\&/,$_);
+                      my $value=$packagetab{$_};
+		      my $part=$keyroot;
+                      $part=~s/^\_//;
+                      if ($subp eq 'display') {
+			  $value.=' [Part: '.$part.']';
+                      }
+                      my $unikey='parameter'.$keyroot.'_'.$name;
+                      $metathesekeys{$unikey}=1;
+                      $metacache{$uri.':'.$unikey.'.part'}=$part;
+                      unless 
+                       (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
+                         $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
+		      }
+                  }
+              } keys %packagetab;
+             } else {
 	      my $entry=$token->[1];
               my $unikey=$entry;
               if (defined($token->[2]->{'part'})) { 
                  $unikey.='_'.$token->[2]->{'part'}; 
 	      }
+              if (defined($token->[2]->{'id'})) { 
+                 $unikey.='_'.$token->[2]->{'id'}; 
+	      }
               if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'}; 
 	      }
-              if ($metacache{$uri.':keys'}) {
-                 $metacache{$uri.':keys'}.=','.$unikey;
-              } else {
-                 $metacache{$uri.':keys'}=$unikey;
-	      }
+              $metathesekeys{$unikey}=1;
               map {
 		  $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               } @{$token->[3]};
@@ -1860,8 +2096,10 @@ sub metadata {
 		      ) { $metacache{$uri.':'.$unikey}=
 			      $metacache{$uri.':'.$unikey.'.default'};
 		      }
-          }
+	    }
+	 }
        }
+       $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
     }
     return $metacache{$uri.':'.$what};
 }
@@ -1971,16 +2209,21 @@ sub numval {
 }    
 
 sub rndseed {
-    my $symb;
-    unless ($symb=&symbread()) { return time; }
-    { 
+    my ($symb,$courseid,$domain,$username)=@_;
+    if (!$symb) {
+      unless ($symb=&symbread()) { return time; }
+    }
+    if (!$courseid) { $courseid=$ENV{'request.course.id'};}
+    if (!$domain) {$domain=$ENV{'user.domain'};}
+    if (!$username) {$username=$ENV{'user.name'};}
+    {
       use integer;
       my $symbchck=unpack("%32C*",$symb) << 27;
       my $symbseed=numval($symb) << 22;
-      my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17;
-      my $nameseed=numval($ENV{'user.name'}) << 12;
-      my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7;
-      my $courseseed=unpack("%32C*",$ENV{'request.course.id'});
+      my $namechck=unpack("%32C*",$username) << 17;
+      my $nameseed=numval($username) << 12;
+      my $domainseed=unpack("%32C*",$domain) << 7;
+      my $courseseed=unpack("%32C*",$courseid);
       my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
       #uncommenting these lines can break things!
       #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
@@ -2083,7 +2326,7 @@ sub unescape {
 # ================================================================ Main Program
 
 sub BEGIN {
-if ($readit ne 'done') {
+unless ($readit) {
 # ------------------------------------------------------------ Read access.conf
 {
     my $config=Apache::File->new("/etc/httpd/conf/access.conf");
@@ -2102,9 +2345,11 @@ if ($readit ne 'done') {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
 
     while (my $configline=<$config>) {
+       chomp($configline);
        my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
        $hostname{$id}=$name;
        $hostdom{$id}=$domain;
+       $hostip{$id}=$ip;
        if ($role eq 'library') { $libserv{$id}=$name; }
     }
 }
@@ -2126,8 +2371,10 @@ if ($readit ne 'done') {
 
     while (my $configline=<$config>) {
        chomp($configline);
+      if ($configline) {
        my ($role,$perm)=split(/ /,$configline);
        if ($perm ne '') { $pr{$role}=$perm; }
+      }
     }
 }
 
@@ -2137,8 +2384,25 @@ if ($readit ne 'done') {
 
     while (my $configline=<$config>) {
        chomp($configline);
+      if ($configline) {
        my ($short,$plain)=split(/:/,$configline);
        if ($plain ne '') { $prp{$short}=$plain; }
+      }
+    }
+}
+
+# ---------------------------------------------------------- Read package table
+{
+    my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");
+
+    while (my $configline=<$config>) {
+       chomp($configline);
+       my ($short,$plain)=split(/:/,$configline);
+       my ($pack,$name)=split(/\&/,$short);
+       if ($plain ne '') {
+          $packagetab{$pack.'&'.$name.'&name'}=$name; 
+          $packagetab{$short}=$plain; 
+       }
     }
 }