--- loncom/lonnet/perl/lonnet.pm	2003/03/22 21:23:35	1.345
+++ loncom/lonnet/perl/lonnet.pm	2003/05/10 23:00:39	1.373
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.345 2003/03/22 21:23:35 www Exp $
+# $Id: lonnet.pm,v 1.373 2003/05/10 23:00:39 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -74,8 +74,8 @@ use HTTP::Headers;
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache 
-   %courselogs %accesshash $processmarker $dumpcount 
-   %coursedombuf %coursehombuf %courseresdatacache 
+   %courselogs %accesshash %userrolehash $processmarker $dumpcount 
+   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache 
    %domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir);
 use IO::Socket;
 use GDBM_File;
@@ -347,6 +347,30 @@ sub delenv {
     return 'ok';
 }
 
+# ------------------------------------------ Find out current server userload
+# there is a copy in lond
+sub userload {
+    my $numusers=0;
+    {
+	opendir(LONIDS,$perlvar{'lonIDsDir'});
+	my $filename;
+	my $curtime=time;
+	while ($filename=readdir(LONIDS)) {
+	    if ($filename eq '.' || $filename eq '..') {next;}
+	    my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];
+	    if ($curtime-$atime < 3600) { $numusers++; }
+	}
+	closedir(LONIDS);
+    }
+    my $userloadpercent=0;
+    my $maxuserload=$perlvar{'lonUserLoadLim'};
+    if ($maxuserload) {
+	$userloadpercent=100*$numusers/$maxuserload;
+    }
+    $userloadpercent=sprintf("%.2f",$userloadpercent);
+    return $userloadpercent;
+}
+
 # ------------------------------------------ Fight off request when overloaded
 
 sub overloaderror {
@@ -373,17 +397,23 @@ sub overloaderror {
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my $loadpercent = shift;
+    my ($loadpercent,$userloadpercent) = @_;
     my $tryserver;
     my $spareserver='';
-    my $lowestserver=$loadpercent; 
+    if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
+    my $lowestserver=$loadpercent > $userloadpercent?
+	             $loadpercent :  $userloadpercent;
     foreach $tryserver (keys %spareid) {
-       my $answer=reply('load',$tryserver);
+       my $loadans=reply('load',$tryserver);
+       my $userloadans=reply('userload',$tryserver);
+       if ($userloadans !~ /\d/) { $userloadans=0; }
+       my $answer=$loadans > $userloadans?
+                  $loadans :  $userloadans;
        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
 	   $spareserver="http://$hostname{$tryserver}";
            $lowestserver=$answer;
        }
-    }    
+    }
     return $spareserver;
 }
 
@@ -591,7 +621,11 @@ sub idput {
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
-    my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+    my ($ckey,$cdom,$cnum,$udom,$uname,$logentry)=@_;
     $cdom=
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
     $cnum=
@@ -599,15 +633,18 @@ sub assign_access_key {
     $udom=$ENV{'user.name'} unless (defined($udom));
     $uname=$ENV{'user.domain'} unless (defined($uname));
     my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
-    if (($existing{$ckey}=~/^\d+$/) || # has time - new key
-        ($existing{$ckey} eq $udom.':'.$uname)) { # this should not happen,
+    if (($existing{$ckey}=~/^\#(.*)$/) || # - new key
+        ($existing{$ckey}=~/^$uname\:$udom\#(.*)$/)) { 
+                                                  # assigned to this person
+                                                  # - this should not happen,
                                                   # unless something went wrong
                                                   # the first time around
 # ready to assign
-    } elsif (!$existing{$ckey}) {
-        if (&put('accesskey',{$ckey=>$udom.':'.$uname},$cdom,$cnum) eq 'ok') {
+        $logentry=$1.'; '.$logentry;
+        if (&put('accesskey',{$ckey=>$uname.':'.$udom.'#'.$logentry},
+                                                 $cdom,$cnum) eq 'ok') {
 # key now belongs to user
-	    my $envkey='key.'.$cdom.'.'.$cnum;
+	    my $envkey='key.'.$cdom.'_'.$cnum;
             if (&put('environment',{$envkey => $ckey}) eq 'ok') {
                 &appenv('environment.'.$envkey => $ckey);
                 return 'ok';
@@ -618,6 +655,7 @@ sub assign_access_key {
         } else {
             return 'error: Could not assign key, try again later.';
         }
+    } elsif (!$existing{$ckey}) {
 # the key does not exist
 	return 'error: The key does not exist';
     } else {
@@ -626,15 +664,43 @@ sub assign_access_key {
     }
 }
 
+# ------------------------------------------ put an additional comment on a key
+
+sub comment_access_key {
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+    my ($ckey,$cdom,$cnum,$logentry)=@_;
+    $cdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+    $cnum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+    my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
+    if ($existing{$ckey}) {
+        $existing{$ckey}.='; '.$logentry;
+# ready to assign
+        if (&put('accesskeys',{$ckey=>$existing{$ckey}},
+                                                 $cdom,$cnum) eq 'ok') {
+	    return 'ok';
+        } else {
+	    return 'error: Count not store comment.';
+        }
+    } else {
+# the key does not exist
+	return 'error: The key does not exist';
+    }
+}
+
 # ------------------------------------------------------ Generate a set of keys
 
 sub generate_access_keys {
-    my ($number,$cdom,$cnum)=@_;
+    my ($number,$cdom,$cnum,$logentry)=@_;
     $cdom=
    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
     $cnum=
    $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
-    unless (&allowed('ccc',$cdom)) { return 0; }
+    unless (&allowed('mky',$cdom)) { return 0; }
     unless (($cdom) && ($cnum)) { return 0; }
     if ($number>10000) { return 0; }
     sleep(2); # make sure don't get same seed twice
@@ -650,7 +716,11 @@ sub generate_access_keys {
        if ($existing{$newkey}) {
            $i--;
        } else {
-	  if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') {
+	  if (&put('accesskeys',
+              { $newkey => '# generated '.localtime().
+                           ' by '.$ENV{'user.name'}.'@'.$ENV{'user.domain'}.
+                           '; '.$logentry },
+		   $cdom,$cnum) eq 'ok') {
               $total++;
 	  }
        }
@@ -671,7 +741,7 @@ sub validate_access_key {
     $udom=$ENV{'user.name'} unless (defined($udom));
     $uname=$ENV{'user.domain'} unless (defined($uname));
     my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
-    return ($existing{$ckey} eq $udom.':'.$uname);
+    return ($existing{$ckey}=~/^$uname\:$udom\#/);
 }
 
 # ------------------------------------- Find the section of student in a course
@@ -1027,12 +1097,24 @@ sub log {
 }
 
 # ------------------------------------------------------------------ Course Log
+#
+# This routine flushes several buffers of non-mission-critical nature
+#
 
 sub flushcourselogs {
-    &logthis('Flushing course log buffers');
+    &logthis('Flushing log buffers');
+#
+# course logs
+# This is a log of all transactions in a course, which can be used
+# for data mining purposes
+#
+# It also collects the courseid database, which lists last transaction
+# times and course titles for all courseids
+#
+    my %courseidbuffer=();
     foreach (keys %courselogs) {
         my $crsid=$_;
-        if (&reply('log:'.$coursedombuf{$crsid}.':'.
+        if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
 		          &escape($courselogs{$crsid}),
 		          $coursehombuf{$crsid}) eq 'ok') {
 	    delete $courselogs{$crsid};
@@ -1043,9 +1125,26 @@ sub flushcourselogs {
                         " exceeded maximum size, deleting.</font>");
                delete $courselogs{$crsid};
             }
-        }        
+        }
+        if ($courseidbuffer{$coursehombuf{$crsid}}) {
+           $courseidbuffer{$coursehombuf{$crsid}}.='&'.
+			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid});
+        } else {
+           $courseidbuffer{$coursehombuf{$crsid}}=
+			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid});
+        }    
     }
-    &logthis('Flushing access logs');
+#
+# Write course id database (reverse lookup) to homeserver of courses 
+# Is used in pickcourse
+#
+    foreach (keys %courseidbuffer) {
+        &courseidput($hostdom{$_},$courseidbuffer{$_},$_);
+    }
+#
+# File accesses
+# Writes to the dynamic metadata of resources to get hit counts, etc.
+#
     foreach (keys %accesshash) {
         my $entry=$_;
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
@@ -1054,6 +1153,20 @@ sub flushcourselogs {
 	    delete $accesshash{$entry};
         }
     }
+#
+# Roles
+# Reverse lookup of user roles for course faculty/staff and co-authorship
+#
+    foreach (keys %userrolehash) {
+        my $entry=$_;
+        my ($role,$uname,$udom,$runame,$rudom,$rsec)=
+	    split(/\:/,$entry);
+        if (&Apache::lonnet::put('nohist_userroles',
+             { $role.':'.$uname.':'.$udom.':'.$rsec => $userrolehash{$entry} },
+                $rudom,$runame) eq 'ok') {
+	    delete $userrolehash{$entry};
+        }
+    }
     $dumpcount++;
 }
 
@@ -1062,10 +1175,13 @@ sub courselog {
     $what=time.':'.$what;
     unless ($ENV{'request.course.id'}) { return ''; }
     $coursedombuf{$ENV{'request.course.id'}}=
-       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+       $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+    $coursenumbuf{$ENV{'request.course.id'}}=
        $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
     $coursehombuf{$ENV{'request.course.id'}}=
        $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+    $coursedescrbuf{$ENV{'request.course.id'}}=
+       $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
     if (defined $courselogs{$ENV{'request.course.id'}}) {
 	$courselogs{$ENV{'request.course.id'}}.='&'.$what;
     } else {
@@ -1102,7 +1218,83 @@ sub countacc {
         $accesshash{$key}=1;
     }
 }
-    
+
+sub linklog {
+    my ($from,$to)=@_;
+    $from=&declutter($from);
+    $to=&declutter($to);
+    $accesshash{$from.'___'.$to.'___comefrom'}=1;
+    $accesshash{$to.'___'.$from.'___goto'}=1;
+}
+  
+sub userrolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
+    if (($trole=~/^ca/) || ($trole=~/^in/) || 
+        ($trole=~/^cc/) || ($trole=~/^ep/) ||
+        ($trole=~/^cr/)) {
+       my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
+       $userrolehash
+         {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
+                    =$tend.':'.$tstart;
+   }
+}
+
+sub get_course_adv_roles {
+    my $cid=shift;
+    $cid=$ENV{'request.course.id'} unless (defined($cid));
+    my %coursehash=&coursedescription($cid);
+    my %returnhash=();
+    my %dumphash=
+            &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
+    my $now=time;
+    foreach (keys %dumphash) {
+	my ($tend,$tstart)=split(/\:/,$dumphash{$_});
+        if (($tstart) && ($tstart<0)) { next; }
+        if (($tend) && ($tend<$now)) { next; }
+        if (($tstart) && ($now<$tstart)) { next; }
+        my ($role,$username,$domain,$section)=split(/\:/,$_);
+        my $key=&plaintext($role);
+        if ($section) { $key.=' (Sec/Grp '.$section.')'; }
+        if ($returnhash{$key}) {
+	    $returnhash{$key}.=','.$username.':'.$domain;
+        } else {
+            $returnhash{$key}=$username.':'.$domain;
+        }
+     }
+    return %returnhash;
+}
+
+# ---------------------------------------------------------- Course ID routines
+# Deal with domain's nohist_courseid.db files
+#
+
+sub courseidput {
+    my ($domain,$what,$coursehome)=@_;
+    return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+}
+
+sub courseiddump {
+    my ($domfilter,$descfilter,$sincefilter)=@_;
+    my %returnhash=();
+    unless ($domfilter) { $domfilter=''; }
+    foreach my $tryserver (keys %libserv) {
+	if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) {
+	    foreach (
+             split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
+			       $sincefilter.':'.&escape($descfilter),
+                               $tryserver))) {
+		my ($key,$value)=split(/\=/,$_);
+                if (($key) && ($value)) {
+		    $returnhash{&unescape($key)}=&unescape($value);
+                }
+            }
+
+        }
+    }
+    return %returnhash;
+}
+
+#
 # ----------------------------------------------------------- Check out an item
 
 sub checkout {
@@ -1707,6 +1899,8 @@ sub rolesinit {
             my ($trole,$tend,$tstart)=split(/_/,$role);
             $userroles.='user.role.'.$trole.'.'.$area.'='.
                         $tstart.'.'.$tend."\n";
+# log the associated role with the area
+            &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
             if ($tend!=0) {
 	        if ($tend<$now) {
 	            $trole='';
@@ -1718,42 +1912,54 @@ sub rolesinit {
                 }
             }
             if (($area ne '') && ($trole ne '')) {
-	       my $spec=$trole.'.'.$area;
-               my ($tdummy,$tdomain,$trest)=split(/\//,$area);
-               if ($trole =~ /^cr\//) {
-		   my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
-                   my $homsvr=homeserver($rauthor,$rdomain);
-                   if ($hostname{$homsvr} ne '') {
-                      my $roledef=
-			  reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole",
-                                $homsvr);
-                      if (($roledef ne 'con_lost') && ($roledef ne '')) {
-                         my ($syspriv,$dompriv,$coursepriv)=
-			     split(/\_/,unescape($roledef));
- 	                 $allroles{'cm./'}.=':'.$syspriv;
-                         $allroles{$spec.'./'}.=':'.$syspriv;
-                         if ($tdomain ne '') {
-                             $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
-                             $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
-                             if ($trest ne '') {
-		                $allroles{'cm.'.$area}.=':'.$coursepriv;
-		                $allroles{$spec.'.'.$area}.=':'.$coursepriv;
-                             }
-	                 }
-                      }
-                   }
-               } else {
-	           $allroles{'cm./'}.=':'.$pr{$trole.':s'};
-	           $allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
-                   if ($tdomain ne '') {
-                     $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
-                     $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
-                      if ($trest ne '') {
-		          $allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
-		          $allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
-                      }
-	           }
-	       }
+		my $spec=$trole.'.'.$area;
+		my ($tdummy,$tdomain,$trest)=split(/\//,$area);
+		if ($trole =~ /^cr\//) {
+		    my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
+		    my $homsvr=homeserver($rauthor,$rdomain);
+		    if ($hostname{$homsvr} ne '') {
+			my $roledef=
+			    reply("get:$rdomain:$rauthor:roles:rolesdef_$rrole",
+				  $homsvr);
+			if (($roledef ne 'con_lost') && ($roledef ne '')) {
+			    my ($syspriv,$dompriv,$coursepriv)=
+				split(/\_/,unescape($roledef));
+			    if (defined($syspriv)) {
+				$allroles{'cm./'}.=':'.$syspriv;
+				$allroles{$spec.'./'}.=':'.$syspriv;
+			    }
+			    if ($tdomain ne '') {
+				if (defined($dompriv)) {
+				    $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
+				    $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
+				}
+				if ($trest ne '') {
+				    if (defined($coursepriv)) {
+					$allroles{'cm.'.$area}.=':'.$coursepriv;
+					$allroles{$spec.'.'.$area}.=':'.$coursepriv;
+				    }
+				}
+			    }
+			}
+		    }
+		} else {
+		    if (defined($pr{$trole.':s'})) {
+			$allroles{'cm./'}.=':'.$pr{$trole.':s'};
+			$allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
+		    }
+		    if ($tdomain ne '') {
+			if (defined($pr{$trole.':d'})) {
+			    $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+			    $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+			}
+			if ($trest ne '') {
+			    if (defined($pr{$trole.':c'})) {
+				$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
+				$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
+			    }
+			}
+		    }
+		}
             }
           } 
         }
@@ -2422,7 +2628,7 @@ sub plaintext {
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
-    my ($udom,$uname,$url,$role,$end,$start)=@_;
+    my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
     my $mrole;
     if ($role =~ /^cr\//) {
 	unless (&allowed('ccr',$url)) {
@@ -2435,7 +2641,7 @@ sub assignrole {
     } else {
         my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
-        unless (&allowed('c'.$role,$cwosec)) { 
+        unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { 
            &logthis('Refused assignrole: '.
              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
 		    $ENV{'user.name'}.' at '.$ENV{'user.domain'});
@@ -2453,7 +2659,25 @@ sub assignrole {
            $command.='_0_'.$start;
         }
     }
-    return &reply($command,&homeserver($uname,$udom));
+# actually delete
+    if ($deleteflag) {
+	if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
+# modify command to delete the role
+           $command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:".
+                "$udom:$uname:$url".'_'."$mrole";
+	   &logthis("$ENV{'user.name'} at $ENV{'user.domain'} deletes $mrole in $url for $uname at $udom"); 
+# set start and finish to negative values for userrolelog
+           $start=-1;
+           $end=-1;
+        }
+    }
+# send command
+    my $answer=&reply($command,&homeserver($uname,$udom));
+# log new user role if status is ok
+    if ($answer eq 'ok') {
+	&userrolelog($mrole,$uname,$udom,$url,$start,$end);
+    }
+    return $answer;
 }
 
 # -------------------------------------------------- Modify user authentication
@@ -2699,6 +2923,11 @@ sub createcourse {
 	return 'error: no such course';
     }
 # ----------------------------------------------------------------- Course made
+# log existance
+    &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description),
+                 $uhome);
+    &flushcourselogs();
+# set toplevel url
     my $topurl=$url;
     unless ($nonstandard) {
 # ------------------------------------------ For standard courses, make top url
@@ -2727,25 +2956,26 @@ ENDINITMAP
 # ---------------------------------------------------------- Assign Custom Role
 
 sub assigncustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag)=@_;
     return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
-                       $end,$start);
+                       $end,$start,$deleteflag);
 }
 
 # ----------------------------------------------------------------- Revoke Role
 
 sub revokerole {
-    my ($udom,$uname,$url,$role)=@_;
+    my ($udom,$uname,$url,$role,$deleteflag)=@_;
     my $now=time;
-    return &assignrole($udom,$uname,$url,$role,$now);
+    return &assignrole($udom,$uname,$url,$role,$now,$deleteflag);
 }
 
 # ---------------------------------------------------------- Revoke Custom Role
 
 sub revokecustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag)=@_;
     my $now=time;
-    return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now);
+    return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,
+           $deleteflag);
 }
 
 # ------------------------------------------------------------ Directory lister
@@ -2943,8 +3173,10 @@ sub EXT {
     unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb
     my $courseid;
+    my $publicuser;
     if (!($uname && $udom)) {
-      (my $cursymb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+      (my $cursymb,$courseid,$udom,$uname,$publicuser)=
+	  &Apache::lonxml::whichuser();
       if (!$symbparm) {	$symbparm=$cursymb; }
     } else {
 	$courseid=$ENV{'request.course.id'};
@@ -2967,7 +3199,12 @@ sub EXT {
 	    if (defined($Apache::lonhomework::parsing_a_problem)) {
 		return $Apache::lonhomework::history{$qualifierrest};
 	    } else {
-		my %restored=&restore($symbparm,$courseid,$udom,$uname);
+		my %restored;
+		if ($publicuser || $ENV{'request.state'} eq 'construct') {
+		    %restored=&tmprestore($symbparm,$courseid,$udom,$uname);
+		} else {
+		    %restored=&restore($symbparm,$courseid,$udom,$uname);
+		}
 		return $restored{$qualifierrest};
 	    }
 # ----------------------------------------------------------------- user.access
@@ -2980,7 +3217,11 @@ sub EXT {
 		($udom eq $ENV{'user.domain'})) {
 		return $ENV{join('.',('environment',$qualifierrest))};
 	    } else {
-		my %returnhash=&userenvironment($udom,$uname,$qualifierrest);
+		my %returnhash;
+		if (!$publicuser) {
+		    %returnhash=&userenvironment($udom,$uname,
+						 $qualifierrest);
+		}
 		return $returnhash{$qualifierrest};
 	    }
 # ----------------------------------------------------------------- user.course
@@ -3004,8 +3245,11 @@ sub EXT {
             return $uname;
 # ---------------------------------------------------- Any other user namespace
         } else {
-            my %reply=&get($space,[$qualifierrest],$udom,$uname);
-            return $reply{$qualifierrest};
+	    my %reply;
+	    if (!$publicuser) {
+		%reply=&get($space,[$qualifierrest],$udom,$uname);
+	    }
+	    return $reply{$qualifierrest};
         }
     } elsif ($realm eq 'query') {
 # ---------------------------------------------- pull stuff out of query string
@@ -3024,7 +3268,7 @@ sub EXT {
         return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
 
-	if ($courseid eq $ENV{'request.course.id'}) {
+	if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
 
 	    #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
 
@@ -3198,6 +3442,7 @@ sub metadata {
         my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         undef %metathesekeys;
+	delete($metacache{$uri.':packages'});
         while ($token=$parser->get_token) {
 	    if ($token->[0] eq 'S') {
 		if (defined($token->[2]->{'package'})) {
@@ -3224,16 +3469,20 @@ sub metadata {
 				$value.=' [Part: '.$part.']';
 			    }
 			    my $unikey='parameter'.$keyroot.'_'.$name;
-			    if ($subp eq 'default') { $unikey='parameter_0_'.$name; }
-			    $metathesekeys{$unikey}=1;
-			    $metacache{$uri.':'.$unikey.'.part'}=$part;
+			    if ($subp eq 'default') {
+				$unikey='parameter_0_'.$name;
+				$metacache{$uri.':'.$unikey.'.part'}='0';
+			    } else {
+				$metacache{$uri.':'.$unikey.'.part'}=$part;
+				$metathesekeys{$unikey}=1;
+			    }
 			    unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
 				$metacache{$uri.':'.$unikey.'.'.$subp}=$value;
 			    }
 			    if (defined($metacache{$uri.':'.$unikey.'.default'})) {
 				$metacache{$uri.':'.$unikey}=
-				    $metacache{$uri.':'.$unikey.'.default'}
-				}
+				    $metacache{$uri.':'.$unikey.'.default'};
+			    }
 			}
 		    }
 		} else {
@@ -3329,7 +3578,7 @@ sub metadata_generate_part0 {
 	if ($metakey=~/^parameter\_(.*)/) {
 	  my $part=$$metacache{$uri.':'.$metakey.'.part'};
 	  my $name=$$metacache{$uri.':'.$metakey.'.name'};
-	  if (! exists($$metadata{'parameter_0_'.$name})) {
+	  if (! exists($$metadata{'parameter_0_'.$name.'.name'})) {
 	    $allnames{$name}=$part;
 	  }
 	}
@@ -3369,6 +3618,7 @@ sub gettitle {
         $title=$bighash{'title_'.$mapid.'.'.$resid};
         untie %bighash;
     }
+    $title=~s/\&colon\;/\:/gs;
     if ($title) {
         $titlecache{$symb}=$title;
         return $title;
@@ -3542,29 +3792,92 @@ sub numval {
     $txt=~tr/u-z/0-5/;
     $txt=~s/\D//g;
     return int($txt);
-}    
+}
+
+sub latest_rnd_algorithm_id {
+    return '64bit';
+}
 
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
+
+    my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser();
     if (!$symb) {
-      unless ($symb=&symbread()) { return time; }
+	unless ($symb=$wsymb) { return time; }
+    }
+    if (!$courseid) { $courseid=$wcourseid; }
+    if (!$domain) { $domain=$wdomain; }
+    if (!$username) { $username=$wusername }
+    my $which=$ENV{"course.$courseid.rndseed"};
+    my $CODE=$ENV{'scantron.CODE'};
+    if (defined($CODE)) {
+	&rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+    } elsif ($which eq '64bit') {
+	return &rndseed_64bit($symb,$courseid,$domain,$username);
+    }
+    return &rndseed_32bit($symb,$courseid,$domain,$username);
+}
+
+sub rndseed_32bit {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	my $symbchck=unpack("%32C*",$symb) << 27;
+	my $symbseed=numval($symb) << 22;
+	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;
+	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return $num;
     }
-    if (!$courseid) { $courseid=$ENV{'request.course.id'};}
-    if (!$domain) {$domain=$ENV{'user.domain'};}
-    if (!$username) {$username=$ENV{'user.name'};}
+}
+
+sub rndseed_64bit {
+    my ($symb,$courseid,$domain,$username)=@_;
     {
-      use integer;
-      my $symbchck=unpack("%32C*",$symb) << 27;
-      my $symbseed=numval($symb) << 22;
-      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");
-      #&Apache::lonxml::debug("rndseed :$num:$symb");
-      return $num;
+	use integer;
+	my $symbchck=unpack("%32S*",$symb) << 21;
+	my $symbseed=numval($symb) << 10;
+	my $namechck=unpack("%32S*",$username);
+	
+	my $nameseed=numval($username) << 21;
+	my $domainseed=unpack("%32S*",$domain) << 10;
+	my $courseseed=unpack("%32S*",$courseid);
+	
+	my $num1=$symbchck+$symbseed+$namechck;
+	my $num2=$nameseed+$domainseed+$courseseed;
+	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return "$num1,$num2";
+    }
+}
+
+sub rndseed_CODE_64bit {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	my $symbchck=unpack("%32S*",$symb) << 16;
+	my $symbseed=numval($symb);
+	my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
+	my $courseseed=unpack("%32S*",$courseid);
+	my $num1=$symbseed+$CODEseed;
+	my $num2=$courseseed+$symbchck;
+	#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
+	return "$num1,$num2";
+    }
+}
+
+sub setup_random_from_rndseed {
+    my ($rndseed)=@_;
+    if ($rndseed =~/,/) {
+	my ($num1,$num2)=split(/,/,$rndseed);
+	&Math::Random::random_set_seed(abs($num1),abs($num2));
+    } else {
+	&Math::Random::random_set_seed_from_phrase($rndseed);
     }
 }
 
@@ -3690,6 +4003,7 @@ sub goodbye {
    &logthis("Starting Shut down");
    &flushcourselogs();
    &logthis("Shutting down");
+   return DONE;
 }
 
 BEGIN {