--- loncom/lonnet/perl/lonnet.pm	2000/01/21 19:08:12	1.10
+++ 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);
 
@@ -163,6 +164,7 @@ sub appenv {
 }
 
 # ------------------------------ Find server with least workload from spare.tab
+
 sub spareserver {
     my $tryserver;
     my $spareserver='';
@@ -178,6 +180,7 @@ sub spareserver {
 }
 
 # --------- Try to authenticate user from domain's lib servers (first this one)
+
 sub authenticate {
     my ($uname,$upass,$udom)=@_;
 
@@ -217,6 +220,7 @@ sub authenticate {
 }
 
 # ---------------------- Find the homebase for a user from domain's lib servers
+
 sub homeserver {
     my ($uname,$udom)=@_;
 
@@ -237,6 +241,7 @@ sub homeserver {
 }
 
 # ----------------------------- Subscribe to a resource, return URL if possible
+
 sub subscribe {
     my $fname=shift;
     my $author=$fname;
@@ -309,6 +314,68 @@ sub restore {
                ."$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
 
 sub BEGIN {
@@ -349,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');
 }
@@ -357,3 +446,4 @@ $readit='done';
 
 
 
+