--- loncom/lonnet/perl/lonnet.pm 1999/12/22 17:18:04 1.7 +++ loncom/lonnet/perl/lonnet.pm 2000/02/29 16:24:00 1.11 @@ -2,14 +2,18 @@ # 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,02/24,02/28,02/29 Gerd Kortemeyer package Apache::lonnet; use strict; use Apache::File; -use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv $readit); +use LWP::UserAgent(); +use vars +qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp $readit); use IO::Socket; +use Apache::Constants qw(:common :http); # --------------------------------------------------------------------- Logging @@ -43,8 +47,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; } @@ -141,8 +145,10 @@ sub appenv { } for (my $i=0; $i<=$#oldenv; $i++) { chomp($oldenv[$i]); - my ($name,$value)=split(/=/,$oldenv[$i]); - $newenv{$name}=$value; + if ($oldenv[$i] ne '') { + my ($name,$value)=split(/=/,$oldenv[$i]); + $newenv{$name}=$value; + } } { my $fh; @@ -158,6 +164,7 @@ sub appenv { } # ------------------------------ Find server with least workload from spare.tab + sub spareserver { my $tryserver; my $spareserver=''; @@ -173,6 +180,7 @@ sub spareserver { } # --------- Try to authenticate user from domain's lib servers (first this one) + sub authenticate { my ($uname,$upass,$udom)=@_; @@ -180,24 +188,39 @@ 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'; + } } } my $tryserver; foreach $tryserver (keys %libserv) { if ($hostdom{$tryserver} eq $udom) { - my $answer=reply("enc:auth:$udom:$uname:$upass",$tryserver); + my $answer=reply("encrypt: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'; } # ---------------------- Find the homebase for a user from domain's lib servers + sub homeserver { my ($uname,$udom)=@_; @@ -218,14 +241,13 @@ 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'; } @@ -233,6 +255,126 @@ 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'}:"; +} + +# -------------------------------------------------------- Get user priviledges + +sub rolesinit { + my ($domain,$username,$authhost)=@_; + my $rolesdump=reply("dump:$domain:$username:roles",$authhost); + my %allroles=(); + my %thesepriv=(); + my $userroles=''; + my $now=time; + my $thesestr; + + &logthis("$domain, $username, $authhost, $rolesdump"); + + if ($rolesdump ne '') { + map { + my ($area,$role)=split(/=/,$_); + my ($trole,$tend,$tstart)=split(/_/,$role); + if ($tend!=0) { + if ($tend<$now) { + $trole=''; + } + } + if ($tstart!=0) { + if ($tstart>$now) { + $trole=''; + } + } + if (($area ne '') && ($trole ne '')) { + $userroles.='user.role.'.$trole.'='.$area."\n"; + my ($tdummy,$tdomain,$trest)=split(/\//,$area); + $allroles{'/'}.=':'.$pr{$trole.':s'}; + if ($tdomain ne '') { + $allroles{'/'.$tdomain.'/'}.=':'.$pr{$trole.':d'}; + if ($trest ne '') { + $allroles{$area}.=':'.$pr{$trole.':c'}; + } + } + } + } split(/&/,$rolesdump); + map { + %thesepriv=(); + map { + if ($_ ne '') { + my ($priviledge,$restrictions)=split(/&/,$_); + if ($restrictions eq '') { + $thesepriv{$priviledge}='F'; + } else { + if ($thesepriv{$priviledge} ne 'F') { + $thesepriv{$priviledge}.=$restrictions; + } + } + } + } split(/:/,$allroles{$_}); + $thesestr=''; + map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv; + $userroles.='user.priv.'.$_.'='.$thesestr."\n"; + } keys %allroles; + } + return $userroles; +} + # ================================================================ Main Program @@ -245,6 +387,7 @@ if ($readit ne 'done') { while (my $configline=<$config>) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); $perlvar{$varname}=$varvalue; } } @@ -273,6 +416,28 @@ if ($readit ne 'done') { } } } +# ------------------------------------------------------------ Read permissions +{ + my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab"); + + while (my $configline=<$config>) { + chomp($configline); + my ($role,$perm)=split(/ /,$configline); + if ($perm ne '') { $pr{$role}=$perm; } + } +} + +# -------------------------------------------- Read plain texts for permissions +{ + my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab"); + + while (my $configline=<$config>) { + chomp($configline); + my ($short,$plain)=split(/:/,$configline); + if ($plain ne '') { $prp{$short}=$plain; } + } +} + $readit='done'; &logthis('Read configuration'); } @@ -281,3 +446,4 @@ $readit='done'; +