[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.677 and 1.678

version 1.677, 2005/11/15 18:39:16 version 1.678, 2005/11/15 21:35:02
Line 2575  sub rolesinit { Line 2575  sub rolesinit {
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);      my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }      if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
     my %allroles=();      my %allroles=();
       my %allgroups=();   
     my $now=time;      my $now=time;
     my $userroles="user.login.time=$now\n";      my $userroles="user.login.time=$now\n";
       my $group_privs;
   
     if ($rolesdump ne '') {      if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {          foreach (split(/&/,$rolesdump)) {
   if ($_!~/^rolesdef_/) {    if ($_!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);              my ($area,$role)=split(/=/,$_);
     $area=~s/\_\w\w$//;      $area=~s/\_\w\w$//;
             my ($trole,$tend,$tstart);              my ($trole,$tend,$tstart,$group_privs);
     if ($role=~/^cr/) {       if ($role=~/^cr/) { 
  if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {   if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
     ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);      ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
Line 2591  sub rolesinit { Line 2593  sub rolesinit {
  } else {   } else {
     $trole=$role;      $trole=$role;
  }   }
               } elsif ($role =~ m|^gr/|) {
                   ($trole,$tend,$tstart) = split(/_/,$role);
                   ($trole,$group_privs) = split(/\//,$trole);
                   $group_privs = &unescape($group_privs);
     } else {      } else {
  ($trole,$tend,$tstart)=split(/_/,$role);   ($trole,$tend,$tstart)=split(/_/,$role);
     }      }
Line 2602  sub rolesinit { Line 2608  sub rolesinit {
  my ($tdummy,$tdomain,$trest)=split(/\//,$area);   my ($tdummy,$tdomain,$trest)=split(/\//,$area);
  if ($trole =~ /^cr\//) {   if ($trole =~ /^cr\//) {
                     &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);                      &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
                   } elsif ($trole eq 'gr') {
                       &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
  } else {   } else {
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);                      &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
  }   }
             }              }
           }            }
         }          }
         my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);          my ($author,$adv) = &set_userprivs(\$userroles,\%allroles,\%allgroups);
         $userroles.='user.adv='.$adv."\n".          $userroles.='user.adv='.$adv."\n".
             'user.author='.$author."\n";              'user.author='.$author."\n";
         $env{'user.adv'}=$adv;          $env{'user.adv'}=$adv;
Line 2650  sub custom_roleprivs { Line 2658  sub custom_roleprivs {
     }      }
 }  }
   
   sub group_roleprivs {
       my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
       my $access = 1;
       my $now = time;
       if (($tend!=0) && ($tend<$now)) { $access = 0; }
       if (($tstart!=0) && ($tstart>$now)) { $access=0; }
       if ($access) {
           my ($course,$group) = ($area =~ m|(/\w+/\w+)/([^/]+)$|);
           $$allgroups{$course}{$group} .=':'.$group_privs;
       }
   }
   
 sub standard_roleprivs {  sub standard_roleprivs {
     my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;      my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
Line 2670  sub standard_roleprivs { Line 2689  sub standard_roleprivs {
 }  }
   
 sub set_userprivs {  sub set_userprivs {
     my ($userroles,$allroles) = @_;       my ($userroles,$allroles,$allgroups) = @_; 
     my $author=0;      my $author=0;
     my $adv=0;      my $adv=0;
       my %grouproles = ();
       my %groups_checked = ();
       if (keys(%{$allgroups}) > 0) {
           foreach my $role (keys %{$allroles}) {
               my ($trole,$area);
               if ($role =~ m|^(\w+)\.(/\w+/\w+)|) {
                   $trole = $1;
                   $area = $2;
                   unless ($groups_checked{$area}) {
                       $groups_checked{$area} = 1;
                       if (exists($$allgroups{$area})) {
                           foreach my $group (keys(%{$$allgroups{$area}})) {
                               my $spec = $trole.'.'.$area;
                               $grouproles{$spec.'.'.$area.'/'.$group} = 
                                                       $$allgroups{$area}{$group};
                           }
                       }
                   }
               }
           }
       }
       foreach (keys(%grouproles)) {
           $$allroles{$_} = $grouproles{$_};
       }
     foreach (keys %{$allroles}) {      foreach (keys %{$allroles}) {
         my %thesepriv=();          my %thesepriv=();
         if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }          if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
Line 3024  sub allowed { Line 3067  sub allowed {
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
           
       
       
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }      if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|))       if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
Line 3072  sub allowed { Line 3113  sub allowed {
     if (($priv eq 'ccc') && ($env{'request.role'} =~ /^dc\./)) {      if (($priv eq 'ccc') && ($env{'request.role'} =~ /^dc\./)) {
         # uri is the requested domain in this case.          # uri is the requested domain in this case.
         # comparison to 'request.role.domain' shows if the user has selected          # comparison to 'request.role.domain' shows if the user has selected
         # a role of dc for the domain in question.           # a role of dc for the domain in question.
         return 'F' if ($uri eq $env{'request.role.domain'});          return 'F' if ($uri eq $env{'request.role.domain'});
     }      }
   
Line 3103  sub allowed { Line 3144  sub allowed {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
   # Group: uri itself is a group
       my $groupuri=$uri;
       $groupuri=~s/^([^\/])/\/$1/;
       if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri}
          =~/\Q$priv\E\&([^\:]*)/) {
          $thisallowed.=$1;
       }
   
 # URI is an uploaded document for this course, default permissions don't matter  # URI is an uploaded document for this course, default permissions don't matter
 # not allowing 'edit' access (editupload) to uploaded course docs  # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {      if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
Line 3675  sub assignrole { Line 3724  sub assignrole {
            return 'refused';              return 'refused'; 
         }          }
         $mrole='cr';          $mrole='cr';
       } elsif ($role =~ /^gr\//) {
           my $cwogrp=$url;
           $cwogrp=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
           unless (&allowed('mdg',$cwogrp)) {
               &logthis('Refused group assignrole: '.
                 $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
                       $env{'user.name'}.' at '.$env{'user.domain'});
               return 'refused';
           }
           $mrole='gr';
     } else {      } else {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;          $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
Removed from v.1.677  
changed lines
  Added in v.1.678

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