[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.1460 and 1.1461

version 1.1460, 2021/06/15 20:52:28 version 1.1461, 2021/07/19 15:48:27
Line 8117  sub customaccess { Line 8117  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;      my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_;
     my $ver_orguri=$uri;      my $ver_orguri=$uri;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
Line 8342  sub allowed { Line 8342  sub allowed {
             if ($env{'user.priv.'.$env{'request.role'}.'./'}              if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                 my $value = $1;                  my $value = $1;
                 my $deeplinkblock = &deeplink_check($priv,$symb,$uri);                  my $deeplinkblock;
                   unless ($nodeeplinkcheck) {
                       $deeplinkblock = &deeplink_check($priv,$symb,$uri);
                   }
                 if ($deeplinkblock) {                  if ($deeplinkblock) {
                     $thisallowed='D';                      $thisallowed='D';
                 } elsif ($noblockcheck) {                  } elsif ($noblockcheck) {
Line 8365  sub allowed { Line 8368  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 $deeplinkblock = &deeplink_check($priv,$symb,$refuri);                          my $deeplinkblock;
                           unless ($nodeeplinkcheck) {
                               $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
                           }
                         if ($deeplinkblock) {                          if ($deeplinkblock) {
                             $thisallowed='D';                              $thisallowed='D';
                         } elsif ($noblockcheck) {                          } elsif ($noblockcheck) {
Line 8441  sub allowed { Line 8447  sub allowed {
                =~/\Q$priv\E\&([^\:]*)/) {                 =~/\Q$priv\E\&([^\:]*)/) {
                my $value = $1;                 my $value = $1;
                if ($priv eq 'bre') {                 if ($priv eq 'bre') {
                    my $deeplinkblock = &deeplink_check($priv,$symb,$uri);                     my $deeplinkblock;
                      unless ($nodeeplinkcheck) {
                          $deeplinkblock = &deeplink_check($priv,$symb,$uri);
                      }
                    if ($deeplinkblock) {                     if ($deeplinkblock) {
                        $thisallowed = 'D';                         $thisallowed = 'D';
                    } elsif ($noblockcheck) {                     } elsif ($noblockcheck) {
Line 8486  sub allowed { Line 8495  sub allowed {
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                   my $value = $1;                    my $value = $1;
                   if ($priv eq 'bre') {                    if ($priv eq 'bre') {
                       my $deeplinkblock = &deeplink_check($priv,$symb,$refuri);                        my $deeplinkblock;
                         unless ($nodeeplinkcheck) {
                             $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
                         }
                       if ($deeplinkblock) {                        if ($deeplinkblock) {
                           $thisallowed = 'D';                            $thisallowed = 'D';
                       } elsif ($noblockcheck) {                        } elsif ($noblockcheck) {
Line 8669  sub allowed { Line 8681  sub allowed {
        }         }
    }     }
   
   # Restricted for deeplinked session?
   
       if ($env{'request.deeplink.login'}) {
           if ($env{'acc.deeplinkout'} && !$nodeeplinkout) {
               if (!$symb) { $symb=&symbread($uri,1); }
               if (($symb) && ($env{'acc.deeplinkout'}=~/\&\Q$symb\E\&/)) {
                   return '';
               }
           }
       }
   
 # Restricted by state or randomout?  # Restricted by state or randomout?
   
    if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
Line 9026  sub deeplink_check { Line 9049  sub deeplink_check {
         @symbs = keys(%possibles);          @symbs = keys(%possibles);
     }      }
   
     my ($login,$switchrole,$allow);      my ($deeplink_symb,$allow);
     if ($env{'request.deeplink.login'} =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {      if ($env{'request.deeplink.login'}) {
         my $key = $1;          $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
         my $tinyurl;  
         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);  
         if (defined($cached)) {  
              $tinyurl = $result;  
         } else {  
              my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);  
              my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);  
              if ($currtiny{$key} ne '') {  
                  $tinyurl = $currtiny{$key};  
                  &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);  
              }  
         }  
         if ($tinyurl ne '') {  
             my ($cnumreq,$posslogin) = split(/\&/,$tinyurl);  
             if ($cnumreq eq $cnum) {  
                 $login = $posslogin;  
             } else {  
                 $switchrole = 1;  
             }  
         }  
     }      }
     foreach my $symb (@symbs) {      foreach my $symb (@symbs) {
         last if ($allow);          last if ($allow);
Line 9059  sub deeplink_check { Line 9062  sub deeplink_check {
             my ($listed,$scope,$access) = split(/,/,$deeplink);              my ($listed,$scope,$access) = split(/,/,$deeplink);
             if ($access eq 'any') {              if ($access eq 'any') {
                 $allow = 1;                  $allow = 1;
             } elsif ($login) {              } elsif ($deeplink_symb) {
                 if ($access eq 'only') {                  if ($access eq 'only') {
                     if ($scope eq 'res') {                      if ($scope eq 'res') {
                         if ($symb eq $login) {                          if ($symb eq $deeplink_symb) {
                             $allow = 1;                              $allow = 1;
                         }                          }
                     } elsif (($scope eq 'map') || ($scope eq 'rec')) {                      } elsif (($scope eq 'map') || ($scope eq 'rec')) {
                         my ($map_from_symb) = &deversion((&decode_symb($symb))[0]);                          my ($map_from_symb,$map_from_login); 
                         my ($map_from_login) = &deversion((&decode_symb($login))[0]);                          $map_from_symb = &deversion((&decode_symb($symb))[0]);
                           if ($deeplink_symb =~ /\.(page|sequence)$/) {
                               $map_from_login = &deversion((&decode_symb($deeplink_symb))[2]);
                           } else {
                               $map_from_login = &deversion((&decode_symb($deeplink_symb))[0]);
                           }
                         if (($map_from_symb) && ($map_from_login)) {                          if (($map_from_symb) && ($map_from_login)) {
                             if ($map_from_symb eq $map_from_login) {                              if ($map_from_symb eq $map_from_login) {
                                 $allow = 1;                                  $allow = 1;
Line 12260  sub EXT_cache_set { Line 12268  sub EXT_cache_set {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
 sub EXT {  sub EXT {
   
     my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_;      my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid,$recurseupref)=@_;
     unless ($varname) { return ''; }      unless ($varname) { return ''; }
     #get real user name/domain, courseid and symb      #get real user name/domain, courseid and symb
     my $courseid;      my $courseid;
Line 12414  sub EXT { Line 12422  sub EXT {
         }          }
   
  my ($section, $group, @groups, @recurseup, $recursed);   my ($section, $group, @groups, @recurseup, $recursed);
           if (ref($recurseupref) eq 'ARRAY') {
               @recurseup = @{$recurseupref};
               $recursed = 1;
           }
  my ($courselevelm,$courseleveli,$courselevel,$mapp);   my ($courselevelm,$courseleveli,$courselevel,$mapp);
         if (($courseid eq '') && ($cid)) {          if (($courseid eq '') && ($cid)) {
             $courseid = $cid;              $courseid = $cid;
Removed from v.1.1460  
changed lines
  Added in v.1.1461

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