Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1280 and 1.1281

version 1.1280, 2015/04/09 17:46:54 version 1.1281, 2015/04/13 16:30:32
Line 6639  sub customaccess { Line 6639  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri,$symb,$role,$clientip)=@_;      my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;
     my $ver_orguri=$uri;      my $ver_orguri=$uri;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
Line 6834  sub allowed { Line 6834  sub allowed {
         if ($match) {          if ($match) {
             if ($env{'user.priv.'.$env{'request.role'}.'./'}              if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                 my @blockers = &has_comm_blocking($priv,$symb,$uri);                  my $value = $1;
                 if (@blockers > 0) {                  if ($noblockcheck) {
                     $thisallowed = 'B';                      $thisallowed.=$value;
                 } else {                  } else {
                     $thisallowed.=$1;                      my @blockers = &has_comm_blocking($priv,$symb,$uri);
                       if (@blockers > 0) {
                           $thisallowed = 'B';
                       } else {
                           $thisallowed.=$value;
                       }
                 }                  }
             }              }
         } else {          } else {
Line 6850  sub allowed { Line 6855  sub allowed {
                     $refuri=&declutter($refuri);                      $refuri=&declutter($refuri);
                     my ($match) = &is_on_map($refuri);                      my ($match) = &is_on_map($refuri);
                     if ($match) {                      if ($match) {
                         my @blockers = &has_comm_blocking($priv,$symb,$refuri);                          if ($noblockcheck) {
                         if (@blockers > 0) {  
                             $thisallowed = 'B';  
                         } else {  
                             $thisallowed='F';                              $thisallowed='F';
                           } else {
                               my @blockers = &has_comm_blocking($priv,$symb,$refuri);
                               if (@blockers > 0) {
                                   $thisallowed = 'B';
                               } else {
                                   $thisallowed='F';
                               }
                         }                          }
                     }                      }
                 }                  }
Line 6909  sub allowed { Line 6918  sub allowed {
                =~/\Q$priv\E\&([^\:]*)/) {                 =~/\Q$priv\E\&([^\:]*)/) {
                my $value = $1;                 my $value = $1;
                if ($priv eq 'bre') {                 if ($priv eq 'bre') {
                    my @blockers = &has_comm_blocking($priv,$symb,$uri);                     if ($noblockcheck) {
                    if (@blockers > 0) {  
                        $thisallowed = 'B';  
                    } else {  
                        $thisallowed.=$value;                         $thisallowed.=$value;
                      } else {
                          my @blockers = &has_comm_blocking($priv,$symb,$uri);
                          if (@blockers > 0) {
                              $thisallowed = 'B';
                          } else {
                              $thisallowed.=$value;
                          }
                    }                     }
                } else {                 } else {
                    $thisallowed.=$value;                     $thisallowed.=$value;
Line 6947  sub allowed { Line 6960  sub allowed {
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                   my $value = $1;                    my $value = $1;
                   if ($priv eq 'bre') {                    if ($priv eq 'bre') {
                       my @blockers = &has_comm_blocking($priv,$symb,$refuri);                        if ($noblockcheck) {
                       if (@blockers > 0) {  
                           $thisallowed = 'B';  
                       } else {  
                           $thisallowed.=$value;                            $thisallowed.=$value;
                         } else {
                             my @blockers = &has_comm_blocking($priv,$symb,$refuri);
                             if (@blockers > 0) {
                                 $thisallowed = 'B';
                             } else {
                                 $thisallowed.=$value;
                             }
                       }                        }
                   } else {                    } else {
                       $thisallowed.=$value;                        $thisallowed.=$value;
Line 7271  sub has_comm_blocking { Line 7288  sub has_comm_blocking {
                                 if ($mapsymb) {                                  if ($mapsymb) {
                                     if (ref($navmap)) {                                      if (ref($navmap)) {
                                         my $mapres = $navmap->getBySymb($mapsymb);                                          my $mapres = $navmap->getBySymb($mapsymb);
                                         @to_test = $mapres->retrieveResources($mapres);                                          @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);
                                         foreach my $res (@to_test) {                                          foreach my $res (@to_test) {
                                             my $symb = $res->symb();                                              my $symb = $res->symb();
                                             next if ($symb eq $mapsymb);                                              next if ($symb eq $mapsymb);
Line 12945  escaped strings of the action recorded i Line 12962  escaped strings of the action recorded i
   
 =item *  =item *
   
 allowed($priv,$uri,$symb,$role) : check for a user privilege; returns codes for allowed actions  allowed($priv,$uri,$symb,$role,$clientip,$noblockcheck) : check for a user privilege; 
   returns codes for allowed actions
   
   The first argument is required, all others are optional.
   
   $priv is the privilege being checked.
   $uri contains additional information about what is being checked for access (e.g.,
   URL, course ID etc.). 
   $symb is the unique resource instance identifier in a course; if needed,
   but not provided, it will be retrieved via a call to &symbread(). 
   $role is the role for which a priv is being checked (only used if priv is evb). 
   $clientip is the user's IP address (only used when checking for access to portfolio 
   files).
   $noblockcheck, if true, skips calls to &has_comm_blocking() for the bre priv. This 
   prevents recursive calls to &allowed.  
   
  F: full access   F: full access
  U,I,K: authentication modes (cxx only)   U,I,K: authentication modes (cxx only)
  '': forbidden   '': forbidden
  1: user needs to choose course   1: user needs to choose course
  2: browse allowed   2: browse allowed
  A: passphrase authentication needed   A: passphrase authentication needed
    B: access temporarily blocked because of a blocking event in a course.
   
 =item *  =item *
   

Removed from v.1.1280  
changed lines
  Added in v.1.1281


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