--- loncom/lonnet/perl/lonnet.pm 2000/01/13 14:48:36 1.8
+++ loncom/lonnet/perl/lonnet.pm 2000/02/29 16:24:00 1.11
@@ -3,14 +3,15 @@
# 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,
-# 01/06,01/13 Gerd Kortemeyer
+# 01/06,01/13,02/24,02/28,02/29 Gerd Kortemeyer
package Apache::lonnet;
use strict;
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 %pr %prp $readit);
use IO::Socket;
use Apache::Constants qw(:common :http);
@@ -46,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;
}
@@ -144,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;
@@ -161,6 +164,7 @@ sub appenv {
}
# ------------------------------ Find server with least workload from spare.tab
+
sub spareserver {
my $tryserver;
my $spareserver='';
@@ -176,6 +180,7 @@ sub spareserver {
}
# --------- Try to authenticate user from domain's lib servers (first this one)
+
sub authenticate {
my ($uname,$upass,$udom)=@_;
@@ -183,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)=@_;
@@ -221,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';
}
@@ -271,16 +290,91 @@ sub repcopy {
if ($response->is_error()) {
unlink($transname);
my $message=$response->status_line;
- $r->log_reason("LWP GET: $message",$filename);
+ &logthis("LWP GET: $message: $filename");
return HTTP_SERVICE_UNAVAILABLE;
} else {
rename($transname,$filename);
- $r->filename($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
@@ -322,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');
}
@@ -330,3 +446,4 @@ $readit='done';
+