[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.157 and 1.1075.2.158

version 1.1075.2.157, 2021/09/11 16:00:23 version 1.1075.2.158, 2021/12/13 19:55:44
Line 1378  sub help_open_menu { Line 1378  sub help_open_menu {
 }  }
   
 sub top_nav_help {  sub top_nav_help {
     my ($text) = @_;      my ($text,$linkattr) = @_;
     $text = &mt($text);      $text = &mt($text);
     my $stay_on_page;      my $stay_on_page;
     unless ($env{'environment.remote'} eq 'on') {      unless ($env{'environment.remote'} eq 'on') {
Line 1394  sub top_nav_help { Line 1394  sub top_nav_help {
     if ($link) {      if ($link) {
         return <<"END";          return <<"END";
 $banner_link  $banner_link
 <a href="$link" title="$title">$text</a>  <a href="$link" title="$title" $linkattr>$text</a>
 END  END
     } else {      } else {
         return '&nbsp;'.$text.'&nbsp;';          return '&nbsp;'.$text.'&nbsp;';
Line 3127  sub authform_filesystem { Line 3127  sub authform_filesystem {
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.                      $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'"'.$disabled.' />';                      $jscall.'"'.$disabled.' />';
     }      }
     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.      $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'"'.$disabled.' />';                 ' onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt      $result = &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',          ('[_1] Filesystem Authenticated (with initial password [_2])',
          '<label><input type="radio" name="login" value="fsys" '.           '<label>'.$authtype,'</label>'.$autharg);
          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',  
          '</label><input type="password" size="10" name="fsysarg" value="" '.  
                   'onchange="'.$jscall.'"'.$disabled.' />');  
     return $result;      return $result;
 }  }
   
Line 4731  sub findallcourses { Line 4728  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;      my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
   
       unless ($activity eq 'docs') {
           my ($has_evb,$check_ipaccess);
           my $dom = $env{'user.domain'};
           if ($env{'request.course.id'}) {
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
               my $checkrole = "cm./$cdom/$cnum";
               my $sec = $env{'request.course.sec'};
               if ($sec ne '') {
                   $checkrole .= "/$sec";
               }
               if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   ($env{'request.role'} !~ /^st/)) {
                   $has_evb = 1;
               }
               unless ($has_evb) {
                   if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
                       ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
                       if ($udom eq $cdom) {
                           $check_ipaccess = 1;
                       }
                   }
               }
           }
           unless ($has_evb || $check_ipaccess) {
               my @machinedoms = &Apache::lonnet::current_machine_domains();
               if (($dom eq 'public') && ($activity eq 'port')) {
                   $dom = $udom;
               }
               if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
                   $check_ipaccess = 1;
               } else {
                   my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                   my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                   my $prim = &Apache::lonnet::domain($dom,'primary');
                   my $intdom = &Apache::lonnet::internet_dom($prim);
                   if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
                       if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
                           $check_ipaccess = 1;
                       }
                   }
               }
           }
           if ($check_ipaccess) {
               my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
               unless (defined($cached)) {
                   my %domconfig =
                       &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
                   $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
               }
               if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
                   foreach my $id (keys(%{$ipaccessref})) {
                       if (ref($ipaccessref->{$id}) eq 'HASH') {
                           my $range = $ipaccessref->{$id}->{'ip'};
                           if ($range) {
                               if (&Apache::lonnet::ip_match($clientip,$range)) {
                                   if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
                                       if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
                                           return ('','','',$id,$dom);
                                           last;
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
     if (defined($udom) && defined($uname)) {      if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.          # If uname and udom are for a course, check for blocks in the course.
         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {          if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
Line 4955  sub get_blocks { Line 5021  sub get_blocks {
                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};                   my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                 if ($start && $end) {                  if ($start && $end) {
                     if (($start <= time) && ($end >= time)) {                      if (($start <= time) && ($end >= time)) {
                         unless (grep(/^\Q$block\E$/,@blockers)) {                          if (ref($commblocks{$block}) eq 'HASH') {
                             push(@blockers,$block);                              if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                             $triggered{$block} = {                                  if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                                                    start => $start,                                      unless(grep(/^\Q$block\E$/,@blockers)) {
                                                    end   => $end,                                          push(@blockers,$block);
                                                    type  => $type,                                          $triggered{$block} = {
                                                  };                                                                 start => $start,
                                                                  end   => $end,
                                                                  type  => $type,
                                                                };
                                       }
                                   }
                               }
                         }                          }
                     }                      }
                 }                  }
Line 5025  sub parse_block_record { Line 5097  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;      my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     my ($startblock,$endblock,$triggerblock) =       if ($clientip eq '') {
         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);          $clientip = &Apache::lonnet::get_requestor_ip();
       }
       my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
           &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if (($startblock && $endblock) || ($by_ip)) {
         $blocked = 1;          $blocked = 1;
     }      }
   
Line 5041  sub blocking_status { Line 5116  sub blocking_status {
   
 # build a link to a popup window containing the details  # build a link to a popup window containing the details
     my $querystring  = "?activity=$activity";      my $querystring  = "?activity=$activity";
 # $uname and $udom decide whose portfolio the user is trying to look at  # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
     if (($activity eq 'port') || ($activity eq 'passwd')) {      if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);          $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/);
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);          $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } elsif ($activity eq 'docs') {      } elsif ($activity eq 'docs') {
Line 5076  END_MYBLOCK Line 5151  END_MYBLOCK
         $text = &mt('Printing Blocked');          $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {      } elsif ($activity eq 'passwd') {
         $text = &mt('Password Changing Blocked');          $text = &mt('Password Changing Blocked');
       } elsif ($activity eq 'grades') {
           $text = &mt('Gradebook Blocked');
       } elsif ($activity eq 'search') {
           $text = &mt('Search Blocked');
       } elsif ($activity eq 'about') {
           $text = &mt('Access to User Information Pages Blocked');
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='$class'>
Line 5228  sub get_domainconf { Line 5309  sub get_domainconf {
                                     }                                      }
                                 }                                  }
                             }                              }
                           } elsif ($key eq 'saml') {
                               if (ref($domconfig{'login'}{$key}) eq 'HASH') {
                                   foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
                                       if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
                                           $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
                                           foreach my $item ('text','img','alt','url','title','notsso') {
                                               $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
                                           }
                                       }
                                   }
                               }
                         } else {                          } else {
                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {                              foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                                 $designhash{$udom.'.login.'.$key.'_'.$img} =                                   $designhash{$udom.'.login.'.$key.'_'.$img} = 
Line 5597  sub bodytag { Line 5689  sub bodytag {
     if ($realm) {      if ($realm) {
         $realm = '/'.$realm;          $realm = '/'.$realm;
     }      }
     if ($role  eq 'ca') {      if ($rol  eq 'ca') {
         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});          my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
         $realm = &plainname($rname,$rdom);          $realm = &plainname($rname,$rdom);
     }       } 
 # realm  # realm
       my ($cid,$sec);
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
           $cid = $env{'request.course.id'};
           if ($env{'request.course.sec'}) {
               $sec = $env{'request.course.sec'};
           }
       } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
           if (&Apache::lonnet::is_course($1,$2)) {
               $cid = $1.'_'.$2;
               $sec = $3;
           }
       }
       if ($cid) {
         if ($env{'request.role'} !~ /^cr/) {          if ($env{'request.role'} !~ /^cr/) {
             $role = &Apache::lonnet::plaintext($role,&course_type());              $role = &Apache::lonnet::plaintext($role,&course_type());
         } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {          } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
Line 5614  sub bodytag { Line 5718  sub bodytag {
         } else {          } else {
             $role = (split(/\//,$role,4))[-1];              $role = (split(/\//,$role,4))[-1];
         }          }
         if ($env{'request.course.sec'}) {          if ($sec) {
             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};              $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$sec;
         }             }   
  $realm = $env{'course.'.$env{'request.course.id'}.'.description'};   $realm = $env{'course.'.$cid.'.description'};
     } else {      } else {
         $role = &Apache::lonnet::plaintext($role);          $role = &Apache::lonnet::plaintext($role);
     }      }
Line 5639  sub bodytag { Line 5743  sub bodytag {
     if ($public) {      if ($public) {
  undef($role);   undef($role);
     }      }
       
     my $titleinfo = '<h1>'.$title.'</h1>';      my $titleinfo = '<h1>'.$title.'</h1>';
     #      #
     # Extra info if you are the DC      # Extra info if you are the DC
     my $dc_info = '';      my $dc_info = '';
     if ($env{'user.adv'} && exists($env{'user.role.dc./'.      if (($env{'user.adv'} && ($env{'request.course.id'}) &&
                         $env{'course.'.$env{'request.course.id'}.          (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
                                  '.domain'}.'/'})) {  
         my $cid = $env{'request.course.id'};  
         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};          $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info =~ s/\s+$//;          $dc_info =~ s/\s+$//;
     }      }
Line 5679  sub bodytag { Line 5781  sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(          $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');              Apache::lonmenu::utilityfunctions($httphost), 'start');
   
         my ($left,$right) = Apache::lonmenu::primary_menu();          my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
   
         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {          if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
             if ($dc_info) {              if ($dc_info) {
                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
             }              }
             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
                            <em>$realm</em> $dc_info</div>|;                             <em>$realm</em> $dc_info</div>|;
Line 5707  sub bodytag { Line 5809  sub bodytag {
         }          }
         #don't show menus for public users          #don't show menus for public users
         if (!$public){          if (!$public){
             $bodytag .= Apache::lonmenu::secondary_menu($httphost);              $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
             $bodytag .= Apache::lonmenu::serverform();              $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
Line 7825  ul.LC_funclist li { Line 7927  ul.LC_funclist li {
  cursor:pointer;   cursor:pointer;
 }  }
   
   .LCisDisabled {
     cursor: not-allowed;
     opacity: 0.5;
   }
   
   a[aria-disabled="true"] {
     color: currentColor;
     display: inline-block;  /* For IE11/ MS Edge bug */
     pointer-events: none;
     text-decoration: none;
   }
   
 pre.LC_wordwrap {  pre.LC_wordwrap {
   white-space: pre-wrap;    white-space: pre-wrap;
   white-space: -moz-pre-wrap;    white-space: -moz-pre-wrap;
Line 8021  ADDMETA Line 8135  ADDMETA
                         }                          }
                     }                      }
                     if ($offload) {                      if ($offload) {
                         my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);                          my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
                         if (($newserver eq '') && ($offloadoth)) {                          if (($newserver eq '') && ($offloadoth)) {
                             my @domains = &Apache::lonnet::current_machine_domains();                              my @domains = &Apache::lonnet::current_machine_domains();
                             if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {                               if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
Line 8203  sub print_suppression { Line 8317  sub print_suppression {
         }          }
         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);          my $clientip = &Apache::lonnet::get_requestor_ip();
           my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
         if ($blocked) {          if ($blocked) {
             my $checkrole = "cm./$cdom/$cnum";              my $checkrole = "cm./$cdom/$cnum";
             if ($env{'request.course.sec'} ne '') {              if ($env{'request.course.sec'} ne '') {
Line 8324  $args - additional optional args support Line 8439  $args - additional optional args support
                                will contain https://<hostname> if server uses                                 will contain https://<hostname> if server uses
                                https (as per hosts.tab), but request is for http                                 https (as per hosts.tab), but request is for http
              hostname       -> hostname, originally from $r->hostname(), (optional).               hostname       -> hostname, originally from $r->hostname(), (optional).
                links_disabled -> Links in primary and secondary menus are disabled
                                  (Can enable them once page has loaded - see lonroles.pm
                                  for an example).
   
 =back  =back
   
Line 15373  sub construct_course { Line 15491  sub construct_course {
                    'plc.users.denied',                     'plc.users.denied',
                    'hidefromcat',                     'hidefromcat',
                    'checkforpriv',                     'checkforpriv',
                    'categories',                     'categories'],
                    'internal.uniquecode'],  
                    $$crsudom,$$crsunum);                     $$crsudom,$$crsunum);
         if ($args->{'textbook'}) {          if ($args->{'textbook'}) {
             $cenv{'internal.textbook'} = $args->{'textbook'};              $cenv{'internal.textbook'} = $args->{'textbook'};
Line 17146  sub create_captcha { Line 17263  sub create_captcha {
   
         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {          if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".              $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                         '<span class="LC_nobreak">'.
                       &mt('Type in the letters/numbers shown below').'&nbsp;'.                        &mt('Type in the letters/numbers shown below').'&nbsp;'.
                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.                        '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                       '<br />'.                        '</span><br />'.
                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';                        '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
             last;              last;
         }          }
     }      }
       if ($output eq '') {
           &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
       }
     return $output;      return $output;
 }  }
   
Line 17191  sub check_captcha { Line 17312  sub check_captcha {
 sub create_recaptcha {  sub create_recaptcha {
     my ($pubkey,$version) = @_;      my ($pubkey,$version) = @_;
     if ($version >= 2) {      if ($version >= 2) {
         return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';          return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
                  '<div style="padding:0;clear:both;margin:0;border:0"></div>';
     } else {      } else {
         my $use_ssl;          my $use_ssl;
         if ($ENV{'SERVER_PORT'} == 443) {          if ($ENV{'SERVER_PORT'} == 443) {
Line 17283  sub cleanup_html { Line 17405  sub cleanup_html {
 # $interval indicates how often to check for messages.  # $interval indicates how often to check for messages.
 sub critical_redirect {  sub critical_redirect {
     my ($interval) = @_;      my ($interval) = @_;
       unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
           return ();
       }
     if ((time-$env{'user.criticalcheck.time'})>$interval) {      if ((time-$env{'user.criticalcheck.time'})>$interval) {
         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},          my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                                         $env{'user.name'});                                          $env{'user.name'});
         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});          &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
         my $redirecturl;          my $redirecturl;
         if ($what[0]) {          if ($what[0]) {
             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {              if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
                 $redirecturl='/adm/email?critical=display';                  $redirecturl='/adm/email?critical=display';
                 my $url=&Apache::lonnet::absolute_url().$redirecturl;                  my $url=&Apache::lonnet::absolute_url().$redirecturl;
                 return (1, $url);                  return (1, $url);
Removed from v.1.1075.2.157  
changed lines
  Added in v.1.1075.2.158

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