[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.127.2.7 and 1.1075.2.151

version 1.1075.2.127.2.7, 2019/02/06 16:10:34 version 1.1075.2.151, 2021/01/29 02:42:15
Line 71  use Apache::lonuserutils(); Line 71  use Apache::lonuserutils();
 use Apache::lonuserstate();  use Apache::lonuserstate();
 use Apache::courseclassifier();  use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   use HTTP::Request;
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale;  use DateTime::Locale;
 use Encode();  use Encode();
Line 82  use Crypt::DES; Line 83  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
 use File::Copy();  use File::Copy();
 use File::Path();  use File::Path();
 use String::CRC32();  
 use Short::URL();  
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 429  sub studentbrowser_javascript { Line 428  sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
 // <![CDATA[  // <![CDATA[
     var stdeditbrowser;      var stdeditbrowser;
     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {      function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
         var url = '/adm/pickstudent?';          var url = '/adm/pickstudent?';
         var filter;          var filter;
  if (!ignorefilter) {   if (!ignorefilter) {
Line 444  sub studentbrowser_javascript { Line 443  sub studentbrowser_javascript {
                                     '&udomelement='+udom+                                      '&udomelement='+udom+
                                     '&clicker='+clicker;                                      '&clicker='+clicker;
  if (roleflag) { url+="&roles=1"; }   if (roleflag) { url+="&roles=1"; }
         if (courseadvonly) { url+="&courseadvonly=1"; }          if (courseadv == 'condition') {
               if (document.getElementById('courseadv')) {
                   courseadv = document.getElementById('courseadv').value;
               }
           }
           if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
         var title = 'Student_Browser';          var title = 'Student_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 476  ENDRESBRW Line 480  ENDRESBRW
 }  }
   
 sub selectstudent_link {  sub selectstudent_link {
    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;     my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".     my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".                        &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";                        &Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 487  sub selectstudent_link { Line 491  sub selectstudent_link {
    return '';     return '';
        }         }
        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";         $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
        if ($courseadvonly)  {         if ($courseadv eq 'only') {
            $callargs .= ",'',1,1";             $callargs .= ",'',1,'$courseadv'";
          } elsif ($courseadv eq 'none') {
              $callargs .= ",'','','$courseadv'";
          } elsif ($courseadv eq 'condition') {
              $callargs .= ",'','','$courseadv'";
        }         }
        return '<span class="LC_nobreak">'.         return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.                '<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 1405  sub help_menu_js { Line 1413  sub help_menu_js {
         &Apache::loncommon::start_page('Help Menu', undef,          &Apache::loncommon::start_page('Help Menu', undef,
        {'frameset'    => 1,         {'frameset'    => 1,
  'js_ready'    => 1,   'js_ready'    => 1,
                                         'use_absolute' => $httphost,                                           'use_absolute' => $httphost,
  'add_entries' => {   'add_entries' => {
     'border' => '0',      'border' => '0',
     'rows'   => "110,*",},});      'rows'   => "110,*",},});
Line 2264  sub select_form { Line 2272  sub select_form {
     if ($onchange) {      if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';          $onchange = ' onchange="'.$onchange.'"';
     }      }
     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";      my $disabled;
       if ($readonly) {
           $disabled = ' disabled="disabled"';
       }
       my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     my @keys;      my @keys;
     if (exists($hashref->{'select_form_order'})) {      if (exists($hashref->{'select_form_order'})) {
  @keys=@{$hashref->{'select_form_order'}};   @keys=@{$hashref->{'select_form_order'}};
Line 3168  sub get_assignable_auth { Line 3180  sub get_assignable_auth {
     return ($authnum,%can_assign);      return ($authnum,%can_assign);
 }  }
   
   sub check_passwd_rules {
       my ($domain,$plainpass) = @_;
       my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
       my ($min,$max,@chars,@brokerule,$warning);
       $min = $Apache::lonnet::passwdmin;
       if (ref($passwdconf{'chars'}) eq 'ARRAY') {
           if ($passwdconf{'min'} =~ /^\d+$/) {
               if ($passwdconf{'min'} > $min) {
                   $min = $passwdconf{'min'};
               }
           }
           if ($passwdconf{'max'} =~ /^\d+$/) {
               $max = $passwdconf{'max'};
           }
           @chars = @{$passwdconf{'chars'}};
       }
       if (($min) && (length($plainpass) < $min)) {
           push(@brokerule,'min');
       }
       if (($max) && (length($plainpass) > $max)) {
           push(@brokerule,'max');
       }
       if (@chars) {
           my %rules;
           map { $rules{$_} = 1; } @chars;
           if ($rules{'uc'}) {
               unless ($plainpass =~ /[A-Z]/) {
                   push(@brokerule,'uc');
               }
           }
           if ($rules{'lc'}) {
               unless ($plainpass =~ /[a-z]/) {
                   push(@brokerule,'lc');
               }
           }
           if ($rules{'num'}) {
               unless ($plainpass =~ /\d/) {
                   push(@brokerule,'num');
               }
           }
           if ($rules{'spec'}) {
               unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   push(@brokerule,'spec');
               }
           }
       }
       if (@brokerule) {
           my %rulenames = &Apache::lonlocal::texthash(
               uc   => 'At least one upper case letter',
               lc   => 'At least one lower case letter',
               num  => 'At least one number',
               spec => 'At least one non-alphanumeric',
           );
           $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
           $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
           $rulenames{'num'} .= ': 0123456789';
           $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
           $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
           $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
           $warning = &mt('Password did not satisfy the following:').'<ul>';
           foreach my $rule ('min','max','uc','lc','num','spec') {
               if (grep(/^$rule$/,@brokerule)) {
                   $warning .= '<li>'.$rulenames{$rule}.'</li>';
               }
           }
           $warning .= '</ul>';
       }
       if (wantarray) {
           return @brokerule;
       }
       return $warning;
   }
   
 ###############################################################  ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 4338  sub get_student_view_with_retries { Line 4423  sub get_student_view_with_retries {
     }      }
 }  }
   
   sub css_links {
       my ($currsymb,$level) = @_;
       my ($links,@symbs,%cssrefs,%httpref);
       if ($level eq 'map') {
           my $navmap = Apache::lonnavmaps::navmap->new();
           if (ref($navmap)) {
               my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
               my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
               foreach my $res (@resources) {
                   if (ref($res) && $res->symb()) {
                       push(@symbs,$res->symb());
                   }
               }
           }
       } else {
           @symbs = ($currsymb);
       }
       foreach my $symb (@symbs) {
           my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
           if ($css_href =~ /\S/) {
               unless ($css_href =~ m{https?://}) {
                   my $url = (&Apache::lonnet::decode_symb($symb))[-1];
                   my $proburl =  &Apache::lonnet::clutter($url);
                   my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
                   unless ($css_href =~ m{^/}) {
                       $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
                   }
                   if ($css_href =~ m{^/(res|uploaded)/}) {
                       unless (($httpref{'httpref.'.$css_href}) ||
                               (&Apache::lonnet::is_on_map($css_href))) {
                           my $thisurl = $proburl;
                           if ($env{'httpref.'.$proburl}) {
                               $thisurl = $env{'httpref.'.$proburl};
                           }
                           $httpref{'httpref.'.$css_href} = $thisurl;
                       }
                   }
               }
               $cssrefs{$css_href} = 1;
           }
       }
       if (keys(%httpref)) {
           &Apache::lonnet::appenv(\%httpref);
       }
       if (keys(%cssrefs)) {
           foreach my $css_href (keys(%cssrefs)) {
               next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
               $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
           }
       }
       return $links;
   }
   
 =pod  =pod
   
 =item * &get_student_answers()   =item * &get_student_answers() 
Line 4593  sub findallcourses { Line 4731  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;      my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
   
     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))) {
             my ($startblock,$endblock,$triggerblock) =              my ($startblock,$endblock,$triggerblock) =
                 &get_blocks($setters,$activity,$udom,$uname,$url);                  &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
             return ($startblock,$endblock,$triggerblock);              return ($startblock,$endblock,$triggerblock);
         }          }
     } else {      } else {
Line 4722  sub blockcheck { Line 4860  sub blockcheck {
                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));                   ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
         next if ($no_userblock);          next if ($no_userblock);
   
         # Retrieve blocking times and identity of locker for course          # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.          # of specified user, unless user has 'evb' privilege.
                   
         my ($start,$end,$trigger) =           my ($start,$end,$trigger) = 
             &get_blocks($setters,$activity,$cdom,$cnum,$url);              &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
         if (($start != 0) &&           if (($start != 0) && 
             (($startblock == 0) || ($startblock > $start))) {              (($startblock == 0) || ($startblock > $start))) {
             $startblock = $start;              $startblock = $start;
Line 4746  sub blockcheck { Line 4884  sub blockcheck {
 }  }
   
 sub get_blocks {  sub get_blocks {
     my ($setters,$activity,$cdom,$cnum,$url) = @_;      my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
Line 4759  sub get_blocks { Line 4897  sub get_blocks {
     my $now = time;      my $now = time;
     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);      my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
     if ($activity eq 'docs') {      if ($activity eq 'docs') {
         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);          my ($blocked,$nosymbcache,$noenccheck);
           if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
               $blocked = 1;
               $nosymbcache = 1;
               $noenccheck = 1;
           }
           @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
         foreach my $block (@blockers) {          foreach my $block (@blockers) {
             if ($block =~ /^firstaccess____(.+)$/) {              if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;                  my $item = $1;
Line 4881  sub parse_block_record { Line 5025  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url,$is_course) = @_;      my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
     my %setters;      my %setters;
   
 # check for active blocking  # check for active blocking
     my ($startblock,$endblock,$triggerblock) =       my ($startblock,$endblock,$triggerblock) = 
         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);          &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
     my $blocked = 0;      my $blocked = 0;
     if ($startblock && $endblock) {      if ($startblock && $endblock) {
         $blocked = 1;          $blocked = 1;
Line 4902  sub blocking_status { Line 5046  sub blocking_status {
         $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') {
         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');          my $showurl = &Apache::lonenc::check_encrypt($url);
           $querystring .= '&amp;url='.&HTML::Entities::encode($showurl,'\'&"<>');
           if ($symb) {
               my $showsymb = &Apache::lonenc::check_encrypt($symb);
               $querystring .= '&amp;symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
           }
     }      }
   
     my $output .= <<'END_MYBLOCK';      my $output .= <<'END_MYBLOCK';
Line 4951  sub check_ip_acc { Line 5100  sub check_ip_acc {
         return 1;          return 1;
     }      }
     my $allowed=0;      my $allowed=0;
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};      my $ip;
       if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
           ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
           $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
       } else {
           my $remote_ip = &Apache::lonnet::get_requestor_ip();
           $ip = $remote_ip || $env{'request.host'} || $clientip;
       }
   
     my $name;      my $name;
     foreach my $pattern (split(',',$acc)) {      foreach my $pattern (split(',',$acc)) {
Line 4996  sub check_ip_acc { Line 5152  sub check_ip_acc {
     return $allowed;      return $allowed;
 }  }
   
 sub check_slotip_acc {  
     my ($acc,$clientip)=@_;  
     &Apache::lonxml::debug("acc is $acc");  
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {  
         return 1;  
     }  
     my $allowed;  
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};  
   
     my $name;  
     my %access = (  
                      allowfrom => 1,  
                      denyfrom  => 0,  
                  );  
     my @allows;  
     my @denies;  
     foreach my $item (split(',',$acc)) {  
         $item =~ s/^\s*//;  
         $item =~ s/\s*$//;  
         my $pattern;  
         if ($item =~ /^\!(.+)$/) {  
             push(@denies,$1);  
         } else {  
             push(@allows,$item);  
         }  
    }  
    my $numdenies = scalar(@denies);  
    my $numallows = scalar(@allows);  
    my $count = 0;  
    foreach my $pattern (@denies,@allows) {  
         $count ++;  
         my $acctype = 'allowfrom';  
         if ($count <= $numdenies) {  
             $acctype = 'denyfrom';  
         }  
         if ($pattern =~ /\*$/) {  
             #35.8.*  
             $pattern=~s/\*//;  
             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }  
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {  
             #35.8.3.[34-56]  
             my $low=$2;  
             my $high=$3;  
             $pattern=$1;  
             if ($ip =~ /^\Q$pattern\E/) {  
                 my $last=(split(/\./,$ip))[3];  
                 if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }  
             }  
         } elsif ($pattern =~ /^\*/) {  
             #*.msu.edu  
             $pattern=~s/\*//;  
             if (!defined($name)) {  
                 use Socket;  
                 my $netaddr=inet_aton($ip);  
                 ($name)=gethostbyaddr($netaddr,AF_INET);  
             }  
             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }  
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {  
             #127.0.0.1  
             if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }  
         } else {  
             #some.name.com  
             if (!defined($name)) {  
                 use Socket;  
                 my $netaddr=inet_aton($ip);  
                 ($name)=gethostbyaddr($netaddr,AF_INET);  
             }  
             if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }  
         }  
         if ($allowed =~ /^(0|1)$/) { last; }  
     }  
     if ($allowed eq '') {  
         if ($numdenies && !$numallows) {  
             $allowed = 1;  
         } else {  
             $allowed = 0;  
         }  
     }  
     return $allowed;  
 }  
   
 ###############################################  ###############################################
   
 =pod  =pod
Line 5473  Inputs: Line 5548  Inputs:
   
 =item * $args, optional argument valid values are  =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg              no_auto_mt_title -> prevents &mt()ing the title arg
               use_absolute     -> for external resource or syllabus, this will
                                   contain https://<hostname> if server uses
                                   https (as per hosts.tab), but request is for http
               hostname         -> hostname, from $r->hostname().
   
 =item * $advtoolsref, optional argument, ref to an array containing  =item * $advtoolsref, optional argument, ref to an array containing
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
Line 5498  sub bodytag { Line 5577  sub bodytag {
     }      }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }      if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     my $httphost = $args->{'use_absolute'};      my $httphost = $args->{'use_absolute'};
       my $hostname = $args->{'hostname'};
   
     $function = &get_users_function() if (!$function);      $function = &get_users_function() if (!$function);
     my $img =    &designparm($function.'.img',$domain);      my $img =    &designparm($function.'.img',$domain);
Line 5586  sub bodytag { Line 5666  sub bodytag {
         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},          &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                             $forcereg,$args->{'group'},                                              $forcereg,$args->{'group'},
                                             $args->{'bread_crumbs'},                                              $args->{'bread_crumbs'},
                                             $advtoolsref,'',\$forbodytag);                                              $advtoolsref,'','',\$forbodytag);
         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {          unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
             $funclist = $forbodytag;              $funclist = $forbodytag;
         }          }
Line 5632  sub bodytag { Line 5712  sub bodytag {
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');              $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {              if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'});                                  $args->{'bread_crumbs'},'','',$hostname);
             } elsif ($forcereg) {              } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},                                                              $args->{'group'},
                                                             $args->{'hide_buttons'});                                                              $args->{'hide_buttons',
                                                               $hostname});
             } else {              } else {
                 my $forbodytag;                  my $forbodytag;
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                  &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                     $forcereg,$args->{'group'},                                                      $forcereg,$args->{'group'},
                                                     $args->{'bread_crumbs'},                                                      $args->{'bread_crumbs'},
                                                     $advtoolsref,'',\$forbodytag);                                                      $advtoolsref,'',$hostname,
                                                       \$forbodytag);
                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {                  unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                     $bodytag .= $forbodytag;                      $bodytag .= $forbodytag;
                 }                  }
Line 6156  td.LC_menubuttons_text { Line 6238  td.LC_menubuttons_text {
   background: $tabbg;    background: $tabbg;
 }  }
   
   td.LC_zero_height {
     line-height: 0;
     cellpadding: 0;
   }
   
 table.LC_data_table {  table.LC_data_table {
   border: 1px solid #000000;    border: 1px solid #000000;
   border-collapse: separate;    border-collapse: separate;
Line 6746  table.LC_prior_tries td { Line 6833  table.LC_prior_tries td {
   padding: 6px;    padding: 6px;
 }  }
   
 .LC_answer_unknown {  .LC_answer_unknown,
   .LC_answer_warning {
   background: orange;    background: orange;
   color: black;    color: black;
   padding: 6px;    padding: 6px;
Line 6828  table.LC_data_table tr > td.LC_docs_entr Line 6916  table.LC_data_table tr > td.LC_docs_entr
   color: #990000;    color: #990000;
 }  }
   
   .LC_domprefs_email,
 .LC_docs_reinit_warn,  .LC_docs_reinit_warn,
 .LC_docs_ext_edit {  .LC_docs_ext_edit {
   font-size: x-small;    font-size: x-small;
Line 7736  ul.LC_funclist li { Line 7825  ul.LC_funclist li {
  cursor:pointer;   cursor:pointer;
 }  }
   
   pre.LC_wordwrap {
     white-space: pre-wrap;
     white-space: -moz-pre-wrap;
     white-space: -pre-wrap;
     white-space: -o-pre-wrap;
     word-wrap: break-word;
   }
   
 /*  /*
   styles used by TTH when "Default set of options to pass to tth/m    styles used by TTH when "Default set of options to pass to tth/m
   when converting TeX" in course settings has been set    when converting TeX" in course settings has been set
Line 7895  ADDMETA Line 7992  ADDMETA
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};                  my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {                  unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);                      my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
                       my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                       my ($offload,$offloadoth);
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {                      if (ref($domdefs{'offloadnow'}) eq 'HASH') {
                         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};  
                         if ($domdefs{'offloadnow'}{$lonhost}) {                          if ($domdefs{'offloadnow'}{$lonhost}) {
                             my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);                              $offload = 1;
                             if (($newserver) && ($newserver ne $lonhost)) {                              if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                                 my $numsec = 5;                                  (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                                 my $timeout = $numsec * 1000;                                  unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                                 my ($newurl,$locknum,%locks,$msg);                                      $offloadoth = 1;
                                 if ($env{'request.role.adv'}) {                                      $dom_in_use = $env{'user.domain'};
                                     ($locknum,%locks) = &Apache::lonnet::get_locks();  
                                 }                                  }
                                 my $disable_submit = 0;                              }
                                 if ($requrl =~ /$LONCAPA::assess_re/) {                          }
                                     $disable_submit = 1;                      }
                       unless ($offload) {
                           if (ref($domdefs{'offloadoth'}) eq 'HASH') {
                               if ($domdefs{'offloadoth'}{$lonhost}) {
                                   if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
                                       (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
                                       unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
                                           $offload = 1;
                                           $offloadoth = 1;
                                           $dom_in_use = $env{'user.domain'};
                                       }
                                 }                                  }
                                 if ($locknum) {                              }
                                     my @lockinfo = sort(values(%locks));                          }
                                     $msg = &mt('Once the following tasks are complete: ')."\\n".                      }
                                            join(", ",sort(values(%locks)))."\\n".                      if ($offload) {
                                            &mt('your session will be transferred to a different server, after you click "Roles".');                          my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
                           if (($newserver eq '') && ($offloadoth)) {
                               my @domains = &Apache::lonnet::current_machine_domains();
                               if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                                   ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                               }
                           }
                           if (($newserver) && ($newserver ne $lonhost)) {
                               my $numsec = 5;
                               my $timeout = $numsec * 1000;
                               my ($newurl,$locknum,%locks,$msg);
                               if ($env{'request.role.adv'}) {
                                   ($locknum,%locks) = &Apache::lonnet::get_locks();
                               }
                               my $disable_submit = 0;
                               if ($requrl =~ /$LONCAPA::assess_re/) {
                                   $disable_submit = 1;
                               }
                               if ($locknum) {
                                   my @lockinfo = sort(values(%locks));
                                   $msg = &mt('Once the following tasks are complete: ')."\n".
                                          join(", ",sort(values(%locks)))."\n";
                                   if (&show_course()) {
                                       $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                                 } else {                                  } else {
                                     if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {                                      $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
                                         $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";                                  }
                                     }                              } else {
                                     $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);                                  if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
                                     $newurl = '/adm/switchserver?otherserver='.$newserver;                                      $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
                                     if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {                                  }
                                         $newurl .= '&role='.$env{'request.role'};                                  $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
                                   $newurl = '/adm/switchserver?otherserver='.$newserver;
                                   if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
                                       $newurl .= '&role='.$env{'request.role'};
                                   }
                                   if ($env{'request.symb'}) {
                                       my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
                                       if ($shownsymb =~ m{^/enc/}) {
                                           my $reqdmajor = 2;
                                           my $reqdminor = 11;
                                           my $reqdsubminor = 3;
                                           my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
                                           my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
                                           my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
                                           if (($major eq '' && $minor eq '') ||
                                               (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
                                               (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
                                                ($reqdsubminor > $subminor))))) {
                                               undef($shownsymb);
                                           }
                                     }                                      }
                                     if ($env{'request.symb'}) {                                      if ($shownsymb) {
                                         $newurl .= '&symb='.$env{'request.symb'};                                          &js_escape(\$shownsymb);
                                     } else {                                          $newurl .= '&symb='.$shownsymb;
                                         $newurl .= '&origurl='.$requrl;  
                                     }                                      }
                                   } else {
                                       my $shownurl = &Apache::lonenc::check_encrypt($requrl);
                                       &js_escape(\$shownurl);
                                       $newurl .= '&origurl='.$shownurl;
                                 }                                  }
                                 &js_escape(\$msg);                              }
                                 $result.=<<OFFLOAD                              &js_escape(\$msg);
                               $result.=<<OFFLOAD
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 7952  function LC_Offload_Now() { Line 8105  function LC_Offload_Now() {
 // ]]>  // ]]>
 </script>  </script>
 OFFLOAD  OFFLOAD
                             }  
                         }                          }
                     }                      }
                 }                  }
Line 8168  $args - additional optional args support Line 8320  $args - additional optional args support
                                     to lonhtmlcommon::breadcrumbs                                      to lonhtmlcommon::breadcrumbs
              group          -> includes the current group, if page is for a               group          -> includes the current group, if page is for a
                                specific group                                 specific group
                use_absolute   -> for request for external resource or syllabus, this
                                  will contain https://<hostname> if server uses
                                  https (as per hosts.tab), but request is for http
                hostname       -> hostname, originally from $r->hostname(), (optional).
   
 =back  =back
   
Line 8369  sub modal_link { Line 8525  sub modal_link {
         $target_attr = 'target="'.$target.'"';          $target_attr = 'target="'.$target.'"';
     }      }
     return <<"ENDLINK";      return <<"ENDLINK";
 <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">  <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
            $linktext</a>  
 ENDLINK  ENDLINK
 }  }
   
Line 8473  sub end_togglebox { Line 8628  sub end_togglebox {
 }  }
   
 sub LCprogressbar_script {  sub LCprogressbar_script {
    my ($id)=@_;     my ($id,$number_to_do)=@_;
    return(<<ENDPROGRESS);     if ($number_to_do) {
          return(<<ENDPROGRESS);
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 \$('#progressbar$id').progressbar({  \$('#progressbar$id').progressbar({
Line 8487  sub LCprogressbar_script { Line 8643  sub LCprogressbar_script {
 // ]]>  // ]]>
 </script>  </script>
 ENDPROGRESS  ENDPROGRESS
      } else {
          return(<<ENDPROGRESS);
   <script type="text/javascript">
   // <![CDATA[
   \$('#progressbar$id').progressbar({
     value: false,
     create: function(event, ui) {
       \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
       \$('.ui-progressbar-overlay', this).css({'margin':'0'});
     }
   });
   // ]]>
   </script>
   ENDPROGRESS
      }
 }  }
   
 sub LCprogressbarUpdate_script {  sub LCprogressbarUpdate_script {
    return(<<ENDPROGRESSUPDATE);     return(<<ENDPROGRESSUPDATE);
 <style type="text/css">  <style type="text/css">
 .ui-progressbar { position:relative; }  .ui-progressbar { position:relative; }
   .progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
 .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }  .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
 </style>  </style>
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 var LCprogressTxt='---';  var LCprogressTxt='---';
   
 function LCupdateProgress(percent,progresstext,id) {  function LCupdateProgress(percent,progresstext,id,maxnum) {
    LCprogressTxt=progresstext;     LCprogressTxt=progresstext;
    \$('#progressbar'+id).progressbar('value',percent);     if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
          \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
      } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
          \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
      } else {
          \$('#progressbar'+id).progressbar('value',percent);
      }
 }  }
 // ]]>  // ]]>
 </script>  </script>
Line 8513  my $LCidcnt; Line 8691  my $LCidcnt;
 my $LCcurrentid;  my $LCcurrentid;
   
 sub LCprogressbar {  sub LCprogressbar {
     my ($r)=(@_);      my ($r,$number_to_do,$preamble)=@_;
     $LClastpercent=0;      $LClastpercent=0;
     $LCidcnt++;      $LCidcnt++;
     $LCcurrentid=$$.'_'.$LCidcnt;      $LCcurrentid=$$.'_'.$LCidcnt;
     my $starting=&mt('Starting');      my ($starting,$content);
     my $content=(<<ENDPROGBAR);      if ($number_to_do) {
           $starting=&mt('Starting');
           $content=(<<ENDPROGBAR);
   $preamble
   <div id="progressbar$LCcurrentid">    <div id="progressbar$LCcurrentid">
     <span class="pblabel">$starting</span>      <span class="pblabel">$starting</span>
   </div>    </div>
 ENDPROGBAR  ENDPROGBAR
     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));      } else {
           $starting=&mt('Loading...');
           $LClastpercent='false';
           $content=(<<ENDPROGBAR);
   $preamble
     <div id="progressbar$LCcurrentid">
         <div class="progress-label">$starting</div>
     </div>
   ENDPROGBAR
       }
       &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
 }  }
   
 sub LCprogressbarUpdate {  sub LCprogressbarUpdate {
     my ($r,$val,$text)=@_;      my ($r,$val,$text,$number_to_do)=@_;
     unless ($val) {       if ($number_to_do) {
        if ($LClastpercent) {          unless ($val) { 
            $val=$LClastpercent;              if ($LClastpercent) {
        } else {                  $val=$LClastpercent;
            $val=0;              } else {
        }                  $val=0;
               }
           }
           if ($val<0) { $val=0; }
           if ($val>100) { $val=0; }
           $LClastpercent=$val;
           unless ($text) { $text=$val.'%'; }
       } else {
           $val = 'false';
     }      }
     if ($val<0) { $val=0; }  
     if ($val>100) { $val=0; }  
     $LClastpercent=$val;  
     unless ($text) { $text=$val.'%'; }  
     $text=&js_ready($text);      $text=&js_ready($text);
     &r_print($r,<<ENDUPDATE);      &r_print($r,<<ENDUPDATE);
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 LCupdateProgress($val,'$text','$LCcurrentid');  LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
 // ]]>  // ]]>
 </script>  </script>
 ENDUPDATE  ENDUPDATE
Line 12188  sub process_decompression { Line 12383  sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {                      if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {                          foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);                              my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                             unless (($item =~ /^\.+$/) || ($item eq $file) ||                               unless (($item =~ /^\.+$/) || ($item eq $file)) { 
                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {  
                                 push(@newitems,$item);                                  push(@newitems,$item);
                                 if ($dirptr&$testdir) {                                  if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;                                      $is_dir{$item} = 1;
Line 12777  sub process_extracted_files { Line 12971  sub process_extracted_files {
                             $newseqid{$i} = $newidx;                              $newseqid{$i} = $newidx;
                             unless ($errtext) {                              unless ($errtext) {
                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',                                  $result .=  '<li>'.&mt('Folder: [_1] added to course',
                                                        &HTML::Entities::encode($docstitle,'<>&"')).                                                         &HTML::Entities::encode($docstitle,'<>&"'))..
                                             '</li>'."\n";                                              '</li>'."\n";
                             }                              }
                         }                          }
Line 12802  sub process_extracted_files { Line 12996  sub process_extracted_files {
                                             $fetch =~ s/^\Q$prefix$dir\E//;                                              $fetch =~ s/^\Q$prefix$dir\E//;
                                             $prompttofetch{$fetch} = 1;                                              $prompttofetch{$fetch} = 1;
                                         }                                          }
                                     }                                     }
                                 }                                  }
                                 $LONCAPA::map::resources[$newidx]=                                  $LONCAPA::map::resources[$newidx]=
                                     $docstitle.':'.$url.':false:normal:res';                                      $docstitle.':'.$url.':false:normal:res';
Line 12902  sub process_extracted_files { Line 13096  sub process_extracted_files {
                                 $result .= '<li>'.&mt('[_1] included as a dependency',                                  $result .= '<li>'.&mt('[_1] included as a dependency',
                                                       &HTML::Entities::encode($showpath,'<>&"')).                                                        &HTML::Entities::encode($showpath,'<>&"')).
                                            '</li>'."\n";                                             '</li>'."\n";
                             }                                  unless ($ishome) {
                             unless ($ishome) {                                      my $fetch = "$fullpath/$title";
                                 my $fetch = "$fullpath/$title";                                      $fetch =~ s/^\Q$prefix$dir\E//;
                                 $fetch =~ s/^\Q$prefix$dir\E//;                                      $prompttofetch{$fetch} = 1;
                                 $prompttofetch{$fetch} = 1;                                  }
                             }                              }
                         }                          }
                     }                      }
Line 13193  sub upfile_store { Line 13387  sub upfile_store {
     $env{'form.upfile'}=~s/\n+$//gs;      $env{'form.upfile'}=~s/\n+$//gs;
   
     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.      my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
                              '_enroll_'.$env{'request.course.id'}.'_'.                                       '_enroll_'.$env{'request.course.id'}.'_'.
                                      time.'_'.$$);                                       time.'_'.$$);
     return if ($datatoken eq '');      return if ($datatoken eq '');
   
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
Line 14134  $requdom domain of requester (if mailing Line 14329  $requdom domain of requester (if mailing
   
 $reqemail e-mail address of requester (if mailing type is helpdeskmail)  $reqemail e-mail address of requester (if mailing type is helpdeskmail)
   
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
 =back  =back
Line 14276  sub build_recipient_list { Line 14470  sub build_recipient_list {
     } elsif ($origmail ne '') {      } elsif ($origmail ne '') {
         $lastresort = $origmail;          $lastresort = $origmail;
     }      }
   
     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {      if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {          unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};              my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
Line 14462  jsarray (reference to array of categorie Line 14655  jsarray (reference to array of categorie
 subcats (reference to hash of arrays containing all subcategories within each   subcats (reference to hash of arrays containing all subcategories within each 
          category, -recursive)           category, -recursive)
   
   maxd (reference to hash used to hold max depth for all top-level categories).
   
 Returns: nothing  Returns: nothing
   
 Side effects: populates trails and allitems hash references.  Side effects: populates trails and allitems hash references.
Line 14469  Side effects: populates trails and allit Line 14664  Side effects: populates trails and allit
 =cut  =cut
   
 sub extract_categories {  sub extract_categories {
     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;      my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
     if (ref($categories) eq 'HASH') {      if (ref($categories) eq 'HASH') {
         &gather_categories($categories,$cats,$idx,$jsarray);          &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {          if (ref($cats->[0]) eq 'ARRAY') {
Line 14495  sub extract_categories { Line 14690  sub extract_categories {
                         if (ref($subcats) eq 'HASH') {                          if (ref($subcats) eq 'HASH') {
                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');                              push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                         }                          }
                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);                          &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
                     }                      }
                 } else {                  } else {
                     if (ref($subcats) eq 'HASH') {                      if (ref($subcats) eq 'HASH') {
                         $subcats->{$item} = [];                          $subcats->{$item} = [];
                     }                      }
                       if (ref($maxd) eq 'HASH') {
                           $maxd->{$name} = 1;
                       }
                 }                  }
             }              }
         }          }
Line 14538  Side effects: populates trails and allit Line 14736  Side effects: populates trails and allit
 =cut  =cut
   
 sub recurse_categories {  sub recurse_categories {
     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;      my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
     my $shallower = $depth - 1;      my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {      if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {          for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
Line 14565  sub recurse_categories { Line 14763  sub recurse_categories {
                 }                  }
             }              }
             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,              &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                                 $subcats);                                  $subcats,$maxd);
             pop(@{$parents});              pop(@{$parents});
         }          }
     } else {      } else {
         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;          my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
         my $trailstr = join(' -&gt; ',(@{$parents},$category));          my $trailstr = join(' &raquo; ',(@{$parents},$category));
         if ($allitems->{$item} eq '') {          if ($allitems->{$item} eq '') {
             push(@{$trails},$trailstr);              push(@{$trails},$trailstr);
             $allitems->{$item} = scalar(@{$trails})-1;              $allitems->{$item} = scalar(@{$trails})-1;
         }          }
           if (ref($maxd) eq 'HASH') {
               if ($depth > $maxd->{$parents->[0]}) {
                   $maxd->{$parents->[0]} = $depth;
               }
           }
     }      }
     return;      return;
 }  }
Line 14606  sub assign_categories_table { Line 14809  sub assign_categories_table {
     my ($cathash,$currcat,$type,$disabled) = @_;      my ($cathash,$currcat,$type,$disabled) = @_;
     my $output;      my $output;
     if (ref($cathash) eq 'HASH') {      if (ref($cathash) eq 'HASH') {
         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);          my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);          &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
         $maxdepth = scalar(@cats);          $maxdepth = scalar(@cats);
         if (@cats > 0) {          if (@cats > 0) {
             my $itemcount = 0;              my $itemcount = 0;
Line 15386  sub construct_course { Line 15589  sub construct_course {
 # Open all assignments  # Open all assignments
 #  #
     if ($args->{'openall'}) {      if ($args->{'openall'}) {
          my $opendate = time;
          if ($args->{'openallfrom'} =~ /^\d+$/) {
              $opendate = $args->{'openallfrom'};
          }
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';         my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
        my %storecontent = ($storeunder         => time,         my %storecontent = ($storeunder         => $opendate,
                            $storeunder.'.type' => 'date_start');                             $storeunder.'.type' => 'date_start');
                 $outcome .= &mt('All assignments open starting [_1]',
        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput                         &Apache::lonlocal::locallocaltime($opendate)).': '.
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;                     &Apache::lonnet::cput
                          ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
    }     }
 #  #
 # Set first page  # Set first page
Line 15625  sub init_user_environment { Line 15833  sub init_user_environment {
     opendir(DIR,$lonids);      opendir(DIR,$lonids);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {   if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
     unlink($lonids.'/'.$filename);                      if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                               &GDBM_READER(),0640)) {
                           my $linkedfile;
                           if (exists($oldenv{'user.linkedenv'})) {
                               $linkedfile = $oldenv{'user.linkedenv'};
                           }
                           untie(%oldenv);
                           if (unlink("$lonids/$filename")) {
                               if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                                   if (-l "$lonids/$linkedfile.id") {
                                       unlink("$lonids/$linkedfile.id");
                                   }
                               }
                           }
                       } else {
                           unlink($lonids.'/'.$filename);
                       }
  }   }
     }      }
     closedir(DIR);      closedir(DIR);
Line 15660  sub init_user_environment { Line 15884  sub init_user_environment {
   
     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);      my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
     my ($tmp) = keys(%userenv);      my ($tmp) = keys(%userenv);
     if ($tmp =~ /^(con_lost|error|no_such_host)/i) {      if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
       } else {
  undef(%userenv);   undef(%userenv);
     }      }
     if (($userenv{'interface'}) && (!$form->{'interface'})) {      if (($userenv{'interface'}) && (!$form->{'interface'})) {
Line 15675  sub init_user_environment { Line 15900  sub init_user_environment {
 # --------------------------------------------------------- Write first profile  # --------------------------------------------------------- Write first profile
   
     {      {
           my $ip = &Apache::lonnet::get_requestor_ip();
  my %initial_env =    my %initial_env = 
     ("user.name"          => $username,      ("user.name"          => $username,
      "user.domain"        => $domain,       "user.domain"        => $domain,
Line 15693  sub init_user_environment { Line 15919  sub init_user_environment {
      "request.course.sec" => '',       "request.course.sec" => '',
      "request.role"       => 'cm',       "request.role"       => 'cm',
      "request.role.adv"   => $env{'user.adv'},       "request.role.adv"   => $env{'user.adv'},
      "request.host"       => $ENV{'REMOTE_ADDR'},);       "request.host"       => $ip,);
   
         if ($form->{'localpath'}) {          if ($form->{'localpath'}) {
     $initial_env{"browser.localpath"}  = $form->{'localpath'};      $initial_env{"browser.localpath"}  = $form->{'localpath'};
Line 16757  sub symb_to_docspath { Line 16983  sub symb_to_docspath {
 }  }
   
 sub captcha_display {  sub captcha_display {
     my ($context,$lonhost) = @_;      my ($context,$lonhost,$defdom) = @_;
     my ($output,$error);      my ($output,$error);
     my ($captcha,$pubkey,$privkey,$version) =      my ($captcha,$pubkey,$privkey,$version) =
         &get_captcha_config($context,$lonhost);          &get_captcha_config($context,$lonhost,$defdom);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         $output = &create_captcha();          $output = &create_captcha();
         unless ($output) {          unless ($output) {
Line 16776  sub captcha_display { Line 17002  sub captcha_display {
 }  }
   
 sub captcha_response {  sub captcha_response {
     my ($context,$lonhost) = @_;      my ($context,$lonhost,$defdom) = @_;
     my ($captcha_chk,$captcha_error);      my ($captcha_chk,$captcha_error);
     my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);      my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
     if ($captcha eq 'original') {      if ($captcha eq 'original') {
         ($captcha_chk,$captcha_error) = &check_captcha();          ($captcha_chk,$captcha_error) = &check_captcha();
     } elsif ($captcha eq 'recaptcha') {      } elsif ($captcha eq 'recaptcha') {
Line 16790  sub captcha_response { Line 17016  sub captcha_response {
 }  }
   
 sub get_captcha_config {  sub get_captcha_config {
     my ($context,$lonhost) = @_;      my ($context,$lonhost,$dom_in_effect) = @_;
     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);      my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
     my $hostname = &Apache::lonnet::hostname($lonhost);      my $hostname = &Apache::lonnet::hostname($lonhost);
     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);      my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
Line 16838  sub get_captcha_config { Line 17064  sub get_captcha_config {
         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {          } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
             $captcha = 'original';              $captcha = 'original';
         }          }
       } elsif ($context eq 'passwords') {
           if ($dom_in_effect) {
               my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
               if ($passwdconf{'captcha'} eq 'recaptcha') {
                   if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
                       $pubkey = $passwdconf{'recaptchakeys'}{'public'};
                       $privkey = $passwdconf{'recaptchakeys'}{'private'};
                   }
                   if ($privkey && $pubkey) {
                       $captcha = 'recaptcha';
                       $version = $passwdconf{'recaptchaversion'};
                       if ($version ne '2') {
                           $version = 1;
                       }
                   } else {
                       $captcha = 'original';
                   }
               } elsif ($passwdconf{'captcha'} ne 'notused') {
                   $captcha = 'original';
               }
           }
     }      }
     return ($captcha,$pubkey,$privkey,$version);      return ($captcha,$pubkey,$privkey,$version);
 }  }
Line 16918  sub create_recaptcha { Line 17165  sub create_recaptcha {
 sub check_recaptcha {  sub check_recaptcha {
     my ($privkey,$version) = @_;      my ($privkey,$version) = @_;
     my $captcha_chk;      my $captcha_chk;
       my $ip = &Apache::lonnet::get_requestor_ip(); 
     if ($version >= 2) {      if ($version >= 2) {
         my $ua = LWP::UserAgent->new;          my $ua = LWP::UserAgent->new;
         $ua->timeout(10);          $ua->timeout(10);
         my %info = (          my %info = (
                      secret   => $privkey,                       secret   => $privkey,
                      response => $env{'form.g-recaptcha-response'},                       response => $env{'form.g-recaptcha-response'},
                      remoteip => $ENV{'REMOTE_ADDR'},                       remoteip => $ip,
                    );                     );
         my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);          my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
         if ($response->is_success)  {          if ($response->is_success)  {
Line 16940  sub check_recaptcha { Line 17188  sub check_recaptcha {
         my $captcha_result =          my $captcha_result =
             $captcha->check_answer(              $captcha->check_answer(
                                     $privkey,                                      $privkey,
                                     $ENV{'REMOTE_ADDR'},                                      $ip,
                                     $env{'form.recaptcha_challenge_field'},                                      $env{'form.recaptcha_challenge_field'},
                                     $env{'form.recaptcha_response_field'},                                      $env{'form.recaptcha_response_field'},
                                   );                                    );
Line 17057  sub des_decrypt { Line 17305  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
 sub make_short_symbs {  sub is_nonframeable {
     my ($cdom,$cnum,$navmap) = @_;      my ($url,$absolute,$hostname,$ip,$nocache) = @_;
     return unless (ref($navmap));      my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
     my ($numnew,@errors);      return if (($remprotocol eq '') || ($remhost eq ''));
     my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');  
     if (@toshorten) {      $remprotocol = lc($remprotocol);
         my (%maps,%resources,%titles);      $remhost = lc($remhost);
         &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,      my $remport = 80;
                                                                'shorturls',$cdom,$cnum);      if ($remprotocol eq 'https') {
         my %tocreate;          $remport = 443;
         if (keys(%resources)) {      }
             foreach my $item (sort {$a <=> $b} (@toshorten)) {      my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
                 my $symb = $resources{$item};      if ($cached) {
                 if ($symb) {          unless ($nocache) {
                     $tocreate{$cnum.'&'.$symb} = 1;              if ($result) {
                 }                  return 1;
               } else {
                   return 0;
             }              }
         }          }
         if (keys(%tocreate)) {      }
             my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);      my $uselink;
             my $su = Short::URL->new(no_vowels => 1);      my $request = new HTTP::Request('HEAD',$url);
             my $init = '';      my $ua = LWP::UserAgent->new;
             my (%newunique,%addcourse,%courseonly,%failed);      $ua->timeout(5);
             # get lock on tiny db      my $response=$ua->request($request);
             my $now = time;      if ($response->is_success()) {
             my $lockhash = {          my $secpolicy = lc($response->header('content-security-policy'));
                                 "lock\0$now" => $env{'user.name'}.          my $xframeop = lc($response->header('x-frame-options'));
                                                 ':'.$env{'user.domain'},          $secpolicy =~ s/^\s+|\s+$//g;
                             };          $xframeop =~ s/^\s+|\s+$//g;
             my $tries = 0;          if (($secpolicy ne '') || ($xframeop ne '')) {
             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);              my $remotehost = $remprotocol.'://'.$remhost;
             my ($code,$error);              my ($origin,$protocol,$port);
             while (($gotlock ne 'ok') && ($tries<3)) {              if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                 $tries ++;                  $port = $ENV{'SERVER_PORT'};
                 sleep 1;              } else {
                 $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);                  $port = 80;
             }              }
             if ($gotlock eq 'ok') {              if ($absolute eq '') {
                 $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,                  $protocol = 'http:';
                                        \%addcourse,\%courseonly,\%failed);                  if ($port == 443) {
                 if (keys(%failed)) {                      $protocol = 'https:';
                     my $numfailed = scalar(keys(%failed));                  }
                     push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));                  $origin = $protocol.'//'.lc($hostname);
                 }              } else {
                 if (keys(%newunique)) {                  $origin = lc($absolute);
                     my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);                  ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
                     if ($putres eq 'ok') {              }
                         $numnew = scalar(keys(%newunique));              if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                         my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);                  my $framepolicy = $1;
                         unless ($newputres eq 'ok') {                  $framepolicy =~ s/^\s+|\s+$//g;
                             push(@errors,&mt('error: could not store course look-up of short URLs'));                  my @policies = split(/\s+/,$framepolicy);
                         }                  if (@policies) {
                       if (grep(/^\Q'none'\E$/,@policies)) {
                           $uselink = 1;
                     } else {                      } else {
                         push(@errors,&mt('error: could not store unique six character URLs'));                          $uselink = 1;
                           if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
                                   (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
                                   (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
                               undef($uselink);
                           }
                           if ($uselink) {
                               if (grep(/^\Q'self'\E$/,@policies)) {
                                   if (($origin ne '') && ($remotehost eq $origin)) {
                                       undef($uselink);
                                   }
                               }
                           }
                           if ($uselink) {
                               my @possok;
                               if ($ip ne '') {
                                   push(@possok,$ip);
                               }
                               my $hoststr = '';
                               foreach my $part (reverse(split(/\./,$hostname))) {
                                   if ($hoststr eq '') {
                                       $hoststr = $part;
                                   } else {
                                       $hoststr = "$part.$hoststr";
                                   }
                                   if ($hoststr eq $hostname) {
                                       push(@possok,$hostname);
                                   } else {
                                       push(@possok,"*.$hoststr");
                                   }
                               }
                               if (@possok) {
                                   foreach my $poss (@possok) {
                                       last if (!$uselink);
                                       foreach my $policy (@policies) {
                                           if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
                                               undef($uselink);
                                               last;
                                           }
                                       }
                                   }
                               }
                           }
                     }                      }
                 }                  }
         }              } elsif ($xframeop ne '') {
     }                  $uselink = 1;
     return ($numnew,\@errors);                  my @policies = split(/\s*,\s*/,$xframeop);
 }                  if (@policies) {
                       unless (grep(/^deny$/,@policies)) {
 sub shorten_symbs {                          if ($origin ne '') {
     my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;                              if (grep(/^sameorigin$/,@policies)) {
     return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&                                  if ($remotehost eq $origin) {
                    (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&                                      undef($uselink);
                    (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));                                  }
     my (%possibles,%collisions);                              }
     foreach my $key (keys(%{$tocreate})) {                              if ($uselink) {
         my $num = String::CRC32::crc32($key);                                  foreach my $policy (@policies) {
         my $tiny = $su->encode($num,$init);                                      if ($policy =~ /^allow-from\s*(.+)$/) {
         if ($tiny) {                                          my $allowfrom = $1;
             $possibles{$tiny} = $key;                                          if (($allowfrom ne '') && ($allowfrom eq $origin)) {
         }                                              undef($uselink);
     }                                              last;
     if (!$init) {                                          }
         $init = 1;                                      }
     } else {                                  }
         $init ++;                              }
     }                          }
     if (keys(%possibles)) {  
         my @posstiny = keys(%possibles);  
         my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);  
         my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);  
         if (keys(%currtiny)) {  
             foreach my $key (keys(%currtiny)) {  
                 next if ($currtiny{$key} eq '');  
                 if ($currtiny{$key} eq $possibles{$key}) {  
                     my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});  
                     unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {  
                         $courseonly->{$tsymb} = $key;  
                     }                      }
                 } else {  
                     $collisions{$possibles{$key}} = 1;  
                 }                  }
                 delete($possibles{$key});  
             }  
         }  
         foreach my $key (keys(%possibles)) {  
             $newunique->{$key} = $possibles{$key};  
             my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});  
             unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {  
                 $addcourse->{$tsymb} = $key;  
             }              }
         }          }
     }      }
     if (keys(%collisions)) {      if ($nocache) {
         if ($init <5) {          if ($cached) {
             if (!$init) {              my $devalidate;
                 $init = 1;              if ($uselink && !$result) {
             } else {                  $devalidate = 1;
                 $init ++;              } elsif (!$uselink && $result) {
                   $devalidate = 1;
             }              }
             $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,              if ($devalidate) {
                                    $newunique,$addcourse,$courseonly,$failed);                  &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
         } else {  
             foreach my $key (keys(%collisions)) {  
                 $failed->{$key} = 1;  
             }              }
         }          }
       } else {
           if ($uselink) {
               $result = 1;
           } else {
               $result = 0;
           }
           &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
     }      }
     return $init;      return $uselink;
 }  }
   
 1;  1;
Removed from v.1.1075.2.127.2.7  
changed lines
  Added in v.1.1075.2.151

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