[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.1465 and 1.1471

version 1.1465, 2021/09/21 22:54:27 version 1.1471, 2021/11/09 20:14:04
Line 2304  sub retrieve_inst_usertypes { Line 2304  sub retrieve_inst_usertypes {
   
 sub is_domainimage {  sub is_domainimage {
     my ($url) = @_;      my ($url) = @_;
     if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+[^/]-) {      if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo|login)/+[^/]-) {
         if (&domain($1) ne '') {          if (&domain($1) ne '') {
             return '1';              return '1';
         }          }
Line 8855  sub get_commblock_resources { Line 8855  sub get_commblock_resources {
     my ($blocks) = @_;      my ($blocks) = @_;
     my %blockers = ();      my %blockers = ();
     return %blockers unless ($env{'request.course.id'});      return %blockers unless ($env{'request.course.id'});
     return %blockers if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);      my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
       if ($env{'request.course.sec'}) {
           $courseurl .= '/'.$env{'request.course.sec'};
       }
       return %blockers if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %commblocks;      my %commblocks;
     if (ref($blocks) eq 'HASH') {      if (ref($blocks) eq 'HASH') {
         %commblocks = %{$blocks};          %commblocks = %{$blocks};
Line 8887  sub get_commblock_resources { Line 8891  sub get_commblock_resources {
             }              }
         } elsif ($block =~ /^firstaccess____(.+)$/) {          } elsif ($block =~ /^firstaccess____(.+)$/) {
             my $item = $1;              my $item = $1;
             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 @interval;                      my (@interval,$mapname);
                     my $type = 'map';                      my $type = 'map';
                     if ($item eq 'course') {                      if ($item eq 'course') {
                         $type = 'course';                          $type = 'course';
Line 8899  sub get_commblock_resources { Line 8902  sub get_commblock_resources {
                         if ($item =~ /___\d+___/) {                          if ($item =~ /___\d+___/) {
                             $type = 'resource';                              $type = 'resource';
                             @interval=&EXT("resource.0.interval",$item);                              @interval=&EXT("resource.0.interval",$item);
                             if (ref($navmap)) {                          
                                 my $res = $navmap->getBySymb($item);   
                                 push(@to_test,$res);  
                             }  
                         } else {                          } else {
                             my $mapsymb = &symbread($item,1);                              $mapname = &deversion($item);
                             if ($mapsymb) {                              if (ref($navmap)) {
                                 if (ref($navmap)) {                                  my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval');
                                     my $mapres = $navmap->getBySymb($mapsymb);                                  @interval = ($timelimit,'map');
                                     if (ref($mapres)) {  
                                         my $first = $mapres->map_start();  
                                         my $finish = $mapres->map_finish();  
                                         my $it = $navmap->getIterator($first,$finish,undef,0,0);  
                                         if (ref($it)) {  
                                             my $res;  
                                             while ($res = $it->next(undef,1)) {  
                                                 next unless (ref($res));  
                                                 my $symb = $res->symb();  
                                                 next if (($symb eq $mapsymb) || ($symb eq ''));  
                                                 @interval=&EXT("resource.0.interval",$symb);  
                                                 if ($interval[1] eq 'map') {  
                                                     if ($res->answerable()) {  
                                                         push(@to_test,$res);  
                                                         last;  
                                                     }  
                                                 }  
                                             }  
                                         }  
                                     }  
                                 }  
                             }                              }
                         }                          }
                     }                      }
Line 8946  sub get_commblock_resources { Line 8924  sub get_commblock_resources {
                             my $timesup = $first_access+$timelimit;                              my $timesup = $first_access+$timelimit;
                             if ($timesup > $now) {                              if ($timesup > $now) {
                                 my $activeblock;                                  my $activeblock;
                                 foreach my $res (@to_test) {                                  if ($type eq 'resource') {
                                     if ($res->answerable()) {                                      if (ref($navmap)) {
                                         $activeblock = 1;                                          my $res = $navmap->getBySymb($item);
                                         last;                                          if ($res->answerable()) {
                                               $activeblock = 1;
                                           }
                                       }
                                   } elsif ($type eq 'map') {
                                       my $mapsymb = &symbread($mapname,1);
                                       if (($mapsymb) && (ref($navmap))) {
                                           my $mapres = $navmap->getBySymb($mapsymb);
                                           if (ref($mapres)) {
                                               my $first = $mapres->map_start();
                                               my $finish = $mapres->map_finish();
                                               my $it = $navmap->getIterator($first,$finish,undef,0,0);
                                               if (ref($it)) {
                                                   my $res;
                                                   while ($res = $it->next(undef,1)) {
                                                       next unless (ref($res));
                                                       my $symb = $res->symb();
                                                       next if (($symb eq $mapsymb) || ($symb eq ''));
                                                       @interval=&EXT("resource.0.interval",$symb);
                                                       if ($interval[1] eq 'map') {
                                                           if ($res->answerable()) {
                                                               $activeblock = 1;
                                                               last;
                                                           }
                                                       }
                                                   }
                                               }
                                           }
                                     }                                      }
                                 }                                  }
                                 if ($activeblock) {                                  if ($activeblock) {
Line 8979  sub has_comm_blocking { Line 8984  sub has_comm_blocking {
     my @blockers;      my @blockers;
     return unless ($env{'request.course.id'});      return unless ($env{'request.course.id'});
     return unless ($priv eq 'bre');      return unless ($priv eq 'bre');
     return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);  
     return if ($env{'request.state'} eq 'construct');      return if ($env{'request.state'} eq 'construct');
       my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
       if ($env{'request.course.sec'}) {
           $courseurl .= '/'.$env{'request.course.sec'};
       }
       return if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %blockinfo;      my %blockinfo;
     if (ref($blocks) eq 'HASH') {      if (ref($blocks) eq 'HASH') {
         %blockinfo = &get_commblock_resources($blocks);          %blockinfo = &get_commblock_resources($blocks);
Line 9379  sub fetch_enrollment_query { Line 9388  sub fetch_enrollment_query {
 }  }
   
 sub get_query_reply {  sub get_query_reply {
     my ($queryid,$sleep,$loopmax) = @_;;      my ($queryid,$sleep,$loopmax) = @_;
     if (($sleep eq '') || ($sleep !~ /^\d+\.?\d*$/)) {      if (($sleep eq '') || ($sleep !~ /^\d+\.?\d*$/)) {
         $sleep = 0.2;          $sleep = 0.2;
     }      }
Line 12323  sub EXT { Line 12332  sub EXT {
     if ( (defined($Apache::lonhomework::parsing_a_problem)      if ( (defined($Apache::lonhomework::parsing_a_problem)
   || defined($Apache::lonhomework::parsing_a_task))    || defined($Apache::lonhomework::parsing_a_task))
  &&   &&
  ($symbparm eq &symbread()) ) {   ($symbparm eq &symbread()) ) {
  # if we are in the middle of processing the resource the   # if we are in the middle of processing the resource the
  # get the value we are planning on committing   # get the value we are planning on committing
                 if (defined($Apache::lonhomework::results{$qualifierrest})) {                  if (defined($Apache::lonhomework::results{$qualifierrest})) {
Line 14387  sub machine_ids { Line 14396  sub machine_ids {
   
 sub additional_machine_domains {  sub additional_machine_domains {
     my @domains;      my @domains;
     open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");      if (-e "$perlvar{'lonTabDir'}/expected_domains.tab") {
     while( my $line = <$fh>) {          if (open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab")) {
         $line =~ s/\s//g;              while (my $line = <$fh>) {
         push(@domains,$line);                  chomp($line);           
                   $line =~ s/\s//g;
                   push(@domains,$line);
               }
               close($fh);
           }
     }      }
     return @domains;      return @domains;
 }  }
Line 14603  sub use_proxy_alias { Line 14617  sub use_proxy_alias {
     if ($alias) {      if ($alias) {
         my $dom = &host_domain($lonid);          my $dom = &host_domain($lonid);
         if ($dom ne '') {          if ($dom ne '') {
             my $proxyinfo = &get_proxy_settings($dom );              my $proxyinfo = &get_proxy_settings($dom);
             my ($vpnint,$remote_ip);              my ($vpnint,$remote_ip);
             if (ref($proxyinfo) eq 'HASH') {              if (ref($proxyinfo) eq 'HASH') {
                 $vpnint = $proxyinfo->{'vpnint'};                  $vpnint = $proxyinfo->{'vpnint'};
Line 14617  sub use_proxy_alias { Line 14631  sub use_proxy_alias {
         }          }
     }      }
     return;      return;
   }
   
   sub alias_shibboleth {
       my ($lonid) = @_;
       if ($lonid eq '') {
           $lonid = $perlvar{'lonHostID'};
       }
       if (!defined(&hostname($lonid))) {
           return;
       }
       if ($lonid ne '') {
           my ($use_alias,$cached) = &is_cached_new('proxysaml',$lonid);
           if ($cached) {
               return $use_alias;
           }
           my $dom = &Apache::lonnet::host_domain($lonid);
           if ($dom ne '') {
               my $cachetime = 60*60*24;
               my %domconfig =
                   &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
               if (ref($domconfig{'wafproxy'}) eq 'HASH') {
                   if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {
                       $use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};
                   }
               }
               return &do_cache_new('proxysaml',$lonid,$use_alias,$cachetime);
           }
       }
       return;
 }  }
   
 sub get_saml_landing {  sub get_saml_landing {
Removed from v.1.1465  
changed lines
  Added in v.1.1471

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