[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.1168 and 1.1169

version 1.1168, 2012/05/18 15:31:40 version 1.1169, 2012/05/18 16:26:05
Line 3490  sub statslog { Line 3490  sub statslog {
       
 sub userrolelog {  sub userrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend)=@_;      my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
     if (($trole=~/^ca/) || ($trole=~/^aa/) ||      if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) {
         ($trole=~/^in/) || ($trole=~/^cc/) ||  
         ($trole=~/^ep/) || ($trole=~/^cr/) ||  
         ($trole=~/^ta/) || ($trole=~/^co/)) {  
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);         my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash         $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
     }      }
     if (($env{'request.role'} =~ /dc\./) &&      if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) {
  (($trole=~/^au/) || ($trole=~/^in/) ||  
  ($trole=~/^cc/) || ($trole=~/^ep/) ||  
  ($trole=~/^cr/) || ($trole=~/^ta/) ||  
          ($trole=~/^co/))) {  
        $userrolehash         $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}           {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
     }      }
     if (($trole=~/^dc/) || ($trole=~/^ad/) ||      if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
         ($trole=~/^li/) || ($trole=~/^li/) ||  
         ($trole=~/^au/) || ($trole=~/^dg/) ||  
         ($trole=~/^sc/)) {  
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);         my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $domainrolehash         $domainrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
Line 4645  sub privileged { Line 4635  sub privileged {
 # -------------------------------------------------------- Get user privileges  # -------------------------------------------------------- Get user privileges
   
 sub rolesinit {  sub rolesinit {
     my ($domain,$username,$authhost)=@_;      my ($domain, $username) = @_;
     my $now=time;      my %userroles = ('user.login.time' => time);
     my %userroles = ('user.login.time' => $now);      my %rolesdump = &dump("roles", $domain, $username) or return \%userroles;
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);  
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||       # firstaccess and timerinterval are related to timed maps/resources. 
         ($rolesdump =~ /^error:/)) {      # also, blocking can be triggered by an activating timer
         return \%userroles;      # it's saved in the user's %env.
     }      my %firstaccess = &dump('firstaccesstimes', $domain, $username);
     my %firstaccess = &dump('firstaccesstimes',$domain,$username);      my %timerinterval = &dump('timerinterval', $domain, $username);
     my %timerinterval = &dump('timerinterval',$domain,$username);      my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
     my (%coursetimerstarts,%firstaccchk,%firstaccenv,          %timerintchk, %timerintenv);
         %coursetimerintervals,%timerintchk,%timerintenv);  
     foreach my $key (keys(%firstaccess)) {      foreach my $key (keys(%firstaccess)) {
         my ($cid,$rest) = split(/\0/,$key);          my ($cid, $rest) = split(/\0/, $key);
         $coursetimerstarts{$cid}{$rest} = $firstaccess{$key};          $coursetimerstarts{$cid}{$rest} = $firstaccess{$key};
     }      }
   
     foreach my $key (keys(%timerinterval)) {      foreach my $key (keys(%timerinterval)) {
         my ($cid,$rest) = split(/\0/,$key);          my ($cid,$rest) = split(/\0/,$key);
         $coursetimerintervals{$cid}{$rest} = $timerinterval{$key};          $coursetimerintervals{$cid}{$rest} = $timerinterval{$key};
     }      }
   
     my %allroles=();      my %allroles=();
     my %allgroups=();      my %allgroups=();
   
     if ($rolesdump ne '') {      for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) {
         foreach my $entry (split(/&/,$rolesdump)) {          my $role = $rolesdump{$area};
   if ($entry!~/^rolesdef_/) {          $area =~ s/\_\w\w$//;
             my ($area,$role)=split(/=/,$entry);  
     $area=~s/\_\w\w$//;          my ($trole, $tend, $tstart, $group_privs);
             my ($trole,$tend,$tstart,$group_privs);  
     if ($role=~/^cr/) {          if ($role =~ /^cr/) {
 # Custom role, defined by a user           # Custom role, defined by a user 
 # e.g., user.role.cr/msu/smith/mynewrole          # e.g., user.role.cr/msu/smith/mynewrole
  if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {              if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {
     ($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|);                  $trole = $1;
     ($tend,$tstart)=split('_',$trest);                  ($tend, $tstart) = split('_', $2);
  } else {              } else {
     $trole=$role;                  $trole = $role;
  }              }
             } elsif ($role =~ m|^gr/|) {          } elsif ($role =~ m|^gr/|) {
 # Role of member in a group, defined within a course/community          # Role of member in a group, defined within a course/community
 # e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards          # e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards
                 ($trole,$tend,$tstart) = split(/_/,$role);              ($trole, $tend, $tstart) = split(/_/, $role);
                 next if ($tstart eq '-1');              next if $tstart eq '-1';
                 ($trole,$group_privs) = split(/\//,$trole);              ($trole, $group_privs) = split(/\//, $trole);
                 $group_privs = &unescape($group_privs);              $group_privs = &unescape($group_privs);
     } else {          } else {
 # Just a normal role, defined in roles.tab          # Just a normal role, defined in roles.tab
  ($trole,$tend,$tstart)=split(/_/,$role);              ($trole, $tend, $tstart) = split(/_/,$role);
     }          }
     my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,  
  $username);          my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,
     @userroles{keys(%new_role)} = @new_role{keys(%new_role)};                   $username);
             if (($tend!=0) && ($tend<$now)) { $trole=''; }          @userroles{keys(%new_role)} = @new_role{keys(%new_role)};
             if (($tstart!=0) && ($tstart>$now)) { $trole=''; }  
             if (($area ne '') && ($trole ne '')) {          # role expired or not available yet?
  my $spec=$trole.'.'.$area;          $trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or 
  my ($tdummy,$tdomain,$trest)=split(/\//,$area);              ($tstart != 0 && $tstart > $userroles{'user.login.time'});
  if ($trole =~ /^cr\//) {  
 # Custom role, defined by a user          next if $area eq '' or $trole eq '';
                     &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);  
                 } elsif ($trole eq 'gr') {          my $spec = "$trole.$area";
 # Role of a member in a group, defined within a course/community          my ($tdummy, $tdomain, $trest) = split(/\//, $area);
                     &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);  
  } else {          if ($trole =~ /^cr\//) {
 # Normal role, defined in roles.tab          # Custom role, defined by a user
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);              &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
  }          } elsif ($trole eq 'gr') {
                 if ($trole ne 'gr') {          # Role of a member in a group, defined within a course/community
                     my $cid = $tdomain.'_'.$trest;              &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
                     unless ($firstaccchk{$cid}) {              next;
                         if (ref($coursetimerstarts{$cid}) eq 'HASH') {          } else {
                             foreach my $item (keys(%{$coursetimerstarts{$cid}})) {          # Normal role, defined in roles.tab
                                 $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} =               &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
                                     $coursetimerstarts{$cid}{$item};           }
                             }  
                         }          my $cid = $tdomain.'_'.$trest;
                         $firstaccchk{$cid} = 1;          unless ($firstaccchk{$cid}) {
                     }              if (ref($coursetimerstarts{$cid}) eq 'HASH') {
                     unless ($timerintchk{$cid}) {                  foreach my $item (keys(%{$coursetimerstarts{$cid}})) {
                         if (ref($coursetimerintervals{$cid}) eq 'HASH') {                      $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = 
                             foreach my $item (keys(%{$coursetimerintervals{$cid}})) {                          $coursetimerstarts{$cid}{$item}; 
                                 $timerintenv{'course.'.$cid.'.timerinterval.'.$item} =  
                                    $coursetimerintervals{$cid}{$item};  
                             }  
                         }  
                         $timerintchk{$cid} = 1;  
                     }  
                 }                  }
             }              }
           }              $firstaccchk{$cid} = 1;
           }
           unless ($timerintchk{$cid}) {
               if (ref($coursetimerintervals{$cid}) eq 'HASH') {
                   foreach my $item (keys(%{$coursetimerintervals{$cid}})) {
                       $timerintenv{'course.'.$cid.'.timerinterval.'.$item} =
                          $coursetimerintervals{$cid}{$item};
                   }
               }
               $timerintchk{$cid} = 1;
         }          }
         my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups);  
         $userroles{'user.adv'}    = $adv;  
  $userroles{'user.author'} = $author;  
         $env{'user.adv'}=$adv;  
     }      }
   
       @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles,
           \%allroles, \%allgroups);
       $env{'user.adv'} = $userroles{'user.adv'};
   
     return (\%userroles,\%firstaccenv,\%timerintenv);      return (\%userroles,\%firstaccenv,\%timerintenv);
 }  }
   
Line 11696  B<idput($udom,%ids)>: store away a list Line 11692  B<idput($udom,%ids)>: store away a list
   
 =item *  =item *
 X<rolesinit()>  X<rolesinit()>
 B<rolesinit($udom,$username,$authhost)>: get user privileges  B<rolesinit($udom,$username)>: get user privileges.
   returns user role, first access and timer interval hashes
   
 =item *  =item *
 X<getsection()>  X<getsection()>
Removed from v.1.1168  
changed lines
  Added in v.1.1169

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