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

Diff for /loncom/interface/loncommon.pm between versions 1.1307 and 1.1411

version 1.1307, 2018/01/02 16:53:27 version 1.1411, 2023/09/10 18:12:54
Line 61  use POSIX qw(strftime mktime); Line 61  use POSIX qw(strftime mktime);
 use Apache::lonmenu();  use Apache::lonmenu();
 use Apache::lonenc();  use Apache::lonenc();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnet();  use Apache::lonnavmaps();
 use HTML::Entities;  use HTML::Entities;
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
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 LONCAPA::ltiutils;
 use LONCAPA::LWPReq;  use LONCAPA::LWPReq;
   use LONCAPA::map();
   use HTTP::Request;
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale;  use DateTime::Locale;
 use Encode();  use Encode();
Line 79  use Text::Aspell; Line 82  use Text::Aspell;
 use Authen::Captcha;  use Authen::Captcha;
 use Captcha::reCAPTCHA;  use Captcha::reCAPTCHA;
 use JSON::DWIW;  use JSON::DWIW;
 use LWP::UserAgent;  
 use Crypt::DES;  use Crypt::DES;
 use DynaLoader; # for Crypt::DES version  use DynaLoader; # for Crypt::DES version
 use MIME::Lite;  use MIME::Lite;
 use MIME::Types;  use MIME::Types;
 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 201  BEGIN { Line 205  BEGIN {
     {      {
         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                    '/language.tab';                                     '/language.tab';
         if ( open(my $fh,"<$langtabfile") ) {          if ( open(my $fh,'<',$langtabfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
Line 223  BEGIN { Line 227  BEGIN {
     {      {
         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/copyright.tab';                                    '/copyright.tab';
         if ( open (my $fh,"<$copyrightfile") ) {          if ( open (my $fh,'<',$copyrightfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line=~/^\#/);                  next if ($line=~/^\#/);
                 chomp($line);                  chomp($line);
Line 237  BEGIN { Line 241  BEGIN {
     {      {
         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.          my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/source_copyright.tab';                                    '/source_copyright.tab';
         if ( open (my $fh,"<$sourcecopyrightfile") ) {          if ( open (my $fh,'<',$sourcecopyrightfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 251  BEGIN { Line 255  BEGIN {
 # -------------------------------------------------------------- default domain designs  # -------------------------------------------------------------- default domain designs
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile = $designdir.'/default.tab';      my $designfile = $designdir.'/default.tab';
     if ( open (my $fh,"<$designfile") ) {      if ( open (my $fh,'<',$designfile) ) {
         while (my $line = <$fh>) {          while (my $line = <$fh>) {
             next if ($line =~ /^\#/);              next if ($line =~ /^\#/);
             chomp($line);              chomp($line);
Line 265  BEGIN { Line 269  BEGIN {
     {      {
         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                   '/filecategories.tab';                                    '/filecategories.tab';
         if ( open (my $fh,"<$categoryfile") ) {          if ( open (my $fh,'<',$categoryfile) ) {
     while (my $line = <$fh>) {      while (my $line = <$fh>) {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
Line 280  BEGIN { Line 284  BEGIN {
     {      {
         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.          my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                '/filetypes.tab';                 '/filetypes.tab';
         if ( open (my $fh,"<$typesfile") ) {          if ( open (my $fh,'<',$typesfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
  next if ($line =~ /^\#/);   next if ($line =~ /^\#/);
  chomp($line);   chomp($line);
Line 433  sub studentbrowser_javascript { Line 437  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 448  sub studentbrowser_javascript { Line 452  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 480  ENDRESBRW Line 489  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 491  sub selectstudent_link { Line 500  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 946  ENDSCRT Line 959  ENDSCRT
 }  }
   
 sub select_timezone {  sub select_timezone {
    my ($name,$selected,$onchange,$includeempty,$disabled)=@_;     my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
    my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";     my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
    if ($includeempty) {     if ($includeempty) {
        $output .= '<option value=""';         $output .= '<option value=""';
        if (($selected eq '') || ($selected eq 'local')) {         if (($selected eq '') || ($selected eq 'local')) {
Line 1221  END Line 1234  END
         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";          $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
     }      }
     $result .= "</select>\n";      $result .= "</select>\n";
     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};      my %select2;
       if (ref($hashref->{$firstdefault}) eq 'HASH') {
           if (ref($hashref->{$firstdefault}->{'select2'}) eq 'HASH') {
               %select2 = %{$hashref->{$firstdefault}->{'select2'}};
           }
       }
     $result .= $middletext;      $result .= $middletext;
     $result .= "<select size=\"1\" name=\"$secondselectname\"";      $result .= "<select size=\"1\" name=\"$secondselectname\"";
     if ($onchangesecond) {      if ($onchangesecond) {
Line 1246  END Line 1264  END
   
 =pod  =pod
   
 =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)  =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
   
 Returns a string corresponding to an HTML link to the given help  Returns a string corresponding to an HTML link to the given help
 $topic, where $topic corresponds to the name of a .tex file in  $topic, where $topic corresponds to the name of a .tex file in
Line 1270  $imgid is the id of the img tag used for Line 1288  $imgid is the id of the img tag used for
 used in a javascript call to switch the image src.  See   used in a javascript call to switch the image src.  See 
 lonhtmlcommon::htmlareaselectactive() for an example.  lonhtmlcommon::htmlareaselectactive() for an example.
   
   $links_target will optionally be set to a target (_top, _parent or _self).
   
 =cut  =cut
   
 sub help_open_topic {  sub help_open_topic {
     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;      my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
     $text = "" if (not defined $text);      $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);      $stayOnPage = 0 if (not defined $stayOnPage);
     $width = 500 if (not defined $width);      $width = 500 if (not defined $width);
Line 1295  sub help_open_topic { Line 1315  sub help_open_topic {
     }      }
   
     # Add the text      # Add the text
     if ($text ne "") {      my $target = ' target="_top"';
       if ($links_target) {
           $target = ' target="'.$links_target.'"';
       } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
                (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
           $target = '';
       }
       if ($text ne "") {
  $template.='<span class="LC_help_open_topic">'   $template.='<span class="LC_help_open_topic">'
                   .'<a target="_top" href="'.$link.'">'                    .'<a'.$target.' href="'.$link.'">'
                   .$text.'</a>';                    .$text.'</a>';
     }      }
   
Line 1307  sub help_open_topic { Line 1334  sub help_open_topic {
     if ($imgid ne '') {      if ($imgid ne '') {
         $imgid = ' id="'.$imgid.'"';          $imgid = ' id="'.$imgid.'"';
     }      }
     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'      $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
               .'<img src="'.$helpicon.'" border="0"'                .'<img src="'.$helpicon.'" border="0"'
               .' alt="'.&mt('Help: [_1]',$topic).'"'                .' alt="'.&mt('Help: [_1]',$topic).'"'
               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid                 .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
Line 1380  ENDOUTPUT Line 1407  ENDOUTPUT
   
 # now just updates the help link and generates a blue icon  # now just updates the help link and generates a blue icon
 sub help_open_menu {  sub help_open_menu {
     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)       my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target) 
  = @_;       = @_;    
     $stayOnPage = 1;      $stayOnPage = 1;
     my $output;      my $output;
     if ($component_help) {      if ($component_help) {
  if (!$text) {   if (!$text) {
     $output=&help_open_topic($component_help,undef,$stayOnPage,      $output=&help_open_topic($component_help,undef,$stayOnPage,
        $width,$height);         $width,$height,'',$links_target);
  } else {   } else {
     my $help_text;      my $help_text;
     $help_text=&unescape($topic);      $help_text=&unescape($topic);
     $output='<table><tr><td>'.      $output='<table><tr><td>'.
  &help_open_topic($component_help,$help_text,$stayOnPage,   &help_open_topic($component_help,$help_text,$stayOnPage,
  $width,$height).'</td></tr></table>';   $width,$height,'',$links_target).'</td></tr></table>';
  }   }
     }      }
     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);      my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
Line 1401  sub help_open_menu { Line 1428  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 = 1;      my $stay_on_page = 1;
   
Line 1415  sub top_nav_help { Line 1442  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 1500  sub help_open_bug { Line 1527  sub help_open_bug {
     {      {
  $link = $url;   $link = $url;
     }      }
   
       my $target = '_top';
       if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
           (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
           $target = '_blank';
       }
   
     # Add the text      # Add the text
     if ($text ne "")      if ($text ne "")
     {      {
  $template .=    $template .= 
   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".    "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";    "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
     }      }
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Report a Bug');      my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");      my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>   <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 1788  sub colorfuleditor_js { Line 1822  sub colorfuleditor_js {
             save => 'Save page to make this permanent',              save => 'Save page to make this permanent',
         );          );
         &js_escape(\%js_lt);          &js_escape(\%js_lt);
           my $showfile_js = &show_crsfiles_js();
         $browse_or_search = <<"END";          $browse_or_search = <<"END";
   
       $showfile_js
   
     function toggleChooser(form,element,titleid,only,search) {      function toggleChooser(form,element,titleid,only,search) {
         var disp = 'none';          var disp = 'none';
         if (document.getElementById('chooser_'+element)) {          if (document.getElementById('chooser_'+element)) {
Line 1804  sub colorfuleditor_js { Line 1841  sub colorfuleditor_js {
                 toggleResImport(form,element);                  toggleResImport(form,element);
             }              }
             document.getElementById('chooser_'+element).style.display = disp;              document.getElementById('chooser_'+element).style.display = disp;
               var dirsel = '';
               var filesel = '';
               if (document.getElementById('chooser_'+element+'_crsres')) {
                   var currcrsres = document.getElementById('chooser_'+element+'_crsres').style.display;
                   if (currcrsres == 'none') {
                       dirsel = 'coursepath_'+element;
                       var filesel = 'coursefile_'+element;
                       var include;
                       if (document.getElementById('crsres_include_'+element)) {
                           include = document.getElementById('crsres_include_'+element).value;
                       }
                       populateCrsSelects(form,dirsel,filesel,1,include,1,0,1,1,0);
                   }
               }
               if (document.getElementById('chooser_'+element+'_upload')) {
                   var currcrsupload = document.getElementById('chooser_'+element+'_upload').style.display;
                   if (currcrsupload == 'none') {
                       dirsel = 'crsauthorpath_'+element;
                       filesel = '';
                       populateCrsSelects(form,dirsel,filesel,0,'',1,0,1,0,1);
                   }
               }
         }          }
     }      }
   
     function toggleCrsFile(form,element,numdirs) {      function toggleCrsFile(form,element) {
         if (document.getElementById('chooser_'+element+'_crsres')) {          if (document.getElementById('chooser_'+element+'_crsres')) {
             var curr = document.getElementById('chooser_'+element+'_crsres').style.display;              var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
             if (curr == 'none') {              if (curr == 'none') {
                 if (numdirs) {                  if (document.getElementById('coursepath_'+element)) {
                       var numdirs;
                       if (document.getElementById('coursepath_'+element).length) {
                           numdirs = document.getElementById('coursepath_'+element).length;
                       }
                       if ((document.getElementById('hascrsres_'+element)) &&
                           (document.getElementById('nocrsres_'+element))) {
                           if (numdirs) {
                               document.getElementById('hascrsres_'+element).style.display='inline-block';
                               document.getElementById('nocrsres_'+element).style.display='none';
                           } else {
                               document.getElementById('hascrsres_'+element).style.display='none';
                               document.getElementById('nocrsres_'+element).style.display='inline-block';
                           }
                       }
                     form.elements['coursepath_'+element].selectedIndex = 0;                      form.elements['coursepath_'+element].selectedIndex = 0;
                     if (numdirs > 1) {                      if (numdirs > 1) {
                         window['select1'+element+'_changed']();                          var selelem = form.elements['coursefile_'+element];
                           var i, len = selelem.options.length -1;
                           if (len >=0) {
                               for (i = len; i >= 0; i--) {
                                   selelem.remove(i);
                               }
                               selelem.options[0] = new Option('','');
                           }
                     }                      }
                 }                  }
             }               }
             document.getElementById('chooser_'+element+'_crsres').style.display = 'block';              document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
               
         }          }
         if (document.getElementById('chooser_'+element+'_upload')) {          if (document.getElementById('chooser_'+element+'_upload')) {
             document.getElementById('chooser_'+element+'_upload').style.display = 'none';              document.getElementById('chooser_'+element+'_upload').style.display = 'none';
Line 1830  sub colorfuleditor_js { Line 1909  sub colorfuleditor_js {
         return;          return;
     }      }
   
     function toggleCrsUpload(form,element,numcrsdirs) {      function toggleCrsUpload(form,element) {
         if (document.getElementById('chooser_'+element+'_crsres')) {          if (document.getElementById('chooser_'+element+'_crsres')) {
             document.getElementById('chooser_'+element+'_crsres').style.display = 'none';              document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
         }          }
         if (document.getElementById('chooser_'+element+'_upload')) {          if (document.getElementById('chooser_'+element+'_upload')) {
             var curr = document.getElementById('chooser_'+element+'_upload').style.display;              var curr = document.getElementById('chooser_'+element+'_upload').style.display;
             if (curr == 'none') {              if (curr == 'none') {
                 if (numcrsdirs) {                  form.elements['newsubdir_'+element][0].checked = true;
                    form.elements['crsauthorpath_'+element].selectedIndex = 0;                  toggleNewsubdir(form,element);
                    form.elements['newsubdir_'+element][0].checked = true;                  document.getElementById('chooser_'+element+'_upload').style.display = 'block';
                    toggleNewsubdir(form,element);                  if (document.getElementById('uploadcrsres_'+element)) {
                       document.getElementById('uploadcrsres_'+element).value = '';
                 }                  }
             }              }
             document.getElementById('chooser_'+element+'_upload').style.display = 'block';  
         }          }
         return;          return;
     }      }
Line 1887  sub colorfuleditor_js { Line 1966  sub colorfuleditor_js {
         var filename = form.elements['coursefile_'+element];          var filename = form.elements['coursefile_'+element];
         var path = directory.options[directory.selectedIndex].value;          var path = directory.options[directory.selectedIndex].value;
         var file = filename.options[filename.selectedIndex].value;          var file = filename.options[filename.selectedIndex].value;
         form.elements[element].value = '$respath';          if (file != '') {
         if (path == '/') {              form.elements[element].value = '$respath';
             form.elements[element].value += file;              if (path == '/') {
         } else {                  form.elements[element].value += file;
             form.elements[element].value += path+'/'+file;              } else {
         }                  form.elements[element].value += path+'/'+file;
         unClean();              }
         if (document.getElementById('previewimg_'+element)) {              unClean();
             document.getElementById('previewimg_'+element).src = form.elements[element].value;              if (document.getElementById('previewimg_'+element)) {
             var newsrc = document.getElementById('previewimg_'+element).src;                   document.getElementById('previewimg_'+element).src = form.elements[element].value;
         }                  var newsrc = document.getElementById('previewimg_'+element).src; 
         if (document.getElementById('showimg_'+element)) {              }
             document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';              if (document.getElementById('showimg_'+element)) {
                   document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
               }
         }          }
         toggleChooser(form,element);          toggleChooser(form,element);
         return;          return;
Line 2188  sub crsauthor_url { Line 2269  sub crsauthor_url {
 }  }
   
 sub import_crsauthor_form {  sub import_crsauthor_form {
     my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;      my ($firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
     return (0) unless ($env{'request.course.id'});      return (0) unless ($env{'request.course.id'});
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};      my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
     return (0) unless (($cnum ne '') && ($cdom ne ''));      return (0) unless (($cnum ne '') && ($cdom ne ''));
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};  
     my @ids=&Apache::lonnet::current_machine_ids();      my @ids=&Apache::lonnet::current_machine_ids();
     my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);      my ($output,$is_home,$toppath,%subdirs,%files,%selimport_menus,$include,$exclude);
       
     if (grep(/^\Q$crshome\E$/,@ids)) {      if (grep(/^\Q$crshome\E$/,@ids)) {
         $is_home = 1;          $is_home = 1;
     }      }
     $relpath = "/priv/$cdom/$cnum";      $toppath = "/priv/$cdom/$cnum";
     &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);      my $nonemptydir = 1;
       my $js_only;
       if ($only) {
           map { $include->{$_} = 1; } split(/\s*,\s*/,$only);
           $js_only = join(',',map { &js_escape($_); } sort(keys(%{$include})));
       }
       $exclude = &Apache::lonnet::priv_exclude();
       &Apache::lonnet::recursedirs($is_home,1,$include,$exclude,1,0,$toppath,'',\%subdirs,\%files);
       my $numdirs = scalar(keys(%files));
     my %lt = &Apache::lonlocal::texthash (      my %lt = &Apache::lonlocal::texthash (
         fnam => 'Filename',          fnam => 'Filename',
         dire => 'Directory',          dire => 'Directory',
           se   => 'Select',
     );      );
     my $numdirs = scalar(keys(%files));      $output = $lt{'dire'}.':&nbsp;'.
     my (%possexts,$singledir,@singledirfiles);                '<select id="'.$firstselectname.'" name="'.$firstselectname.'" '.
     if ($only) {                'onchange="populateCrsSelects(this.form,'."'$firstselectname','$secondselectname',1,'$js_only',0,1,0,0,0".');">'.
         map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);                '<option value="" selected="selected">'.$lt{'se'}.'</option>';
     }      if ($files{'/'}) {
     my (%nonemptydirs,$possdirs);          $output .= '<option value="/">/</option>'."\n";
     if ($numdirs > 1) {      }
         my @order;      foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
         foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {          next if ($key eq '/');
             if (ref($files{$key}) eq 'HASH') {          $output .= '<option value="'.$key.'">'.$key.'</option>'."\n";
                 my $shown = $key;      }
                 if ($key eq '') {      $output .= '</select><br />'."\n".
                     $shown = '/';                 $lt{'fnam'}.':&nbsp;<select id="'.$secondselectname.'" name="'.$secondselectname.'">'."\n".
                 }                 '<option value="" selected="selected"></option>'."\n".
                 my @ordered = ();                 '</select>'."\n".
                 foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {                 '<input type="hidden" id="crsres_include_'.$suffix.'" value="'.$only.'" />';
                     if ($only) {      return ($numdirs,$output);
                         my ($ext) = ($file =~ /\.([^.]+)$/);  }
                         unless ($possexts{lc($ext)}) {  
                             next;  sub show_crsfiles_js {
                         }      my $excluderef = &Apache::lonnet::priv_exclude();
       my $se = &js_escape(&mt('Select'));
       my $exclude;
       if (ref($excluderef) eq 'HASH') {
           $exclude = join(',', map { &js_escape($_); } sort(keys(%{$excluderef})));
       }
       my $js = <<"END";
   
   
       function populateCrsSelects (form,dirsel,filesel,exc,include,setdir,setfile,recurse,nonemptydir,addtopdir) {
           var relpath = '';
           if ((setfile) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
               var currdir = form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value;
               if (currdir == '') {
                   if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                       selelem = form.elements[filesel];
                       var j, numfiles = selelem.options.length -1;
                       if (numfiles >=0) {
                           for (j = numfiles; j >= 0; j--) {
                               selelem.remove(j);
                           }
                       }
                       if (selelem.options.length == 0) {
                           selelem.options[selelem.options.length] = new Option('','');
                           selelem.selectedIndex = 0;
                     }                      }
                     $selimport_menus{$key}->{'select2'}->{$file} = $file;  
                     push(@ordered,$file);  
                 }  
                 if (@ordered) {  
                     push(@order,$key);  
                     $nonemptydirs{$key} = 1;  
                     $selimport_menus{$key}->{'text'} = $shown;  
                     $selimport_menus{$key}->{'default'} = '';  
                     $selimport_menus{$key}->{'select2'}->{''} = '';  
                     $selimport_menus{$key}->{'order'} = \@ordered;  
                 }                  }
                   return;
               } else {
                   relpath = encodeURIComponent(form.elements[dirsel].options[form.elements[dirsel].selectedIndex].value);
             }              }
         }          }
         $possdirs = scalar(keys(%nonemptydirs));          var http = new XMLHttpRequest();
         if ($possdirs > 1) {          var url = "/adm/courseauthor";
             my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));          var crsrole = "$env{'request.role'}";
             $output = $lt{'dire'}.          var exclude = '';
                       &linked_select_forms($form,'<br />'.          if (exc) {
                                            $lt{'fnam'},'',              exclude = '$exclude';
                                            $firstselectname,$secondselectname,          }
                                            \%selimport_menus,\@order,          var params = "role=course&files=1&rec="+recurse+"&nonempty="+nonemptydir+"&exc="+exclude+"&inc="+include+"&addtop="+addtopdir+"&path="+relpath;
                                            $onchangefirst,'',$suffix).'<br />';          http.open("POST", url, true);
         } elsif ($possdirs == 1) {          http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
             $singledir = (keys(%nonemptydirs))[0];          http.onreadystatechange = function() {
             if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {              if (http.readyState == 4 && http.status == 200) {
                 @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};                  var data = JSON.parse(http.responseText);
             }                  var selelem;
             delete($selimport_menus{$singledir});                  if ((setdir) && (dirsel != null) && (dirsel != 'undefined') && (dirsel != '')) {
         }                      if (Array.isArray(data.dirs)) {
     } elsif ($numdirs == 1) {                          selelem = form.elements[dirsel];
         $singledir = (keys(%files))[0];                          var i, numdirs = selelem.options.length -1;
         foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {                          if (numdirs >=0) {
             if ($only) {                              for (i = numdirs; i >= 0; i--) {
                 my ($ext) = ($file =~ /\.([^.]+)$/);                                  selelem.remove(i);
                 unless ($possexts{lc($ext)}) {                              }
                     next;                          }
                           var len = data.dirs.length;
                           if (len) {
                               selelem.options[selelem.options.length] = new Option('$se','');
                               var j;
                               for (j = 0; j < len; j++) {
                                   selelem.options[selelem.options.length] = new Option(data.dirs[j],data.dirs[j]);
                               }
                               selelem.selectedIndex = 0;
                           }
                           if (!setfile) {
                               if ((filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                                   selelem = form.elements[filesel];
                                   var j, numfiles = selelem.options.length -1;
                                   if (numfiles >=0) {
                                       for (j = numfiles; j >= 0; j--) {
                                           selelem.remove(j);
                                       }
                                   }
                                   if (selelem.options.length == 0) {
                                       selelem.options[selelem.options.length] = new Option('','');
                                       selelem.selectedIndex = 0;
                                   }
                               }
                           }
                       }
                   }
                   if ((setfile) && (filesel != null) && (filesel != 'undefined') && (filesel != '')) {
                       selelem = form.elements[filesel];
                       var i, numfiles = selelem.options.length -1;
                       if (numfiles >=0) {
                           for (i = numfiles; i >= 0; i--) {
                               selelem.remove(i);
                           }
                       }
                       var x;
                       for (x in data.files) {
                           if (Array.isArray(data.files[x])) {
                               if (data.files[x].length > 1) {
                                   selelem.options[selelem.options.length] = new Option('$se','');
                               }
                               var len = data.files[x].length;
                               if (len) {
                                   var k;
                                   for (k = 0; k < len; k++) {
                                       selelem.options[selelem.options.length] = new Option(data.files[x][k],data.files[x][k]);
                                   }
                                   selelem.selectedIndex = 0;
                               }
                           }
                       }
                       if (selelem.options.length == 0) {
                           selelem.options[selelem.options.length] = new Option('','');
                           selelem.selectedIndex = 0;
                       }
                 }                  }
             }              }
             push(@singledirfiles,$file);  
         }  
         if (@singledirfiles) {  
             $possdirs == 1;  
         }          }
           http.send(params);
     }      }
     if (($possdirs == 1) && (@singledirfiles)) {  END
         my $showdir = $singledir;  
         if ($singledir eq '') {  
             $showdir = '/';  
         }  
         $output = $lt{'dire'}.  
                   '<select name="'.$firstselectname.'">'.  
                   '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".  
                   '</select><br />'.  
                   $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".  
                   '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";  
         foreach my $file (@singledirfiles) {  
             $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";  
         }  
         $output .= '</select><br />'."\n";  
     }  
     return ($possdirs,$output);  
 }  }
   
 =pod  =pod
Line 2641  sub display_filter { Line 2782  sub display_filter {
     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',      my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                                                     '$secondid','$thirdid')";                                                      '$secondid','$thirdid')";
     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',      return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
        &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,         &Apache::lonmeta::selectbox('show',$env{'form.show'},'',undef,
    (&mt('all'),10,20,50,100,1000,10000))).     (&mt('all'),10,20,50,100,1000,10000))).
    '</label></span> <span class="LC_nobreak">'.     '</label></span> <span class="LC_nobreak">'.
            &mt('Filter: [_1]',             &mt('Filter: [_1]',
Line 3025  This is not an optimal method, but it wo Line 3166  This is not an optimal method, but it wo
   
 =item * authform_filesystem  =item * authform_filesystem
   
   =item * authform_lti
   
 =back  =back
   
 See loncreateuser.pm for invocation and use examples.  See loncreateuser.pm for invocation and use examples.
Line 3441  sub authform_filesystem { Line 3584  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.' />',      return $result;
          '</label><input type="password" size="10" name="fsysarg" value="" '.  }
                   'onchange="'.$jscall.'"'.$disabled.' />');  
   sub authform_lti {
       my %in = (
                 formname => 'document.cu',
                 kerb_def_dom => 'MSU.EDU',
                 @_,
                 );
       my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
       my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
       if ($in{'readonly'}) {
           $disabled = ' disabled="disabled"';
       }
       if (defined($in{'curr_authtype'})) {
           if ($in{'curr_authtype'} eq 'lti') {
               if ($can_assign{'lti'}) {
                   $lticheck = 'checked="checked" ';
                   if (defined($in{'mode'})) {
                       if ($in{'mode'} eq 'modifyuser') {
                           $lticheck = '';
                       }
                   }
               } else {
                   $result = &mt('Currently LTI Authenticated.');
                   return $result;
               }
           }
       } else {
           if ($authnum == 1) {
               $authtype = '<input type="hidden" name="login" value="lti" />';
           }
       }
       if (!$can_assign{'lti'}) {
           return;
       } elsif ($authtype eq '') {
           if (defined($in{'mode'})) {
               if ($in{'mode'} eq 'modifycourse') {
                   if ($authnum == 1) {
                       $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
                   }
               }
           }
       }
       $jscall = "javascript:changed_radio('lti',$in{'formname'});";
       if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
           $authtype = '<input type="radio" name="login" value="lti" '.
                       $lticheck.' onchange="'.$jscall.'" onclick="'.
                       $jscall.'"'.$disabled.' />';
       }
       $autharg = '<input type="hidden" name="ltiarg" value="" />';
       if ($authtype) {
           $result = &mt('[_1] LTI Authenticated',
                         '<label>'.$authtype.'</label>'.$autharg);
       } else {
           $result = '<b>'.&mt('LTI Authenticated').'</b>'.
                     $autharg;
       }
     return $result;      return $result;
 }  }
   
Line 3462  sub get_assignable_auth { Line 3660  sub get_assignable_auth {
                           krb5 => 1,                            krb5 => 1,
                           int  => 1,                            int  => 1,
                           loc  => 1,                            loc  => 1,
                             lti  => 1,
                      );                       );
     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);      my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
     if (ref($domconfig{'usercreation'}) eq 'HASH') {      if (ref($domconfig{'usercreation'}) eq 'HASH') {
Line 3494  sub get_assignable_auth { Line 3693  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;
   }
   
   sub passwd_validation_js {
       my ($currpasswdval,$domain,$context,$id) = @_;
       my (%passwdconf,$alertmsg);
       if ($context eq 'linkprot') {
           my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
           if (ref($domconfig{'ltisec'}) eq 'HASH') {
               if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
                   %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
               }
           }
           if ($id eq 'add') {
               $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
           } elsif ($id =~ /^\d+$/) {
               my $pos = $id+1;
               $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
           } else {
               $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
           }
       } else {
           %passwdconf = &Apache::lonnet::get_passwdconf($domain);
           $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
       }
       my ($min,$max,@chars,$numrules,$intargjs,%alert);
       $numrules = 0;
       $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'};
               $numrules ++;
           }
           @chars = @{$passwdconf{'chars'}};
           if (@chars) {
               $numrules ++;
           }
       }
       if ($min > 0) {
           $numrules ++;
       }
       if (($min > 0) || ($max ne '') || (@chars > 0)) {
           if ($min) {
               $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
           }
           if ($max) {
               $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
           }
           my (@charalerts,@charrules);
           if (@chars) {
               if (grep(/^uc$/,@chars)) {
                   push(@charalerts,&mt('contain at least one upper case letter'));
                   push(@charrules,'uc');
               }
               if (grep(/^lc$/,@chars)) {
                   push(@charalerts,&mt('contain at least one lower case letter'));
                   push(@charrules,'lc');
               }
               if (grep(/^num$/,@chars)) {
                   push(@charalerts,&mt('contain at least one number'));
                   push(@charrules,'num');
               }
               if (grep(/^spec$/,@chars)) {
                   push(@charalerts,&mt('contain at least one non-alphanumeric'));
                   push(@charrules,'spec');
               }
           }
           $intargjs = qq|            var rulesmsg = '';\n|.
                       qq|            var currpwval = $currpasswdval;\n|;
               if ($min) {
                   $intargjs .= qq|
               if (currpwval.length < $min) {
                   rulesmsg += ' - $alert{min}';
               }
   |;
               }
               if ($max) {
                   $intargjs .= qq|
               if (currpwval.length > $max) {
                   rulesmsg += ' - $alert{max}';
               }
   |;
               }
               if (@chars > 0) {
                   my $charrulestr = '"'.join('","',@charrules).'"';
                   my $charalertstr = '"'.join('","',@charalerts).'"';
                   $intargjs .= qq|            var brokerules = new Array();\n|.
                                qq|            var charrules = new Array($charrulestr);\n|.
                                qq|            var charalerts = new Array($charalertstr);\n|;
                   my %rules;
                   map { $rules{$_} = 1; } @chars;
                   if ($rules{'uc'}) {
                       $intargjs .= qq|
               var ucRegExp = /[A-Z]/;
               if (!ucRegExp.test(currpwval)) {
                   brokerules.push('uc');
               }
   |;
                   }
                   if ($rules{'lc'}) {
                       $intargjs .= qq|
               var lcRegExp = /[a-z]/;
               if (!lcRegExp.test(currpwval)) {
                   brokerules.push('lc');
               }
   |;
                   }
                   if ($rules{'num'}) {
                        $intargjs .= qq|
               var numRegExp = /[0-9]/;
               if (!numRegExp.test(currpwval)) {
                   brokerules.push('num');
               }
   |;
                   }
                   if ($rules{'spec'}) {
                        $intargjs .= q|
               var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
               if (!specRegExp.test(currpwval)) {
                   brokerules.push('spec');
               }
   |;
                   }
                   $intargjs .= qq|
               if (brokerules.length > 0) {
                   for (var i=0; i<brokerules.length; i++) {
                       for (var j=0; j<charrules.length; j++) {
                           if (brokerules[i] == charrules[j]) {
                               rulesmsg += ' - '+charalerts[j]+'\\n';
                               break;
                           }
                       }
                   }
               }
   |;
               }
               $intargjs .= qq|
               if (rulesmsg != '') {
                   rulesmsg = '$alertmsg'+rulesmsg;
                   alert(rulesmsg);
                   return false;
               }
   |;
       }
       return ($numrules,$intargjs);
   }
   
 ###############################################################  ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 3974  sub syllabuswrapper { Line 4395  sub syllabuswrapper {
   
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
   
   sub aboutme_on {
       my ($uname,$udom)=@_;
       unless ($uname) { $uname=$env{'user.name'}; }
       unless ($udom)  { $udom=$env{'user.domain'}; }
       return if ($udom eq 'public' && $uname eq 'public');
       my $hashkey=$uname.':'.$udom;
       my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
       if ($cached) {
           return $aboutme;
       }
       $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
       &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
       return $aboutme;
   }
   
   sub devalidate_aboutme_cache {
       my ($uname,$udom)=@_;
       if (!$udom)  { $udom =$env{'user.domain'}; }
       if (!$uname) { $uname=$env{'user.name'};   }
       return if ($udom eq 'public' && $uname eq 'public');
       my $id=$uname.':'.$udom;
       &Apache::lonnet::devalidate_cache_new('aboutme',$id);
   }
   
 sub track_student_link {  sub track_student_link {
     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;      my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
     my $link ="/adm/trackstudent?";      my $link ="/adm/trackstudent?";
Line 4739  sub get_student_view_with_retries { Line 5184  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 4994  sub findallcourses { Line 5492  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;      my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
       unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
           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;
                       }
                   }
               }
           } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
                   ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
               my $checkrole;
               if ($env{'request.role.domain'} eq '') {
                   $checkrole = "cm./$env{'user.domain'}/";
               } else {
                   $checkrole = "cm./$env{'request.role.domain'}/";
               }
               if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
                   $has_evb = 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 (($activity eq 'wishlist') || ($activity eq 'annotate')) {
               return ();
           }
       }
     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 5011  sub blockcheck { Line 5591  sub blockcheck {
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
     my $triggerblock = '';      my $triggerblock = '';
     my %live_courses = &findallcourses(undef,$uname,$udom);      my %live_courses;
       unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
           %live_courses = &findallcourses(undef,$uname,$udom);
       }
   
     # If uname is for a user, and activity is course-specific, i.e.,      # If uname is for a user, and activity is course-specific, i.e.,
     # boards, chat or groups, check for blocking in current course only.      # boards, chat or groups, check for blocking in current course only.
   
     if (($activity eq 'boards' || $activity eq 'chat' ||      if (($activity eq 'boards' || $activity eq 'chat' ||
          $activity eq 'groups' || $activity eq 'printout' ||           $activity eq 'groups' || $activity eq 'printout' ||
          $activity eq 'reinit' || $activity eq 'alert') &&           $activity eq 'search' || $activity eq 'reinit' ||
            $activity eq 'alert') &&
         ($env{'request.course.id'})) {          ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {          foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {              if ($key ne $env{'request.course.id'}) {
Line 5128  sub blockcheck { Line 5712  sub blockcheck {
         # 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 5148  sub blockcheck { Line 5732  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 5161  sub get_blocks { Line 5745  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 5289  sub parse_block_record { Line 5879  sub parse_block_record {
 }  }
   
 sub blocking_status {  sub blocking_status {
     my ($activity,$uname,$udom,$url,$is_course) = @_;      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);          $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 5305  sub blocking_status { Line 5898  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') {
         $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 5335  END_MYBLOCK Line 5933  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 'alert') {      } elsif ($activity eq 'alert') {
         $text = &mt('Checking Critical Messages Blocked');          $text = &mt('Checking Critical Messages Blocked');
     } elsif ($activity eq 'reinit') {      } elsif ($activity eq 'reinit') {
         $text = &mt('Checking Course Update Blocked');          $text = &mt('Checking Course Update Blocked');
       } elsif ($activity eq 'about') {
           $text = &mt('Access to User Information Pages Blocked');
       } elsif ($activity eq 'wishlist') {
           $text = &mt('Access to Stored Links Blocked');
       } elsif ($activity eq 'annotate') {
           $text = &mt('Access to Annotations Blocked');
     }      }
     $output .= <<"END_BLOCK";      $output .= <<"END_BLOCK";
 <div class='$class'>  <div class='$class'>
Line 5362  sub check_ip_acc { Line 5970  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed;      my ($ip,$allowed);
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};      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;
     my %access = (      my %access = (
Line 5514  sub get_domainconf { Line 6128  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','window','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 5578  sub get_legacy_domconf { Line 6203  sub get_legacy_domconf {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile =  $designdir.'/'.$udom.'.tab';      my $designfile =  $designdir.'/'.$udom.'.tab';
     if (-e $designfile) {      if (-e $designfile) {
         if ( open (my $fh,"<$designfile") ) {          if ( open (my $fh,'<',$designfile) ) {
             while (my $line = <$fh>) {              while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);                  next if ($line =~ /^\#/);
                 chomp($line);                  chomp($line);
Line 5618  sub domainlogo { Line 6243  sub domainlogo {
  &Apache::lonnet::repcopy($local_name);   &Apache::lonnet::repcopy($local_name);
     }      }
    $imgsrc = &lonhttpdurl($imgsrc);     $imgsrc = &lonhttpdurl($imgsrc);
         }           }
         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';          my $alttext = $domain;
           if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
               $alttext = $designhash{$domain.'.login.alttext_domlogo'};
           }
           return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {      } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
         return &Apache::lonnet::domain($domain,'description');          return &Apache::lonnet::domain($domain,'description');
     } else {      } else {
Line 5737  sub head_subbox { Line 6366  sub head_subbox {
 Input: (optional) filename from which breadcrumb trail is built.  Input: (optional) filename from which breadcrumb trail is built.
        In most cases no input as needed, as $env{'request.filename'}         In most cases no input as needed, as $env{'request.filename'}
        is appropriate for use in building the breadcrumb trail.         is appropriate for use in building the breadcrumb trail.
          frameset flag
          If page header is being requested for use in a frameset, then
          the second (option) argument -- frameset will be true, and
          the target attribute set for links should be target="_parent".
          If $title is supplied as the thitd arg, that will be used to 
          the left of the breadcrumbs tail for the current path.
   
 Returns: HTML div with CSTR path and recent box  Returns: HTML div with CSTR path and recent box
          To be included on Authoring Space pages           To be included on Authoring Space pages
Line 5744  Returns: HTML div with CSTR path and rec Line 6379  Returns: HTML div with CSTR path and rec
 =cut  =cut
   
 sub CSTR_pageheader {  sub CSTR_pageheader {
     my ($trailfile) = @_;      my ($trailfile,$frameset,$title) = @_;
     if ($trailfile eq '') {      if ($trailfile eq '') {
         $trailfile = $env{'request.filename'};          $trailfile = $env{'request.filename'};
     }      }
Line 5767  sub CSTR_pageheader { Line 6402  sub CSTR_pageheader {
         $lastitem = $thisdisfn;          $lastitem = $thisdisfn;
     }      }
   
     my ($crsauthor,$title);      my $crsauthor;
     if (($env{'request.course.id'}) &&      if (($env{'request.course.id'}) &&
         ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&          ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
         ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {          ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
         $crsauthor = 1;          $crsauthor = 1;
         $title = &mt('Course Authoring Space');          if ($title eq '') {
     } else {              $title = &mt('Course Authoring Space');
           }
       } elsif ($title eq '') {
         $title = &mt('Authoring Space');          $title = &mt('Authoring Space');
     }      }
   
       my ($target,$crumbtarget) = (' target="_top"','_top');
       if ($frameset) {
           $target = ' target="_parent"';
           $crumbtarget = '_parent';
       } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
           $target = '';
           $crumbtarget = '';
       } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
           $target = ' target="'.$env{'request.deeplink.target'}.'"';
           $crumbtarget = $env{'request.deeplink.target'};
       }
   
     my $output =      my $output =
          '<div>'           '<div>'
         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?          .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
         .'<b>'.$title.'</b> '          .'<b>'.$title.'</b> '
         .'<form name="dirs" method="post" action="'.$formaction          .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
         .'" target="_top">' #FIXME lonpubdir: target="_parent"          .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);  
   
     if ($lastitem) {      if ($lastitem) {
         $output .=          $output .=
Line 5793  sub CSTR_pageheader { Line 6441  sub CSTR_pageheader {
     }      }
   
     if ($crsauthor) {      if ($crsauthor) {
         $output .= '</form>'.&Apache::lonmenu::constspaceform();          $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
     } else {      } else {
         $output .=          $output .=
              '<br />'               '<br />'
             #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"              #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
             .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')              .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
             .'</form>'              .'</form>'
             .&Apache::lonmenu::constspaceform();              .&Apache::lonmenu::constspaceform($frameset);
     }      }
     $output .= '</div>';      $output .= '</div>';
   
Line 5855  Inputs: Line 6503  Inputs:
             inlineremote items to be added in "Functions" menu below              inlineremote items to be added in "Functions" menu below
             breadcrumbs.              breadcrumbs.
   
   =item * $ltiscope, optional argument, will be one of: resource, map or
               course, if LON-CAPA is in LTI Provider context. Value is
               the scope of use, i.e., launch was for access to a single, a map
               or the entire course.
   
   =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
               context, this will contain the URL for the landing item in
               the course, after launch from an LTI Consumer
   
   =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
               context, this will contain a reference to hash of items
               to be included in the page header and/or inline menu.
   
   =item * $menucoll, optional argument, if specific menu collection is in
               effect, either set as the default for the course, or set for
               the deeplink paramater for $env{'request.deeplink.login'}
               then $menucoll will be the number of that collection. 
   
   =item * $menuref, optional argument, reference to a hash, containing the
               menu options included for the menu in effect, based on the
               configuration for the numbered menu collection in use.  
   
   =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
               within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
               if so, $showncrumbsref is set there to 1, and will propagate back
               via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
               being called a second time.
   
 =back  =back
   
 Returns: A uniform header for LON-CAPA web pages.    Returns: A uniform header for LON-CAPA web pages.  
Line 5866  other decorations will be returned. Line 6542  other decorations will be returned.
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;          $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
           $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
   
     my $public;      my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))      if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
Line 5895  sub bodytag { Line 6572  sub bodytag {
     if ($realm) {      if ($realm) {
         $realm = '/'.$realm;          $realm = '/'.$realm;
     }      }
     if ($role  eq 'ca') {      if ($role 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 5912  sub bodytag { Line 6601  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 5937  sub bodytag { Line 6626  sub bodytag {
     if ($public) {      if ($public) {
  undef($role);   undef($role);
     }      }
       
       my $showcrstitle = 1;
       if (($cid) && ($env{'request.lti.login'})) {
           if (ref($ltimenu) eq 'HASH') {
               unless ($ltimenu->{'role'}) {
                   undef($role);
               }
               unless ($ltimenu->{'coursetitle'}) {
                   $realm='&nbsp;';
                   $showcrstitle = 0;
               }
           }
       } elsif (($cid) && ($menucoll)) {
           if (ref($menuref) eq 'HASH') {
               unless ($menuref->{'role'}) {
                   undef($role);
               }
               unless ($menuref->{'crs'}) {
                   $realm='&nbsp;';
                   $showcrstitle = 0;
               }
           }
       }
   
     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'}) && $showcrstitle &&
                         $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+$//;
     }      }
   
     my $crstype;      my $crstype;
     if ($env{'request.course.id'}) {      if ($cid) {
         $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};          $crstype = $env{'course.'.$cid.'.type'};
     } elsif ($args->{'crstype'}) {      } elsif ($args->{'crstype'}) {
         $crstype = $args->{'crstype'};          $crstype = $args->{'crstype'};
     }      }
Line 5971  sub bodytag { Line 6681  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($crstype);          unless ($args->{'no_primary_menu'}) {
               my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
                                                                 $args->{'links_disabled'},
                                                                 $args->{'links_target'});
   
         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>|;
             return $bodytag;                  return $bodytag;
         }              }
   
         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {              unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;                  $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
         }              }
   
         $bodytag .= $right;              $bodytag .= $right;
   
         if ($dc_info) {              if ($dc_info) {
             $dc_info = &dc_courseid_toggle($dc_info);                  $dc_info = &dc_courseid_toggle($dc_info);
               }
               $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
         }          }
         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;  
   
         #if directed to not display the secondary menu, don't.            #if directed to not display the secondary menu, don't.  
         if ($args->{'no_secondary_menu'}) {          if ($args->{'no_secondary_menu'}) {
Line 5999  sub bodytag { Line 6713  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);              unless ($args->{'no_inline_menu'}) {
                   $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
                                                               $args->{'no_primary_menu'},
                                                               $menucoll,$menuref,
                                                               $args->{'links_disabled'},
                                                               $args->{'links_target'});
               }
             $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') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,                  $bodytag .= &Apache::lonmenu::innerregister($forcereg,
                                 $args->{'bread_crumbs'},'','',$hostname);                                  $args->{'bread_crumbs'},'','',$hostname,
                                   $ltiscope,$ltiuri,$showncrumbsref);
             } 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,$ltiscope,$ltiuri,$showncrumbsref);
                                                             $hostname);  
             } else {              } else {
                 $bodytag .=                   $bodytag .= 
                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},                      &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
Line 6093  sub endbodytag { Line 6813  sub endbodytag {
     }      }
     if ( exists( $env{'internal.head.redirect'} ) ) {      if ( exists( $env{'internal.head.redirect'} ) ) {
         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {          if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
               my ($endbodyjs,$idattr);
               if ($env{'internal.head.to_opener'}) {
                   my $linkid = 'LC_continue_link';
                   $idattr = ' id="'.$linkid.'"';
                   my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
                   $endbodyjs=<<ENDJS;
   <script type="text/javascript">
   // <![CDATA[
   function ebFunction(evt) {
       evt.preventDefault();
       var dest = '$redirect_for_js';
       if (window.opener != null && !window.opener.closed) {
           window.opener.location.href=dest;
           window.close();
       } else {
           window.location.href=dest;
       }
       return false;
   }
   
   \$(document).ready(function () {
     if (document.getElementById('$linkid')) {
       var clickelem = document.getElementById('$linkid');
       clickelem.addEventListener('click',ebFunction,false);
     }
   });
   // ]]>
   </script>
   ENDJS
               }
     $endbodytag=      $endbodytag=
         "<br /><a href=\"$env{'internal.head.redirect'}\">".          "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
         &mt('Continue').'</a>'.          &mt('Continue').'</a>'.
         $endbodytag;          $endbodytag;
         }          }
     }      }
       if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
           $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
       }
     return $endbodytag;      return $endbodytag;
 }  }
   
Line 7078  table.LC_prior_tries td { Line 7831  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 7414  fieldset { Line 8168  fieldset {
   /* overflow: hidden; */    /* overflow: hidden; */
 }  }
   
   fieldset#LC_selectuser {
       margin: 0;
       padding: 0;
   }
   
 article.geogebraweb div {  article.geogebraweb div {
     margin: 0;      margin: 0;
 }  }
Line 7957  a#LC_content_toolbar_edittoplevel { Line 8716  a#LC_content_toolbar_edittoplevel {
   background-image:url(/res/adm/pages/edittoplevel.gif);    background-image:url(/res/adm/pages/edittoplevel.gif);
 }  }
   
   a#LC_content_toolbar_printout {
     background-image:url(/res/adm/pages/printout.gif);
   }
   
 ul#LC_toolbar li a:hover {  ul#LC_toolbar li a:hover {
   background-position: bottom center;    background-position: bottom center;
 }  }
Line 8074  ul.LC_funclist li { Line 8837  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 {
     white-space: pre-wrap;
     white-space: -moz-pre-wrap;
     white-space: -pre-wrap;
     white-space: -o-pre-wrap;
     word-wrap: break-word;
   }
   
 /*  /*
   styles used for response display    styles used for response display
 */  */
Line 8239  Inputs: $title - optional title for the Line 9022  Inputs: $title - optional title for the
                                    3- whether the side effect should occur                                     3- whether the side effect should occur
                            (side effect of setting                              (side effect of setting 
                                $env{'internal.head.redirect'} to the url                                  $env{'internal.head.redirect'} to the url 
                                redirected too)                                 redirected to)
                                      4- whether the redirect target should be
                                         the opener of the current (pop-up)
                                         window (side effect of setting
                                         $env{'internal.head.to_opener'} to
                                         1, if true.
                                      5- whether encrypt check should be skipped
             domain         -> force to color decorate a page for a specific              domain         -> force to color decorate a page for a specific
                                domain                                 domain
             function       -> force usage of a specific rolish color scheme              function       -> force usage of a specific rolish color scheme
Line 8302  sub headtag { Line 9091  sub headtag {
         }          }
     }      }
     if (ref($args->{'redirect'})) {      if (ref($args->{'redirect'})) {
  my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};   my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
  $url = &Apache::lonenc::check_encrypt($url);          if (!$skip_enc_check) {
               $url = &Apache::lonenc::check_encrypt($url);
           }
  if (!$inhibit_continue) {   if (!$inhibit_continue) {
     $env{'internal.head.redirect'} = $url;      $env{'internal.head.redirect'} = $url;
  }   }
  $result.=<<ADDMETA   $result.=<<"ADDMETA";
 <meta http-equiv="pragma" content="no-cache" />  <meta http-equiv="pragma" content="no-cache" />
   ADDMETA
           if ($to_opener) {
               $env{'internal.head.to_opener'} = 1;
               my $dest = &js_escape($url);
               my $timeout = int($time * 1000);
               $result .=<<"ENDJS";
   <script type="text/javascript">
   // <![CDATA[
   function LC_To_Opener() {
       var dest = '$dest';
       if (dest != '') {
           if (window.opener != null && !window.opener.closed) {
               window.opener.location.href=dest;
               window.close();
           } else {
               window.location.href=dest;
           }
       }
   }
   \$(document).ready(function () {
       setTimeout('LC_To_Opener()',$timeout);
   });
   // ]]>
   </script>
   ENDJS
           } else {
               $result.=<<"ADDMETA";
 <meta http-equiv="Refresh" content="$time; url=$url" />  <meta http-equiv="Refresh" content="$time; url=$url" />
 ADDMETA  ADDMETA
           }
     } else {      } else {
         unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {          unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
             my $requrl = $env{'request.uri'};              my $requrl = $env{'request.uri'};
Line 8324  ADDMETA Line 9143  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(undef,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 8381  function LC_Offload_Now() { Line 9256  function LC_Offload_Now() {
 // ]]>  // ]]>
 </script>  </script>
 OFFLOAD  OFFLOAD
                             }  
                         }                          }
                     }                      }
                 }                  }
Line 8480  sub print_suppression { Line 9354  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 8599  $args - additional optional args support Line 9474  $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).
                links_target   -> Target for links, e.g., _parent (optional).
   
 =back  =back
   
Line 8611  sub start_page { Line 9490  sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));      #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
   
     $env{'internal.start_page'}++;      $env{'internal.start_page'}++;
     my ($result,@advtools);      my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
   
     if (! exists($args->{'skip_phases'}{'head'}) ) {      if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);          $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
     }      }
       
       if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
           if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
               unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
                   $args->{'no_primary_menu'} = 1;
               }
               unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
                   $args->{'no_inline_menu'} = 1;
               }
               if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
                   map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
               }
           } else {
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
               if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
                   unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
                       $args->{'no_primary_menu'} = 1;
                   }
                   unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
                       $args->{'no_inline_menu'} = 1;
                   }
                   if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
                       map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
                   }
               }
           }
           ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
                                     $env{'course.'.$env{'request.course.id'}.'.domain'},
                                     $env{'course.'.$env{'request.course.id'}.'.num'});
       } elsif ($env{'request.course.id'}) {
           my $expiretime=600;
           if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
               &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
           }
           my ($deeplinkmenu,$menuref);
           ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
           if ($menucoll) {
               if (ref($menuref) eq 'HASH') {
                   %menu = %{$menuref};
               }
               if ($menu{'top'} eq 'n') {
                   $args->{'no_primary_menu'} = 1;
               }
               if ($menu{'inline'} eq 'n') {
                   unless (&Apache::lonnet::allowed('opa')) {
                       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                       my $crstype = &course_type();
                       my $now = time;
                       my $ccrole;
                       if ($crstype eq 'Community') {
                           $ccrole = 'co';
                       } else {
                           $ccrole = 'cc';
                       }
                       if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
                           my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
                           if ((($start) && ($start<0)) ||
                               (($end) && ($end<$now))  ||
                               (($start) && ($now<$start))) {
                               $args->{'no_inline_menu'} = 1;
                           }
                       } else {
                           $args->{'no_inline_menu'} = 1;
                       }
                   }
               }
           }
       }
   
       my $showncrumbs;
     if (! exists($args->{'skip_phases'}{'body'}) ) {      if (! exists($args->{'skip_phases'}{'body'}) ) {
  if ($args->{'frameset'}) {   if ($args->{'frameset'}) {
     my $attr_string = &make_attr_string($args->{'force_register'},      my $attr_string = &make_attr_string($args->{'force_register'},
Line 8629  sub start_page { Line 9579  sub start_page {
                          $args->{'only_body'},      $args->{'domain'},                           $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},                           $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args,                           $args->{'bgcolor'},        $args,
                          \@advtools);                           \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
                            \%menu,\$showncrumbs);
         }          }
     }      }
   
Line 8651  sub start_page { Line 9602  sub start_page {
   
     #Breadcrumbs      #Breadcrumbs
     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {      if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
           unless ($showncrumbs) {
  &Apache::lonhtmlcommon::clear_breadcrumbs();   &Apache::lonhtmlcommon::clear_breadcrumbs();
  #if any br links exists, add them to the breadcrumbs   #if any br links exists, add them to the breadcrumbs
  if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {            if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
Line 8665  sub start_page { Line 9617  sub start_page {
                 my $menulink;                  my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.                  # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                 if ((exists($args->{'bread_crumbs_nomenu'})) ||                  if ((exists($args->{'bread_crumbs_nomenu'})) ||
                        ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
                      ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&                       ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                      ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&                       ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                      (!$env{'request.role.adv'}))) {                       (!$env{'request.role.adv'}))) {
Line 8672  sub start_page { Line 9625  sub start_page {
                 } else {                  } else {
                     undef($menulink);                      undef($menulink);
                 }                  }
                   my $linkprotout;
                   if ($env{'request.deeplink.login'}) {
                       my $linkprotout = &Apache::lonmenu::linkprot_exit();
                       if ($linkprotout) {
                           &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
                       }
                   }
  #if bread_crumbs_component exists show it as headline else show only the breadcrumbs   #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
  if(exists($args->{'bread_crumbs_component'})){   if(exists($args->{'bread_crumbs_component'})){
  $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
                 } else {                  } else {
  $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);   $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
  }   }
           }
     }      }
     return $result;      return $result;
 }  }
Line 8714  sub end_page { Line 9675  sub end_page {
     return $result;      return $result;
 }  }
   
   sub menucoll_in_effect {
       my ($menucoll,$deeplinkmenu,%menu);
       if ($env{'request.course.id'}) {
           $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
           if ($env{'request.deeplink.login'}) {
               my ($deeplink_symb,$deeplink,$check_login_symb);
               my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
                   if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
                       my $navmap = Apache::lonnavmaps::navmap->new();
                       if (ref($navmap)) {
                           $deeplink = $navmap->get_mapparam(undef,
                                                             &Apache::lonnet::declutter($env{'request.noversionuri'}),
                                                             '0.deeplink');
                       } else {
                           $check_login_symb = 1;
                       }
                   } else {
                       my $symb = &Apache::lonnet::symbread();
                       if ($symb) {
                           $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
                       } else {
                           $check_login_symb = 1;
                       }
                   }
               } else {
                   $check_login_symb = 1;
               }
               if ($check_login_symb) {
                   $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
                   if ($deeplink_symb =~ /\.(page|sequence)$/) {
                       my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
                       my $navmap = Apache::lonnavmaps::navmap->new();
                       if (ref($navmap)) {
                           $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
                       }
                   } else {
                       $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
                   }
               }
               if ($deeplink ne '') {
                   my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
                   if ($display =~ /^\d+$/) {
                       $deeplinkmenu = 1;
                       $menucoll = $display;
                   }
               }
           }
           if ($menucoll) {
               %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
           }
       }
       return ($menucoll,$deeplinkmenu,\%menu);
   }
   
   sub deeplink_login_symb {
       my ($cnum,$cdom) = @_;
       my $login_symb;
       if ($env{'request.deeplink.login'}) {
           $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
       }
       return $login_symb;
   }
   
   sub symb_from_tinyurl {
       my ($url,$cnum,$cdom) = @_;
       if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
           my $key = $1;
           my ($tinyurl,$login);
           my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
           if (defined($cached)) {
               $tinyurl = $result;
           } else {
               my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
               my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
               if ($currtiny{$key} ne '') {
                   $tinyurl = $currtiny{$key};
                   &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
               }
           }
           if ($tinyurl ne '') {
               my ($cnumreq,$symb) = split(/\&/,$tinyurl);
               if (wantarray) {
                   return ($cnumreq,$symb);
               } elsif ($cnumreq eq $cnum) {
                   return $symb;
               }
           }
       }
       if (wantarray) {
           return ();
       } else {
           return;
       }
   }
   
   sub usable_exttools {
       my %tooltypes;
       if ($env{'request.course.id'}) {
           if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
              if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
                  %tooltypes = (
                                crs => 1,
                                dom => 1,
                               );
              } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
                  $tooltypes{'crs'} = 1;
              } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
                  $tooltypes{'dom'} = 1;
              }
           } else {
               my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
               my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
               my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
               if ($crstype eq '') {
                   $crstype = 'course';
               }
               if ($crstype eq 'course') {
                   if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
                       $crstype = 'official';
                   } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
                       $crstype = 'textbook';
                   } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
                       $crstype = 'lti';
                   } else {
                       $crstype = 'unofficial';
                   }
               }
               my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
               if ($domdefaults{$crstype.'domexttool'}) {
                   $tooltypes{'dom'} = 1;
               }
               if ($domdefaults{$crstype.'exttool'}) {
                   $tooltypes{'crs'} = 1;
               }
           }
       }
       return %tooltypes;
   }
   
 sub wishlist_window {  sub wishlist_window {
     return(<<'ENDWISHLIST');      return(<<'ENDWISHLIST');
 <script type="text/javascript">  <script type="text/javascript">
Line 8798  sub modal_link { Line 9900  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
 }  }
   
 sub modal_adhoc_script {  sub modal_adhoc_script {
     my ($funcname,$width,$height,$content)=@_;      my ($funcname,$width,$height,$content,$possmathjax)=@_;
       my $mathjax;
       if ($possmathjax) {
           $mathjax = <<'ENDJAX';
                  if (typeof MathJax == 'object') {
                      MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
                  }
   ENDJAX
       }
     return (<<ENDADHOC);      return (<<ENDADHOC);
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 8815  sub modal_adhoc_script { Line 9924  sub modal_adhoc_script {
                 modalWindow.height = $height;                  modalWindow.height = $height;
                 modalWindow.content = '$content';                  modalWindow.content = '$content';
                 modalWindow.open();                  modalWindow.open();
                   $mathjax
         };            };  
 // ]]>  // ]]>
 </script>  </script>
Line 8822  ENDADHOC Line 9932  ENDADHOC
 }  }
   
 sub modal_adhoc_inner {  sub modal_adhoc_inner {
     my ($funcname,$width,$height,$content)=@_;      my ($funcname,$width,$height,$content,$possmathjax)=@_;
     my $innerwidth=$width-20;      my $innerwidth=$width-20;
     $content=&js_ready(      $content=&js_ready(
                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).                   &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
Line 8831  sub modal_adhoc_inner { Line 9941  sub modal_adhoc_inner {
                  &end_scrollbox().                   &end_scrollbox().
                  &end_page()                   &end_page()
              );               );
     return &modal_adhoc_script($funcname,$width,$height,$content);      return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
 }  }
   
 sub modal_adhoc_window {  sub modal_adhoc_window {
     my ($funcname,$width,$height,$content,$linktext)=@_;      my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
     return &modal_adhoc_inner($funcname,$width,$height,$content).      return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";             "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
 }  }
   
Line 9394  Scalar: 1 if 'Course' to be used, 0 othe Line 10504  Scalar: 1 if 'Course' to be used, 0 othe
   
 ###############################################  ###############################################
 sub show_course {  sub show_course {
       my ($udom,$uname) = @_;
       if (($udom ne '') && ($uname ne '')) {
           if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
               if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
                   return 0;
               } else {
                   return 1;
               }
           }
       }
     my $course = !$env{'user.adv'};      my $course = !$env{'user.adv'};
     if (!$env{'user.adv'}) {      if (!$env{'user.adv'}) {
         foreach my $env (keys(%env)) {          foreach my $env (keys(%env)) {
Line 10711  sub sorted_inst_types { Line 11831  sub sorted_inst_types {
 }  }
   
 sub get_institutional_codes {  sub get_institutional_codes {
     my ($settings,$allcourses,$LC_code) = @_;      my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
 # Get complete list of course sections to update  # Get complete list of course sections to update
     my @currsections = ();      my @currsections = ();
     my @currxlists = ();      my @currxlists = ();
       my (%unclutteredsec,%unclutteredlcsec);
     my $coursecode = $$settings{'internal.coursecode'};      my $coursecode = $$settings{'internal.coursecode'};
       my $crskey = $crs.':'.$coursecode;
       @{$unclutteredsec{$crskey}} = ();
       @{$unclutteredlcsec{$crskey}} = ();
   
     if ($$settings{'internal.sectionnums'} ne '') {      if ($$settings{'internal.sectionnums'} ne '') {
         @currsections = split(/,/,$$settings{'internal.sectionnums'});          @currsections = split(/,/,$$settings{'internal.sectionnums'});
Line 10726  sub get_institutional_codes { Line 11850  sub get_institutional_codes {
     }      }
   
     if (@currxlists > 0) {      if (@currxlists > 0) {
         foreach (@currxlists) {          foreach my $xl (@currxlists) {
             if (m/^([^:]+):(\w*)$/) {              if ($xl =~ /^([^:]+):(\w*)$/) {
                 unless (grep/^$1$/,@{$allcourses}) {                  unless (grep/^$1$/,@{$allcourses}) {
                     push(@{$allcourses},$1);                      push(@{$allcourses},$1);
                     $$LC_code{$1} = $2;                      $$LC_code{$1} = $2;
Line 10735  sub get_institutional_codes { Line 11859  sub get_institutional_codes {
             }              }
         }          }
     }      }
    
     if (@currsections > 0) {      if (@currsections > 0) {
         foreach (@currsections) {          foreach my $sec (@currsections) {
             if (m/^(\w+):(\w*)$/) {              if ($sec =~ m/^(\w+):(\w*)$/ ) {
                 my $sec = $coursecode.$1;                  my $instsec = $1;
                 my $lc_sec = $2;                  my $lc_sec = $2;
                 unless (grep/^$sec$/,@{$allcourses}) {                  unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
                       push(@{$unclutteredsec{$crskey}},$instsec);
                       push(@{$unclutteredlcsec{$crskey}},$lc_sec);
                   }
               }
           }
       }
   
       if (@{$unclutteredsec{$crskey}} > 0) {
           my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
           if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
               for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
                   my $sec = $coursecode.$formattedsec{$crskey}[$i];
                   unless (grep/^\Q$sec\E$/,@{$allcourses}) {
                     push(@{$allcourses},$sec);                      push(@{$allcourses},$sec);
                     $$LC_code{$sec} = $lc_sec;                      $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
                 }                  }
             }              }
         }          }
Line 12070  sub modify_html_refs { Line 13207  sub modify_html_refs {
                 return;                  return;
             }              }
         }           } 
         if (open(my $fh,"<$container")) {          if (open(my $fh,'<',$container)) {
             $content = join('', <$fh>);              $content = join('', <$fh>);
             close($fh);              close($fh);
         } else {          } else {
Line 12135  sub modify_html_refs { Line 13272  sub modify_html_refs {
                         }                          }
                     }                      }
                 } else {                  } else {
                     if (open(my $fh,">$container")) {                      if (open(my $fh,'>',$container)) {
                         print $fh $content;                          print $fh $content;
                         close($fh);                          close($fh);
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',                          $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
Line 13351  sub process_extracted_files { Line 14488  sub process_extracted_files {
                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.                              my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.                                        $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                                       $title;                                        $title;
                             if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {                              if (($outer !~ /\D/) &&
                                   (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
                                   ($newidx !~ /\D/)) {
                                 if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {                                  if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                                     mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);                                      mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                                 }                                  }
Line 13764  sub upfile_store { Line 14903  sub upfile_store {
     {      {
         my $datafile = $r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';                             '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,">$datafile") ) {          if ( open(my $fh,'>',$datafile) ) {
             print $fh $env{'form.upfile'};              print $fh $env{'form.upfile'};
             close($fh);              close($fh);
         }          }
Line 13789  sub load_tmp_file { Line 14928  sub load_tmp_file {
     {      {
         my $studentfile = $r->dir_config('lonDaemons').          my $studentfile = $r->dir_config('lonDaemons').
                               '/tmp/'.$datatoken.'.tmp';                                '/tmp/'.$datatoken.'.tmp';
         if ( open(my $fh,"<$studentfile") ) {          if ( open(my $fh,'<',$studentfile) ) {
             @studentdata=<$fh>;              @studentdata=<$fh>;
             close($fh);              close($fh);
         }          }
Line 13799  sub load_tmp_file { Line 14938  sub load_tmp_file {
   
 sub valid_datatoken {  sub valid_datatoken {
     my ($datatoken) = @_;      my ($datatoken) = @_;
     if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) {      if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
         return $datatoken;          return $datatoken;
     }      }
     return;      return;
Line 14955  Inputs: Line 16094  Inputs:
   
 from -              Sender's email address  from -              Sender's email address
   
   replyto -           Reply-To email address
   
 to -                Email address of recipient  to -                Email address of recipient
   
 subject -           Subject of email  subject -           Subject of email
Line 14965  cc_string -         Carbon copy email ad Line 16106  cc_string -         Carbon copy email ad
   
 bcc -               Blind carbon copy email address  bcc -               Blind carbon copy email address
   
 type -              File type of attachment  
   
 attachment_path -   Path of file to be attached  attachment_path -   Path of file to be attached
   
 file_name -         Name of file to be attached  file_name -         Name of file to be attached
Line 14983  attachment_text -   The body of an attac Line 16122  attachment_text -   The body of an attac
 ############################################################  ############################################################
   
 sub mime_email {  sub mime_email {
     my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,       my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, 
         $file_name, $attachment_text) = @_;          $file_name,$attachment_text) = @_;
    
     my $msg = MIME::Lite->new(      my $msg = MIME::Lite->new(
              From    => $from,               From    => $from,
              To      => $to,               To      => $to,
Line 14992  sub mime_email { Line 16132  sub mime_email {
              Type    =>'TEXT',               Type    =>'TEXT',
              Data    => $body,               Data    => $body,
              );               );
       if ($replyto ne '') {
           $msg->add("Reply-To" => $replyto);
       }
     if ($cc_string ne '') {      if ($cc_string ne '') {
         $msg->add("Cc" => $cc_string);          $msg->add("Cc" => $cc_string);
     }      }
Line 15107  jsarray (reference to array of categorie Line 16250  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 15114  Side effects: populates trails and allit Line 16259  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 15142  sub extract_categories { Line 16287  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 15185  Side effects: populates trails and allit Line 16333  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++) {
             my $name = $cats->[$depth]{$category}[$k];              my $name = $cats->[$depth]{$category}[$k];
             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;
Line 15212  sub recurse_categories { Line 16360  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 15253  sub assign_categories_table { Line 16406  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 15392  sub assign_category_rows { Line 16545  sub assign_category_rows {
   
   
 sub commit_customrole {  sub commit_customrole {
     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;      my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
       my $result = &Apache::lonnet::assigncustomrole(
                        $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
                        $context,$othdomby,$requester);
     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.      my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
                          ($start?', '.&mt('starting').' '.localtime($start):'').                           ($start?', '.&mt('starting').' '.localtime($start):'').
                          ($end?', ending '.localtime($end):'').': <b>'.                           ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
               &Apache::lonnet::assigncustomrole(      if (wantarray) {
                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).          return ($output,$result);
                  '</b><br />';      } else {
     return $output;          return $output;
       }
 }  }
   
 sub commit_standardrole {  sub commit_standardrole {
     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;      my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits,
     my ($output,$logmsg,$linefeed);          $othdomby,$requester) = @_;
       my ($output,$logmsg,$linefeed,$result);
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
     } else {      } else {
         $linefeed = "<br />\n";          $linefeed = "<br />\n";
     }        }  
     if ($three eq 'st') {      if ($three eq 'st') {
         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,          $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                                          $one,$two,$sec,$context,$credits);                                        $one,$two,$sec,$context,$credits,$othdomby,
                                         $requester);
         if (($result =~ /^error/) || ($result eq 'not_in_class') ||           if (($result =~ /^error/) || ($result eq 'not_in_class') || 
             ($result eq 'unknown_course') || ($result eq 'refused')) {              ($result eq 'unknown_course') || ($result eq 'refused')) {
             $output = $logmsg.' '.&mt('Error: ').$result."\n";               $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
Line 15432  sub commit_standardrole { Line 16591  sub commit_standardrole {
         $output = &mt('Assigning').' '.$three.' in '.$url.          $output = &mt('Assigning').' '.$three.' in '.$url.
                ($start?', '.&mt('starting').' '.localtime($start):'').                 ($start?', '.&mt('starting').' '.localtime($start):'').
                ($end?', '.&mt('ending').' '.localtime($end):'').': ';                 ($end?', '.&mt('ending').' '.localtime($end):'').': ';
         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);          $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,
                                                 '','',$context,$othdomby,$requester);
         if ($context eq 'auto') {          if ($context eq 'auto') {
             $output .= $result.$linefeed;              $output .= $result.$linefeed;
         } else {          } else {
             $output .= '<b>'.$result.'</b>'.$linefeed;              $output .= '<b>'.$result.'</b>'.$linefeed;
         }          }
     }      }
     return $output;      if (wantarray) {
           return ($output,$result);
       } else {
           return $output;
       }
 }  }
   
 sub commit_studentrole {  sub commit_studentrole {
     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,      my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
         $credits) = @_;          $credits,$othdomby,$requester) = @_;
     my ($result,$linefeed,$oldsecurl,$newsecurl);      my ($result,$linefeed,$oldsecurl,$newsecurl);
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 15468  sub commit_studentrole { Line 16632  sub commit_studentrole {
                 }                  }
                 $oldsecurl = $uurl;                  $oldsecurl = $uurl;
                 $expire_role_result =                   $expire_role_result = 
                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);                      &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
                 if ($env{'request.course.sec'} ne '') {                                                   '','','',$context,$othdomby,$requester);
                   if ($env{'request.course.sec'} ne '') {
                     if ($expire_role_result eq 'refused') {                      if ($expire_role_result eq 'refused') {
                         my @roles = ('st');                          my @roles = ('st');
                         my @statuses = ('previous');                          my @statuses = ('previous');
Line 15495  sub commit_studentrole { Line 16660  sub commit_studentrole {
                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,                  &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                                                            undef,undef,undef,$sec,                                                             undef,undef,undef,$sec,
                                                            $end,$start,'','',$cid,                                                             $end,$start,'','',$cid,
                                                            '',$context,$credits);                                                             '',$context,$credits,'',
                                                              $othdomby,$requester);
             if ($modify_section_result =~ /^ok/) {              if ($modify_section_result =~ /^ok/) {
                 if ($secchange == 1) {                  if ($secchange == 1) {
                     if ($sec eq '') {                      if ($sec eq '') {
Line 15580  sub check_clone { Line 16746  sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};      my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);      my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);      my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
     my $clonemsg;      my $clonetitle;
       my @clonemsg;
     my $can_clone = 0;      my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});      my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {      if ($lctype ne 'community') {
Line 15588  sub check_clone { Line 16755  sub check_clone {
     }      }
     if ($clonehome eq 'no_host') {      if ($clonehome eq 'no_host') {
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
                                 mt => 'No new community created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
                                 args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
                               }));
         } else {          } else {
             $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});              push(@clonemsg,({
         }                                     mt => 'No new course created.',
                                 args => [],
                               },
                               {
                                 mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
                                 args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                               }));
           }
     } else {      } else {
  my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});   my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
           $clonetitle = $clonedesc{'description'};
         if ($args->{'crstype'} eq 'Community') {          if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {              if ($clonedesc{'type'} ne 'Community') {
                 $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});                  push(@clonemsg,({
                 return ($can_clone, $clonemsg, $cloneid, $clonehome);                                    mt => 'No new community created.',
                                     args => [],
                                   },
                                   {
                                     mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
                                     args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
                                   }));
                   return ($can_clone,\@clonemsg,$cloneid,$clonehome);
             }              }
         }          }
  if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&   if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
Line 15686  sub check_clone { Line 16875  sub check_clone {
             }              }
             unless ($can_clone) {              unless ($can_clone) {
                 if ($args->{'crstype'} eq 'Community') {                  if ($args->{'crstype'} eq 'Community') {
                     $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
                                         mt => 'No new community created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                 } else {                  } else {
                     $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});                      push(@clonemsg,({
                                         mt => 'No new course created.',
                                         args => [],
                                       },
                                       {
                                         mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
                                         args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
                                       }));
                 }                  }
     }      }
         }          }
     }      }
     return ($can_clone, $clonemsg, $cloneid, $clonehome);      return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
 }  }
   
 sub construct_course {  sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,      my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
         $cnum,$category,$coderef) = @_;          $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
     my $outcome;      my ($outcome,$msgref,$clonemsgref);
     my $linefeed =  '<br />'."\n";      my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {      if ($context eq 'auto') {
         $linefeed = "\n";          $linefeed = "\n";
Line 15708  sub construct_course { Line 16911  sub construct_course {
 #  #
 # Are we cloning?  # Are we cloning?
 #  #
     my ($can_clone, $clonemsg, $cloneid, $clonehome);      my ($can_clone,$cloneid,$clonehome,$clonetitle);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {      if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
  ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);   ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
  if ($context ne 'auto') {  
             if ($clonemsg ne '') {  
         $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';  
             }  
  }  
  $outcome .= $clonemsg.$linefeed;  
   
         if (!$can_clone) {          if (!$can_clone) {
     return (0,$outcome);      return (0,$outcome,$clonemsgref);
  }   }
     }      }
   
Line 15742  sub construct_course { Line 16938  sub construct_course {
                                              $args->{'ccuname'}.':'.                                               $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},                                               $args->{'ccdomain'},
                                              $args->{'crstype'},                                               $args->{'crstype'},
                                              $cnum,$context,$category);                                               $cnum,$context,$category,
                                                $callercontext);
   
     # Note: The testing routines depend on this being output; see       # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment      # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new      # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.      # will need to be suitably modified.
     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;      if (($callercontext eq 'auto') && ($user_lh ne '')) {
           $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
       } else {
           $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
       }
     if ($$courseid =~ /^error:/) {      if ($$courseid =~ /^error:/) {
         return (0,$outcome);          return (0,$outcome,$clonemsgref);
     }      }
   
 #  #
Line 15759  sub construct_course { Line 16960  sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);      ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);      my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {      if ($crsuhome eq 'no_host') {
         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;          if (($callercontext eq 'auto') && ($user_lh ne '')) {
         return (0,$outcome);              $outcome .= &mt_user($user_lh,
                               'Course creation failed, unrecognized course home server.');
           } else {
               $outcome .= &mt('Course creation failed, unrecognized course home server.');
           }
           $outcome .= $linefeed;
           return (0,$outcome,$clonemsgref);
     }      }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;      $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
   
 #  #
 # Do the cloning  # Do the cloning
 #     #   
       my @clonemsg;
     if ($can_clone && $cloneid) {      if ($can_clone && $cloneid) {
  $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);          push(@clonemsg,
  if ($context ne 'auto') {                        {
     $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';                            mt => 'Created [_1] by cloning from [_2]',
  }                            args => [$showncrstype,$clonetitle],
  $outcome .= $clonemsg.$linefeed;                        });
  my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);   my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # Copy all files  # Copy all files
  &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});          my @info =
       &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
                                                $args->{'dateshift'},$args->{'crscode'},
                                                        $args->{'ccuname'}.':'.$args->{'ccdomain'},
                                                        $args->{'tinyurls'});
           if (@info) {
               push(@clonemsg,@info);
           }
 # Restore URL  # Restore URL
  $cenv{'url'}=$oldcenv{'url'};   $cenv{'url'}=$oldcenv{'url'};
 # Restore title  # Restore title
Line 15800  sub construct_course { Line 17015  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 15816  sub construct_course { Line 17030  sub construct_course {
     if ($args->{'crstype'}) {      if ($args->{'crstype'}) {
         $cenv{'type'}=$args->{'crstype'};          $cenv{'type'}=$args->{'crstype'};
     }      }
       if ($args->{'lti'}) {
           $cenv{'internal.lti'}=$args->{'lti'};
       }
     if ($args->{'crsid'}) {      if ($args->{'crsid'}) {
         $cenv{'courseid'}=$args->{'crsid'};          $cenv{'courseid'}=$args->{'crsid'};
     }      }
Line 16042  sub construct_course { Line 17259  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
 #  #
     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')      unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
     || ($cloneid)) {      || ($cloneid)) {
  use LONCAPA::map;  
  $outcome .= &mt('Setting first resource').': ';   $outcome .= &mt('Setting first resource').': ';
   
  my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';   my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
Line 16101  sub construct_course { Line 17322  sub construct_course {
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum);                    ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
     }      }
   
     return (1,$outcome);      return (1,$outcome,\@clonemsg);
 }  }
   
 sub make_unique_code {  sub make_unique_code {
Line 16185  sub group_term { Line 17406  sub group_term {
 }  }
   
 sub course_types {  sub course_types {
     my @types = ('official','unofficial','community','textbook','placement');      my @types = ('official','unofficial','community','textbook','placement','lti');
     my %typename = (      my %typename = (
                          official   => 'Official course',                           official   => 'Official course',
                          unofficial => 'Unofficial course',                           unofficial => 'Unofficial course',
                          community  => 'Community',                           community  => 'Community',
                          textbook   => 'Textbook course',                           textbook   => 'Textbook course',
                          placement  => 'Placement test',                           placement  => 'Placement test',
                            lti        => 'LTI provider',
                    );                     );
     return (\@types,\%typename);      return (\@types,\%typename);
 }  }
Line 16271  sub compare_arrays { Line 17493  sub compare_arrays {
     return @difference;      return @difference;
 }  }
   
   sub lon_status_items {
       my %defaults = (
                        E         => 100,
                        W         => 4,
                        N         => 1,
                        U         => 5,
                        threshold => 200,
                        sysmail   => 2500,
                      );
       my %names = (
                      E => 'Errors',
                      W => 'Warnings',
                      N => 'Notices',
                      U => 'Unsent',
                   );
       return (\%defaults,\%names);
   }
   
 # -------------------------------------------------------- Initialize user login  # -------------------------------------------------------- Initialize user login
 sub init_user_environment {  sub init_user_environment {
     my ($r, $username, $domain, $authhost, $form, $args) = @_;      my ($r, $username, $domain, $authhost, $form, $args) = @_;
Line 16305  sub init_user_environment { Line 17545  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$/) {
                     if ($ENV{'SERVER_PORT'} == 443) {                      if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
                               &GDBM_READER(),0640)) {
                         my $linkedfile;                          my $linkedfile;
                         if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id",                          if (exists($oldenv{'user.linkedenv'})) {
                                 &GDBM_READER(),0640)) {                              $linkedfile = $oldenv{'user.linkedenv'};
                             if (exists($oldenv{'user.linkedenv'})) {  
                                 $linkedfile = $oldenv{'user.linkedenv'};  
                             }  
                             untie(%oldenv);  
                         }                          }
                         if (unlink($lonids.'/'.$filename)) {                          untie(%oldenv);
                             if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) {                          if (unlink("$lonids/$filename")) {
                                 unlink($lonids.'/'.$linkedfile);                              if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                                   if (-l "$lonids/$linkedfile.id") {
                                       unlink("$lonids/$linkedfile.id");
                                   }
                             }                              }
                         }                          }
                     } else {                      } else {
Line 16371  sub init_user_environment { Line 17611  sub init_user_environment {
 # --------------------------------------------------------- Write first profile  # --------------------------------------------------------- Write first profile
   
     {      {
           my $ip = &Apache::lonnet::get_requestor_ip($r);
  my %initial_env =    my %initial_env = 
     ("user.name"          => $username,      ("user.name"          => $username,
      "user.domain"        => $domain,       "user.domain"        => $domain,
Line 16389  sub init_user_environment { Line 17630  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 16421  sub init_user_environment { Line 17662  sub init_user_environment {
             my %is_adv = ( is_adv => $env{'user.adv'} );              my %is_adv = ( is_adv => $env{'user.adv'} );
             my %domdef = &Apache::lonnet::get_domain_defaults($domain);              my %domdef = &Apache::lonnet::get_domain_defaults($domain);
   
             foreach my $tool ('aboutme','blog','webdav','portfolio') {              foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {
                 $userenv{'availabletools.'.$tool} =                   $userenv{'availabletools.'.$tool} = 
                     &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',                      &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                                                       undef,\%userenv,\%domdef,\%is_adv);                                                        undef,\%userenv,\%domdef,\%is_adv);
             }              }
   
             foreach my $crstype ('official','unofficial','community','textbook','placement') {              foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
                 $userenv{'canrequest.'.$crstype} =                  $userenv{'canrequest.'.$crstype} =
                     &Apache::lonnet::usertools_access($username,$domain,$crstype,                      &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                       'reload','requestcourses',                                                        'reload','requestcourses',
Line 17290  sub needs_coursereinit { Line 18531  sub needs_coursereinit {
     }      }
     if (($now-$env{'request.course.timechecked'})>$interval) {      if (($now-$env{'request.course.timechecked'})>$interval) {
         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});          &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
         my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);          my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
         if ($blocked) {          if ($blocked) {
             return ();              return ();
         }          }
         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);          my $update;
         if ($lastchange > $env{'request.course.tied'}) {          my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');          my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {          if ($lastmainchange > $env{'request.course.tied'}) {
                 my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};              my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                 if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {              if ($needswitch) {
                     &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>                  return ('switch',$switchwarning,$switchserver);
                                              $curr_reqd_hash{'internal.releaserequired'}});              }
                     my ($switchserver,$switchwarning) =              $update = 'main';
                         &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},          }
                                                 $curr_reqd_hash{'internal.releaserequired'});          if ($lastsuppchange > $env{'request.course.suppupdated'}) {
                     if ($switchwarning ne '' || $switchserver ne '') {              if ($update) {
                         return ('switch',$switchwarning,$switchserver);                  $update = 'both';
                     }              } else {
                   my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
                   if ($needswitch) {
                       return ('switch',$switchwarning,$switchserver);
                   } else {
                       $update = 'supp';
                 }                  }
             }              }
             return ('update');              return ($update);
           }
       }
       return ();
   }
   
   sub switch_for_update {
       my ($loncaparev,$cdom,$cnum) = @_;
       my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
       if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
           my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
           if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
               &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
                                       $curr_reqd_hash{'internal.releaserequired'}});
               my ($switchserver,$switchwarning) =
                   &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
                                           $curr_reqd_hash{'internal.releaserequired'});
               if ($switchwarning ne '' || $switchserver ne '') {
                   return ('switch',$switchwarning,$switchserver);
               }
         }          }
     }      }
     return ();      return ();
Line 17358  sub update_content_constraints { Line 18623  sub update_content_constraints {
             }              }
         }          }
         foreach my $key (keys(%allcrsrestypes)) {          foreach my $key (keys(%allcrsrestypes)) {
             my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});              my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {              if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                 ($reqdmajor,$reqdminor) = ($major,$minor);                  ($reqdmajor,$reqdminor) = ($major,$minor);
             }              }
         }          }
         undef($navmap);          undef($navmap);
     }      }
       if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
           my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
           if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
               ($reqdmajor,$reqdminor) = ($major,$minor);
           }
       }
     unless (($reqdmajor eq '') && ($reqdminor eq '')) {      unless (($reqdmajor eq '') && ($reqdminor eq '')) {
         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);          &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
     }      }
Line 17411  sub parse_supplemental_title { Line 18682  sub parse_supplemental_title {
         my $name =  &plainname($uname,$udom);          my $name =  &plainname($uname,$udom);
         $name = &HTML::Entities::encode($name,'"<>&\'');          $name = &HTML::Entities::encode($name,'"<>&\'');
         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');          $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.          $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
             $name.': <br />'.$foldertitle;          if ($foldertitle ne '') {
               $title .= ': <br />'.$foldertitle;
           }
     }      }
     if (wantarray) {      if (wantarray) {
         return ($title,$foldertitle,$renametitle);          return ($title,$foldertitle,$renametitle);
Line 17420  sub parse_supplemental_title { Line 18693  sub parse_supplemental_title {
     return $title;      return $title;
 }  }
   
   sub get_supplemental {
       my ($cnum,$cdom,$ignorecache,$possdel)=@_;
       my $hashid=$cnum.':'.$cdom;
       my ($supplemental,$cached,$set_httprefs);
       unless ($ignorecache) {
           ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
       }
       unless (defined($cached)) {
           my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
           unless ($chome eq 'no_host') {
               my @order = @LONCAPA::map::order;
               my @resources = @LONCAPA::map::resources;
               my @resparms = @LONCAPA::map::resparms;
               my @zombies = @LONCAPA::map::zombies;
               my ($errors,%ids,%hidden);
               $errors =
                   &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
                                         $errors,$possdel,\%ids,\%hidden);
               @LONCAPA::map::order = @order;
               @LONCAPA::map::resources = @resources;
               @LONCAPA::map::resparms = @resparms;
               @LONCAPA::map::zombies = @zombies;
               $set_httprefs = 1;
               if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   &Apache::lonnet::appenv({'request.course.suppupdated' => time});
               }
               $supplemental = {
                                  ids => \%ids,
                                  hidden => \%hidden,
                               };
               &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
           }
       }
       return ($supplemental,$set_httprefs);
   }
   
 sub recurse_supplemental {  sub recurse_supplemental {
     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;      my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
     if ($suppmap) {      if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
           my $mapnum;
           if ($suppmap eq 'supplemental.sequence') {
               $mapnum = 0;
           } else {
               ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
           }
         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);          my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
         if ($fatal) {          if ($fatal) {
             $errors ++;              $errors ++;
         } else {          } else {
             if ($#LONCAPA::map::resources > 0) {              my @order = @LONCAPA::map::order;
                 foreach my $res (@LONCAPA::map::resources) {              if (@order > 0) {
                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);                  my @resources = @LONCAPA::map::resources;
                   my @resparms = @LONCAPA::map::resparms;
                   foreach my $idx (@order) {
                       my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
                     if (($src ne '') && ($status eq 'res')) {                      if (($src ne '') && ($status eq 'res')) {
                           my $id = $mapnum.':'.$idx;
                           push(@{$suppids->{$src}},$id);
                           if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
                               $hiddensupp->{$id} = 1;
                           }
                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {                          if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);                              $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
                                                               $hiddensupp,$hiddensupp->{$id});
                         } else {                          } else {
                             $numfiles ++;                              my $allowed;
                               if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
                                   $allowed = 1;
                               } elsif ($possdel) {
                                   foreach my $item (@{$suppids->{$src}}) {
                                       next if ($item eq $id);
                                       unless ($hiddensupp->{$item}) {
                                          $allowed = 1;
                                          last;
                                       }
                                   }
                                   if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
                                       &Apache::lonnet::delenv('httpref.'.$src);
                                   }
                               }
                               if ($allowed && (!exists($env{'httpref.'.$src}))) {
                                   &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
                               }
                           }
                       }
                   }
               }
           }
       }
       return $errors;
   }
   
   sub set_supp_httprefs {
       my ($cnum,$cdom,$supplemental,$possdel) = @_;
       if (ref($supplemental) eq 'HASH') {
           if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
               foreach my $src (keys(%{$supplemental->{'ids'}})) {
                   next if ($src =~ /\.sequence$/);
                   if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
                       my $allowed;
                       if ($env{'request.role.adv'}) {
                           $allowed = 1;
                       } else {
                           foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
                               unless ($supplemental->{'hidden'}->{$id}) {
                                   $allowed = 1;
                                   last;
                               }
                           }
                       }
                       if (exists($env{'httpref.'.$src})) {
                           if ($possdel) {
                               unless ($allowed) {
                                   &Apache::lonnet::delenv('httpref.'.$src);
                               }
                         }                          }
                       } elsif ($allowed) {
                           &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
                     }                      }
                 }                  }
             }              }
               if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                   &Apache::lonnet::appenv({'request.course.suppupdated' => time});
               }
           }
       }
   }
   
   sub get_supp_parameter {
       my ($resparm,$name)=@_;
       return if ($resparm eq '');
       my $value=undef;
       my $ptype=undef;
       foreach (split('&&&',$resparm)) {
           my ($thistype,$thisname,$thisvalue)=split('___',$_);
           if ($thisname eq $name) {
               $value=$thisvalue;
               $ptype=$thistype;
         }          }
     }      }
     return ($numfiles,$errors);      return $value;
 }  }
   
 sub symb_to_docspath {  sub symb_to_docspath {
Line 17514  sub symb_to_docspath { Line 18906  sub symb_to_docspath {
     return $path;      return $path;
 }  }
   
   sub validate_folderpath {
       my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
       if ($env{'form.folderpath'} ne '') {
           my @items = split(/\&/,$env{'form.folderpath'});
           my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
           for (my $i=0; $i<@items; $i++) {
               my $odd = $i%2;
               if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
                   $badpath = 1;
               } elsif ($odd && $supplementalflag) {
                   my $idx = $i-1;
                   if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
                       my $esc_name = $1;
                       if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
                           $supppath .= '&'.$esc_name;
                           $changed = 1;
                       } else {
                           $supppath .= '&'.$items[$i];
                       }
                   } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
                       $changed = 1;
                       my $is_hidden;
                       unless ($got_supp) {
                           my ($supplemental) = &get_supplemental($coursenum,$coursedom);
                           if (ref($supplemental) eq 'HASH') {
                               if (ref($supplemental->{'hidden'}) eq 'HASH') {
                                   %supphidden = %{$supplemental->{'hidden'}};
                               }
                               if (ref($supplemental->{'ids'}) eq 'HASH') {
                                   %suppids = %{$supplemental->{'ids'}};
                               }
                           }
                           $got_supp = 1;
                       }
                       if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
                           my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
                           if ($supphidden{$mapid}) {
                               $is_hidden = 1;
                           }
                       }
                       $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
                   } else {
                       $supppath .= '&'.$items[$i];
                   }
               } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
                   $badpath = 1;
               } elsif ($supplementalflag) {
                   $supppath .= '&'.$items[$i];
               }
               last if ($badpath);
           }
           if ($badpath) {
               delete($env{'form.folderpath'});
           } elsif ($changed && $supplementalflag) {
               $supppath =~ s/^\&//;
               $env{'form.folderpath'} = $supppath;
           }
       }
       return;
   }
   
 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 17534  sub captcha_display { Line 18987  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 17548  sub captcha_response { Line 19001  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 17596  sub get_captcha_config { Line 19049  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 17613  sub create_captcha { Line 19087  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="new-password" />'.
                       '<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 17658  sub check_captcha { Line 19136  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 17676  sub create_recaptcha { Line 19155  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 %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 $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');          my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
         $request->content(join('&',map {          $request->content(join('&',map {
Line 17703  sub check_recaptcha { Line 19183  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 17755  sub cleanup_html { Line 19235  sub cleanup_html {
 # $context is the calling context -- roles, grades, contents, menu or flip.   # $context is the calling context -- roles, grades, contents, menu or flip. 
 sub critical_redirect {  sub critical_redirect {
     my ($interval,$context) = @_;      my ($interval,$context) = @_;
       unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
           return ();
       }
     if ((time-$env{'user.criticalcheck.time'})>$interval) {      if ((time-$env{'user.criticalcheck.time'})>$interval) {
         if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {          if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
             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('alert',$cnum,$cdom,undef,1);              my $blocked = &blocking_status('alert',undef,$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 17776  sub critical_redirect { Line 19259  sub critical_redirect {
         &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);
Line 17836  sub des_decrypt { Line 19319  sub des_decrypt {
     return $plaintext;      return $plaintext;
 }  }
   
   sub get_requested_shorturls {
       my ($cdom,$cnum,$navmap) = @_;
       return unless (ref($navmap));
       my ($numnew,$errors);
       my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
       if (@toshorten) {
           my (%maps,%resources,%titles);
           &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                  'shorturls',$cdom,$cnum);
           if (keys(%resources)) {
               my %tocreate;
               foreach my $item (sort {$a <=> $b} (@toshorten)) {
                   my $symb = $resources{$item};
                   if ($symb) {
                       $tocreate{$cnum.'&'.$symb} = 1;
                   }
               }
               if (keys(%tocreate)) {
                   ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
                                                         \%tocreate);
               }
           }
       }
       return ($numnew,$errors);
   }
   
   sub make_short_symbs {
       my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
       my ($numnew,@errors);
       if (ref($tocreateref) eq 'HASH') {
           my %tocreate = %{$tocreateref};
           if (keys(%tocreate)) {
               my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
               my $su = Short::URL->new(no_vowels => 1);
               my $init = '';
               my (%newunique,%addcourse,%courseonly,%failed);
               # get lock on tiny db
               my $now = time;
               if ($lockuser eq '') {
                   $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
               }
               my $lockhash = {
                                   "lock\0$now" => $lockuser,
                               };
               my $tries = 0;
               my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
               my ($code,$error);
               while (($gotlock ne 'ok') && ($tries<3)) {
                   $tries ++;
                   sleep 1;
                   $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
               }
               if ($gotlock eq 'ok') {
                   $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
                                          \%addcourse,\%courseonly,\%failed);
                   if (keys(%failed)) {
                       my $numfailed = scalar(keys(%failed));
                       push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
                   }
                   if (keys(%newunique)) {
                       my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
                       if ($putres eq 'ok') {
                           $numnew = scalar(keys(%newunique));
                           my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
                           unless ($newputres eq 'ok') {
                               push(@errors,&mt('error: could not store course look-up of short URLs'));
                           }
                       } else {
                           push(@errors,&mt('error: could not store unique six character URLs'));
                       }
                   }
                   my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
                   unless ($dellockres eq 'ok') {
                       push(@errors,&mt('error: could not release lockfile'));
                   }
               } else {
                   push(@errors,&mt('error: could not obtain lockfile'));
               }
               if (keys(%courseonly)) {
                   my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
                   if ($result ne 'ok') {
                       push(@errors,&mt('error: could not update course look-up of short URLs'));
                   }
               }
           }
       }
       return ($numnew,\@errors);
   }
   
   sub shorten_symbs {
       my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
       return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
                      (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
                      (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
       my (%possibles,%collisions);
       foreach my $key (keys(%{$tocreate})) {
           my $num = String::CRC32::crc32($key);
           my $tiny = $su->encode($num,$init);
           if ($tiny) {
               $possibles{$tiny} = $key;
           }
       }
       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 ($init <5) {
               if (!$init) {
                   $init = 1;
               } else {
                   $init ++;
               }
               $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
                                      $newunique,$addcourse,$courseonly,$failed);
           } else {
               foreach my $key (keys(%collisions)) {
                   $failed->{$key} = 1;
               }
           }
       }
       return $init;
   }
   
   sub is_nonframeable {
       my ($url,$absolute,$hostname,$ip,$nocache) = @_;
       my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
       return if (($remprotocol eq '') || ($remhost eq ''));
   
       $remprotocol = lc($remprotocol);
       $remhost = lc($remhost);
       my $remport = 80;
       if ($remprotocol eq 'https') {
           $remport = 443;
       }
       my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
       if ($cached) {
           unless ($nocache) {
               if ($result) {
                   return 1;
               } else {
                   return 0;
               }
           }
       }
       my $uselink;
       my $request = new HTTP::Request('HEAD',$url);
       my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
       if ($response->is_success()) {
           my $secpolicy = lc($response->header('content-security-policy'));
           my $xframeop = lc($response->header('x-frame-options'));
           $secpolicy =~ s/^\s+|\s+$//g;
           $xframeop =~ s/^\s+|\s+$//g;
           if (($secpolicy ne '') || ($xframeop ne '')) {
               my $remotehost = $remprotocol.'://'.$remhost;
               my ($origin,$protocol,$port);
               if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                   $port = $ENV{'SERVER_PORT'};
               } else {
                   $port = 80;
               }
               if ($absolute eq '') {
                   $protocol = 'http:';
                   if ($port == 443) {
                       $protocol = 'https:';
                   }
                   $origin = $protocol.'//'.lc($hostname);
               } else {
                   $origin = lc($absolute);
                   ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
               }
               if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
                   my $framepolicy = $1;
                   $framepolicy =~ s/^\s+|\s+$//g;
                   my @policies = split(/\s+/,$framepolicy);
                   if (@policies) {
                       if (grep(/^\Q'none'\E$/,@policies)) {
                           $uselink = 1;
                       } else {
                           $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;
                   my @policies = split(/\s*,\s*/,$xframeop);
                   if (@policies) {
                       unless (grep(/^deny$/,@policies)) {
                           if ($origin ne '') {
                               if (grep(/^sameorigin$/,@policies)) {
                                   if ($remotehost eq $origin) {
                                       undef($uselink);
                                   }
                               }
                               if ($uselink) {
                                   foreach my $policy (@policies) {
                                       if ($policy =~ /^allow-from\s*(.+)$/) {
                                           my $allowfrom = $1;
                                           if (($allowfrom ne '') && ($allowfrom eq $origin)) {
                                               undef($uselink);
                                               last;
                                           }
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       if ($nocache) {
           if ($cached) {
               my $devalidate;
               if ($uselink && !$result) {
                   $devalidate = 1;
               } elsif (!$uselink && $result) {
                   $devalidate = 1;
               }
               if ($devalidate) {
                   &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
               }
           }
       } else {
           if ($uselink) {
               $result = 1;
           } else {
               $result = 0;
           }
           &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
       }
       return $uselink;
   }
   
   sub page_menu {
       my ($menucolls,$menunum) = @_;
       my %menu;
       foreach my $item (split(/;/,$menucolls)) {
           my ($num,$value) = split(/\%/,$item);
           if ($num eq $menunum) {
               my @entries = split(/\&/,$value);
               foreach my $entry (@entries) {
                   my ($name,$fields) = split(/=/,$entry);
                   if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
                       $menu{$name} = $fields;
                   } else {
                       my @shown;
                       if ($fields =~ /,/) {
                           @shown = split(/,/,$fields);
                       } else {
                           @shown = ($fields);
                       }
                       if (@shown) {
                           foreach my $field (@shown) {
                               next if ($field eq '');
                               $menu{$field} = 1;
                           }
                       }
                   }
               }
           }
       }
       return %menu;
   }
   
 1;  1;
 __END__;  __END__;
   
Removed from v.1.1307  
changed lines
  Added in v.1.1411

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