--- loncom/lonnet/perl/lonnet.pm	2005/04/07 08:15:41	1.621
+++ loncom/lonnet/perl/lonnet.pm	2006/03/04 04:25:31	1.716
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.621 2005/04/07 08:15:41 albertel Exp $
+# $Id: lonnet.pm,v 1.716 2006/03/04 04:25:31 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,21 +37,23 @@ use HTTP::Date;
 use vars 
 qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom 
    %libserv %pr %prp $memcache %packagetab 
-   %courselogs %accesshash %userrolehash $processmarker $dumpcount 
+   %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
-   %env);
+   %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary
+   $tmpdir $_64bit %env);
 
 use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
 use HTML::LCParser;
+use HTML::Parser;
 use Fcntl qw(:flock);
-use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );
 use Cache::Memcached;
+use Digest::MD5;
+
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
@@ -122,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
@@ -150,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);
@@ -165,7 +167,7 @@ sub reply {
     unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
-       &logthis("<font color=blue>WARNING:".
+       &logthis("<font color=\"blue\">WARNING:".
                 " $cmd to $server returned $answer</font>");
     }
     return $answer;
@@ -189,14 +191,14 @@ sub reconlonc {
             sleep 5;
             if (-e "$peerfile") { return; }
             &logthis(
-  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
+  "<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>");
         } else {
 	    &logthis(
-               "<font color=blue>WARNING:".
+               "<font color=\"blue\">WARNING:".
                " lonc at pid $loncpid not responding, giving up</font>");
         }
     } else {
-     &logthis('<font color=blue>WARNING: lonc not running, giving up</font>');
+     &logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
     }
 }
 
@@ -205,7 +207,7 @@ sub reconlonc {
 sub critical {
     my ($cmd,$server)=@_;
     unless ($hostname{$server}) {
-        &logthis("<font color=blue>WARNING:".
+        &logthis("<font color=\"blue\">WARNING:".
                " Critical message to unknown server ($server)</font>");
         return 'no_such_host';
     }
@@ -239,12 +241,12 @@ sub critical {
             }
             chomp($wcmd);
             if ($wcmd eq $cmd) {
-		&logthis("<font color=blue>WARNING: ".
+		&logthis("<font color=\"blue\">WARNING: ".
                          "Connection buffer $dfilename: $cmd</font>");
                 &logperm("D:$server:$cmd");
 	        return 'con_delayed';
             } else {
-                &logthis("<font color=red>CRITICAL:"
+                &logthis("<font color=\"red\">CRITICAL:"
                         ." Critical connection failed: $server $cmd</font>");
                 &logperm("F:$server:$cmd");
                 return 'con_failed';
@@ -269,7 +271,7 @@ sub transfer_profile_to_env {
     my %Remove;
     for ($envi=0;$envi<=$#profile;$envi++) {
 	chomp($profile[$envi]);
-	my ($envname,$envvalue)=split(/=/,$profile[$envi]);
+	my ($envname,$envvalue)=split(/=/,$profile[$envi],2);
 	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
@@ -287,14 +289,14 @@ sub transfer_profile_to_env {
 
 sub appenv {
     my %newenv=@_;
-    foreach (keys %newenv) {
-	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
-            &logthis("<font color=blue>WARNING: ".
-                "Attempt to modify environment ".$_." to ".$newenv{$_}
+    foreach my $key (keys(%newenv)) {
+	if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) {
+            &logthis("<font color=\"blue\">WARNING: ".
+                "Attempt to modify environment ".$key." to ".$newenv{$key}
                 .'</font>');
-	    delete($newenv{$_});
+	    delete($newenv{$key});
         } else {
-            $env{$_}=$newenv{$_};
+            $env{$key}=$newenv{$key};
         }
     }
 
@@ -303,7 +305,7 @@ sub appenv {
 	return 'error: '.$!;
     }
     unless (flock($lockfh,LOCK_EX)) {
-         &logthis("<font color=blue>WARNING: ".
+         &logthis("<font color=\"blue\">WARNING: ".
                   'Could not obtain exclusive lock in appenv: '.$!);
          close($lockfh);
          return 'error: '.$!;
@@ -321,7 +323,7 @@ sub appenv {
     for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {
-	    my ($name,$value)=split(/=/,$oldenv[$i]);
+	    my ($name,$value)=split(/=/,$oldenv[$i],2);
 	    unless (defined($newenv{$name})) {
 		$newenv{$name}=$value;
 	    }
@@ -348,7 +350,7 @@ sub delenv {
     my $delthis=shift;
     my %newenv=();
     if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
-        &logthis("<font color=blue>WARNING: ".
+        &logthis("<font color=\"blue\">WARNING: ".
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
@@ -359,7 +361,7 @@ sub delenv {
 	    return 'error';
 	}
 	unless (flock($fh,LOCK_SH)) {
-	    &logthis("<font color=blue>WARNING: ".
+	    &logthis("<font color=\"blue\">WARNING: ".
 		     'Could not obtain shared lock in delenv: '.$!);
 	    close($fh);
 	    return 'error: '.$!;
@@ -373,17 +375,17 @@ sub delenv {
 	    return 'error';
 	}
 	unless (flock($fh,LOCK_EX)) {
-	    &logthis("<font color=blue>WARNING: ".
+	    &logthis("<font color=\"blue\">WARNING: ".
 		     'Could not obtain exclusive lock in delenv: '.$!);
 	    close($fh);
 	    return 'error: '.$!;
 	}
-	foreach (@oldenv) {
-	    if ($_=~/^$delthis/) { 
-                my ($key,undef) = split('=',$_);
+	foreach my $cur_key (@oldenv) {
+	    if ($cur_key=~/^$delthis/) { 
+                my ($key,undef) = split('=',$cur_key,2);
                 delete($env{$key});
             } else {
-                print $fh $_; 
+                print $fh $cur_key; 
             }
 	}
 	close($fh);
@@ -442,15 +444,15 @@ sub overloaderror {
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my ($loadpercent,$userloadpercent) = @_;
+    my ($loadpercent,$userloadpercent,$want_server_name) = @_;
     my $tryserver;
     my $spareserver='';
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
     my $lowestserver=$loadpercent > $userloadpercent?
 	             $loadpercent :  $userloadpercent;
-    foreach $tryserver (keys %spareid) {
-	my $loadans=reply('load',$tryserver);
-	my $userloadans=reply('userload',$tryserver);
+    foreach $tryserver (keys(%spareid)) {
+	my $loadans=&reply('load',$tryserver);
+	my $userloadans=&reply('userload',$tryserver);
 	if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
 	    next; #didn't get a number from the server
 	}
@@ -467,7 +469,11 @@ sub spareserver {
 	    $answer = $userloadans;
 	}
 	if (($answer =~ /\d/) && ($answer<$lowestserver)) {
-	    $spareserver="http://$hostname{$tryserver}";
+	    if ($want_server_name) {
+		$spareserver=$tryserver;
+	    } else {
+		$spareserver="http://$hostname{$tryserver}";
+	    }
 	    $lowestserver=$answer;
 	}
     }
@@ -766,6 +772,13 @@ sub validate_access_key {
 }
 
 # ------------------------------------- Find the section of student in a course
+sub devalidate_getsection_cache {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my $hashid="$udom:$unam:$courseid";
+    &devalidate_cache_new('getsection',$hashid);
+}
 
 sub getsection {
     my ($udom,$unam,$courseid)=@_;
@@ -827,8 +840,11 @@ sub getsection {
 }
 
 sub save_cache {
+    my ($r)=@_;
+    if (! $r->is_initial_req()) { return DECLINED; }
     &purge_remembered();
     undef(%env);
+    return OK;
 }
 
 my $to_remember=-1;
@@ -875,6 +891,9 @@ sub do_cache_new {
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
     }
+    if (!defined($time) ) {
+	$time=600;
+    }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     $memcache->set($id,$setvalue,$time);
     # need to make a copy of $value
@@ -928,13 +947,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
@@ -1046,7 +1102,7 @@ sub repcopy {
            if ($response->is_error()) {
 	       unlink($transname);
                my $message=$response->status_line;
-               &logthis("<font color=blue>WARNING:"
+               &logthis("<font color=\"blue\">WARNING:"
                        ." LWP get: $message: $filename</font>");
                return 'unavailable';
            } else {
@@ -1056,7 +1112,7 @@ sub repcopy {
                   if ($mresponse->is_error()) {
 		      unlink($filename.'.meta');
                       &logthis(
-                     "<font color=yellow>INFO: No metadata: $filename</font>");
+                     "<font color=\"yellow\">INFO: No metadata: $filename</font>");
                   }
 	       }
                rename($transname,$filename);
@@ -1089,7 +1145,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));
@@ -1125,8 +1183,11 @@ sub allowuploaded {
 }
 
 # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
-# input: action, courseID, current domain, home server for course, intended
-#        path to file, source of file.
+# input: action, courseID, current domain, intended
+#        path to file, source of file, instruction to parse file for objects,
+#        ref to hash for embedded objects,
+#        ref to hash for codebase of java objects.
+#
 # output: url to file (if action was uploaddoc), 
 #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)
 #
@@ -1149,30 +1210,21 @@ sub allowuploaded {
 #         /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
 #         and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
 #         in course's home server.
-
+#
 
 sub process_coursefile {
-    my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
+    my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
     my $fetchresult;
+    my $home=&homeserver($docuname,$docudom);
     if ($action eq 'propagate') {
-        $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
-                            ,$docuhome);
+        $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+			     $home);
     } else {
-        my $fetchresult = '';
         my $fpath = '';
         my $fname = $file;
         ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
         $fpath=$docudom.'/'.$docuname.'/'.$fpath;
-        my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
-        unless ($fpath eq '') {
-            my @parts=split('/',$fpath);
-            foreach my $part (@parts) {
-                $filepath.= '/'.$part;
-                if ((-e $filepath)!=1) {
-                    mkdir($filepath,0777);
-                }
-            }
-        }
+        my $filepath = &build_filepath($fpath);
         if ($action eq 'copy') {
             if ($source eq '') {
                 $fetchresult = 'no source file';
@@ -1181,30 +1233,75 @@ sub process_coursefile {
                 my $destination = $filepath.'/'.$fname;
                 rename($source,$destination);
                 $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
-                                 $docuhome);
+                                 $home);
             }
         } elsif ($action eq 'uploaddoc') {
             open(my $fh,'>'.$filepath.'/'.$fname);
             print $fh $env{'form.'.$source};
             close($fh);
+            if ($parser eq 'parse') {
+                my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
+                unless ($parse_result eq 'ok') {
+                    &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+                }
+            }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
-                                 $docuhome);
+                                 $home);
             if ($fetchresult eq 'ok') {
                 return '/uploaded/'.$fpath.'/'.$fname;
             } else {
                 &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
-                        ' to host '.$docuhome.': '.$fetchresult);
+                        ' to host '.$home.': '.$fetchresult);
                 return '/adm/notfound.html';
             }
         }
     }
     unless ( $fetchresult eq 'ok') {
         &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
-             ' to host '.$docuhome.': '.$fetchresult);
+             ' to host '.$home.': '.$fetchresult);
     }
     return $fetchresult;
 }
 
+sub build_filepath {
+    my ($fpath) = @_;
+    my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
+    unless ($fpath eq '') {
+        my @parts=split('/',$fpath);
+        foreach my $part (@parts) {
+            $filepath.= '/'.$part;
+            if ((-e $filepath)!=1) {
+                mkdir($filepath,0777);
+            }
+        }
+    }
+    return $filepath;
+}
+
+sub store_edited_file {
+    my ($primary_url,$content,$docudom,$docuname,$fetchresult) = @_;
+    my $file = $primary_url;
+    $file =~ s#^/uploaded/$docudom/$docuname/##;
+    my $fpath = '';
+    my $fname = $file;
+    ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
+    $fpath=$docudom.'/'.$docuname.'/'.$fpath;
+    my $filepath = &build_filepath($fpath);
+    open(my $fh,'>'.$filepath.'/'.$fname);
+    print $fh $content;
+    close($fh);
+    my $home=&homeserver($docuname,$docudom);
+    $$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+			  $home);
+    if ($$fetchresult eq 'ok') {
+        return '/uploaded/'.$fpath.'/'.$fname;
+    } else {
+        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
+		 ' to host '.$home.': '.$$fetchresult);
+        return '/adm/notfound.html';
+    }
+}
+
 sub clean_filename {
     my ($fname)=@_;
 # Replace Windows backslashes by forward slashes
@@ -1222,12 +1319,19 @@ sub clean_filename {
 }
 
 # --------------- Take an uploaded file and put it into the userfiles directory
-# input: name of form element, coursedoc=1 means this is for the course
-# output: url of file in userspace
+# input: $formname - the contents of the file are in $env{"form.$formname"}
+#                    the desired filenam is in $env{"form.$formname"}
+#        $coursedoc - if true up to the current course
+#                     if false
+#        $subdir - directory in userfile to store the file into
+#        $parser, $allfiles, $codebase - unknown
+#
+# output: url of file in userspace, or error: <message> 
+#             or /adm/notfound.html if failure to upload occurse
 
 
 sub userfileupload {
-    my ($formname,$coursedoc,$subdir)=@_;
+    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
@@ -1251,30 +1355,34 @@ sub userfileupload {
         return $fullpath.'/'.$fname; 
     }
 # Create the directory if not present
-    my $docuname='';
-    my $docudom='';
-    my $docuhome='';
     $fname="$subdir/$fname";
     if ($coursedoc) {
-	$docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
-	$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
-	$docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};
-        if ($env{'form.folder'} =~ m/^default/) {
-            return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+        if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
+            return &finishuserfileupload($docuname,$docudom,
+					 $formname,$fname,$parser,$allfiles,
+					 $codebase);
         } else {
             $fname=$env{'form.folder'}.'/'.$fname;
-            return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);
+            return &process_coursefile('uploaddoc',$docuname,$docudom,
+				       $fname,$formname,$parser,
+				       $allfiles,$codebase);
         }
     } else {
-        $docuname=$env{'user.name'};
-        $docudom=$env{'user.domain'};
-        $docuhome=$env{'user.home'};
-        return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+        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);
     }
 }
 
 sub finishuserfileupload {
-    my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
+    my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
     my ($fnamepath,$file);
@@ -1293,12 +1401,29 @@ 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') {
+        my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
+						   $codebase);
+        unless ($parse_result eq 'ok') {
+            &logthis('Failed to parse '.$filepath.$file.
+		     ' for embedded media: '.$parse_result); 
+        }
+    }
 # Notify homeserver to grep it
 #
+    my $docuhome=&homeserver($docuname,$docudom);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
 #
@@ -1311,6 +1436,114 @@ sub finishuserfileupload {
     }    
 }
 
+sub extract_embedded_items {
+    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
+    my @state = ();
+    my %javafiles = (
+                      codebase => '',
+                      code => '',
+                      archive => ''
+                    );
+    my %mediafiles = (
+                      src => '',
+                      movie => '',
+                     );
+    my $p;
+    if ($content) {
+        $p = HTML::LCParser->new($content);
+    } else {
+        $p = HTML::LCParser->new($filepath.'/'.$file);
+    }
+    while (my $t=$p->get_token()) {
+	if ($t->[0] eq 'S') {
+	    my ($tagname, $attr) = ($t->[1],$t->[2]);
+	    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 'script') {
+                if ($attr->{'archive'} =~ /\.jar$/i) {
+                    &add_filetype($allfiles,$attr->{'archive'},'archive');
+                } else {
+                    &add_filetype($allfiles,$attr->{'src'},'src');
+                }
+            }
+            if (lc($tagname) eq 'link') {
+                if (lc($attr->{'rel'}) eq 'stylesheet') { 
+                    &add_filetype($allfiles,$attr->{'href'},'href');
+                }
+            }
+	    if (lc($tagname) eq 'object' ||
+		(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
+		foreach my $item (keys(%javafiles)) {
+		    $javafiles{$item} = '';
+		}
+	    }
+	    if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
+		my $name = lc($attr->{'name'});
+		foreach my $item (keys(%javafiles)) {
+		    if ($name eq $item) {
+			$javafiles{$item} = $attr->{'value'};
+			last;
+		    }
+		}
+		foreach my $item (keys(%mediafiles)) {
+		    if ($name eq $item) {
+			&add_filetype($allfiles, $attr->{'value'}, 'value');
+			last;
+		    }
+		}
+	    }
+	    if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {
+		foreach my $item (keys(%javafiles)) {
+		    if ($attr->{$item}) {
+			$javafiles{$item} = $attr->{$item};
+			last;
+		    }
+		}
+		foreach my $item (keys(%mediafiles)) {
+		    if ($attr->{$item}) {
+			&add_filetype($allfiles,$attr->{$item},$item);
+			last;
+		    }
+		}
+	    }
+	} elsif ($t->[0] eq 'E') {
+	    my ($tagname) = ($t->[1]);
+	    if ($javafiles{'codebase'} ne '') {
+		$javafiles{'codebase'} .= '/';
+	    }  
+	    if (lc($tagname) eq 'applet' ||
+		lc($tagname) eq 'object' ||
+		(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')
+		) {
+		foreach my $item (keys(%javafiles)) {
+		    if ($item ne 'codebase' && $javafiles{$item} ne '') {
+			my $file=$javafiles{'codebase'}.$javafiles{$item};
+			&add_filetype($allfiles,$file,$item);
+		    }
+		}
+	    } 
+	    pop @state;
+	}
+    }
+    return 'ok';
+}
+
+sub add_filetype {
+    my ($allfiles,$file,$type)=@_;
+    if (exists($allfiles->{$file})) {
+	unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) {
+	    push(@{$allfiles->{$file}}, &escape($type));
+	}
+    } else {
+	@{$allfiles->{$file}} = (&escape($type));
+    }
+}
+
 sub removeuploadedurl {
     my ($url)=@_;
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
@@ -1368,7 +1601,7 @@ sub flushcourselogs {
         } else {
             &logthis('Failed to flush log buffer for '.$crsid);
             if (length($courselogs{$crsid})>40000) {
-               &logthis("<font color=blue>WARNING: Buffer for ".$crsid.
+               &logthis("<font color=\"blue\">WARNING: Buffer for ".$crsid.
                         " exceeded maximum size, deleting.</font>");
                delete $courselogs{$crsid};
             }
@@ -1439,6 +1672,31 @@ sub flushcourselogs {
 	    delete $userrolehash{$entry};
         }
     }
+#
+# Reverse lookup of domain roles (dc, ad, li, sc, au)
+#
+    my %domrolebuffer = ();
+    foreach my $entry (keys %domainrolehash) {
+        my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;
+        if ($domrolebuffer{$rudom}) {
+            $domrolebuffer{$rudom}.='&'.&escape($entry).
+                      '='.&escape($domainrolehash{$entry});
+        } else {
+            $domrolebuffer{$rudom}.=&escape($entry).
+                      '='.&escape($domainrolehash{$entry});
+        }
+        delete $domainrolehash{$entry};
+    }
+    foreach my $dom (keys(%domrolebuffer)) {
+        foreach my $tryserver (keys %libserv) {
+            if ($hostdom{$tryserver} eq $dom) {
+                unless (&reply('domroleput:'.$dom.':'.
+                  $domrolebuffer{$dom},$tryserver) eq 'ok') {
+                    &logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
+                }
+            }
+        }
+    }
     $dumpcount++;
 }
 
@@ -1472,7 +1730,7 @@ sub courseacclog {
     my $fnsymb=shift;
     unless ($env{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
-    if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) {
+    if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
         $what.=':POST';
         # FIXME: Probably ought to escape things....
 	foreach (keys %env) {
@@ -1514,14 +1772,24 @@ sub linklog {
   
 sub userrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
-    if (($trole=~/^ca/) || ($trole=~/^in/) || 
-        ($trole=~/^cc/) || ($trole=~/^ep/) ||
-        ($trole=~/^cr/) || ($trole=~/^ta/)) {
+    if (($trole=~/^ca/) || ($trole=~/^aa/) ||
+        ($trole=~/^in/) || ($trole=~/^cc/) ||
+        ($trole=~/^ep/) || ($trole=~/^cr/) ||
+        ($trole=~/^ta/)) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;
-   }
+    }
+    if (($trole=~/^dc/) || ($trole=~/^ad/) ||
+        ($trole=~/^li/) || ($trole=~/^li/) ||
+        ($trole=~/^au/) || ($trole=~/^dg/) ||
+        ($trole=~/^sc/)) {
+       my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
+       $domainrolehash
+         {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
+                    = $tend.':'.$tstart;
+    }
 }
 
 sub get_course_adv_roles {
@@ -1545,7 +1813,11 @@ sub get_course_adv_roles {
 	if ($username eq '' || $domain eq '') { next; }
 	if ((&privileged($username,$domain)) && 
 	    (!$nothide{$username.':'.$domain})) { next; }
+	if ($role eq 'cr') { next; }
         my $key=&plaintext($role);
+	if ($role =~ /^cr/) {
+	    $key=(split('/',$role))[3];
+	}
         if ($section) { $key.=' (Sec/Grp '.$section.')'; }
         if ($returnhash{$key}) {
 	    $returnhash{$key}.=','.$username.':'.$domain;
@@ -1614,7 +1886,7 @@ sub courseidput {
 }
 
 sub courseiddump {
-    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_;
+    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref)=@_;
     my %returnhash=();
     unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {
@@ -1623,7 +1895,7 @@ sub courseiddump {
 	        foreach (
                  split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
 			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter),
+                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter),
                                $tryserver))) {
 		    my ($key,$value)=split(/\=/,$_);
                     if (($key) && ($value)) {
@@ -1636,7 +1908,62 @@ sub courseiddump {
     return %returnhash;
 }
 
-#
+# ---------------------------------------------------------- DC e-mail
+
+sub dcmailput {
+    my ($domain,$msgid,$message,$server)=@_;
+    my $status = &Apache::lonnet::critical(
+       'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
+       &Apache::lonnet::escape($message),$server);
+    return $status;
+}
+
+sub dcmaildump {
+    my ($dom,$startdate,$enddate,$senders) = @_;
+    my %returnhash=();
+    if (exists($domain_primary{$dom})) {
+        my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
+                                                         &escape($enddate).':';
+	my @esc_senders=map { &escape($_)} @$senders;
+	$cmd.=&escape(join('&',@esc_senders));
+	foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+            my ($key,$value) = split(/\=/,$_);
+            if (($key) && ($value)) {
+                $returnhash{&unescape($key)} = &unescape($value);
+            }
+        }
+    }
+    return %returnhash;
+}
+# ---------------------------------------------------------- Domain roles
+
+sub get_domain_roles {
+    my ($dom,$roles,$startdate,$enddate)=@_;
+    if (undef($startdate) || $startdate eq '') {
+        $startdate = '.';
+    }
+    if (undef($enddate) || $enddate eq '') {
+        $enddate = '.';
+    }
+    my $rolelist = join(':',@{$roles});
+    my %personnel = ();
+    foreach my $tryserver (keys(%libserv)) {
+        if ($hostdom{$tryserver} eq $dom) {
+            %{$personnel{$tryserver}}=();
+            foreach (
+                split(/\&/,&reply('domrolesdump:'.$dom.':'.
+                   &escape($startdate).':'.&escape($enddate).':'.
+                   &escape($rolelist), $tryserver))) {
+                my($key,$value) = split(/\=/,$_);
+                if (($key) && ($value)) {
+                    $personnel{$tryserver}{&unescape($key)} = &unescape($value);
+                }
+            }
+        }
+    }
+    return %personnel;
+}
+
 # ----------------------------------------------------------- Check out an item
 
 sub get_first_access {
@@ -1682,7 +2009,7 @@ sub checkout {
 		 $now.'&'.$ENV{'REMOTE_ADDR'});
     my $token=&reply('tmpput:'.$infostr,$lonhost);
     if ($token=~/^error\:/) { 
-        &logthis("<font color=blue>WARNING: ".
+        &logthis("<font color=\"blue\">WARNING: ".
                 "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
                  "</font>");
         return ''; 
@@ -1698,7 +2025,7 @@ sub checkout {
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';
     } else {
-        &logthis("<font color=blue>WARNING: ".
+        &logthis("<font color=\"blue\">WARNING: ".
                 "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
                  "</font>");
     }    
@@ -1708,7 +2035,7 @@ sub checkout {
                                                  $token)) ne 'ok') {
 	return '';
     } else {
-        &logthis("<font color=blue>WARNING: ".
+        &logthis("<font color=\"blue\">WARNING: ".
                 "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
                  "</font>");
     }
@@ -2303,19 +2630,28 @@ sub rolesinit {
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
     my %allroles=();
+    my %allgroups=();   
     my $now=time;
     my $userroles="user.login.time=$now\n";
+    my $group_privs;
 
     if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {
 	  if ($_!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);
 	    $area=~s/\_\w\w$//;
-	    
-            my ($trole,$tend,$tstart);
+            my ($trole,$tend,$tstart,$group_privs);
 	    if ($role=~/^cr/) { 
-		($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
-		($tend,$tstart)=split('_',$trest);
+		if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
+		    ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
+		    ($tend,$tstart)=split('_',$trest);
+		} else {
+		    $trole=$role;
+		}
+            } elsif ($role =~ m|^gr/|) {
+                ($trole,$tend,$tstart) = split(/_/,$role);
+                ($trole,$group_privs) = split(/\//,$trole);
+                $group_privs = &unescape($group_privs);
 	    } else {
 		($trole,$tend,$tstart)=split(/_/,$role);
 	    }
@@ -2327,13 +2663,15 @@ sub rolesinit {
 		my ($tdummy,$tdomain,$trest)=split(/\//,$area);
 		if ($trole =~ /^cr\//) {
                     &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+                } elsif ($trole eq 'gr') {
+                    &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
 		} else {
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
 		}
             }
-          } 
+          }
         }
-        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
+        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles,\%allgroups);
         $userroles.='user.adv='.$adv."\n".
 	            'user.author='.$author."\n";
         $env{'user.adv'}=$adv;
@@ -2375,6 +2713,17 @@ sub custom_roleprivs {
     }
 }
 
+sub group_roleprivs {
+    my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
+    my $access = 1;
+    my $now = time;
+    if (($tend!=0) && ($tend<$now)) { $access = 0; }
+    if (($tstart!=0) && ($tstart>$now)) { $access=0; }
+    if ($access) {
+        my ($course,$group) = ($area =~ m|(/\w+/\w+)/([^/]+)$|);
+        $$allgroups{$course}{$group} .=':'.$group_privs;
+    }
+}
 
 sub standard_roleprivs {
     my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
@@ -2395,9 +2744,31 @@ sub standard_roleprivs {
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles) = @_; 
+    my ($userroles,$allroles,$allgroups) = @_; 
     my $author=0;
     my $adv=0;
+    my %grouproles = ();
+    if (keys(%{$allgroups}) > 0) {
+        foreach my $role (keys %{$allroles}) {
+            my ($trole,$area,$sec,$extendedarea);
+            if ($role =~ m|^(\w+)\.(/\w+/\w+)(/?\w*)|) {
+                $trole = $1;
+                $area = $2;
+                $sec = $3;
+                $extendedarea = $area.$sec;
+                if (exists($$allgroups{$area})) {
+                    foreach my $group (keys(%{$$allgroups{$area}})) {
+                        my $spec = $trole.'.'.$extendedarea;
+                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+                                                $$allgroups{$area}{$group};
+                    }
+                }
+            }
+        }
+    }
+    foreach (keys(%grouproles)) {
+        $$allroles{$_} = $grouproles{$_};
+    }
     foreach (keys %{$allroles}) {
         my %thesepriv=();
         if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
@@ -2465,7 +2836,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);
@@ -2474,11 +2845,11 @@ 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;
@@ -2558,10 +2929,16 @@ sub convert_dump_to_currentdump{
     return \%returnhash;
 }
 
+# ------------------------------------------------------ critical inc interface
+
+sub cinc {
+    return &inc(@_,'critical');
+}
+
 # --------------------------------------------------------------- inc interface
 
 sub inc {
-    my ($namespace,$store,$udomain,$uname) = @_;
+    my ($namespace,$store,$udomain,$uname,$critical) = @_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
@@ -2579,7 +2956,11 @@ sub inc {
         }
     }
     $items=~s/\&$//;
-    return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
+    if ($critical) {
+	return &critical("inc:$udomain:$uname:$namespace:$items",$uhome);
+    } else {
+	return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
+    }
 }
 
 # --------------------------------------------------------------- put interface
@@ -2597,28 +2978,71 @@ sub put {
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
-# ---------------------------------------------------------- putstore interface
-                                                                                     
-sub putstore {
+# ------------------------------------------------------------ newput interface
+
+sub newput {
    my ($namespace,$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 my $key (keys(%$storehash)) {
+       $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
    }
-   foreach (keys %allitems) {
-       $allitems{$_} =~ s/\:$//;
-       $items.= $_.'='.$allitems{$_}.'&';
+   $items=~s/\&$//;
+   return &reply("newput:$udomain:$uname:$namespace:$items",$uhome);
+}
+
+# ---------------------------------------------------------  putstore interface
+
+sub 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 $items='';
+   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
@@ -2630,7 +3054,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);
@@ -2659,6 +3083,37 @@ sub eget {
    return %returnhash;
 }
 
+# ------------------------------------------------------------ tmpput interface
+sub tmpput {
+    my ($storehash,$server)=@_;
+    my $items='';
+    foreach (keys(%$storehash)) {
+	$items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+    }
+    $items=~s/\&$//;
+    return &reply("tmpput:$items",$server);
+}
+
+# ------------------------------------------------------------ tmpget interface
+sub tmpget {
+    my ($token,$server)=@_;
+    if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
+    my $rep=&reply("tmpget:$token",$server);
+    my %returnhash;
+    foreach my $item (split(/\&/,$rep)) {
+	my ($key,$value)=split(/=/,$item);
+	$returnhash{&unescape($key)}=&thaw_unescape($value);
+    }
+    return %returnhash;
+}
+
+# ------------------------------------------------------------ tmpget interface
+sub tmpdel {
+    my ($token,$server)=@_;
+    if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
+    return &reply("tmpdel:$token",$server);
+}
+
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {
@@ -2697,12 +3152,11 @@ sub customaccess {
 
 sub allowed {
     my ($priv,$uri,$symb)=@_;
+    my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
     $uri=&declutter($uri);
     
-    
-    
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
@@ -2711,12 +3165,29 @@ sub allowed {
     }
 
 # Free bre access to user's own portfolio contents
-    my ($space,$domain,$name,$dir)=split('/',$uri);
-    if (($space=~/^(uploaded|ediupload)$/) && ($env{'user.name'} eq $name) && 
-	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
+    my ($space,$domain,$name,@dir)=split('/',$uri);
+    if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
+	($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') {
@@ -2749,7 +3220,7 @@ sub allowed {
     if (($priv eq 'ccc') && ($env{'request.role'} =~ /^dc\./)) {
         # uri is the requested domain in this case.
         # comparison to 'request.role.domain' shows if the user has selected
-        # a role of dc for the domain in question. 
+        # a role of dc for the domain in question.
         return 'F' if ($uri eq $env{'request.role.domain'});
     }
 
@@ -2780,15 +3251,38 @@ sub allowed {
        $thisallowed.=$1;
     }
 
-# URI is an uploaded document for this course
+# Group: uri itself is a group
+    my $groupuri=$uri;
+    $groupuri=~s/^([^\/])/\/$1/;
+    if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri}
+       =~/\Q$priv\E\&([^\:]*)/) {
+       $thisallowed.=$1;
+    }
+
+# URI is an uploaded document for this course, default permissions don't matter
 # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
-	my $refuri=$env{'httpref.'.$orguri};
-	if ($refuri) {
-	    if ($refuri =~ m|^/adm/|) {
-		$thisallowed='F';
-	    }
-	}
+	$thisallowed='';
+        my ($match)=&is_on_map($uri);
+        if ($match) {
+            if ($env{'user.priv.'.$env{'request.role'}.'./'}
+                  =~/\Q$priv\E\&([^\:]*)/) {
+                $thisallowed.=$1;
+            }
+        } else {
+            my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri};
+            if ($refuri) {
+                if ($refuri =~ m|^/adm/|) {
+                    $thisallowed='F';
+                } else {
+                    $refuri=&declutter($refuri);
+                    my ($match) = &is_on_map($refuri);
+                    if ($match) {
+                        $thisallowed='F';
+                    }
+                }
+            }
+        }
     }
 
 # Full access at system, domain or course-wide level? Exit.
@@ -2799,7 +3293,16 @@ sub allowed {
 
 # If this is generating or modifying users, exit with special codes
 
-    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) {
+    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) {
+	if (($priv eq 'cca') || ($priv eq 'caa')) {
+	    my ($audom,$auname)=split('/',$uri);
+# no author name given, so this just checks on the general right to make a co-author in this domain
+	    unless ($auname) { return $thisallowed; }
+# an author name is given, so we are about to actually make a co-author for a certain account
+	    if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) ||
+		(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
+		 ($audom ne $env{'request.role.domain'}))) { return ''; }
+	}
 	return $thisallowed;
     }
 #
@@ -2947,17 +3450,21 @@ sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\Q$rolecode\E/) {
-           &log($env{'user.domain'},$env{'user.name'},$env{'user.host'},
-                'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
-                $env{'request.course.id'});
+	   if ($priv ne 'pch') { 
+	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
+			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
+			$env{'request.course.id'});
+	   }
            return '';
        }
 
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
 	   =~/\Q$unamedom\E/) {
-           &log($env{'user.domain'},$env{'user.name'},$env{'user.host'},
-                'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
-                $env{'request.course.id'});
+	   if ($priv ne 'pch') { 
+	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
+			'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
+			$env{'request.course.id'});
+	   }
            return '';
        }
    }
@@ -2967,9 +3474,11 @@ sub allowed {
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
-	  &log($env{'user.domain'},$env{'user.name'},$env{'user.host'},
-                    'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
-          return '';
+	   if ($priv ne 'pch') { 
+	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
+			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
+	   }
+	   return '';
        }
    }
 
@@ -2992,16 +3501,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=&declutter(shift);
-    $uri=~s/\.\d+\.(\w+)$/\.$1/;
-    my @uriparts=split(/\//,$uri);
-    my $filename=$uriparts[$#uriparts];
-    my $pathname=$uri;
-    $pathname=~s|/\Q$filename\E$||;
-    $pathname=~s/^adm\/wrapper\///;    
+    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\|]+)\&/);
@@ -3274,6 +3784,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 = '';
@@ -3307,11 +3893,102 @@ sub auto_instcode_format {
     return $response;
 }
 
+# ------------------------------------------------------- Course Group routines
+
+sub get_coursegroups {
+    my ($cdom,$cnum,$group) = @_;
+    return(&dump('coursegroups',$cdom,$cnum,$group));
+}
+
+sub modify_coursegroup {
+    my ($cdom,$cnum,$groupsettings) = @_;
+    return(&put('coursegroups',$groupsettings,$cdom,$cnum));
+}
+
+sub modify_group_roles {
+    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;
+    my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
+    my $role = 'gr/'.&escape($userprivs);
+    my ($uname,$udom) = split(/:/,$user);
+    my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    if ($result eq 'ok') {
+        &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
+    }
+
+    return $result;
+}
+
+sub modify_coursegroup_membership {
+    my ($cdom,$cnum,$membership) = @_;
+    my $result = &put('groupmembership',$membership,$cdom,$cnum);
+    return $result;
+}
+
+sub get_active_groups {
+    my ($udom,$uname,$cdom,$cnum) = @_;
+    my $now = time;
+    my %groups = ();
+    foreach my $key (keys(%env)) {
+        if ($key =~ m-user\.role\.gr\./([^/]+)/([^/]+)/(\w+)$-) {
+            my ($start,$end) = split(/\./,$env{$key});
+            if (($end!=0) && ($end<$now)) { next; }
+            if (($start!=0) && ($start>$now)) { next; }
+            if ($1 eq $cdom && $2 eq $cnum) {
+                $groups{$3} = $env{$key} ;
+            }
+        }
+    }
+    return %groups;
+}
+
+sub get_group_membership {
+    my ($cdom,$cnum,$group) = @_;
+    return(&dump('groupmembership',$cdom,$cnum,$group));
+}
+
+sub get_users_groups {
+    my ($udom,$uname,$courseid) = @_;
+    my $cachetime=1800;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+
+    my $hashid="$udom:$uname:$courseid";
+    my ($result,$cached)=&is_cached_new('getgroups',$hashid);
+    if (defined($cached)) { return $result; }
+
+    my %roleshash = &dump('roles',$udom,$uname,$courseid);
+    my ($tmp) = keys(%roleshash);
+    if ($tmp=~/^error:/) {
+        &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
+        return '';
+    } else {
+        my $grouplist;
+        foreach my $key (keys %roleshash) {
+            if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
+                unless ($roleshash{$key} =~ /_1_1$/) {   # deleted membership
+                    $grouplist .= $1.':';
+                }
+            }
+        }
+        $grouplist =~ s/:$//;
+        return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
+    }
+}
+
+sub devalidate_getgroups_cache {
+    my ($udom,$uname,$cdom,$cnum)=@_;
+    my $courseid = $cdom.'_'.$cnum;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my $hashid="$udom:$uname:$courseid";
+    &devalidate_cache_new('getgroups',$hashid);
+}
+
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
     my $short=shift;
-    return &mt($prp{$short});
+    return &Apache::lonlocal::mt($prp{$short});
 }
 
 # ----------------------------------------------------------------- Assign Role
@@ -3329,6 +4006,16 @@ sub assignrole {
            return 'refused'; 
         }
         $mrole='cr';
+    } elsif ($role =~ /^gr\//) {
+        my $cwogrp=$url;
+        $cwogrp=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
+        unless (&allowed('mdg',$cwogrp)) {
+            &logthis('Refused group assignrole: '.
+              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+                    $env{'user.name'}.' at '.$env{'user.domain'});
+            return 'refused';
+        }
+        $mrole='gr';
     } else {
         my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
@@ -3366,7 +4053,7 @@ sub assignrole {
     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);
+	&userrolelog($role,$uname,$udom,$url,$start,$end);
     }
     return $answer;
 }
@@ -3489,6 +4176,7 @@ sub modifyuser {
     }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
+    &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
 	     $last.', '.$gene.' by '.
@@ -3569,6 +4257,8 @@ sub modify_student_enrollment {
 		   $cdom,$cnum);
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
+    } else {
+	&devalidate_getsection_cache($udom,$uname,$cid);
     }
     # Add student role to user
     my $uurl='/'.$cid;
@@ -3627,7 +4317,9 @@ sub createcourse {
         return 'refused';
     }
 # ------------------------------------------------------------------- Create ID
-   my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
+   my $uname=int(1+rand(9)).
+       ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+       substr($$.time,0,5).unpack("H8",pack("I32",time)).
        unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
 # ----------------------------------------------- Make sure that does not exist
    my $uhome=&homeserver($uname,$udom,'true');
@@ -3673,7 +4365,7 @@ sub createcourse {
 </map>
 ENDINITMAP
         $topurl=&declutter(
-        &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+        &finishuserfileupload($uname,$udom,'initmap','default.sequence')
                           );
     }
 # ----------------------------------------------------------- Write preferences
@@ -3740,7 +4432,6 @@ sub mark_as_readonly {
     my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }
-
     foreach my $file (@{$files}) {
         push(@{$current_permissions{$file}},$what);
     }
@@ -3819,17 +4510,21 @@ sub files_not_in_path {
 
 #--------------------------------------------------------------Get Marked as Read Only
 
+
 sub get_marked_as_readonly {
     my ($domain,$user,$what) = @_;
     my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }
-
     my @readonly_files;
+    my $cmp1=$what;
+    if (ref($what)) { $cmp1=join('',@{$what}) };
     while (my ($file_name,$value) = each(%current_permissions)) {
         if (ref($value) eq "ARRAY"){
             foreach my $stored_what (@{$value}) {
-                if ($stored_what eq $what) {
+                my $cmp2=$stored_what;
+                if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) };
+                if ($cmp1 eq $cmp2) {
                     push(@readonly_files, $file_name);
                 } elsif (!defined($what)) {
                     push(@readonly_files, $file_name);
@@ -3864,30 +4559,34 @@ sub get_marked_as_readonly_hash {
 # ------------------------------------------------------------ Unmark as Read Only
 
 sub unmark_as_readonly {
-    # unmarks all files locked by $what 
-    # for portfolio submissions, $what contains $crsid and $symb
-    my ($domain,$user,$what) = @_;
+    # unmarks $file_name (if $file_name is defined), or all files locked by $what 
+    # for portfolio submissions, $what contains [$symb,$crsid] 
+    my ($domain,$user,$what,$file_name) = @_;
+    my $symb_crs = $what;
+    if (ref($what)) { $symb_crs=join('',@$what); }
     my %current_permissions = &dump('file_permissions',$domain,$user);
     my ($tmp)=keys(%current_permissions);
     if ($tmp=~/^error:/) { undef(%current_permissions); }
-
     my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
-    foreach my $file(@readonly_files){
-        my $current_locks = $current_permissions{$file};
+    foreach my $file (@readonly_files) {
+	if (defined($file_name) && ($file_name ne $file)) { next; }
+	my $current_locks = $current_permissions{$file};
         my @new_locks;
         my @del_keys;
         if (ref($current_locks) eq "ARRAY"){
             foreach my $locker (@{$current_locks}) {
-                unless ($locker eq $what) {
-                    push(@new_locks, $what);
+                my $compare=$locker;
+                if (ref($locker)) { $compare=join('',@{$locker}) };
+                if ($compare ne $symb_crs) {
+                    push(@new_locks, $locker);
                 }
             }
-            if (@new_locks > 0) {
+            if (scalar(@new_locks) > 0) {
                 $current_permissions{$file} = \@new_locks;
             } else {
                 push(@del_keys, $file);
                 &del('file_permissions',\@del_keys, $domain, $user);
-                delete $current_permissions{$file};
+                delete($current_permissions{$file});
             }
         }
     }
@@ -4017,13 +4716,62 @@ sub GetFileTimestamp {
     }
 }
 
+sub stat_file {
+    my ($uri) = @_;
+    $uri = &clutter($uri);
+    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 {
@@ -4031,43 +4779,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;
 }
@@ -4082,13 +4836,14 @@ sub devalidatecourseresdata {
 
 # --------------------------------------------------- Course Resourcedata Query
 
-sub courseresdata {
-    my ($coursenum,$coursedomain,@which)=@_;
+sub get_courseresdata {
+    my ($coursenum,$coursedomain)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;
     my ($result,$cached)=&is_cached_new('courseres',$hashid);
+    my %dumpreply;
     unless (defined($cached)) {
-	my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
+	%dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
 	$result=\%dumpreply;
 	my ($tmp) = keys(%dumpreply);
 	if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
@@ -4100,6 +4855,54 @@ sub courseresdata {
 	    &do_cache_new('courseres',$hashid,$result,600);
 	}
     }
+    return $result;
+}
+
+sub devalidateuserresdata {
+    my ($uname,$udom)=@_;
+    my $hashid="$udom:$uname";
+    &devalidate_cache_new('userres',$hashid);
+}
+
+sub get_userresdata {
+    my ($uname,$udom)=@_;
+    #most student don\'t have any data set, check if there is some data
+    if (&EXT_cache_status($udom,$uname)) { return undef; }
+
+    my $hashid="$udom:$uname";
+    my ($result,$cached)=&is_cached_new('userres',$hashid);
+    if (!defined($cached)) {
+	my %resourcedata=&dump('resourcedata',$udom,$uname);
+	$result=\%resourcedata;
+	&do_cache_new('userres',$hashid,$result,600);
+    }
+    my ($tmp)=keys(%$result);
+    if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
+	return $result;
+    }
+    #error 2 occurs when the .db doesn't exist
+    if ($tmp!~/error: 2 /) {
+	&logthis("<font color=\"blue\">WARNING:".
+		 " Trying to get resource data for ".
+		 $uname." at ".$udom.": ".
+		 $tmp."</font>");
+    } elsif ($tmp=~/error: 2 /) {
+	#&EXT_cache_set($udom,$uname);
+	&do_cache_new('userres',$hashid,undef,600);
+	undef($tmp); # not really an error so don't send it back
+    }
+    return $tmp;
+}
+
+sub resdata {
+    my ($name,$domain,$type,@which)=@_;
+    my $result;
+    if ($type eq 'course') {
+	$result=&get_courseresdata($name,$domain);
+    } elsif ($type eq 'user') {
+	$result=&get_userresdata($name,$domain);
+    }
+    if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
 	if (defined($result->{$item})) {
 	    return $result->{$item};
@@ -4130,13 +4933,13 @@ sub EXT_cache_status {
 sub EXT_cache_set {
     my ($target_domain,$target_user) = @_;
     my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
-    &appenv($cachename => time);
+    #&appenv($cachename => time);
 }
 
 # --------------------------------------------------------- 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;
@@ -4166,8 +4969,10 @@ sub EXT {
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
-	    if (defined($Apache::lonhomework::parsing_a_problem) ||
-		defined($Apache::lonhomework::parsing_a_task)) {
+	    if ( (defined($Apache::lonhomework::parsing_a_problem)
+		  || defined($Apache::lonhomework::parsing_a_task))
+		 &&
+		 ($symbparm eq &symbread()) ) {
 		return $Apache::lonhomework::history{$qualifierrest};
 	    } else {
 		my %restored;
@@ -4231,7 +5036,7 @@ sub EXT {
 # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {
 	    if ($qualifier eq 'textremote') {
-		if (&mt('textual_remote_display') eq 'on') {
+		if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') {
 		    return 1;
 		} else {
 		    return 0;
@@ -4248,10 +5053,21 @@ sub EXT {
         return $env{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
 
-	my $section;
 	if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
+
+	if ($space eq 'title') {
+	    if (!$symbparm) { $symbparm = $env{'request.filename'}; }
+	    return &gettitle($symbparm);
+	}
+	
+	if ($space eq 'map') {
+	    my ($map) = &decode_symb($symbparm);
+	    return &symbread($map);
+	}
+
+	my ($section, $group, @groups);
 	my ($courselevelm,$courselevel);
 	if ($symbparm && defined($courseid) && 
 	    $courseid eq $env{'request.course.id'}) {
@@ -4268,12 +5084,20 @@ sub EXT {
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
+                @groups=&sort_course_groups($env{'request.course.groups'},$courseid); 
+                if (@groups > 0) {
+                    @groups = sort(@groups);
+                }
 	    } else {
 		if (! defined($usection)) {
 		    $section=&getsection($udom,$uname,$courseid);
 		} else {
 		    $section = $usection;
 		}
+                my $grouplist = &get_users_groups($udom,$uname,$courseid);
+                if ($grouplist) {
+                    @groups=&sort_course_groups($grouplist,$courseid);
+                }
 	    }
 
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
@@ -4285,44 +5109,25 @@ sub EXT {
 	    $courselevelm=$courseid.'.'.$mapparm;
 
 # ----------------------------------------------------------- first, check user
-	    #most student don\'t have any data set, check if there is some data
-	    if (! &EXT_cache_status($udom,$uname)) {
-		my $hashid="$udom:$uname";
-		my ($result,$cached)=&is_cached_new('userres',$hashid);
-		if (!defined($cached)) {
-		    my %resourcedata=&dump('resourcedata',$udom,$uname);
-		    $result=\%resourcedata;
-		    &do_cache_new('userres',$hashid,$result);
-		}
-		my ($tmp)=keys(%$result);
-		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
-		    if ($$result{$courselevelr}) {
-			return $$result{$courselevelr}; }
-		    if ($$result{$courselevelm}) {
-			return $$result{$courselevelm}; }
-		    if ($$result{$courselevel}) {
-			return $$result{$courselevel}; }
-		} else {
-		    #error 2 occurs when the .db doesn't exist
-		    if ($tmp!~/error: 2 /) {
-			&logthis("<font color=blue>WARNING:".
-				 " Trying to get resource data for ".
-				 $uname." at ".$udom.": ".
-				 $tmp."</font>");
-		    } elsif ($tmp=~/error: 2 /) {
-			&EXT_cache_set($udom,$uname);
-		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
-			return $tmp;
-		    }
-		}
-	    }
+
+	    my $userreply=&resdata($uname,$udom,'user',
+				       ($courselevelr,$courselevelm,
+					$courselevel));
+	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
+            my $coursereply;
+            if (@groups > 0) {
+                $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
+                                       $mapparm,$spacequalifierrest);
+                if (defined($coursereply)) { return $coursereply; }
+            }
 
-	    my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},
-					   $env{'course.'.$courseid.'.domain'},
-					   ($seclevelr,$seclevelm,$seclevel,
-					    $courselevelr));
+	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+				     $env{'course.'.$courseid.'.domain'},
+				     'course',
+				     ($seclevelr,$seclevelm,$seclevel,
+				      $courselevelr));
 	    if (defined($coursereply)) { return $coursereply; }
 
 # ------------------------------------------------------ third, check map parms
@@ -4354,9 +5159,10 @@ sub EXT {
 # ---------------------------------------------- fourth, look in rest pf course
 	if ($symbparm && defined($courseid) && 
 	    $courseid eq $env{'request.course.id'}) {
-	    my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},
-					   $env{'course.'.$courseid.'.domain'},
-					   ($courselevelm,$courselevel));
+	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+				     $env{'course.'.$courseid.'.domain'},
+				     'course',
+				     ($courselevelm,$courselevel));
 	    if (defined($coursereply)) { return $coursereply; }
 	}
 # ------------------------------------------------------------------ Cascade up
@@ -4388,10 +5194,41 @@ sub EXT {
 	if ($space eq 'time') {
 	    return time;
         }
+    } elsif ($realm eq 'server') {
+# ----------------------------------------------------------------- system.time
+	if ($space eq 'name') {
+	    return $ENV{'SERVER_NAME'};
+        }
     }
     return '';
 }
 
+sub check_group_parms {
+    my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
+    my @groupitems = ();
+    my $resultitem;
+    my @levels = ($symbparm,$mapparm,$what);
+    foreach my $group (@{$groups}) {
+        foreach my $level (@levels) {
+             my $item = $courseid.'.['.$group.'].'.$level;
+             push(@groupitems,$item);
+        }
+    }
+    my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                            $env{'course.'.$courseid.'.domain'},
+                                     'course',@groupitems);
+    return $coursereply;
+}
+
+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);
+    }
+    return @groups;
+}
+
 sub packages_tab_default {
     my ($uri,$varname)=@_;
     my (undef,$part,$name)=split(/\./,$varname);
@@ -4584,7 +5421,6 @@ sub metadata {
 	}
 	my ($extension) = ($uri =~ /\.(\w+)$/);
 	foreach my $key (sort(keys(%packagetab))) {
-	    #&logthis("extsion1 $extension $key !!");
 	    #no specific packages #how's our extension
 	    if ($key!~/^extension_\Q$extension\E&/) { next; }
 	    &metadata_create_package_def($uri,$key,'extension_'.$extension,
@@ -4620,7 +5456,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);
+	&do_cache_new('meta',$uri,\%metaentry,60*60);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -4672,7 +5508,7 @@ sub metadata_generate_part0 {
 					   '.type'};
       my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.
 			     '.display'};
-      my $expr='\\[Part: '.$allnames{$name}.'\\]';
+      my $expr='[Part: '.$allnames{$name}.']';
       $olddis=~s/\Q$expr\E/\[Part: 0\]/;
       $$metacache{"$key.display"}=$olddis;
     }
@@ -4716,10 +5552,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}};
     }
@@ -4734,9 +5577,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';
@@ -4753,6 +5599,7 @@ sub symbverify {
     my $thisfn=$thisurl;
 # wrapper not part of symbs
     $thisfn=~s/^\/adm\/wrapper//;
+    $thisfn=~s/^\/adm\/coursedocs\/showdoc\///;
     $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }
@@ -4777,7 +5624,7 @@ sub symbverify {
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
 	    foreach (split(/\,/,$ids)) {
-               my ($mapid,$resid)=split(/\./,$_);
+	       my ($mapid,$resid)=split(/\./,$_);
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
@@ -4807,6 +5654,7 @@ sub symbclean {
 # remove wrapper
 
     $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
+    $symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/;
     return $symb;
 }
 
@@ -4883,6 +5731,9 @@ sub symbread {
         if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
             $targetfn = 'adm/wrapper/'.$thisfn;
         }
+	if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
+	    $targetfn=$1;
+	}
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_READER(),0640)) {
 	    $syval=$hash{$targetfn};
@@ -4916,7 +5767,8 @@ sub symbread {
                  if ($#possibilities==0) {
 # ----------------------------------------------- There is only one possibility
 		     my ($mapid,$resid)=split(/\./,$ids);
-                     $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
+		     $syval=&encode_symb($bighash{'map_id_'.$mapid},
+						    $resid,$thisfn);
                  } elsif (!$donotrecurse) {
 # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;
@@ -4926,8 +5778,8 @@ sub symbread {
          		    my ($mapid,$resid)=split(/\./,$_);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {
 				$realpossible++;
-                                $syval=declutter($bighash{'map_id_'.$mapid}).
-                                       '___'.$resid;
+                                $syval=&encode_symb($bighash{'map_id_'.$mapid},
+						    $resid,$thisfn);
                             }
 			 }
                      }
@@ -4941,7 +5793,6 @@ sub symbread {
         }
         if ($syval) {
 	    return $env{$cache_str}=$syval;
-	    #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
         }
     }
     &appenv('request.ambiguous' => $thisfn);
@@ -4996,8 +5847,37 @@ sub numval3 {
     return $total;
 }
 
+sub digest {
+    my ($data)=@_;
+    my $digest=&Digest::MD5::md5($data);
+    my ($a,$b,$c,$d)=unpack("iiii",$digest);
+    my ($e,$f);
+    {
+        use integer;
+        $e=($a+$b);
+        $f=($c+$d);
+        if ($_64bit) {
+            $e=(($e<<32)>>32);
+            $f=(($f<<32)>>32);
+        }
+    }
+    if (wantarray) {
+	return ($e,$f);
+    } else {
+	my $g;
+	{
+	    use integer;
+	    $g=($e+$f);
+	    if ($_64bit) {
+		$g=(($g<<32)>>32);
+	    }
+	}
+	return $g;
+    }
+}
+
 sub latest_rnd_algorithm_id {
-    return '64bit4';
+    return '64bit5';
 }
 
 sub get_rand_alg {
@@ -5037,11 +5917,15 @@ sub rndseed {
     if (!$username) { $username=$wusername }
     my $which=&get_rand_alg();
     if (defined(&getCODE())) {
-	if ($which eq '64bit4') {
+	if ($which eq '64bit5') {
+	    return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
+	} elsif ($which eq '64bit4') {
 	    return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);
 	} else {
 	    return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
 	}
+    } elsif ($which eq '64bit5') {
+	return &rndseed_64bit5($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit4') {
 	return &rndseed_64bit4($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit3') {
@@ -5164,6 +6048,12 @@ sub rndseed_64bit4 {
     }
 }
 
+sub rndseed_64bit5 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    my ($num1,$num2)=&digest("$symb,$courseid,$domain,$username");
+    return "$num1:$num2";
+}
+
 sub rndseed_CODE_64bit {
     my ($symb,$courseid,$domain,$username)=@_;
     {
@@ -5202,6 +6092,13 @@ sub rndseed_CODE_64bit4 {
     }
 }
 
+sub rndseed_CODE_64bit5 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    my $code = &getCODE();
+    my ($num1,$num2)=&digest("$symb,$courseid,$code");
+    return "$num1:$num2";
+}
+
 sub setup_random_from_rndseed {
     my ($rndseed)=@_;
     if ($rndseed =~/([,:])/) {
@@ -5408,9 +6305,17 @@ 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:;
+    } elsif ($file=~m:^/home/[^/]*/public_html/:) {
+	# is a correct contruction space reference
+        $location = $file;
     } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
   	    ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);
@@ -5443,14 +6348,18 @@ sub filelocation {
 sub hreflocation {
     my ($dir,$file)=@_;
     unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
-	my $finalpath=filelocation($dir,$file);
-	$finalpath=~s-^/home/httpd/html--;
-	$finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;
-	return $finalpath;
-    } elsif ($file=~m-^/home-) {
-	$file=~s-^/home/httpd/html--;
+	$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--;
+    } elsif ($file=~m-/home/(\w+)/public_html/-) {
 	$file=~s-^/home/(\w+)/public_html/-/~$1/-;
-	return $file;
+    } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {
+	$file=~s-^/home/httpd/lonUsers/([^/]*)/./././([^/]*)/userfiles/
+	    -/uploaded/$1/$2/-x;
     }
     return $file;
 }
@@ -5486,6 +6395,8 @@ 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/\?.+$//;
     return $thisfn;
@@ -5498,6 +6409,30 @@ sub clutter {
     unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn; 
     }
+    if ($thisfn !~m|/adm|) {
+	if ($thisfn =~ m|/ext/|) {
+	    $thisfn='/adm/wrapper'.$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;
 }
 
@@ -5536,13 +6471,6 @@ sub thaw_unescape {
     return &unescape($value);
 }
 
-sub mod_perl_version {
-    return 1;
-    if (defined($perlvar{'MODPERL2'})) {
-	return 2;
-    }
-}
-
 sub correct_line_ends {
     my ($result)=@_;
     $$result =~s/\r\n/\n/mg;
@@ -5613,7 +6541,7 @@ BEGIN {
 #           next if /^\#/;
            chomp;
            my ($domain, $domain_description, $def_auth, $def_auth_arg,
-	       $def_lang, $city, $longi, $lati) = split(/:/,$_);
+	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_);
 	   $domain_auth_def{$domain}=$def_auth;
            $domain_auth_arg_def{$domain}=$def_auth_arg;
 	   $domaindescription{$domain}=$domain_description;
@@ -5621,6 +6549,7 @@ BEGIN {
 	   $domain_city{$domain}=$city;
 	   $domain_longi{$domain}=$longi;
 	   $domain_lati{$domain}=$lati;
+           $domain_primary{$domain}=$primary;
 
  #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
 #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
@@ -5652,14 +6581,21 @@ BEGIN {
 
 sub get_iphost {
     if (%iphost) { return %iphost; }
+    my %name_to_ip;
     foreach my $id (keys(%hostname)) {
 	my $name=$hostname{$id};
-	my $ip = gethostbyname($name);
-	if (!$ip || length($ip) ne 4) {
-	    &logthis("Skipping host $id name $name no IP found\n");
-	    next;
+	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\n");
+		next;
+	    }
+	    $ip=inet_ntoa($ip);
+	    $name_to_ip{$name} = $ip;
+	} else {
+	    $ip = $name_to_ip{$name};
 	}
-	$ip=inet_ntoa($ip);
 	push(@{$iphost{$ip}},$id);
     }
     return %iphost;
@@ -5734,7 +6670,7 @@ $processmarker='_'.time.'_'.$perlvar{'lo
 $dumpcount=0;
 
 &logtouch();
-&logthis('<font color=yellow>INFO: Read configuration</font>');
+&logthis('<font color="yellow">INFO: Read configuration</font>');
 $readit=1;
     {
 	use integer;
@@ -6136,13 +7072,17 @@ revokecustomrole($udom,$uname,$url,$role
 
 =item *
 
-coursedescription($courseid) : course description
+coursedescription($courseid) : returns a hash of information about the
+specified course id, including all environment settings for the
+course, the description of the course will be in the hash under the
+key 'description'
 
 =item *
 
-courseresdata($coursenum,$coursedomain,@which) : request for current
-parameter setting for a specific course, @what should be a list of
-parameters to ask about. This routine caches answers for 5 minutes.
+resdata($name,$domain,$type,@which) : request for current parameter
+setting for a specific $type, where $type is either 'course' or 'user',
+@what should be a list of parameters to ask about. This routine caches
+answers for 5 minutes.
 
 =back
 
@@ -6339,10 +7279,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.
@@ -6358,14 +7303,10 @@ 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().  
+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 *
 
@@ -6498,6 +7439,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
@@ -6557,7 +7508,6 @@ userspace, probably shouldn't be called
 
   docuname: username or courseid of destination for the file
   docudom: domain of user/course of destination for the file
-  docuhome: loncapa id of the library server that is getting the file
   formname: same as for userfileupload()
   fname: filename (inculding subdirectories) for the file