loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.7 and 1.9

version 1.7, 1999/12/22 17:18:04	version 1.9, 2000/01/14 21:12:40
Line 2	Line 2
# TCP networking package	# TCP networking package
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,	# 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,	# 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;	package Apache::lonnet;

use strict;	use strict;
use Apache::File;	use Apache::File;
	use LWP::UserAgent();
use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit);	use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit);
use IO::Socket;	use IO::Socket;
	use Apache::Constants qw(:common :http);

# --------------------------------------------------------------------- Logging	# --------------------------------------------------------------------- Logging

Line 43 sub subreply {	Line 46 sub subreply {
or return "con_lost";	or return "con_lost";
print $client "$cmd\n";	print $client "$cmd\n";
my $answer=<$client>;	my $answer=<$client>;
chomp($answer);
if (!$answer) { $answer="con_lost"; }	if (!$answer) { $answer="con_lost"; }
	chomp($answer);
return $answer;	return $answer;
}	}

Line 141 sub appenv {	Line 144 sub appenv {
}	}
for (my $i=0; $i<=$#oldenv; $i++) {	for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);	chomp($oldenv[$i]);
my ($name,$value)=split(/=/,$oldenv[$i]);	if ($oldenv[$i] ne '') {
$newenv{$name}=$value;	my ($name,$value)=split(/=/,$oldenv[$i]);
	$newenv{$name}=$value;
	}
}	}
{	{
my $fh;	my $fh;
Line 180 sub authenticate {	Line 185 sub authenticate {
($udom eq $perlvar{'lonDefDomain'})) {	($udom eq $perlvar{'lonDefDomain'})) {
my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});	my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
if ($answer =~ /authorized/) {	if ($answer =~ /authorized/) {
if ($answer eq 'authorized') { return $perlvar{'lonHostID'}; }	if ($answer eq 'authorized') {
if ($answer eq 'non_authorized') { return 'no_host'; }	&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';
	}
}	}
}	}

Line 190 sub authenticate {	Line 201 sub authenticate {
if ($hostdom{$tryserver} eq $udom) {	if ($hostdom{$tryserver} eq $udom) {
my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);	my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver);
if ($answer =~ /authorized/) {	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';	return 'no_host';
}	}

Line 220 sub homeserver {	Line 239 sub homeserver {
# ----------------------------- Subscribe to a resource, return URL if possible	# ----------------------------- Subscribe to a resource, return URL if possible
sub subscribe {	sub subscribe {
my $fname=shift;	my $fname=shift;
&logthis($fname);
my $author=$fname;	my $author=$fname;
$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;	$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;
my ($udom,$uname)=split(/\//,$author);	my ($udom,$uname)=split(/\//,$author);
my $home=homeserver($uname,$udom);	my $home=homeserver($uname,$udom);
&logthis("$home $udom $uname");
if (($home eq 'no_host') \|\| ($home eq $perlvar{'lonHostID'})) {	if (($home eq 'no_host') \|\| ($home eq $perlvar{'lonHostID'})) {
return 'not_found';	return 'not_found';
}	}
Line 233 sub subscribe {	Line 250 sub subscribe {
return $answer;	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	# ================================================================ Main Program

Line 245 if ($readit ne 'done') {	Line 320 if ($readit ne 'done') {
while (my $configline=<$config>) {	while (my $configline=<$config>) {
if ($configline =~ /PerlSetVar/) {	if ($configline =~ /PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
	chomp($varvalue);
$perlvar{$varname}=$varvalue;	$perlvar{$varname}=$varvalue;
}	}
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.7
changed lines
	Added in v.1.9