--- loncom/lonnet/perl/lonnet.pm 2017/08/27 02:36:58 1.1352 +++ loncom/lonnet/perl/lonnet.pm 2017/09/25 00:36:35 1.1355 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1352 2017/08/27 02:36:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1355 2017/09/25 00:36:35 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -650,7 +650,7 @@ sub transfer_profile_to_env { # ---------------------------------------------------- Check for valid session sub check_for_valid_session { - my ($r,$name,$userhashref) = @_; + my ($r,$name,$userhashref,$domref) = @_; my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); my ($linkname,$pubname); if ($name eq '') { @@ -678,7 +678,16 @@ sub check_for_valid_session { } else { $lonidsdir=$r->dir_config('lonIDsDir'); } - return undef if (!-e "$lonidsdir/$handle.id"); + if (!-e "$lonidsdir/$handle.id") { + if ((ref($domref)) && ($name eq 'lonID') && + ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) { + my ($possuname,$possudom,$possuhome) = ($1,$2,$3); + if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) { + $$domref = $possudom; + } + } + return undef; + } my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); return undef if (!$opened); @@ -3171,13 +3180,19 @@ 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 $stale; + 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/})) { + unless (($url =~ /\.\d+\.\w+$/) || ($url =~ m{^/res/lib/templates/})) { my $homeserver = &homeserver($auname,$audom); unless (($homeserver eq 'no_host') || (grep { $_ eq $homeserver } ¤t_machine_ids())) { @@ -3194,12 +3209,32 @@ sub remove_stale_resfile { my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') ); my $locmodtime = (stat($fname))[9]; if ($locmodtime < $remmodtime) { - unlink($fname); - if ($uri!~/\.meta$/) { - unlink($fname.'.meta'); + 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; } - &reply("unsub:$fname",$homeserver); - $stale = 1; } } } @@ -3207,7 +3242,7 @@ sub remove_stale_resfile { } } } - return $stale; + return $removed; } # -------------------------------- Allow a /uploaded/ URI to be vouched for