--- loncom/lonnet/perl/lonnet.pm 1999/12/22 17:18:04 1.7 +++ loncom/lonnet/perl/lonnet.pm 2000/01/13 14:48:36 1.8 @@ -2,14 +2,17 @@ # TCP networking package # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, -# 11/8,11/16,11/18,11/22,11/23,12/22 Gerd Kortemeyer +# 11/8,11/16,11/18,11/22,11/23,12/22, +# 01/06,01/13 Gerd Kortemeyer package Apache::lonnet; use strict; use Apache::File; +use LWP::UserAgent(); use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit); use IO::Socket; +use Apache::Constants qw(:common :http); # --------------------------------------------------------------------- Logging @@ -233,6 +236,51 @@ sub subscribe { return $answer; } +# -------------------------------------------------------------- Replicate file + +sub repcopy { + my $filename=shift; + my $transname="$filename.in.transfer"; + my $remoteurl=subscribe($filename); + if ($remoteurl eq 'con_lost') { + &logthis("Subscribe returned con_lost: $filename"); + return HTTP_SERVICE_UNAVAILABLE; + } elsif ($remoteurl eq 'not_found') { + &logthis("Subscribe returned not_found: $filename"); + return HTTP_NOT_FOUND; + } elsif ($remoteurl eq 'forbidden') { + &logthis("Subscribe returned forbidden: $filename"); + return FORBIDDEN; + } else { + my @parts=split(/\//,$filename); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + if ($path ne "$perlvar{'lonDocRoot'}/res") { + &logthis("Malconfiguration for replication: $filename"); + return HTTP_BAD_REQUEST; + } + 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; + } + } +} + # ================================================================ Main Program @@ -245,6 +293,7 @@ if ($readit ne 'done') { while (my $configline=<$config>) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); $perlvar{$varname}=$varvalue; } }