--- loncom/lonnet/perl/lonrep.pm 1999/10/13 17:48:51 1.1 +++ loncom/lonnet/perl/lonrep.pm 2007/04/26 01:18:47 1.13 @@ -1,19 +1,57 @@ # The LearningOnline Network # Replication Manager -# (Access Handler for File Transfers -# (lonacc: Cookie Based Access Handler -# 5/21/99,5/22,5/29,5/31,6/15 Gerd Kortemeyer) -# 6/16,6/18 Gerd Kortemeyer) -# 6/18,6/21,6/26,6/28,6/29,6/30, -# 7/2,7/3,7/9,7/10,7/12 Gerd Kortemeyer +# +# $Id: lonrep.pm,v 1.13 2007/04/26 01:18:47 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# package Apache::lonrep; use strict; use Apache::Constants qw(:common :http); -use LWP::UserAgent(); -use Apache::lonnet(); +use Apache::lonnet; use Apache::File(); +use CGI::Cookie(); + +sub update_filename { + my ($r,$filename) = @_; + my $oldfile = $r->filename($filename); + if ($ENV{'MOD_PERL_API_VERSION'} == 2 + && -e $filename) { + eval { + require APR::Finfo; + require APR::Const; + $r->finfo(APR::Finfo::stat($filename, + &APR::Const::FINFO_NORM(), + $r->pool)); + }; + if ($@) { + return $@; + } + } + return; +} sub handler { my $r = shift; @@ -21,53 +59,42 @@ sub handler { return OK; } else { my $filename=$r->filename.$r->path_info; - my $transname="$filename.in.transfer"; - if (-e $transname) { + if ($filename=~/\/$/) { return OK; } + if (-e "$filename.in.transfer") { sleep 10; - $r->filename($filename); - if (-e $r->finfo) { - return OK; + if (-e $filename) { + my $error = &update_filename($r,$filename); + if ($error) { + $r->log_reason('Update filename failed '.$error); + return HTTP_SERVICE_UNAVAILABLE; + } + return OK; } else { - $r->log_reason("Waiting for file transfer timed out",$filename); - return HTTP_SERVICE_UNAVAILABLE; + $r->log_reason("Waiting for file transfer timed out",$filename); + return HTTP_SERVICE_UNAVAILABLE; } } else { - my $remoteurl=Apache::lonnet::subscribe($filename); - if ($remoteurl eq 'con_lost') { - $r->log_reason("Subscribe returned con_lost",$filename); - return HTTP_SERVICE_UNAVAILABLE; - } elsif ($remoteurl eq 'not_found') { - $r->log_reason("Subscribe returned not_found",$filename); - return HTTP_NOT_FOUND; - } elsif ($remoteurl eq 'forbidden') { - $r->log_reason("Subscribe returned forbidden",$filename); - return FORBIDDEN; - } else { - my @parts=split(/\//,$filename); - my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; - my $count; - for ($count=5;$count<$#parts;$count++) { - $path.="/$parts[$count]"; - if ((-e $path)!=1) { - mkdir($path,0777); - } - } - my $ua=new LWP::UserAgent; - my $request=new HTTP::Request('GET',"$remoteurl"); - my $response=$ua->request($request,$transname); - if ($response->is_error()) { - unlink($transname); - my $message=$response->status_line; - $r->log_reason("LWP GET: $message",$filename); - return HTTP_SERVICE_UNAVAILABLE; - } else { - rename($transname,$filename); - $r->filename($filename); - return OK; - } - } + my $response=&Apache::lonnet::repcopy($filename); + if ($response eq 'ok' && -e $filename) { + $r->path_info(''); + my $error = &update_filename($r,$filename); + if ($error) { + $r->log_reason('Update filename failed after replication '.$error); + return HTTP_SERVICE_UNAVAILABLE; + } + return OK; + } + my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); + my $lonid=$cookies{'lonID'}; + if ($lonid) { + $r->log_reason('Replication failed for '.$lonid->value); + return $response; + } else { + $r->log_reason('Replication failed for unknown user'); + return FORBIDDEN; + } } - } + } } 1;