[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1352 and 1.1355

version 1.1352, 2017/08/27 02:36:58 version 1.1355, 2017/09/25 00:36:35
Line 650  sub transfer_profile_to_env { Line 650  sub transfer_profile_to_env {
   
 # ---------------------------------------------------- Check for valid session   # ---------------------------------------------------- Check for valid session 
 sub 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 %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     my ($linkname,$pubname);      my ($linkname,$pubname);
     if ($name eq '') {      if ($name eq '') {
Line 678  sub check_for_valid_session { Line 678  sub check_for_valid_session {
     } else {      } else {
         $lonidsdir=$r->dir_config('lonIDsDir');          $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");      my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
     return undef if (!$opened);      return undef if (!$opened);
Line 3171  sub externalssi { Line 3180  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 {  sub remove_stale_resfile {
     my ($url) = @_;      my ($url) = @_;
     my $stale;      my $removed;
     if ($url=~m{^/res/($match_domain)/($match_username)/}) {      if ($url=~m{^/res/($match_domain)/($match_username)/}) {
         my $audom = $1;          my $audom = $1;
         my $auname = $2;          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);              my $homeserver = &homeserver($auname,$audom);
             unless (($homeserver eq 'no_host') ||              unless (($homeserver eq 'no_host') ||
                     (grep { $_ eq $homeserver } &current_machine_ids())) {                      (grep { $_ eq $homeserver } &current_machine_ids())) {
Line 3194  sub remove_stale_resfile { Line 3209  sub remove_stale_resfile {
                             my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );                              my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );
                             my $locmodtime = (stat($fname))[9];                              my $locmodtime = (stat($fname))[9];
                             if ($locmodtime < $remmodtime) {                              if ($locmodtime < $remmodtime) {
                                 unlink($fname);                                  my $stale;
                                 if ($uri!~/\.meta$/) {                                  my $answer = &reply('pong',$homeserver);
                                     unlink($fname.'.meta');                                  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;  
                             }                              }
                         }                          }
                     }                      }
Line 3207  sub remove_stale_resfile { Line 3242  sub remove_stale_resfile {
             }              }
         }          }
     }      }
     return $stale;      return $removed;
 }  }
   
 # -------------------------------- Allow a /uploaded/ URI to be vouched for  # -------------------------------- Allow a /uploaded/ URI to be vouched for
Removed from v.1.1352  
changed lines
  Added in v.1.1355

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>