[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.827 and 1.828

version 1.827, 2007/01/18 18:21:10 version 1.828, 2007/01/18 21:02:06
Line 1176  sub repcopy { Line 1176  sub repcopy {
     }      }
     $filename=~s/[\n\r]//g;      $filename=~s/[\n\r]//g;
     my $transname="$filename.in.transfer";      my $transname="$filename.in.transfer";
   # FIXME: this should flock
     if ((-e $filename) || (-e $transname)) { return 'ok'; }      if ((-e $filename) || (-e $transname)) { return 'ok'; }
     my $remoteurl=subscribe($filename);      my $remoteurl=subscribe($filename);
     if ($remoteurl =~ /^con_lost by/) {      if ($remoteurl =~ /^con_lost by/) {
Line 7158  sub repcopy_userfile { Line 7159  sub repcopy_userfile {
     if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }      if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
     my ($cdom,$cnum,$filename) =       my ($cdom,$cnum,$filename) = 
  ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);   ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);
     my ($info,$rtncode);  
     my $uri="/uploaded/$cdom/$cnum/$filename";      my $uri="/uploaded/$cdom/$cnum/$filename";
     if (-e "$file") {      if (-e "$file") {
   # we already have a local copy, check it out
  my @fileinfo = stat($file);   my @fileinfo = stat($file);
    my $rtncode;
    my $info;
  my $lwpresp = &getuploaded('HEAD',$uri,$cdom,$cnum,\$info,\$rtncode);   my $lwpresp = &getuploaded('HEAD',$uri,$cdom,$cnum,\$info,\$rtncode);
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
   # there is no such file anymore, even though we had a local copy
     if ($rtncode eq '404') {      if ($rtncode eq '404') {
  unlink($file);   unlink($file);
     }      }
     #my $ua=new LWP::UserAgent;  
     #my $request=new HTTP::Request('GET',&tokenwrapper($uri));  
     #my $response=$ua->request($request);  
     #if ($response->is_success()) {  
  # return $response->content;  
  #    } else {  
  # return -1;  
  #    }  
     return -1;      return -1;
  }   }
  if ($info < $fileinfo[9]) {   if ($info < $fileinfo[9]) {
   # nice, the file we have is up-to-date, just say okay
     return 'ok';      return 'ok';
    } else {
   # the file is outdated, get rid of it
       unlink($file);
  }   }
  $info = '';      }
  $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);  # one way or the other, at this point, we don't have the file
  if ($lwpresp ne 'ok') {  # construct the correct path for the file
     return -1;      my @parts = ($cdom,$cnum); 
  }      if ($filename =~ m|^(.+)/[^/]+$|) {
     } else {   push @parts, split(/\//,$1);
  my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);      }
  if ($lwpresp ne 'ok') {      my $path = $perlvar{'lonDocRoot'}.'/userfiles';
     my $ua=new LWP::UserAgent;      foreach my $part (@parts) {
     my $request=new HTTP::Request('GET',&tokenwrapper($uri));   $path .= '/'.$part;
     # FIXME, right reads everything into memory then writes it out   if (!-e $path) {
     # doing something like      mkdir($path,0770);
     #    my $response=$ua->request($request,$file);  
     # would make this write directly to disk  
     my $response=$ua->request($request);  
     if ($response->is_success()) {  
  $info=$response->content;  
     } else {  
  return -1;  
     }  
  }  
  my @parts = ($cdom,$cnum);   
  if ($filename =~ m|^(.+)/[^/]+$|) {  
     push @parts, split(/\//,$1);  
  }  
  my $path = $perlvar{'lonDocRoot'}.'/userfiles';  
  foreach my $part (@parts) {  
     $path .= '/'.$part;  
     if (!-e $path) {  
  mkdir($path,0770);  
     }  
  }   }
     }      }
     open(FILE,">$file");  # now the path exists for sure
     print FILE $info;  # get a user agent
     close(FILE);      my $ua=new LWP::UserAgent;
       my $transferfile=$file.'.in.transfer';
   # FIXME: this should flock
       if (-e $transferfile) { return 'ok'; }
       my $request;
       $uri=~s/^\///;
       if (&homeserver($cnum,$cdom) eq $perlvar{'lonHostID'}) {
   # if this is my own server, get it via tokenwrapper
           $request=new HTTP::Request('GET',&tokenwrapper('/'.$uri));
       } else {
   # get it from another server, raw request
    $request=new HTTP::Request('GET','http://'.$hostname{&homeserver($cnum,$cdom)}.'/raw/'.$uri);
       }
       my $response=$ua->request($request,$transferfile);
   # did it work?
       if ($response->is_error()) {
    unlink($transferfile);
    &logthis("Userfile repcopy failed for $uri");
    return -1;
       }
   # worked, rename the transfer file
       rename($transferfile,$file);
     return 'ok';      return 'ok';
 }  }
   
Line 7237  sub tokenwrapper { Line 7239  sub tokenwrapper {
     }      }
 }  }
   
   # call with reqtype HEAD: get last modification time
   # call with reqtype GET: get the file contents
   # Do not call this with reqtype GET for large files! It loads everything into memory
   #
 sub getuploaded {  sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;      my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;      $uri=~s/^\///;
Removed from v.1.827  
changed lines
  Added in v.1.828

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