--- loncom/lonnet/perl/lonnet.pm 1999/11/16 22:00:17 1.3 +++ loncom/lonnet/perl/lonnet.pm 1999/12/22 17:18:04 1.7 @@ -1,7 +1,8 @@ # 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 Gerd Kortemeyer package Apache::lonnet; @@ -54,29 +55,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 +84,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 +94,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 +113,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 +127,35 @@ 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]); + 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 {