[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.1281 and 1.1282

version 1.1281, 2015/04/13 16:30:32 version 1.1282, 2015/04/15 04:11:17
Line 4444  my $cachedkey=''; Line 4444  my $cachedkey='';
 # The cached times for this user  # The cached times for this user
 my %cachedtimes=();  my %cachedtimes=();
 # When this was last done  # When this was last done
 my $cachedtime=();  my $cachedtime='';
   
 sub load_all_first_access {  sub load_all_first_access {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
Line 4506  sub set_first_access { Line 4506  sub set_first_access {
     return 'already_set';      return 'already_set';
 }  }
 }  }
   
 # --------------------------------------------- Set Expire Date for Spreadsheet  # --------------------------------------------- Set Expire Date for Spreadsheet
   
 sub expirespread {  sub expirespread {
Line 7199  sub constructaccess { Line 7200  sub constructaccess {
     return '';      return '';
 }  }
   
   # ----------------------------------------------------------- Content Blocking
   
   {
   # Caches for faster Course Contents display where content blocking
   # is in operation (i.e., interval param set) for timed quiz.
   #
   # User for whom data are being temporarily cached.
   my $cacheduser='';
   # Cached blockers for this user (a hash of blocking items). 
   my %cachedblockers=();
   # When the data were last cached.
   my $cachedlast='';
   
   sub load_all_blockers {
       my ($uname,$udom,$blocks)=@_;
       if (($uname ne '') && ($udom ne '')) { 
           if (($cacheduser eq $uname.':'.$udom) &&
               (abs($cachedlast-time)<5)) {
               return;
           }
       }
       $cachedlast=time;
       $cacheduser=$uname.':'.$udom;
       %cachedblockers = &get_commblock_resources($blocks);
   }
   
 sub get_comm_blocks {  sub get_comm_blocks {
     my ($cdom,$cnum) = @_;      my ($cdom,$cnum) = @_;
     if ($cdom eq '' || $cnum eq '') {      if ($cdom eq '' || $cnum eq '') {
Line 7219  sub get_comm_blocks { Line 7246  sub get_comm_blocks {
     return %commblocks;      return %commblocks;
 }  }
   
 sub has_comm_blocking {  sub get_commblock_resources {
     my ($priv,$symb,$uri,$blocks) = @_;      my ($blocks) = @_;
     return unless ($env{'request.course.id'});      my %blockers = ();
     return unless ($priv eq 'bre');      return %blockers unless ($env{'request.course.id'});
     return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);      return %blockers if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
     my %commblocks;      my %commblocks;
     if (ref($blocks) eq 'HASH') {      if (ref($blocks) eq 'HASH') {
         %commblocks = %{$blocks};          %commblocks = %{$blocks};
     } else {      } else {
         %commblocks = &get_comm_blocks();          %commblocks = &get_comm_blocks();
     }      }
     return unless (keys(%commblocks) > 0);      return %blockers unless (keys(%commblocks) > 0); 
     if (!$symb) { $symb=&symbread($uri,1); }  
     my ($map,$resid,undef)=&decode_symb($symb);  
     my %tocheck = (  
                     maps      => $map,  
                     resources => $symb,  
                   );  
     my @blockers;  
     my $now = time;  
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
       return %blockers unless (ref($navmap));
       my $now = time;
     foreach my $block (keys(%commblocks)) {      foreach my $block (keys(%commblocks)) {
         if ($block =~ /^(\d+)____(\d+)$/) {          if ($block =~ /^(\d+)____(\d+)$/) {
             my ($start,$end) = ($1,$2);              my ($start,$end) = ($1,$2);
Line 7247  sub has_comm_blocking { Line 7268  sub has_comm_blocking {
                 if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {                  if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                     if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {                      if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
                         if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {                          if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {
                             if ($commblocks{$block}{'blocks'}{'docs'}{'maps'}{$map}) {                              if (keys(%{$commblocks{$block}{'blocks'}{'docs'}{'maps'}})) {
                                 unless (grep(/^\Q$block\E$/,@blockers)) {                                  $blockers{$block}{maps} = $commblocks{$block}{'blocks'}{'docs'}{'maps'}; 
                                     push(@blockers,$block);  
                                 }  
                             }                              }
                         }                          }
                         if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {                          if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {
                             if ($commblocks{$block}{'blocks'}{'docs'}{'resources'}{$symb}) {                              if (keys(%{$commblocks{$block}{'blocks'}{'docs'}{'resources'}})) {
                                 unless (grep(/^\Q$block\E$/,@blockers)) {                                    $blockers{$block}{'resources'} = $commblocks{$block}{'blocks'}{'docs'}{'resources'};
                                     push(@blockers,$block);  
                                 }  
                             }                              }
                         }                          }
                     }                      }
Line 7268  sub has_comm_blocking { Line 7285  sub has_comm_blocking {
             my @to_test;              my @to_test;
             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {              if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                 if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {                  if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
                     my $check_interval;                      my @interval;
                     if (&check_docs_block($commblocks{$block}{'blocks'}{'docs'},\%tocheck)) {                      my $type = 'map';
                         my @interval;                      if ($item eq 'course') {
                         my $type = 'map';                          $type = 'course';
                         if ($item eq 'course') {                          @interval=&EXT("resource.0.interval");
                             $type = 'course';                      } else {
                             @interval=&EXT("resource.0.interval");                          if ($item =~ /___\d+___/) {
                               $type = 'resource';
                               @interval=&EXT("resource.0.interval",$item);
                               if (ref($navmap)) {                        
                                   my $res = $navmap->getBySymb($item); 
                                   push(@to_test,$res);
                               }
                         } else {                          } else {
                             if ($item =~ /___\d+___/) {                              my $mapsymb = &symbread($item,1);
                                 $type = 'resource';                              if ($mapsymb) {
                                 @interval=&EXT("resource.0.interval",$item);                                  if (ref($navmap)) {
                                 if (ref($navmap)) {                                                              my $mapres = $navmap->getBySymb($mapsymb);
                                     my $res = $navmap->getBySymb($item);                                       @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);
                                     push(@to_test,$res);                                      foreach my $res (@to_test) {
                                 }                                          my $symb = $res->symb();
                             } else {                                          next if ($symb eq $mapsymb);
                                 my $mapsymb = &symbread($item,1);                                          if ($symb ne '') {
                                 if ($mapsymb) {                                              @interval=&EXT("resource.0.interval",$symb);
                                     if (ref($navmap)) {                                              if ($interval[1] eq 'map') {
                                         my $mapres = $navmap->getBySymb($mapsymb);                                                  last;
                                         @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);  
                                         foreach my $res (@to_test) {  
                                             my $symb = $res->symb();  
                                             next if ($symb eq $mapsymb);  
                                             if ($symb ne '') {  
                                                 @interval=&EXT("resource.0.interval",$symb);  
                                                 if ($interval[1] eq 'map') {  
                                                     last;  
                                                 }  
                                             }                                              }
                                         }                                          }
                                     }                                      }
                                 }                                  }
                             }                              }
                         }                          }
                         if ($interval[0] =~ /\d+/) {                      }
                             my $first_access;                      if ($interval[0] =~ /^\d+$/) {
                             if ($type eq 'resource') {                          my $first_access;
                                 $first_access=&get_first_access($interval[1],$item);                          if ($type eq 'resource') {
                             } elsif ($type eq 'map') {                              $first_access=&get_first_access($interval[1],$item);
                                 $first_access=&get_first_access($interval[1],undef,$item);                          } elsif ($type eq 'map') {
                             } else {                              $first_access=&get_first_access($interval[1],undef,$item);
                                 $first_access=&get_first_access($interval[1]);                          } else {
                             }                              $first_access=&get_first_access($interval[1]);
                             if ($first_access) {                          }
                                 my $timesup = $first_access+$interval[0];                          if ($first_access) {
                                 if ($timesup > $now) {                              my $timesup = $first_access+$interval[0];
                                     foreach my $res (@to_test) {                              if ($timesup > $now) {
                                         if ($res->is_problem()) {                                  my $activeblock;
                                             if ($res->completable()) {                                  foreach my $res (@to_test) {
                                                 unless (grep(/^\Q$block\E$/,@blockers)) {                                      if ($res->completable()) {
                                                     push(@blockers,$block);                                          $activeblock = 1;
                                                 }                                          last;
                                                 last;                                      }
                                             }                                  }
                                   if ($activeblock) {
                                       if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {
                                            if (keys(%{$commblocks{$block}{'blocks'}{'docs'}{'maps'}})) {
                                                $blockers{$block}{'maps'} = $commblocks{$block}{'blocks'}{'docs'}{'maps'};
                                            }
                                       }
                                       if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {
                                           if (keys(%{$commblocks{$block}{'blocks'}{'docs'}{'resources'}})) {
                                               $blockers{$block}{'resources'} = $commblocks{$block}{'blocks'}{'docs'}{'resources'};
                                         }                                          }
                                     }                                      }
                                 }                                  }
Line 7333  sub has_comm_blocking { Line 7356  sub has_comm_blocking {
             }              }
         }          }
     }      }
     return @blockers;      return %blockers;
 }  }
   
 sub check_docs_block {  sub has_comm_blocking {
     my ($docsblock,$tocheck) =@_;      my ($priv,$symb,$uri,$blocks) = @_;
     if ((ref($docsblock) ne 'HASH') || (ref($tocheck) ne 'HASH')) {      my @blockers;
         return;      return unless ($env{'request.course.id'});
       return unless ($priv eq 'bre');
       return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
       return if ($env{'request.state'} eq 'construct');
       &load_all_blockers($env{'user.name'},$env{'user.domain'},$blocks);
       return unless (keys(%cachedblockers) > 0);
       my (%possibles,@symbs);
       if (!$symb) {
           $symb = &symbread($uri,1,1,1,\%possibles);
     }      }
     if (ref($docsblock->{'maps'}) eq 'HASH') {      if ($symb) {
         if ($tocheck->{'maps'}) {          @symbs = ($symb);
             if ($docsblock->{'maps'}{$tocheck->{'maps'}}) {      } elsif (keys(%possibles)) { 
                 return 1;          @symbs = keys(%possibles);
       }
       my $noblock;
       foreach my $symb (@symbs) {
           last if ($noblock);
           my ($map,$resid,$resurl)=&decode_symb($symb);
           foreach my $block (keys(%cachedblockers)) {
               if ($block =~ /^firstaccess____(.+)$/) {
                   my $item = $1;
                   if (($item eq $map) || ($item eq $symb)) {
                       $noblock = 1;
                       last;
                   }
             }              }
         }              if (ref($cachedblockers{$block}) eq 'HASH') {
     }                  if (ref($cachedblockers{$block}{'resources'}) eq 'HASH') {
     if (ref($docsblock->{'resources'}) eq 'HASH') {                      if ($cachedblockers{$block}{'resources'}{$symb}) {
         if ($tocheck->{'resources'}) {                          unless (grep(/^\Q$block\E$/,@blockers)) {
             if ($docsblock->{'resources'}{$tocheck->{'resources'}}) {                              push(@blockers,$block);
                 return 1;                          }
                       }
                   }
               }
               if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
                   if ($cachedblockers{$block}{'maps'}{$map}) {
                       unless (grep(/^\Q$block\E$/,@blockers)) {
                           push(@blockers,$block);
                       }
                   }
             }              }
         }          }
     }      }
     return;      return if ($noblock);
       return @blockers;
 }  }
   }
   
   # -------------------------------- Deversion and split uri into path an filename   
   
 #  #
 #   Removes the versino from a URI and  #   Removes the version from a URI and
 #   splits it in to its filename and path to the filename.  #   splits it in to its filename and path to the filename.
 #   Seems like File::Basename could have done this more clearly.  #   Seems like File::Basename could have done this more clearly.
 #   Parameters:  #   Parameters:
Line 11108  sub deversion { Line 11164  sub deversion {
 # ------------------------------------------------------ Return symb list entry  # ------------------------------------------------------ Return symb list entry
   
 sub symbread {  sub symbread {
     my ($thisfn,$donotrecurse)=@_;      my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;      my $cache_str='request.symbread.cached.'.$thisfn;
     if (defined($env{$cache_str})) { return $env{$cache_str}; }      if (defined($env{$cache_str})) {
           if ($ignorecachednull) {
               return $env{$cache_str} unless ($env{$cache_str} eq '');
           } else {
               return $env{$cache_str};
           }
       }
 # no filename provided? try from environment  # no filename provided? try from environment
     unless ($thisfn) {      unless ($thisfn) {
         if ($env{'request.symb'}) {          if ($env{'request.symb'}) {
Line 11172  sub symbread { Line 11234  sub symbread {
      my ($mapid,$resid)=split(/\./,$ids);       my ($mapid,$resid)=split(/\./,$ids);
      $syval=&encode_symb($bighash{'map_id_'.$mapid},       $syval=&encode_symb($bighash{'map_id_'.$mapid},
     $resid,$thisfn);      $resid,$thisfn);
                  } elsif (!$donotrecurse) {                       if (ref($possibles) eq 'HASH') {
                            $possibles->{$syval} = 1;    
                        }
                        if ($checkforblock) {
                            my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
                            if (@blockers) {
                                $syval = '';
                                return;
                            }
                        }
                    } elsif ((!$donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) { 
 # ------------------------------------------ There is more than one possibility  # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;                       my $realpossible=0;
                      foreach my $id (@possibilities) {                       foreach my $id (@possibilities) {
  my $file=$bighash{'src_'.$id};   my $file=$bighash{'src_'.$id};
                          if (&allowed('bre',$file)) {                           my $canaccess;
              my ($mapid,$resid)=split(/\./,$id);                           if (($donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) {
                             if ($bighash{'map_type_'.$mapid} ne 'page') {                               $canaccess = 1;
  $realpossible++;                           } else { 
                                 $syval=&encode_symb($bighash{'map_id_'.$mapid},                               $canaccess = &allowed('bre',$file);
     $resid,$thisfn);                           }
                             }                           if ($canaccess) {
                 my ($mapid,$resid)=split(/\./,$id);
                                if ($bighash{'map_type_'.$mapid} ne 'page') {
                                    my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
                $resid,$thisfn);
                                    if (ref($possibles) eq 'HASH') {
                                        $possibles->{$syval} = 1;
                                    }
                                    if ($checkforblock) {
                                        my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
                                        unless (@blockers > 0) {
                                            $syval = $poss_syval;
                                            $realpossible++;
                                        }
                                    } else {
                                        $syval = $poss_syval;
                                        $realpossible++;
                                    }
                                }
  }   }
                      }                       }
      if ($realpossible!=1) { $syval=''; }       if ($realpossible!=1) { $syval=''; }
Line 11191  sub symbread { Line 11281  sub symbread {
                      $syval='';                       $syval='';
                  }                   }
       }        }
               untie(%bighash)                untie(%bighash);
            }             }
         }          }
         if ($syval) {          if ($syval) {
Line 12962  escaped strings of the action recorded i Line 13052  escaped strings of the action recorded i
   
 =item *  =item *
   
 allowed($priv,$uri,$symb,$role,$clientip,$noblockcheck) : check for a user privilege;   allowed($priv,$uri,$symb,$role) : check for a user privilege; returns codes for allowed actions
 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 *
   
Line 13378  will be stored for query Line 13452  will be stored for query
   
 =item *  =item *
   
 symbread($filename) : return symbolic list entry (filename argument optional);  symbread($filename,$donotrecurse,$ignorecachednull,$checkforblock,$possibles) : 
   return symbolic list entry (all arguments optional). 
   
   Args: filename is the filename (including path) for the file for which a symb 
   is required; donotrecurse, if true will prevent calls to allowed() being made 
   to check access status if more than one resource was found in the bighash 
   (see rev. 1.249) to avoid an infinite loop if an ambiguous resource is part of 
   a randompick); ignorecachednull, if true will prevent a symb of '' being 
   returned if $env{$cache_str} is defined as ''; checkforblock if true will
   cause possible symbs to be checked to determine if they are subject to content
   blocking, if so they will not be included as possible symbs; possibles is a
   ref to a hash, which, as a side effect, will be populated with all possible 
   symbs (content blocking not tested).
    
 returns the data handle  returns the data handle
   
 =item *  =item *
Removed from v.1.1281  
changed lines
  Added in v.1.1282

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