[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
www
lon-capa-cvs@mail.lon-capa.org
Thu, 18 Jan 2007 21:02:10 -0000
www Thu Jan 18 16:02:10 2007 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
Work on &repcopy_userfiles - now copies to a file rather than into memory
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.827 loncom/lonnet/perl/lonnet.pm:1.828
--- loncom/lonnet/perl/lonnet.pm:1.827 Thu Jan 18 13:21:10 2007
+++ loncom/lonnet/perl/lonnet.pm Thu Jan 18 16:02:06 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.827 2007/01/18 18:21:10 raeburn Exp $
+# $Id: lonnet.pm,v 1.828 2007/01/18 21:02:06 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1176,6 +1176,7 @@
}
$filename=~s/[\n\r]//g;
my $transname="$filename.in.transfer";
+# FIXME: this should flock
if ((-e $filename) || (-e $transname)) { return 'ok'; }
my $remoteurl=subscribe($filename);
if ($remoteurl =~ /^con_lost by/) {
@@ -7158,64 +7159,65 @@
if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
my ($cdom,$cnum,$filename) =
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);
- my ($info,$rtncode);
my $uri="/uploaded/$cdom/$cnum/$filename";
if (-e "$file") {
+# we already have a local copy, check it out
my @fileinfo = stat($file);
+ my $rtncode;
+ my $info;
my $lwpresp = &getuploaded('HEAD',$uri,$cdom,$cnum,\$info,\$rtncode);
if ($lwpresp ne 'ok') {
+# there is no such file anymore, even though we had a local copy
if ($rtncode eq '404') {
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;
}
if ($info < $fileinfo[9]) {
+# nice, the file we have is up-to-date, just say okay
return 'ok';
+ } else {
+# the file is outdated, get rid of it
+ unlink($file);
}
- $info = '';
- $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
- if ($lwpresp ne 'ok') {
- return -1;
- }
- } else {
- my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
- if ($lwpresp ne 'ok') {
- my $ua=new LWP::UserAgent;
- my $request=new HTTP::Request('GET',&tokenwrapper($uri));
- # FIXME, right reads everything into memory then writes it out
- # doing something like
- # 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);
- }
+ }
+# one way or the other, at this point, we don't have the file
+# construct the correct path for the file
+ 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");
- print FILE $info;
- close(FILE);
+# now the path exists for sure
+# get a user agent
+ 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';
}
@@ -7237,6 +7239,10 @@
}
}
+# 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 {
my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
$uri=~s/^\///;