--- loncom/lonnet/perl/lonnet.pm 1999/11/16 22:00:17 1.3 +++ loncom/lonnet/perl/lonnet.pm 2000/01/14 21:12:40 1.9 @@ -1,14 +1,18 @@ # The LearningOnline Network # 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 Gerd Kortemeyer +# 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, +# 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 @@ -42,8 +46,8 @@ sub subreply { or return "con_lost"; print $client "$cmd\n"; my $answer=<$client>; - chomp($answer); if (!$answer) { $answer="con_lost"; } + chomp($answer); return $answer; } @@ -54,29 +58,6 @@ sub reply { return $answer; } -# ------------------------------------------------ Try to send delayed messages - -sub senddelayed { - my $server=shift; - my $dfname; - my $path="$perlvar{'lonSockDir'}/delayed"; - while ($dfname=<$path/*.$server>) { - my $wcmd; - { - my $dfh=Apache::File->new($dfname); - $wcmd=<$dfh>; - } - my ($server,$cmd)=split(/:/,$wcmd); - chomp($cmd); - my $answer=subreply($cmd,$server); - if ($answer ne 'con_lost') { - unlink("$dfname"); - &logthis("Delayed $cmd to $server: $answer"); - &logperm("S:$server:$cmd"); - } - } -} - # ----------------------------------------------------------- Send USR1 to lonc sub reconlonc { @@ -106,7 +87,6 @@ sub reconlonc { # ------------------------------------------------------ Critical communication sub critical { my ($cmd,$server)=@_; - &senddelayed($server); my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $pingreply=reply('ping',$server); @@ -117,13 +97,14 @@ sub critical { if ($answer eq 'con_lost') { my $now=time; my $middlename=$cmd; + $middlename=substr($middlename,0,16); $middlename=~s/\W//g; my $dfilename= "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server"; { my $dfh; if ($dfh=Apache::File->new(">$dfilename")) { - print $dfh "$server:$cmd\n"; + print $dfh "$cmd\n"; } } sleep 2; @@ -135,7 +116,7 @@ sub critical { } } chomp($wcmd); - if ($wcmd eq "$server:$cmd") { + if ($wcmd eq $cmd) { &logthis("Connection buffer $dfilename: $cmd"); &logperm("D:$server:$cmd"); return 'con_delayed'; @@ -149,6 +130,37 @@ sub critical { return $answer; } +# ---------------------------------------------------------- Append Environment + +sub appenv { + my %newenv=@_; + my @oldenv; + { + my $fh; + unless ($fh=Apache::File->new("$ENV{'user.environment'}")) { + return 'error'; + } + @oldenv=<$fh>; + } + for (my $i=0; $i<=$#oldenv; $i++) { + chomp($oldenv[$i]); + if ($oldenv[$i] ne '') { + my ($name,$value)=split(/=/,$oldenv[$i]); + $newenv{$name}=$value; + } + } + { + my $fh; + unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) { + return 'error'; + } + my $newname; + foreach $newname (keys %newenv) { + print $fh "$newname=$newenv{$newname}\n"; + } + } + return 'ok'; +} # ------------------------------ Find server with least workload from spare.tab sub spareserver { @@ -173,8 +185,14 @@ sub authenticate { ($udom eq $perlvar{'lonDefDomain'})) { my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'}); if ($answer =~ /authorized/) { - if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; } - if ($answer eq 'non_authorized') { return 'no_host'; } + if ($answer eq 'authorized') { + &logthis("User $uname at $udom authorized by local server"); + return $perlvar{'lonHostID'}; + } + if ($answer eq 'non_authorized') { + &logthis("User $uname at $udom rejected by local server"); + return 'no_host'; + } } } @@ -183,10 +201,18 @@ sub authenticate { if ($hostdom{$tryserver} eq $udom) { my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver); if ($answer =~ /authorized/) { - if ($answer eq 'authorized') { return $tryserver; } + if ($answer eq 'authorized') { + &logthis("User $uname at $udom authorized by $tryserver"); + return $tryserver; + } + if ($answer eq 'non_authorized') { + &logthis("User $uname at $udom rejected by $tryserver"); + return 'no_host'; + } } } - } + } + &logthis("User $uname at $udom could not be authenticated"); return 'no_host'; } @@ -213,12 +239,10 @@ sub homeserver { # ----------------------------- Subscribe to a resource, return URL if possible sub subscribe { my $fname=shift; - &logthis($fname); my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); my $home=homeserver($uname,$udom); - &logthis("$home $udom $uname"); if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { return 'not_found'; } @@ -226,6 +250,64 @@ 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; + &logthis("LWP GET: $message: $filename"); + return HTTP_SERVICE_UNAVAILABLE; + } else { + rename($transname,$filename); + return OK; + } + } +} + +# ----------------------------------------------------------------------- Store + +sub store { + my %storehash=shift; + my $command="store:$ENV{'user.domain'}:$ENV{'user.name'}:" + ."$ENV{'user.class'}:$ENV{'request.filename'}:"; +} + +# --------------------------------------------------------------------- Restore + +sub restore { + my $command="restore:$ENV{'user.domain'}:$ENV{'user.name'}:" + ."$ENV{'user.class'}:$ENV{'request.filename'}:"; +} # ================================================================ Main Program @@ -238,6 +320,7 @@ if ($readit ne 'done') { while (my $configline=<$config>) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); $perlvar{$varname}=$varvalue; } }