--- loncom/lonnet/perl/lonnet.pm	2005/04/07 06:56:24	1.620
+++ loncom/lonnet/perl/lonnet.pm	2005/07/26 13:30:34	1.648
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.620 2005/04/07 06:56:24 albertel Exp $
+# $Id: lonnet.pm,v 1.648 2005/07/26 13:30:34 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -47,6 +47,7 @@ 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);
@@ -270,7 +271,6 @@ sub transfer_profile_to_env {
     for ($envi=0;$envi<=$#profile;$envi++) {
 	chomp($profile[$envi]);
 	my ($envname,$envvalue)=split(/=/,$profile[$envi]);
-	$ENV{$envname} = $envvalue;
 	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
@@ -278,7 +278,6 @@ sub transfer_profile_to_env {
             }
         }
     }
-    $ENV{'user.environment'} = "$lonidsdir/$handle.id";
     $env{'user.environment'} = "$lonidsdir/$handle.id";
     foreach my $expired_key (keys(%Remove)) {
         &delenv($expired_key);
@@ -296,7 +295,6 @@ sub appenv {
                 .'</font>');
 	    delete($newenv{$_});
         } else {
-            $ENV{$_}=$newenv{$_};
             $env{$_}=$newenv{$_};
         }
     }
@@ -384,7 +382,6 @@ sub delenv {
 	foreach (@oldenv) {
 	    if ($_=~/^$delthis/) { 
                 my ($key,undef) = split('=',$_);
-                delete($ENV{$key});
                 delete($env{$key});
             } else {
                 print $fh $_; 
@@ -831,8 +828,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;
@@ -879,6 +879,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
@@ -1129,8 +1132,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)
 #
@@ -1153,30 +1159,22 @@ 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';
@@ -1185,30 +1183,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
@@ -1231,7 +1274,7 @@ sub clean_filename {
 
 
 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);
@@ -1255,30 +1298,30 @@ 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'};
+	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);
@@ -1301,8 +1344,17 @@ sub finishuserfileupload {
 	print FH $env{'form.'.$formname};
 	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') {
 #
@@ -1315,6 +1367,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);
@@ -1618,7 +1778,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) {
@@ -1627,7 +1787,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)) {
@@ -2562,10 +2722,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);
@@ -2583,7 +2749,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
@@ -2601,8 +2771,23 @@ sub put {
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
-# ---------------------------------------------------------- putstore interface
-                                                                                     
+# ------------------------------------------------------------ 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='';
+   foreach my $key (keys(%$storehash)) {
+       $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+   }
+   $items=~s/\&$//;
+   return &reply("newput:$udomain:$uname:$namespace:$items",$uhome);
+}
+
+# ---------------------------------------------------------  putstore interface
+
 sub putstore {
    my ($namespace,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
@@ -2716,7 +2901,7 @@ 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) && 
+    if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
 	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
         return 'F';
     }
@@ -2803,7 +2988,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;
     }
 #
@@ -3677,7 +3871,7 @@ sub createcourse {
 </map>
 ENDINITMAP
         $topurl=&declutter(
-        &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+        &finishuserfileupload($uname,$udom,'initmap','default.sequence')
                           );
     }
 # ----------------------------------------------------------- Write preferences
@@ -3744,7 +3938,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);
     }
@@ -3823,17 +4016,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);
@@ -3868,13 +4065,14 @@ 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};
@@ -3882,7 +4080,13 @@ sub unmark_as_readonly {
         my @del_keys;
         if (ref($current_locks) eq "ARRAY"){
             foreach my $locker (@{$current_locks}) {
-                unless ($locker eq $what) {
+                my $compare=$locker;
+                if (ref($locker)) { $compare=join('',@{$locker}) };
+                if ($compare eq $symb_crs) {
+                    if (defined($file_name) && ($file_name ne $file)) {
+                        push(@new_locks, $what);
+                    }
+                } else {
                     push(@new_locks, $what);
                 }
             }
@@ -4086,13 +4290,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) {
@@ -4104,6 +4309,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};
@@ -4134,7 +4387,7 @@ 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
@@ -4289,44 +4542,20 @@ 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=&courseresdata($env{'course.'.$courseid.'.num'},
-					   $env{'course.'.$courseid.'.domain'},
-					   ($seclevelr,$seclevelm,$seclevel,
-					    $courselevelr));
+	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+				     $env{'course.'.$courseid.'.domain'},
+				     'course',
+				     ($seclevelr,$seclevelm,$seclevel,
+				      $courselevelr));
 	    if (defined($coursereply)) { return $coursereply; }
 
 # ------------------------------------------------------ third, check map parms
@@ -4358,9 +4587,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
@@ -4588,7 +4818,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,
@@ -4624,7 +4853,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*24);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -4676,7 +4905,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;
     }
@@ -4781,7 +5010,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) { 
@@ -4920,7 +5149,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;
@@ -4930,8 +5160,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);
                             }
 			 }
                      }
@@ -4945,7 +5175,6 @@ sub symbread {
         }
         if ($syval) {
 	    return $env{$cache_str}=$syval;
-	    #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
         }
     }
     &appenv('request.ambiguous' => $thisfn);
@@ -6140,13 +6369,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
 
@@ -6561,7 +6794,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