[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.10 and 1.11

version 1.10, 2000/01/21 19:08:12 version 1.11, 2000/02/29 16:24:00
Line 3 Line 3
 # 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,  # 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;  package Apache::lonnet;
   
 use strict;  use strict;
 use Apache::File;  use Apache::File;
 use LWP::UserAgent();  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 IO::Socket;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
   
Line 163  sub appenv { Line 164  sub appenv {
 }  }
   
 # ------------------------------ Find server with least workload from spare.tab  # ------------------------------ Find server with least workload from spare.tab
   
 sub spareserver {  sub spareserver {
     my $tryserver;      my $tryserver;
     my $spareserver='';      my $spareserver='';
Line 178  sub spareserver { Line 180  sub spareserver {
 }  }
   
 # --------- Try to authenticate user from domain's lib servers (first this one)  # --------- Try to authenticate user from domain's lib servers (first this one)
   
 sub authenticate {  sub authenticate {
     my ($uname,$upass,$udom)=@_;      my ($uname,$upass,$udom)=@_;
   
Line 217  sub authenticate { Line 220  sub authenticate {
 }  }
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
   
 sub homeserver {  sub homeserver {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
   
Line 237  sub homeserver { Line 241  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;
     my $author=$fname;      my $author=$fname;
Line 309  sub restore { Line 314  sub restore {
                ."$ENV{'user.class'}:$ENV{'request.filename'}:";                 ."$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  # ================================================================ Main Program
   
 sub BEGIN {  sub BEGIN {
Line 349  if ($readit ne 'done') { Line 416  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';  $readit='done';
 &logthis('Read configuration');  &logthis('Read configuration');
 }  }
Line 357  $readit='done'; Line 446  $readit='done';
   
   
   
   
Removed from v.1.10  
changed lines
  Added in v.1.11

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