--- loncom/lonnet/perl/lonnet.pm	2006/01/10 21:41:39	1.694
+++ loncom/lonnet/perl/lonnet.pm	2006/03/27 23:00:18	1.722
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.694 2006/01/10 21:41:39 albertel Exp $
+# $Id: lonnet.pm,v 1.722 2006/03/27 23:00:18 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -124,7 +124,7 @@ sub logperm {
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
-    my $peerfile="$perlvar{'lonSockDir'}/$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
@@ -152,7 +152,7 @@ sub subreply {
     }
     my $answer;
     if ($client) {
-	print $client "$cmd\n";
+	print $client "sethost:$server:$cmd\n";
 	$answer=<$client>;
 	if (!$answer) { $answer="con_lost"; }
 	chomp($answer);
@@ -260,6 +260,13 @@ sub critical {
 
 sub transfer_profile_to_env {
     my ($lonidsdir,$handle)=@_;
+    if (!defined($lonidsdir)) {
+	$lonidsdir = $perlvar{'lonIDsDir'};
+    }
+    if (!defined($handle)) {
+        ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
+    }
+
     my @profile;
     {
 	open(my $idf,"$lonidsdir/$handle.id");
@@ -843,6 +850,7 @@ sub save_cache {
     my ($r)=@_;
     if (! $r->is_initial_req()) { return DECLINED; }
     &purge_remembered();
+    #&Apache::loncommon::validate_page();
     undef(%env);
     return OK;
 }
@@ -947,13 +955,50 @@ sub userenvironment {
 sub studentphoto {
     my ($udom,$unam,$ext) = @_;
     my $home=&Apache::lonnet::homeserver($unam,$udom);
-    my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext",$home);
-    my $url="/uploaded/$udom/$unam/internal/studentphoto.".$ext;
-    if ($ret ne 'ok') {
-	return '/adm/lonKaputt/lonlogo_broken.gif';
+    if (defined($env{'request.course.id'})) {
+        if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
+            if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
+                return(&retrievestudentphoto($udom,$unam,$ext)); 
+            } else {
+                my ($result,$perm_reqd)=
+		    &Apache::lonnet::auto_photo_permission($unam,$udom);
+                if ($result eq 'ok') {
+                    if (!($perm_reqd eq 'yes')) {
+                        return(&retrievestudentphoto($udom,$unam,$ext));
+                    }
+                }
+            }
+        }
+    } else {
+        my ($result,$perm_reqd) = 
+	    &Apache::lonnet::auto_photo_permission($unam,$udom);
+        if ($result eq 'ok') {
+            if (!($perm_reqd eq 'yes')) {
+                return(&retrievestudentphoto($udom,$unam,$ext));
+            }
+        }
+    }
+    return '/adm/lonKaputt/lonlogo_broken.gif';
+}
+
+sub retrievestudentphoto {
+    my ($udom,$unam,$ext,$type) = @_;
+    my $home=&Apache::lonnet::homeserver($unam,$udom);
+    my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext:$type",$home);
+    if ($ret eq 'ok') {
+        my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";
+        if ($type eq 'thumbnail') {
+            $url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext"; 
+        }
+        my $tokenurl=&Apache::lonnet::tokenwrapper($url);
+        return $tokenurl;
+    } else {
+        if ($type eq 'thumbnail') {
+            return '/adm/lonKaputt/genericstudent_tn.gif';
+        } else { 
+            return '/adm/lonKaputt/lonlogo_broken.gif';
+        }
     }
-    my $tokenurl=&Apache::lonnet::tokenwrapper($url);
-    return $tokenurl;
 }
 
 # -------------------------------------------------------------------- New chat
@@ -1108,7 +1153,9 @@ sub ssi {
     my $ua=new LWP::UserAgent;
     
     my $request;
-    
+
+    $form{'no_update_last_known'}=1;
+
     if (%form) {
       $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
@@ -1281,7 +1328,7 @@ sub clean_filename {
 
 # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}
-#                    the desired filenam is in $env{"form.$formname"}
+#                    the desired filenam is in $env{"form.$formname.filename"}
 #        $coursedoc - if true up to the current course
 #                     if false
 #        $subdir - directory in userfile to store the file into
@@ -1292,7 +1339,7 @@ sub clean_filename {
 
 
 sub userfileupload {
-    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
+    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
@@ -1315,6 +1362,7 @@ sub userfileupload {
         close($fh);
         return $fullpath.'/'.$fname; 
     }
+    
 # Create the directory if not present
     $fname="$subdir/$fname";
     if ($coursedoc) {
@@ -1330,9 +1378,19 @@ sub userfileupload {
 				       $fname,$formname,$parser,
 				       $allfiles,$codebase);
         }
+    } elsif (defined($destuname)) {
+        my $docuname=$destuname;
+        my $docudom=$destudom;
+	return &finishuserfileupload($docuname,$docudom,$formname,
+				     $fname,$parser,$allfiles,$codebase);
+        
     } else {
         my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};
+        if (exists($env{'form.group'})) {
+            $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);
     }
@@ -1358,8 +1416,16 @@ sub finishuserfileupload {
     }
 # Save the file
     {
-	open(FH,'>'.$filepath.'/'.$file);
-	print FH $env{'form.'.$formname};
+	if (!open(FH,'>'.$filepath.'/'.$file)) {
+	    &logthis('Failed to create '.$filepath.'/'.$file);
+	    print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
+	    return '/adm/notfound.html';
+	}
+	if (!print FH ($env{'form.'.$formname})) {
+	    &logthis('Failed to write to '.$filepath.'/'.$file);
+	    print STDERR ('Failed to write to '.$filepath.'/'.$file."\n");
+	    return '/adm/notfound.html';
+	}
 	close(FH);
     }
     if ($parser eq 'parse') {
@@ -2785,7 +2851,7 @@ sub del {
 # -------------------------------------------------------------- dump interface
 
 sub dump {
-   my ($namespace,$udomain,$uname,$regexp)=@_;
+   my ($namespace,$udomain,$uname,$regexp,$range)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
@@ -2794,16 +2860,23 @@ sub dump {
    } else {
        $regexp='.';
    }
-   my $rep=reply("dump:$udomain:$uname:$namespace:$regexp",$uhome);
+   my $rep=reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
    my @pairs=split(/\&/,$rep);
    my %returnhash=();
    foreach (@pairs) {
-      my ($key,$value)=split(/=/,$_);
+      my ($key,$value)=split(/=/,$_,2);
       $returnhash{unescape($key)}=&thaw_unescape($value);
    }
    return %returnhash;
 }
 
+# --------------------------------------------------------- dumpstore interface
+
+sub dumpstore {
+   my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+   return &dump($namespace,$udomain,$uname,$regexp,$range);
+}
+
 # -------------------------------------------------------------- keys interface
 
 sub getkeys {
@@ -2945,25 +3018,53 @@ sub newput {
 # ---------------------------------------------------------  putstore interface
 
 sub putstore {
-   my ($namespace,$storehash,$udomain,$uname)=@_;
+   my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
-   my %allitems = ();
-   foreach (keys %$storehash) {
-       if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
-           my $key = $1.':keys:'.$2;
-           $allitems{$key} .= $3.':';
-       }
-       $items.=$_.'='.&freeze_escape($$storehash{$_}).'&';
-   }
-   foreach (keys %allitems) {
-       $allitems{$_} =~ s/\:$//;
-       $items.= $_.'='.$allitems{$_}.'&';
+   foreach my $key (keys(%$storehash)) {
+       $items.= &escape($key).'='.&freeze_escape($storehash->{$key}).'&';
    }
    $items=~s/\&$//;
-   return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+   my $esc_symb=&escape($symb);
+   my $esc_v=&escape($version);
+   my $reply =
+       &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
+	      $uhome);
+   if ($reply eq 'unknown_cmd') {
+       # gfall back to way things use to be done
+       return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
+			    $uname);
+   }
+   return $reply;
+}
+
+sub old_putstore {
+    my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
+    if (!$udomain) { $udomain=$env{'user.domain'}; }
+    if (!$uname) { $uname=$env{'user.name'}; }
+    my $uhome=&homeserver($uname,$udomain);
+    my %newstorehash;
+    foreach (keys %$storehash) {
+	my $key = $version.':'.&escape($symb).':'.$_;
+	$newstorehash{$key} = $storehash->{$_};
+    }
+    my $items='';
+    my %allitems = ();
+    foreach (keys %newstorehash) {
+	if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
+	    my $key = $1.':keys:'.$2;
+	    $allitems{$key} .= $3.':';
+	}
+	$items.=$_.'='.&freeze_escape($newstorehash{$_}).'&';
+    }
+    foreach (keys %allitems) {
+	$allitems{$_} =~ s/\:$//;
+	$items.= $_.'='.$allitems{$_}.'&';
+    }
+    $items=~s/\&$//;
+    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # ------------------------------------------------------ critical put interface
@@ -2975,7 +3076,7 @@ sub cput {
    my $uhome=&homeserver($uname,$udomain);
    my $items='';
    foreach (keys %$storehash) {
-       $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+       $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
    }
    $items=~s/\&$//;
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -3073,6 +3174,7 @@ sub customaccess {
 
 sub allowed {
     my ($priv,$uri,$symb)=@_;
+    my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
     $uri=&declutter($uri);
@@ -3085,12 +3187,29 @@ sub allowed {
     }
 
 # Free bre access to user's own portfolio contents
-    my ($space,$domain,$name,$dir)=split('/',$uri);
+    my ($space,$domain,$name,@dir)=split('/',$uri);
     if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
-	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
+	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) {
         return 'F';
     }
 
+# bre access to group if user has rgf priv for this group and course.
+    if (($space=~/^(uploaded|editupload)$/) && ($dir[0] eq 'groups') 
+         && ($dir[2] eq 'portfolio') && ($priv eq 'bre')) {
+        if (exists($env{'request.course.id'})) {
+            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            if (($domain eq $cdom) && ($name eq $cnum)) {
+                my $courseprivid=$env{'request.course.id'};
+                $courseprivid=~s/\_/\//;
+                if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid
+                    .'/'.$dir[1]} =~/rgf\&([^\:]*)/) {
+                    return $1; 
+                }
+            }
+        }
+    }
+
 # Free bre to public access
 
     if ($priv eq 'bre') {
@@ -3173,7 +3292,7 @@ sub allowed {
                 $thisallowed.=$1;
             }
         } else {
-            my $refuri=$env{'httpref.'.$orguri};
+            my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri};
             if ($refuri) {
                 if ($refuri =~ m|^/adm/|) {
                     $thisallowed='F';
@@ -3404,16 +3523,17 @@ sub allowed {
    return 'F';
 }
 
+sub split_uri_for_cond {
+    my $uri=&deversion(&declutter(shift));
+    my @uriparts=split(/\//,$uri);
+    my $filename=pop(@uriparts);
+    my $pathname=join('/',@uriparts);
+    return ($pathname,$filename);
+}
 # --------------------------------------------------- Is a resource on the map?
 
 sub is_on_map {
-    my $uri=&deversion(&declutter(shift));
-    my @uriparts=split(/\//,$uri);
-    my $filename=$uriparts[$#uriparts];
-    my $pathname=$uri;
-    $pathname=~s|/\Q$filename\E$||;
-    $pathname=~s/^adm\/wrapper\///;
-    $pathname=~s/^adm\/coursedocs\/showdoc\///;
+    my ($pathname,$filename) = &split_uri_for_cond(shift);
     #Trying to find the conditional for the file
     my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
 	       /\&\Q$filename\E\:([\d\|]+)\&/);
@@ -3686,6 +3806,82 @@ sub auto_create_password {
     return ($authparam,$create_passwd,$authchk);
 }
 
+sub auto_photo_permission {
+    my ($cnum,$cdom,$students) = @_;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my ($outcome,$perm_reqd,$conditions) = 
+	split(/:/,&unescape(&reply('autophotopermission:'.$cdom,$homeserver)),3);
+    if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
+    return ($outcome,$perm_reqd,$conditions);
+}
+
+sub auto_checkphotos {
+    my ($uname,$udom,$pid) = @_;
+    my $homeserver = &homeserver($uname,$udom);
+    my ($result,$resulttype);
+    my $outcome = &unescape(&reply('autophotocheck:'.&escape($udom).':'.
+				   &escape($uname).':'.&escape($pid),
+				   $homeserver));
+    if ($outcome =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
+    if ($outcome) {
+        ($result,$resulttype) = split(/:/,$outcome);
+    } 
+    return ($result,$resulttype);
+}
+
+sub auto_photochoice {
+    my ($cnum,$cdom) = @_;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my ($update,$comment) = split(/:/,&unescape(&reply('autophotochoice:'.
+						       &escape($cdom),
+						       $homeserver)));
+    if ($update =~ /^(con_lost|unknown_cmd|no_such_host)$/) {
+	return (undef,undef);
+    }
+    return ($update,$comment);
+}
+
+sub auto_photoupdate {
+    my ($affiliatesref,$dom,$cnum,$photo) = @_;
+    my $homeserver = &homeserver($cnum,$dom);
+    my $host=$hostname{$homeserver};
+    my $cmd = '';
+    my $maxtries = 1;
+    foreach (keys %{$affiliatesref}) {
+        $cmd .= $_.'='.join(",",@{$$affiliatesref{$_}}).'%%';
+    }
+    $cmd =~ s/%%$//;
+    $cmd = &escape($cmd);
+    my $query = 'institutionalphotos';
+    my $queryid=&reply("querysend:".$query.':'.$dom.':'.$cnum.':'.$cmd,$homeserver);
+    unless ($queryid=~/^\Q$host\E\_/) {
+        &logthis('institutionalphotos: invalid queryid: '.$queryid.' for host: '.$host.' and homeserver: '.$homeserver.' and course: '.$cnum);
+        return 'error: '.$queryid;
+    }
+    my $reply = &get_query_reply($queryid);
+    my $tries = 1;
+    while (($reply=~/^timeout/) && ($tries < $maxtries)) {
+        $reply = &get_query_reply($queryid);
+        $tries ++;
+    }
+    if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
+        &logthis('institutionalphotos error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' course: '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
+    } else {
+        my @responses = split(/:/,$reply);
+        my $outcome = shift(@responses); 
+        foreach my $item (@responses) {
+            my ($key,$value) = split(/=/,$item);
+            $$photo{$key} = $value;
+        }
+        return $outcome;
+    }
+    return 'error';
+}
+
 sub auto_instcode_format {
     my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
     my $courses = '';
@@ -4542,13 +4738,70 @@ sub GetFileTimestamp {
     }
 }
 
+sub stat_file {
+    my ($uri) = @_;
+    $uri = &clutter($uri);
+
+    # we want just the url part without the unneeded accessor url bits
+    if ($file =~ m-^/adm/-) {
+	$file=~s-^/adm/wrapper/-/-;
+	$file=~s-^/adm/coursedocs/showdoc/-/-;
+    }
+    
+    my ($udom,$uname,$file,$dir);
+    if ($uri =~ m-^/(uploaded|editupload)/-) {
+	($udom,$uname,$file) =
+	    ($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-);
+	$file = 'userfiles/'.$file;
+	$dir = &Apache::loncommon::propath($udom,$uname);
+    }
+    if ($uri =~ m-^/res/-) {
+	($udom,$uname) = 
+	    ($uri =~ m-/(?:res)/?([^/]*)/?([^/]*)/-);
+	$file = $uri;
+    }
+
+    if (!$udom || !$uname || !$file) {
+	# unable to handle the uri
+	return ();
+    }
+
+    my ($result) = &dirlist($file,$udom,$uname,$dir);
+    my @stats = split('&', $result);
+    
+    if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
+	shift(@stats); #filename is first
+	return @stats;
+    }
+    return ();
+}
+
 # -------------------------------------------------------- Value of a Condition
 
+# gets the value of a specific preevaluated condition
+#    stored in the string  $env{user.state.<cid>}
+# or looks up a condition reference in the bighash and if if hasn't
+# already been evaluated recurses into docondval to get the value of
+# the condition, then memoizing it to 
+#   $env{user.state.<cid>.<condition>}
 sub directcondval {
     my $number=shift;
     if (!defined($env{'user.state.'.$env{'request.course.id'}})) {
 	&Apache::lonuserstate::evalstate();
     }
+    if (exists($env{'user.state.'.$env{'request.course.id'}.".$number"})) {
+	return $env{'user.state.'.$env{'request.course.id'}.".$number"};
+    } elsif ($number =~ /^_/) {
+	my $sub_condition;
+	if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
+		&GDBM_READER(),0640)) {
+	    $sub_condition=$bighash{'conditions'.$number};
+	    untie(%bighash);
+	}
+	my $value = &docondval($sub_condition);
+	&appenv('user.state.'.$env{'request.course.id'}.".$number" => $value);
+	return $value;
+    }
     if ($env{'user.state.'.$env{'request.course.id'}}) {
        return substr($env{'user.state.'.$env{'request.course.id'}},$number,1);
     } else {
@@ -4556,43 +4809,49 @@ sub directcondval {
     }
 }
 
+# get the collection of conditions for this resource
 sub condval {
     my $condidx=shift;
-    my $result=0;
     my $allpathcond='';
-    foreach (split(/\|/,$condidx)) {
-       if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$_})) {
-	   $allpathcond.=
-               '('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$_}.')|';
-       }
+    foreach my $cond (split(/\|/,$condidx)) {
+	if (defined($env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond})) {
+	    $allpathcond.=
+		'('.$env{'acc.cond.'.$env{'request.course.id'}.'.'.$cond}.')|';
+	}
     }
     $allpathcond=~s/\|$//;
-    if ($env{'request.course.id'}) {
-       if ($allpathcond) {
-          my $operand='|';
-	  my @stack;
-           foreach ($allpathcond=~/(\d+|\(|\)|\&|\|)/g) {
-              if ($_ eq '(') {
-                 push @stack,($operand,$result)
-              } elsif ($_ eq ')') {
-                  my $before=pop @stack;
-		  if (pop @stack eq '&') {
-		      $result=$result>$before?$before:$result;
-                  } else {
-                      $result=$result>$before?$result:$before;
-                  }
-              } elsif (($_ eq '&') || ($_ eq '|')) {
-                  $operand=$_;
-              } else {
-                  my $new=directcondval($_);
-                  if ($operand eq '&') {
-                     $result=$result>$new?$new:$result;
-                  } else {
-                     $result=$result>$new?$result:$new;
-                  }
-              }
-          }
-       }
+    return &docondval($allpathcond);
+}
+
+#evaluates an expression of conditions
+sub docondval {
+    my ($allpathcond) = @_;
+    my $result=0;
+    if ($env{'request.course.id'}
+	&& defined($allpathcond)) {
+	my $operand='|';
+	my @stack;
+	foreach my $chunk ($allpathcond=~/(\d+|_\d+\.\d+|\(|\)|\&|\|)/g) {
+	    if ($chunk eq '(') {
+		push @stack,($operand,$result);
+	    } elsif ($chunk eq ')') {
+		my $before=pop @stack;
+		if (pop @stack eq '&') {
+		    $result=$result>$before?$before:$result;
+		} else {
+		    $result=$result>$before?$result:$before;
+		}
+	    } elsif (($chunk eq '&') || ($chunk eq '|')) {
+		$operand=$chunk;
+	    } else {
+		my $new=directcondval($chunk);
+		if ($operand eq '&') {
+		    $result=$result>$new?$new:$result;
+		} else {
+		    $result=$result>$new?$result:$new;
+		}
+	    }
+	}
     }
     return $result;
 }
@@ -4709,8 +4968,8 @@ sub EXT_cache_set {
 
 # --------------------------------------------------------- Value of a Variable
 sub EXT {
-    my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
 
+    my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
     unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb
     my $courseid;
@@ -4965,6 +5224,11 @@ sub EXT {
 	if ($space eq 'time') {
 	    return time;
         }
+    } elsif ($realm eq 'server') {
+# ----------------------------------------------------------------- system.time
+	if ($space eq 'name') {
+	    return $ENV{'SERVER_NAME'};
+        }
     }
     return '';
 }
@@ -4988,10 +5252,7 @@ sub check_group_parms {
 
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($grouplist,$courseid) = @_;
-    my @groups = split/:/,$grouplist;
-    if (@groups > 1) {
-        @groups = sort(@groups);
-    }
+    my @groups = sort(split(/:/,$grouplist));
     return @groups;
 }
 
@@ -5037,8 +5298,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)
-	  && ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
 	($uri =~ m|home/[^/]+/public_html/|)) {
 	return undef;
@@ -5223,7 +5483,7 @@ sub metadata {
 	$metaentry{':keys'}=join(',',keys %metathesekeys);
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache_new('meta',$uri,\%metaentry,60*60*24);
+	&do_cache_new('meta',$uri,\%metaentry,60*60);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -5319,10 +5579,17 @@ sub get_slot {
 	$cdom=$env{'course.'.$courseid.'.domain'};
 	$cnum=$env{'course.'.$courseid.'.num'};
     }
-    my %slotinfo=&get('slots',[$which],$cdom,$cnum);
-    &Apache::lonhomework::showhash(%slotinfo);
-    my ($tmp)=keys(%slotinfo);
-    if ($tmp=~/^error:/) { return (); }
+    my $key=join("\0",'slots',$cdom,$cnum,$which);
+    my %slotinfo;
+    if (exists($remembered{$key})) {
+	$slotinfo{$which} = $remembered{$key};
+    } else {
+	%slotinfo=&get('slots',[$which],$cdom,$cnum);
+	&Apache::lonhomework::showhash(%slotinfo);
+	my ($tmp)=keys(%slotinfo);
+	if ($tmp=~/^error:/) { return (); }
+	$remembered{$key} = $slotinfo{$which};
+    }
     if (ref($slotinfo{$which}) eq 'HASH') {
 	return %{$slotinfo{$which}};
     }
@@ -5337,9 +5604,12 @@ sub symblist {
     if (($env{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_WRCREAT(),0640)) {
-	    foreach (keys %newhash) {
-                $hash{declutter($_)}=&encode_symb($mapname,$newhash{$_}->[1],
-						  $newhash{$_}->[0]);
+	    foreach my $url (keys %newhash) {
+		next if ($url eq 'last_known'
+			 && $env{'form.no_update_last_known'});
+		$hash{declutter($url)}=&encode_symb($mapname,
+						    $newhash{$url}->[1],
+						    $newhash{$url}->[0]);
             }
             if (untie(%hash)) {
 		return 'ok';
@@ -6062,6 +6332,11 @@ sub filelocation {
     my ($dir,$file) = @_;
     my $location;
     $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
+
+    if ($file =~ m-^/adm/-) {
+	$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:;
@@ -6101,6 +6376,9 @@ sub hreflocation {
     my ($dir,$file)=@_;
     unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
 	$file=filelocation($dir,$file);
+    } elsif ($file=~m-^/adm/-) {
+	$file=~s-^/adm/wrapper/-/-;
+	$file=~s-^/adm/coursedocs/showdoc/-/-;
     }
     if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
 	$file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
@@ -6144,10 +6422,10 @@ sub declutter {
     if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
     $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
     $thisfn=~s/^\///;
+    $thisfn=~s|^adm/wrapper/||;
+    $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
     $thisfn=~s/\?.+$//;
-    $thisfn=~s|adm/wrapper/||;
-    $thisfn=~s|adm/coursedocs/showdoc/||;
     return $thisfn;
 }
 
@@ -6159,19 +6437,29 @@ sub clutter {
        $thisfn='/res'.$thisfn; 
     }
     if ($thisfn !~m|/adm|) {
-	my ($ext) = ($thisfn =~ /\.(\w+)$/);
-	my $embstyle=&Apache::loncommon::fileembstyle($ext);
-	if (($embstyle eq 'img') 
-	    || ($embstyle eq 'emb')
-	    || ($embstyle eq 'wrp')) {
+	if ($thisfn =~ m|/ext/|) {
 	    $thisfn='/adm/wrapper'.$thisfn;
-	} elsif ($embstyle eq 'ssi') {
-	    #do nothing with these
-	} elsif ($thisfn!~/\.(sequence|page)$/) {
-	    $thisfn='/adm/coursedocs/showdoc'.$thisfn;
+	} else {
+	    my ($ext) = ($thisfn =~ /\.(\w+)$/);
+	    my $embstyle=&Apache::loncommon::fileembstyle($ext);
+	    if ($embstyle eq 'ssi'
+		|| ($embstyle eq 'hdn')
+		|| ($embstyle eq 'rat')
+		|| ($embstyle eq 'prv')
+		|| ($embstyle eq 'ign')) {
+		#do nothing with these
+	    } elsif (($embstyle eq 'img') 
+		|| ($embstyle eq 'emb')
+		|| ($embstyle eq 'wrp')) {
+		$thisfn='/adm/wrapper'.$thisfn;
+	    } elsif ($embstyle eq 'unk'
+		     && $thisfn!~/\.(sequence|page)$/) {
+		$thisfn='/adm/coursedocs/showdoc'.$thisfn;
+	    } else {
+#		&logthis("Got a blank emb style");
+	    }
 	}
     }
-
     return $thisfn;
 }
 
@@ -6989,6 +7277,27 @@ all args are optional
 
 =item *
 
+dumpstore($namespace,$udom,$uname,$regexp,$range) : 
+dumps the complete (or key matching regexp) namespace into a hash
+($udom, $uname, $regexp, $range are optional) for a namespace that is
+normally &store()ed into
+
+$range should be either an integer '100' (give me the first 100
+                                           matching records)
+              or be  two integers sperated by a - with no spaces
+                 '30-50' (give me the 30th through the 50th matching
+                          records)
+
+
+=item *
+
+putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :
+replaces a &store() version of data with a replacement set of data
+for a particular resource in a namespace passed in the $storehash hash 
+reference
+
+=item *
+
 tmpstore($storehash,$symb,$namespace,$udom,$uname) : storage that
 works very similar to store/cstore, but all data is stored in a
 temporary location and can be reset using tmpreset, $storehash should
@@ -7018,10 +7327,15 @@ namesp ($udom and $uname are optional)
 
 =item *
 
-dump($namespace,$udom,$uname,$regexp) : 
+dump($namespace,$udom,$uname,$regexp,$range) : 
 dumps the complete (or key matching regexp) namespace into a hash
-($udom, $uname and $regexp are optional)
+($udom, $uname, $regexp, $range are optional)
 
+$range should be either an integer '100' (give me the first 100
+                                           matching records)
+              or be  two integers sperated by a - with no spaces
+                 '30-50' (give me the 30th through the 50th matching
+                          records)
 =item *
 
 inc($namespace,$store,$udom,$uname) : increments $store in $namespace.
@@ -7037,17 +7351,6 @@ put($namespace,$storehash,$udom,$uname)
 
 =item *
 
-putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp
-keys used in storehash include version information (e.g., 1:$symb:message etc.) as
-used in records written by &store and retrieved by &restore.  This function 
-was created for use in editing discussion posts, without incrementing the
-version number included in the key for a particular post. The colon 
-separated list of attribute names (e.g., the value associated with the key 
-1:keys:$symb) is also generated and passed in the ampersand separated 
-items sent to lonnet::reply().  
-
-=item *
-
 cput($namespace,$storehash,$udom,$uname) : critical put
 ($udom and $uname are optional)
 
@@ -7177,6 +7480,16 @@ getfile($file,$caller) : two cases - req
    - returns the entire contents of a file or -1; 
    it properly subscribes to and replicates the file if neccessary.
 
+
+=item *
+
+stat_file($url) : $url is expected to be a /res/ or /uploaded/ style file
+                  reference
+
+returns either a stat() list of data about the file or an empty list
+if the file doesn't exist or couldn't find out about it (connection
+problems or user unknown)
+
 =item *
 
 filelocation($dir,$file) : returns file system location of a file