--- loncom/lonnet/perl/lonnet.pm	2005/04/15 22:03:23	1.624
+++ loncom/lonnet/perl/lonnet.pm	2005/10/10 18:15:52	1.661
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.624 2005/04/15 22:03:23 albertel Exp $
+# $Id: lonnet.pm,v 1.661 2005/10/10 18:15:52 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);
@@ -766,6 +767,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 +835,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;
@@ -1128,8 +1139,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)
 #
@@ -1152,30 +1166,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';
@@ -1184,30 +1190,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
@@ -1230,7 +1281,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);
@@ -1254,30 +1305,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);
@@ -1300,8 +1351,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') {
 #
@@ -1314,6 +1374,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);
@@ -1475,7 +1643,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) {
@@ -1517,9 +1685,10 @@ 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}
@@ -1548,7 +1717,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;
@@ -1639,7 +1812,27 @@ sub courseiddump {
     return %returnhash;
 }
 
-#
+# ---------------------------------------------------------- DC e-mail
+sub dcmaildump {
+    my ($dom,$startdate,$enddate,$senders) = @_;
+    my %returnhash=(); 
+    foreach my $tryserver (keys(%libserv)) {
+        if ($hostdom{$tryserver} eq $dom) {
+            %{$returnhash{$tryserver}}=();
+            foreach (
+                split(/\&/,&reply('dcmaildump:'.$dom.':'.
+                   &escape($startdate).':'.&escape($enddate).':'.
+                   &escape($senders), ,$tryserver))) {
+                my($key,$value) = split(/\=/,$_);
+                if (($key) && ($value)) {
+                    $returnhash{$tryserver}{&unescape($key)} = &unescape($value);
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
 # ----------------------------------------------------------- Check out an item
 
 sub get_first_access {
@@ -2317,8 +2510,12 @@ sub rolesinit {
 	    
             my ($trole,$tend,$tstart);
 	    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;
+		}
 	    } else {
 		($trole,$tend,$tstart)=split(/_/,$role);
 	    }
@@ -2561,10 +2758,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);
@@ -2582,7 +2785,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
@@ -2600,8 +2807,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'}; }
@@ -2715,7 +2937,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';
     }
@@ -2802,7 +3024,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;
     }
 #
@@ -2998,8 +3229,7 @@ sub allowed {
 # --------------------------------------------------- Is a resource on the map?
 
 sub is_on_map {
-    my $uri=&declutter(shift);
-    $uri=~s/\.\d+\.(\w+)$/\.$1/;
+    my $uri=&deversion(&declutter(shift));
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
@@ -3572,6 +3802,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;
@@ -3676,7 +3908,7 @@ sub createcourse {
 </map>
 ENDINITMAP
         $topurl=&declutter(
-        &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+        &finishuserfileupload($uname,$udom,'initmap','default.sequence')
                           );
     }
 # ----------------------------------------------------------- Write preferences
@@ -3743,7 +3975,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);
     }
@@ -3822,17 +4053,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);
@@ -3867,30 +4102,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});
             }
         }
     }
@@ -4107,6 +4346,12 @@ sub get_courseresdata {
     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
@@ -4130,7 +4375,9 @@ sub get_userresdata {
 		 $uname." at ".$udom.": ".
 		 $tmp."</font>");
     } elsif ($tmp=~/error: 2 /) {
-	&EXT_cache_set($udom,$uname);
+	#&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;
 }
@@ -4174,7 +4421,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
@@ -4210,8 +4457,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;
@@ -4605,7 +4854,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,
@@ -4693,7 +4941,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;
     }
@@ -4798,7 +5046,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) { 
@@ -4937,7 +5185,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;
@@ -4947,8 +5196,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);
                             }
 			 }
                      }
@@ -4962,7 +5211,6 @@ sub symbread {
         }
         if ($syval) {
 	    return $env{$cache_str}=$syval;
-	    #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
         }
     }
     &appenv('request.ambiguous' => $thisfn);
@@ -5432,6 +5680,9 @@ sub filelocation {
     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)/+([^/]+)/+([^/]+)/+(.*)$-);
@@ -5673,14 +5924,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;
@@ -6157,7 +6415,10 @@ 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 *
 
@@ -6579,7 +6840,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