--- loncom/lonnet/perl/lonnet.pm	2005/06/13 20:23:54	1.638
+++ loncom/lonnet/perl/lonnet.pm	2005/10/27 19:47:39	1.669
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.638 2005/06/13 20:23:54 albertel Exp $
+# $Id: lonnet.pm,v 1.669 2005/10/27 19:47:39 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -37,7 +37,7 @@ 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
@@ -767,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)=@_;
@@ -1169,7 +1176,6 @@ sub process_coursefile {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
 			     $home);
     } else {
-        my $fetchresult = '';
         my $fpath = '';
         my $fname = $file;
         ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
@@ -1302,7 +1308,7 @@ sub userfileupload {
     if ($coursedoc) {
 	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
 	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
-        if ($env{'form.folder'} =~ m/^default/) {
+        if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
             return &finishuserfileupload($docuname,$docudom,
 					 $formname,$fname,$parser,$allfiles,
 					 $codebase);
@@ -1368,7 +1374,7 @@ sub finishuserfileupload {
 }
 
 sub extract_embedded_items {
-    my ($filepath,$file,$allfiles,$codebase) = @_;
+    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
     my @state = ();
     my %javafiles = (
                       codebase => '',
@@ -1379,118 +1385,99 @@ sub extract_embedded_items {
                       src => '',
                       movie => '',
                      );
-    my $p = HTML::Parser->new
-    (
-        xml_mode => 1,
-        start_h =>
-            [sub {
-                 my ($tagname, $attr) = @_;
-                 push (@state, $tagname);
-                 if (lc($tagname) eq 'img') {
-                     if (exists($$allfiles{$attr->{'src'}})) {
-                         unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) {
-                             push (@{$$allfiles{$attr->{'src'}}},&escape('src'));
-                         }
-                     } else {
-                         @{$$allfiles{$attr->{'src'}}} = (&escape('src'));
-                     }
-                 }
-                 if (lc($tagname) eq 'object') {
-                     foreach my $item (keys (%javafiles)) {
-                         $javafiles{$item} = '';
-                     }
-                 }
-                 if (lc($state[-2]) eq 'object') {
-                     if (lc($tagname) eq 'param') {
-                         my $name = lc($attr->{'name'});
-                         foreach my $item (keys (%mediafiles)) {
-                             if ($name eq $item) {
-                                 if (exists($$allfiles{$attr->{'value'}})) {
-                                     unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) {
-                                         push(@{$$allfiles{$attr->{'value'}}},&escape('value'));
-                                     }
-                                 } else {
-                                     @{$$allfiles{$attr->{'value'}}} = (&escape('value'));
-                                 }
-                                 last;
-                             }
-                         }
-                         foreach my $item (keys (%javafiles)) {
-                             if ($name eq $item) {
-                                 $javafiles{$item} = $attr->{'value'};
-                                 last;
-                             }
-                         }
-                     }
-                 }
-                 if (lc($tagname) eq 'embed') {
-                     unless (lc($state[-2]) eq 'object') {
-                         foreach my $item (keys (%javafiles)) {
-                             $javafiles{$item} = '';
-                         }
-                     }
-                     foreach my $item (keys (%javafiles)) {
-                         if ($attr->{$item}) {
-                             $javafiles{$item} = $attr->{$item};
-                             last;
-                         }
-                     }
-                     foreach my $item (keys (%mediafiles)) {
-                         if ($attr->{$item}) {
-                             if (exists($$allfiles{$attr->{$item}})) {
-                                 unless (grep/^$item$/,@{$$allfiles{$item}}) {
-                                     push(@{$$allfiles{$attr->{$item}}},&escape($item));
-                                 }
-                             } else {
-                                 @{$$allfiles{$attr->{$item}}} = (&escape($item));
-                             }
-                             last;
-                         }
-                     }
-                 }
-            }, "tagname, attr"],
-        text_h =>
-             [sub {
-                 my ($text) = @_;
-        }, "dtext"],
-        end_h =>
-               [sub {
-                   my ($tagname) = @_;
-                   unless ($javafiles{'codebase'} eq '') {
-                       $javafiles{'codebase'} .= '/';
-                   }  
-                   if (lc($tagname) eq 'object') {
-                       &extract_java_items(\%javafiles,$allfiles,$codebase);
-                   } 
-                   if (lc($tagname) eq 'embed') {
-                       unless (lc($state[-2]) eq 'object') {
-                           &extract_java_items(\%javafiles,$allfiles,$codebase);
-                       }
-                   }
-                   pop @state;
-                }, "tagname"],
-    );
-    $p->parse_file($filepath.'/'.$file);
-    $p->eof;
+    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 extract_java_items {
-    my ($javafiles,$allfiles,$codebase) = @_;
-    foreach my $item (keys(%{$javafiles})) {
-        if ($item ne 'codebase') {
-            if ($$javafiles{$item} ne '') {
-		my $file=$javafiles->{'codebase'}.$javafiles->{$item};
-                if (exists($allfiles->{$file})) {
-                    unless (scalar(grep(/^$item$/, @{$allfiles->{$file}}))) {
-                        push(@{$allfiles->{$file}}, &escape($item));
-		    }
-		} else {
-                    @{$allfiles->{$file}} = (&escape($item));
-                    $codebase->{$file} = $javafiles->{'codebase'};
-                }
-            }
-        }
+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));
     }
 }
 
@@ -1622,6 +1609,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++;
 }
 
@@ -1655,7 +1667,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) {
@@ -1697,14 +1709,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 {
@@ -1728,7 +1750,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;
@@ -1819,7 +1845,65 @@ sub courseiddump {
     return %returnhash;
 }
 
-#
+# ---------------------------------------------------------- DC e-mail
+
+sub dcmailput {
+    my ($domain,$msgid,$contents,$server)=@_;
+    my $status = &Apache::lonnet::critical(
+       'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
+       &Apache::lonnet::escape($$contents{$server}),$server);
+    return $status;
+}
+
+sub dcmaildump {
+    my ($dom,$startdate,$enddate,$senders) = @_;
+    my %returnhash=(); 
+    foreach my $tryserver (keys(%libserv)) {
+        if ($hostdom{$tryserver} eq $dom) {
+            %{$returnhash{$tryserver}}=();
+	    my $cmd='dcmaildump:'.$dom.':'.
+		&escape($startdate).':'.&escape($enddate).':';
+	    my @esc_senders=map { &escape($_)} @$senders;
+	    $cmd.=&escape(join('&',@esc_senders));
+	    foreach (split(/\&/,&reply($cmd,$tryserver))) {
+                my ($key,$value) = split(/\=/,$_);
+                if (($key) && ($value)) {
+                    $returnhash{$tryserver}{&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 {
@@ -2494,11 +2578,14 @@ sub rolesinit {
 	  if ($_!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);
 	    $area=~s/\_\w\w$//;
-	    
             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);
 	    }
@@ -2514,7 +2601,7 @@ sub rolesinit {
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
 		}
             }
-          } 
+          }
         }
         my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
         $userroles.='user.adv='.$adv."\n".
@@ -2867,6 +2954,29 @@ 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)=@_;
+    my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'});
+    my %returnhash;
+    foreach my $item (split(/\&/,$rep)) {
+	my ($key,$value)=split(/=/,$item);
+	$returnhash{&unescape($key)}=&thaw_unescape($value);
+    }
+    return %returnhash;
+}
+
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {
@@ -2920,7 +3030,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';
     }
@@ -2988,13 +3098,20 @@ sub allowed {
        $thisallowed.=$1;
     }
 
-# URI is an uploaded document for this course
+# 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/|)) {
+	$thisallowed='';
 	my $refuri=$env{'httpref.'.$orguri};
 	if ($refuri) {
 	    if ($refuri =~ m|^/adm/|) {
 		$thisallowed='F';
+	    } else {
+                $refuri=&declutter($refuri);
+                my ($match) = &is_on_map($refuri);
+                if ($match) {
+                    $thisallowed='F';
+                }
 	    }
 	}
     }
@@ -3007,7 +3124,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;
     }
 #
@@ -3203,8 +3329,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;
@@ -3574,7 +3699,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;
 }
@@ -3777,6 +3902,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;
@@ -4084,28 +4211,25 @@ sub unmark_as_readonly {
     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}) {
                 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);
+                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});
             }
         }
     }
@@ -4433,8 +4557,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;
@@ -4915,7 +5041,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;
     }
@@ -5020,7 +5146,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) { 
@@ -5654,6 +5780,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)/+([^/]+)/+([^/]+)/+(.*)$-);
@@ -5686,14 +5815,15 @@ 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);
+    }
+    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;
 }
@@ -5895,14 +6025,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;