--- loncom/lonnet/perl/lonnet.pm 1999/10/13 17:48:51 1.1 +++ 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 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 { @@ -171,25 +178,17 @@ sub authenticate { if (($perlvar{'lonRole'} eq 'library') && ($udom eq $perlvar{'lonDefDomain'})) { - my $subdir=$uname; - $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $passfilename="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname/passwd"; - if (-e $passfilename) { - my $pf = Apache::File->new($passfilename); - my $realpasswd=<$pf>; - chomp($realpasswd); - if ( $realpasswd eq $upass ) { - return $perlvar{'lonHostID'}; - } else { - return 'no_host'; - } - } + 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'; } + } } my $tryserver; foreach $tryserver (keys %libserv) { if ($hostdom{$tryserver} eq $udom) { - my $answer=reply("auth:$udom:$uname:$upass",$tryserver); + my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver); if ($answer =~ /authorized/) { if ($answer eq 'authorized') { return $tryserver; } }