--- loncom/lonnet/perl/lonnet.pm	2017/08/08 15:33:13	1.1348
+++ loncom/lonnet/perl/lonnet.pm	2017/08/27 17:49:49	1.1354
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1348 2017/08/08 15:33:13 raeburn Exp $
+# $Id: lonnet.pm,v 1.1354 2017/08/27 17:49:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1600,17 +1600,17 @@ sub internet_dom_servers {
 
 sub trusted_domains {
     my ($cmdtype,$calldom) = @_;
-    my (%trusted,%untrusted);
+    my ($trusted,$untrusted);
     if (&domain($calldom) eq '') {
-        return (\%trusted,\%untrusted);
+        return ($trusted,$untrusted);
     }
     unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
-        return (\%trusted,\%untrusted);
+        return ($trusted,$untrusted);
     }
     my $callprimary = &domain($calldom,'primary');
     my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
     if ($intcalldom eq '') {
-        return (\%trusted,\%untrusted);
+        return ($trusted,$untrusted);
     }
 
     my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
@@ -1660,17 +1660,17 @@ sub trusted_domains {
             }
             foreach my $exc (@allexc) {
                 if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
-                    map { $untrusted{$_}; } @{$doms_by_intdom{$exc}};
+                    $untrusted = $doms_by_intdom{$exc};
                 }
             }
             foreach my $inc (@allinc) {
                 if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
-                    map { $trusted{$_}; } @{$doms_by_intdom{$inc}};
+                    $trusted = $doms_by_intdom{$inc};
                 }
             }
         }
     }
-    return(\%trusted,\%untrusted);
+    return ($trusted,$untrusted);
 }
 
 sub will_trust {
@@ -3171,6 +3171,71 @@ sub externalssi {
     }
 }
 
+
+# If the local copy of a replicated resource is outdated, trigger a  
+# connection from the homeserver to flush the delayed queue. If no update 
+# happens, remove local copies of outdated resource (and corresponding
+# metadata file).
+
+sub remove_stale_resfile {
+    my ($url) = @_;
+    my $removed;
+    if ($url=~m{^/res/($match_domain)/($match_username)/}) {
+        my $audom = $1;
+        my $auname = $2;
+        unless (($url =~ /\.\d+\.\w+$/) || ($url =~ m{^/res/lib/templates/})) {
+            my $homeserver = &homeserver($auname,$audom);
+            unless (($homeserver eq 'no_host') ||
+                    (grep { $_ eq $homeserver } &current_machine_ids())) {
+                my $fname = &filelocation('',$url);
+                if (-e $fname) {
+                    my $protocol = $protocol{$homeserver};
+                    $protocol = 'http' if ($protocol ne 'https');
+                    my $hostname = &hostname($homeserver);
+                    if ($hostname) {
+                        my $uri = &declutter($url);
+                        my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri);
+                        my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1);
+                        if ($response->is_success()) {
+                            my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );
+                            my $locmodtime = (stat($fname))[9];
+                            if ($locmodtime < $remmodtime) {
+                                my $stale;
+                                my $answer = &reply('pong',$homeserver);
+                                if ($answer eq $homeserver.':'.$perlvar{'lonHostID'}) {
+                                    sleep(0.2);
+                                    $locmodtime = (stat($fname))[9];
+                                    if ($locmodtime < $remmodtime) {
+                                        my $posstransfer = $fname.'.in.transfer';
+                                        if ((-e $posstransfer) && ($remmodtime < (stat($posstransfer))[9])) {
+                                            $removed = 1;
+                                        } else {
+                                            $stale = 1;
+                                        }
+                                    } else {
+                                        $removed = 1;
+                                    }
+                                } else {
+                                    $stale = 1;
+                                }
+                                if ($stale) {
+                                    unlink($fname);
+                                    if ($uri!~/\.meta$/) {
+                                        unlink($fname.'.meta');
+                                    }
+                                    &reply("unsub:$fname",$homeserver);
+                                    $removed = 1;
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $removed;
+}
+
 # -------------------------------- Allow a /uploaded/ URI to be vouched for
 
 sub allowuploaded {
@@ -3694,12 +3759,12 @@ sub userfileupload {
                          '_'.$env{'user.domain'}.'/pending';
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
             my ($docuname,$docudom);
-            if ($destudom) {
+            if ($destudom =~ /^$match_domain$/) {
                 $docudom = $destudom;
             } else {
                 $docudom = $env{'user.domain'};
             }
-            if ($destuname) {
+            if ($destuname =~ /^$match_username$/) {
                 $docuname = $destuname;
             } else {
                 $docuname = $env{'user.name'};
@@ -13363,8 +13428,23 @@ sub fetch_dns_checksums {
 	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
+                if ((exists($hostname{$id})) && ($hostname{$id} ne '')) {
+                    my $curr = $hostname{$id};
+                    my $skip;
+                    if (ref($name_to_host{$curr}) eq 'ARRAY') {
+                        if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) {
+                            $skip = 1;
+                        } else {
+                            @{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}};
+                        }
+                    }
+                    unless ($skip) {
+                        push(@{$name_to_host{$name}},$id);
+                    }
+                } else {
+                    push(@{$name_to_host{$name}},$id);
+                }
 		$hostname{$id}=$name;
-		push(@{$name_to_host{$name}}, $id);
 		$hostdom{$id}=$domain;
 		if ($role eq 'library') { $libserv{$id}=$name; }
                 if (defined($protocol)) {