--- loncom/interface/loncommon.pm	2017/08/07 20:22:13	1.1287
+++ loncom/interface/loncommon.pm	2020/09/28 00:10:28	1.1347
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1287 2017/08/07 20:22:13 raeburn Exp $
+# $Id: loncommon.pm,v 1.1347 2020/09/28 00:10:28 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -72,6 +72,7 @@ use Apache::lonuserstate();
 use Apache::courseclassifier();
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::LWPReq;
+use HTTP::Request;
 use DateTime::TimeZone;
 use DateTime::Locale;
 use Encode();
@@ -79,11 +80,14 @@ use Text::Aspell;
 use Authen::Captcha;
 use Captcha::reCAPTCHA;
 use JSON::DWIW;
-use LWP::UserAgent;
 use Crypt::DES;
 use DynaLoader; # for Crypt::DES version
 use MIME::Lite;
 use MIME::Types;
+use File::Copy();
+use File::Path();
+use String::CRC32();
+use Short::URL();
 
 # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);
@@ -199,7 +203,7 @@ BEGIN {
     {
         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                    '/language.tab';
-        if ( open(my $fh,"<$langtabfile") ) {
+        if ( open(my $fh,'<',$langtabfile) ) {
             while (my $line = <$fh>) {
                 next if ($line=~/^\#/);
                 chomp($line);
@@ -221,7 +225,7 @@ BEGIN {
     {
         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/copyright.tab';
-        if ( open (my $fh,"<$copyrightfile") ) {
+        if ( open (my $fh,'<',$copyrightfile) ) {
             while (my $line = <$fh>) {
                 next if ($line=~/^\#/);
                 chomp($line);
@@ -235,7 +239,7 @@ BEGIN {
     {
         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                   '/source_copyright.tab';
-        if ( open (my $fh,"<$sourcecopyrightfile") ) {
+        if ( open (my $fh,'<',$sourcecopyrightfile) ) {
             while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);
                 chomp($line);
@@ -249,7 +253,7 @@ BEGIN {
 # -------------------------------------------------------------- default domain designs
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile = $designdir.'/default.tab';
-    if ( open (my $fh,"<$designfile") ) {
+    if ( open (my $fh,'<',$designfile) ) {
         while (my $line = <$fh>) {
             next if ($line =~ /^\#/);
             chomp($line);
@@ -263,7 +267,7 @@ BEGIN {
     {
         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                                   '/filecategories.tab';
-        if ( open (my $fh,"<$categoryfile") ) {
+        if ( open (my $fh,'<',$categoryfile) ) {
 	    while (my $line = <$fh>) {
 		next if ($line =~ /^\#/);
 		chomp($line);
@@ -278,7 +282,7 @@ BEGIN {
     {
         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                '/filetypes.tab';
-        if ( open (my $fh,"<$typesfile") ) {
+        if ( open (my $fh,'<',$typesfile) ) {
             while (my $line = <$fh>) {
 		next if ($line =~ /^\#/);
 		chomp($line);
@@ -431,7 +435,7 @@ sub studentbrowser_javascript {
 <script type="text/javascript" language="Javascript">
 // <![CDATA[
     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 filter;
 	if (!ignorefilter) {
@@ -446,7 +450,12 @@ sub studentbrowser_javascript {
                                     '&udomelement='+udom+
                                     '&clicker='+clicker;
 	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 options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';
@@ -478,7 +487,7 @@ ENDRESBRW
 }
 
 sub selectstudent_link {
-   my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
+   my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
@@ -489,8 +498,12 @@ sub selectstudent_link {
 	   return '';
        }
        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
-       if ($courseadvonly)  {
-           $callargs .= ",'',1,1";
+       if ($courseadv eq 'only') {
+           $callargs .= ",'',1,'$courseadv'";
+       } elsif ($courseadv eq 'none') {
+           $callargs .= ",'','','$courseadv'";
+       } elsif ($courseadv eq 'condition') {
+           $callargs .= ",'','','$courseadv'";
        }
        return '<span class="LC_nobreak">'.
               '<a href="javascript:openstdbrowser('.$callargs.');">'.
@@ -1293,9 +1306,13 @@ sub help_open_topic {
     }
 
     # Add the text
+    my $target = ' target="_top"';
+    if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
+        $target = '';
+    }
     if ($text ne "") {	
 	$template.='<span class="LC_help_open_topic">'
-                  .'<a target="_top" href="'.$link.'">'
+                  .'<a'.$target.' href="'.$link.'">'
                   .$text.'</a>';
     }
 
@@ -1305,7 +1322,7 @@ sub help_open_topic {
     if ($imgid ne '') {
         $imgid = ' id="'.$imgid.'"';
     }
-    $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
+    $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
               .'<img src="'.$helpicon.'" border="0"'
               .' alt="'.&mt('Help: [_1]',$topic).'"'
               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
@@ -1498,19 +1515,24 @@ sub help_open_bug {
     {
 	$link = $url;
     }
+
+    my $target = ' target="_top"';
+    if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
+        $target = '';
+    }
     # Add the text
     if ($text ne "")
     {
 	$template .= 
   "<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." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
     }
 
     # Add the graphic
     my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";
- <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
+ <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };
     return $template;
@@ -2221,6 +2243,7 @@ sub import_crsauthor_form {
                 }
                 my @ordered = ();
                 foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
+                    next if ($file =~ /\.rights$/);
                     if ($only) {
                         my ($ext) = ($file =~ /\.([^.]+)$/);
                         unless ($possexts{lc($ext)}) {
@@ -2264,11 +2287,13 @@ sub import_crsauthor_form {
                 unless ($possexts{lc($ext)}) {
                     next;
                 }
+            } else {
+                next if ($file =~ /\.rights$/);
             }
             push(@singledirfiles,$file);
         }
         if (@singledirfiles) {
-            $possdirs == 1;
+            $possdirs = 1;
         }
     }
     if (($possdirs == 1) && (@singledirfiles)) {
@@ -2477,10 +2502,24 @@ sub create_text_file {
 # ------------------------------------------
 
 sub domain_select {
-    my ($name,$value,$multiple)=@_;
+    my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
+    my @possdoms;
+    if (ref($incdoms) eq 'ARRAY') {
+        @possdoms = @{$incdoms};
+    } else {
+        @possdoms = &Apache::lonnet::all_domains();
+    }
+
     my %domains=map { 
 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
-    } &Apache::lonnet::all_domains();
+    } @possdoms;
+
+    if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
+        foreach my $dom (@{$excdoms}) {
+            delete($domains{$dom});
+        }
+    }
+
     if ($multiple) {
 	$domains{''}=&mt('Any domain');
 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
@@ -3009,6 +3048,8 @@ This is not an optimal method, but it wo
 
 =item * authform_filesystem
 
+=item * authform_lti
+
 =back
 
 See loncreateuser.pm for invocation and use examples.
@@ -3425,14 +3466,69 @@ sub authform_filesystem {
                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                     $jscall.'"'.$disabled.' />';
     }
-    $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
+    $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
                ' onchange="'.$jscall.'"'.$disabled.' />';
     $result = &mt
         ('[_1] Filesystem Authenticated (with initial password [_2])',
-         '<label><input type="radio" name="login" value="fsys" '.
-         $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
-         '</label><input type="password" size="10" name="fsysarg" value="" '.
-                  'onchange="'.$jscall.'"'.$disabled.' />');
+         '<label>'.$authtype,'</label>'.$autharg);
+    return $result;
+}
+
+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;
 }
 
@@ -3446,6 +3542,7 @@ sub get_assignable_auth {
                           krb5 => 1,
                           int  => 1,
                           loc  => 1,
+                          lti  => 1,
                      );
     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
     if (ref($domconfig{'usercreation'}) eq 'HASH') {
@@ -3478,6 +3575,79 @@ sub get_assignable_auth {
     return ($authnum,%can_assign);
 }
 
+sub check_passwd_rules {
+    my ($domain,$plainpass) = @_;
+    my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
+    my ($min,$max,@chars,@brokerule,$warning);
+    $min = $Apache::lonnet::passwdmin;
+    if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+        if ($passwdconf{'min'} =~ /^\d+$/) {
+            if ($passwdconf{'min'} > $min) {
+                $min = $passwdconf{'min'};
+            }
+        }
+        if ($passwdconf{'max'} =~ /^\d+$/) {
+            $max = $passwdconf{'max'};
+        }
+        @chars = @{$passwdconf{'chars'}};
+    }
+    if (($min) && (length($plainpass) < $min)) {
+        push(@brokerule,'min');
+    }
+    if (($max) && (length($plainpass) > $max)) {
+        push(@brokerule,'max');
+    }
+    if (@chars) {
+        my %rules;
+        map { $rules{$_} = 1; } @chars;
+        if ($rules{'uc'}) {
+            unless ($plainpass =~ /[A-Z]/) {
+                push(@brokerule,'uc');
+            }
+        }
+        if ($rules{'lc'}) {
+            unless ($plainpass =~ /[a-z]/) {
+                push(@brokerule,'lc');
+            }
+        }
+        if ($rules{'num'}) {
+            unless ($plainpass =~ /\d/) {
+                push(@brokerule,'num');
+            }
+        }
+        if ($rules{'spec'}) {
+            unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
+                push(@brokerule,'spec');
+            }
+        }
+    }
+    if (@brokerule) {
+        my %rulenames = &Apache::lonlocal::texthash(
+            uc   => 'At least one upper case letter',
+            lc   => 'At least one lower case letter',
+            num  => 'At least one number',
+            spec => 'At least one non-alphanumeric',
+        );
+        $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+        $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
+        $rulenames{'num'} .= ': 0123456789';
+        $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
+        $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
+        $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
+        $warning = &mt('Password did not satisfy the following:').'<ul>';
+        foreach my $rule ('min','max','uc','lc','num','spec') {
+            if (grep(/^$rule$/,@brokerule)) {
+                $warning .= '<li>'.$rulenames{$rule}.'</li>';
+            }
+        }
+        $warning .= '</ul>';
+    }
+    if (wantarray) {
+        return @brokerule;
+    }
+    return $warning;
+}
+
 ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################
@@ -4563,9 +4733,15 @@ sub get_previous_attempt {
       }
       $prevattempts.= &end_data_table_row().&end_data_table();
     } else {
+      my $msg;
+      if ($symb =~ /ext\.tool$/) {
+          $msg = &mt('No grade passed back.');
+      } else {
+          $msg = &mt('Nothing submitted - no attempts.');
+      }
       $prevattempts=
 	  &start_data_table().&start_data_table_row().
-	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
+	  '<td>'.$msg.'</td>'.
 	  &end_data_table_row().&end_data_table();
     }
   } else {
@@ -4670,6 +4846,9 @@ sub get_student_view {
   }
   if (defined($target)) { $form{'grade_target'} = $target; }
   $feedurl=&Apache::lonnet::clutter($feedurl);
+  if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
+      $feedurl =~ s{^/adm/wrapper}{};
+  }
   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;
@@ -4969,13 +5148,13 @@ sub findallcourses {
 ###############################################
 
 sub blockcheck {
-    my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
+    my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
 
     if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.
         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
             my ($startblock,$endblock,$triggerblock) =
-                &get_blocks($setters,$activity,$udom,$uname,$url);
+                &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
             return ($startblock,$endblock,$triggerblock);
         }
     } else {
@@ -4993,7 +5172,8 @@ sub blockcheck {
 
     if (($activity eq 'boards' || $activity eq 'chat' ||
          $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'})) {
         foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {
@@ -5099,11 +5279,11 @@ sub blockcheck {
                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
         next if ($no_userblock);
 
-        # Retrieve blocking times and identity of locker for course
+        # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.
 
         my ($start,$end,$trigger) = 
-            &get_blocks($setters,$activity,$cdom,$cnum,$url);
+            &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
         if (($start != 0) && 
             (($startblock == 0) || ($startblock > $start))) {
             $startblock = $start;
@@ -5123,7 +5303,7 @@ sub blockcheck {
 }
 
 sub get_blocks {
-    my ($setters,$activity,$cdom,$cnum,$url) = @_;
+    my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
     my $startblock = 0;
     my $endblock = 0;
     my $triggerblock = '';
@@ -5136,7 +5316,12 @@ sub get_blocks {
     my $now = time;
     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
     if ($activity eq 'docs') {
-        @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
+        my ($blocked,$nosymbcache);
+        if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
+            $blocked = 1;
+            $nosymbcache = 1;
+        }
+        @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$blocked,\%commblocks);
         foreach my $block (@blockers) {
             if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;
@@ -5264,12 +5449,12 @@ sub parse_block_record {
 }
 
 sub blocking_status {
-    my ($activity,$uname,$udom,$url,$is_course) = @_;
+    my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
     my %setters;
 
 # check for active blocking
     my ($startblock,$endblock,$triggerblock) = 
-        &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
+        &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
     my $blocked = 0;
     if ($startblock && $endblock) {
         $blocked = 1;
@@ -5285,7 +5470,12 @@ sub blocking_status {
         $querystring .= "&amp;udom=$udom"      if ($udom =~ /^$match_domain$/); 
         $querystring .= "&amp;uname=$uname"    if ($uname =~ /^$match_username$/);
     } 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';
@@ -5310,6 +5500,10 @@ END_MYBLOCK
         $text = &mt('Printing Blocked');
     } elsif ($activity eq 'passwd') {
         $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') {
         $text = &mt('Checking Critical Messages Blocked');
     } elsif ($activity eq 'reinit') {
@@ -5337,8 +5531,13 @@ sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;
     }
-    my $allowed;
-    my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
+    my ($ip,$allowed);
+    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 {
+        $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
+    }
 
     my $name;
     my %access = (
@@ -5553,7 +5752,7 @@ sub get_legacy_domconf {
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     my $designfile =  $designdir.'/'.$udom.'.tab';
     if (-e $designfile) {
-        if ( open (my $fh,"<$designfile") ) {
+        if ( open (my $fh,'<',$designfile) ) {
             while (my $line = <$fh>) {
                 next if ($line =~ /^\#/);
                 chomp($line);
@@ -5752,13 +5951,18 @@ sub CSTR_pageheader {
         $title = &mt('Authoring Space');
     }
 
+    my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
+    if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
+        $target = '';
+        $crumbtarget = '';
+    }
+
     my $output =
          '<div>'
         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
         .'<b>'.$title.'</b> '
-        .'<form name="dirs" method="post" action="'.$formaction
-        .'" target="_top">' #FIXME lonpubdir: target="_parent"
-        .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
+        .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
+        .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
 
     if ($lastitem) {
         $output .=
@@ -5772,7 +5976,7 @@ sub CSTR_pageheader {
     } else {
         $output .=
              '<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()')
             .'</form>'
             .&Apache::lonmenu::constspaceform();
@@ -5830,6 +6034,19 @@ Inputs:
             inlineremote items to be added in "Functions" menu below
             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.
+
 =back
 
 Returns: A uniform header for LON-CAPA web pages.  
@@ -5841,7 +6058,7 @@ other decorations will be returned.
 
 sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
-        $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
+        $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
 
     my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -5912,7 +6129,18 @@ sub bodytag {
     if ($public) {
 	undef($role);
     }
-    
+
+    if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
+        if (ref($ltimenu) eq 'HASH') {
+            unless ($ltimenu->{'role'}) {
+                undef($role);
+            }
+            unless ($ltimenu->{'coursetitle'}) {
+                $realm='&nbsp;';
+            }
+        }
+    }
+
     my $titleinfo = '<h1>'.$title.'</h1>';
     #
     # Extra info if you are the DC
@@ -5946,27 +6174,29 @@ sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(
             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);
 
-        if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
-             if ($dc_info) {
-                 $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
-             }
-             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
-                <em>$realm</em> $dc_info</div>|;
-            return $bodytag;
-        }
+            if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
+                if ($dc_info) {
+                    $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
+                }
+                $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
+                               <em>$realm</em> $dc_info</div>|;
+                return $bodytag;
+            }
 
-        unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
-            $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
-        }
+            unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
+                $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
+            }
 
-        $bodytag .= $right;
+            $bodytag .= $right;
 
-        if ($dc_info) {
-            $dc_info = &dc_courseid_toggle($dc_info);
+            if ($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 ($args->{'no_secondary_menu'}) {
@@ -5974,17 +6204,20 @@ sub bodytag {
         }
         #don't show menus for public users
         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'});
+            }
             $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
-                                $args->{'bread_crumbs'},'','',$hostname);
+                                $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
             } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},
                                                             $args->{'hide_buttons'},
-                                                            $hostname);
+                                                            $hostname,$ltiscope,$ltiuri);
             } else {
                 $bodytag .= 
                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
@@ -7053,7 +7286,8 @@ table.LC_prior_tries td {
   padding: 6px;
 }
 
-.LC_answer_unknown {
+.LC_answer_unknown,
+.LC_answer_warning {
   background: orange;
   color: black;
   padding: 6px;
@@ -8049,6 +8283,14 @@ ul.LC_funclist li {
 		cursor:pointer;
 }
 
+pre.LC_wordwrap {
+  white-space: pre-wrap;
+  white-space: -moz-pre-wrap;
+  white-space: -pre-wrap;
+  white-space: -o-pre-wrap;
+  word-wrap: break-word;
+}
+
 /*
   styles used for response display
 */
@@ -8299,43 +8541,85 @@ ADDMETA
                 my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
                 unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
                     my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
+                    my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+                    my $offload;
                     if (ref($domdefs{'offloadnow'}) eq 'HASH') {
-                        my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
                         if ($domdefs{'offloadnow'}{$lonhost}) {
-                            my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$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;
+                            $offload = 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;
+                                        $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".
-                                           &mt('your session will be transferred to a different server, after you click "Roles".');
+                            }
+                        }
+                    }
+                    if ($offload) {
+                        my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$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 {
-                                    if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
-                                        $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
-                                    }
-                                    $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'};
+                                    $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
+                                }
+                            } else {
+                                if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
+                                    $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
+                                }
+                                $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'}) {
-                                        $newurl .= '&symb='.$env{'request.symb'};
-                                    } else {
-                                        $newurl .= '&origurl='.$requrl;
+                                    if ($shownsymb) {
+                                        &js_escape(\$shownsymb);
+                                        $newurl .= '&symb='.$shownsymb;
                                     }
+                                } 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" />
 <script type="text/javascript">
 // <![CDATA[
@@ -8356,7 +8640,6 @@ function LC_Offload_Now() {
 // ]]>
 </script>
 OFFLOAD
-                            }
                         }
                     }
                 }
@@ -8586,11 +8869,42 @@ sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
 
     $env{'internal.start_page'}++;
-    my ($result,@advtools);
+    my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
 
     if (! exists($args->{'skip_phases'}{'head'}) ) {
         $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'});
+    }
     
     if (! exists($args->{'skip_phases'}{'body'}) ) {
 	if ($args->{'frameset'}) {
@@ -8604,7 +8918,7 @@ sub start_page {
                          $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args,
-                         \@advtools);
+                         \@advtools,$ltiscope,$ltiuri,\%ltimenu);
         }
     }
 
@@ -8640,6 +8954,7 @@ sub start_page {
                 my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
                 if ((exists($args->{'bread_crumbs_nomenu'})) ||
+                     ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
                      ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
                      ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
                      (!$env{'request.role.adv'}))) {
@@ -8773,8 +9088,7 @@ sub modal_link {
         $target_attr = 'target="'.$target.'"';
     }
     return <<"ENDLINK";
-<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
-           $linktext</a>
+<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
 ENDLINK
 }
 
@@ -8877,8 +9191,9 @@ sub end_togglebox {
 }
 
 sub LCprogressbar_script {
-   my ($id)=@_;
-   return(<<ENDPROGRESS);
+   my ($id,$number_to_do)=@_;
+   if ($number_to_do) {
+       return(<<ENDPROGRESS);
 <script type="text/javascript">
 // <![CDATA[
 \$('#progressbar$id').progressbar({
@@ -8891,21 +9206,43 @@ sub LCprogressbar_script {
 // ]]>
 </script>
 ENDPROGRESS
+   } else {
+       return(<<ENDPROGRESS);
+<script type="text/javascript">
+// <![CDATA[
+\$('#progressbar$id').progressbar({
+  value: false,
+  create: function(event, ui) {
+    \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
+    \$('.ui-progressbar-overlay', this).css({'margin':'0'});
+  }
+});
+// ]]>
+</script>
+ENDPROGRESS
+   }
 }
 
 sub LCprogressbarUpdate_script {
    return(<<ENDPROGRESSUPDATE);
 <style type="text/css">
 .ui-progressbar { position:relative; }
+.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
 .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
 </style>
 <script type="text/javascript">
 // <![CDATA[
 var LCprogressTxt='---';
 
-function LCupdateProgress(percent,progresstext,id) {
+function LCupdateProgress(percent,progresstext,id,maxnum) {
    LCprogressTxt=progresstext;
-   \$('#progressbar'+id).progressbar('value',percent);
+   if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
+       \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
+   } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
+       \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
+   } else {
+       \$('#progressbar'+id).progressbar('value',percent);
+   }
 }
 // ]]>
 </script>
@@ -8917,37 +9254,54 @@ my $LCidcnt;
 my $LCcurrentid;
 
 sub LCprogressbar {
-    my ($r)=(@_);
+    my ($r,$number_to_do,$preamble)=@_;
     $LClastpercent=0;
     $LCidcnt++;
     $LCcurrentid=$$.'_'.$LCidcnt;
-    my $starting=&mt('Starting');
-    my $content=(<<ENDPROGBAR);
+    my ($starting,$content);
+    if ($number_to_do) {
+        $starting=&mt('Starting');
+        $content=(<<ENDPROGBAR);
+$preamble
   <div id="progressbar$LCcurrentid">
     <span class="pblabel">$starting</span>
   </div>
 ENDPROGBAR
-    &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
+    } else {
+        $starting=&mt('Loading...');
+        $LClastpercent='false';
+        $content=(<<ENDPROGBAR);
+$preamble
+  <div id="progressbar$LCcurrentid">
+      <div class="progress-label">$starting</div>
+  </div>
+ENDPROGBAR
+    }
+    &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
 }
 
 sub LCprogressbarUpdate {
-    my ($r,$val,$text)=@_;
-    unless ($val) { 
-       if ($LClastpercent) {
-           $val=$LClastpercent;
-       } else {
-           $val=0;
-       }
+    my ($r,$val,$text,$number_to_do)=@_;
+    if ($number_to_do) {
+        unless ($val) { 
+            if ($LClastpercent) {
+                $val=$LClastpercent;
+            } else {
+                $val=0;
+            }
+        }
+        if ($val<0) { $val=0; }
+        if ($val>100) { $val=0; }
+        $LClastpercent=$val;
+        unless ($text) { $text=$val.'%'; }
+    } else {
+        $val = 'false';
     }
-    if ($val<0) { $val=0; }
-    if ($val>100) { $val=0; }
-    $LClastpercent=$val;
-    unless ($text) { $text=$val.'%'; }
     $text=&js_ready($text);
     &r_print($r,<<ENDUPDATE);
 <script type="text/javascript">
 // <![CDATA[
-LCupdateProgress($val,'$text','$LCcurrentid');
+LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
 // ]]>
 </script>
 ENDUPDATE
@@ -9132,14 +9486,21 @@ function expand_div(caller) {
 
 sub simple_error_page {
     my ($r,$title,$msg,$args) = @_;
+    my %displayargs;
     if (ref($args) eq 'HASH') {
         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
+        if ($args->{'only_body'}) {
+            $displayargs{'only_body'} = 1;
+        }
+        if ($args->{'no_nav_bar'}) {
+            $displayargs{'no_nav_bar'} = 1;
+        }
     } else {
         $msg = &mt($msg);
     }
 
     my $page =
-	&Apache::loncommon::start_page($title).
+	&Apache::loncommon::start_page($title,'',\%displayargs).
 	'<p class="LC_error">'.$msg.'</p>'.
 	&Apache::loncommon::end_page();
     if (ref($r)) {
@@ -10138,15 +10499,15 @@ sub user_picker {
         $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
     } else {
         my $defdom = $env{'request.role.domain'};
-        my ($trustedref,$untrustedref);
+        my ($trusted,$untrusted);
         if (($context eq 'requestcrs') || ($context eq 'course')) {
-            ($trustedref,$untrustedref) = &Apache::lonnet::trusted_domains('enroll',$defdom);
+            ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
         } elsif ($context eq 'author') {
-            ($trustedref,$untrustedref) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
+            ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
         } elsif ($context eq 'domain') {
-            ($trustedref,$untrustedref) = &Apache::lonnet::trusted_domains('domroles',$defdom);
+            ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
         }
-        $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trustedref,$untrustedref);
+        $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
     }
     my $srchinsel = ' <select name="srchin">';
 
@@ -11998,7 +12359,7 @@ sub modify_html_refs {
                 return;
             }
         } 
-        if (open(my $fh,"<$container")) {
+        if (open(my $fh,'<',$container)) {
             $content = join('', <$fh>);
             close($fh);
         } else {
@@ -12063,7 +12424,7 @@ sub modify_html_refs {
                         }
                     }
                 } else {
-                    if (open(my $fh,">$container")) {
+                    if (open(my $fh,'>',$container)) {
                         print $fh $content;
                         close($fh);
                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
@@ -12580,6 +12941,18 @@ sub decompress_uploaded_file {
 
 sub process_decompression {
     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
+    unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
+        return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
+               &mt('Unexpected file path.').'</p>'."\n";
+    }
+    unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
+        return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
+               &mt('Unexpected course context.').'</p>'."\n";
+    }
+    unless ($file eq &Apache::lonnet::clean_filename($file)) {
+        return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
+               &mt('Filename contained unexpected characters.').'</p>'."\n";
+    }
     my ($dir,$error,$warning,$output);
     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
         $error = &mt('Filename not a supported archive file type.').
@@ -12614,30 +12987,44 @@ sub process_decompression {
                 }
             }
             my $numskip = scalar(@to_skip);
-            if (($numskip > 0) && 
-                ($numskip == $env{'form.archive_itemcount'})) {
+            my $numoverwrite = scalar(@to_overwrite);
+            if (($numskip) && (!$numoverwrite)) { 
                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
             } elsif ($dir eq '') {
                 $error = &mt('Directory containing archive file unavailable.');
             } elsif (!$error) {
                 my ($decompressed,$display);
-                if ($numskip > 0) {
+                if (($numskip) || ($numoverwrite)) {
                     my $tempdir = time.'_'.$$.int(rand(10000));
                     mkdir("$dir/$tempdir",0755);
-                    system("mv $dir/$file $dir/$tempdir/$file");
-                    ($decompressed,$display) = 
-                        &decompress_uploaded_file($file,"$dir/$tempdir");
-                    foreach my $item (@to_skip) {
-                        if (($item ne '') && ($item !~ /\.\./)) {
-                            if (-f "$dir/$tempdir/$item") { 
-                                unlink("$dir/$tempdir/$item");
-                            } elsif (-d "$dir/$tempdir/$item") {
-                                system("rm -rf $dir/$tempdir/$item");
+                    if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
+                        ($decompressed,$display) = 
+                            &decompress_uploaded_file($file,"$dir/$tempdir");
+                        foreach my $item (@to_skip) {
+                            if (($item ne '') && ($item !~ /\.\./)) {
+                                if (-f "$dir/$tempdir/$item") { 
+                                    unlink("$dir/$tempdir/$item");
+                                } elsif (-d "$dir/$tempdir/$item") {
+                                    &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
+                                }
+                            }
+                        }
+                        foreach my $item (@to_overwrite) {
+                            if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
+                                if (($item ne '') && ($item !~ /\.\./)) {
+                                    if (-f "$dir/$item") {
+                                        unlink("$dir/$item");
+                                    } elsif (-d "$dir/$item") {
+                                        &File::Path::remove_tree("$dir/$item",{ safe => 1 });
+                                    }
+                                    &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
+                                }
                             }
                         }
+                        if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
+                            &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
+                        }
                     }
-                    system("mv $dir/$tempdir/* $dir");
-                    rmdir("$dir/$tempdir");   
                 } else {
                     ($decompressed,$display) = 
                         &decompress_uploaded_file($file,$dir);
@@ -12655,8 +13042,7 @@ sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
-                            unless (($item =~ /^\.+$/) || ($item eq $file) || 
-                                    ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
+                            unless (($item =~ /^\.+$/) || ($item eq $file)) {
                                 push(@newitems,$item);
                                 if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;
@@ -13141,7 +13527,7 @@ END
 sub process_extracted_files {
     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
     my $numitems = $env{'form.archive_count'};
-    return unless ($numitems);
+    return if ((!$numitems) || ($numitems =~ /\D/));
     my @ids=&Apache::lonnet::current_machine_ids();
     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
         %folders,%containers,%mapinner,%prompttofetch);
@@ -13154,7 +13540,7 @@ sub process_extracted_files {
     } else {
         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
-        $dir = "$dir_root/$docudom/$docuname";    
+        $dir = "$dir_root/$docudom/$docuname";
     }
     my $currdir = "$dir_root/$destination";
     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
@@ -13243,7 +13629,9 @@ sub process_extracted_files {
                                                         '.'.$containers{$outer},1,1);
                             $newseqid{$i} = $newidx;
                             unless ($errtext) {
-                                $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
+                                $result .=  '<li>'.&mt('Folder: [_1] added to course',
+                                                       &HTML::Entities::encode($docstitle,'<>&"')).
+                                            '</li>'."\n";
                             }
                         }
                     } else {
@@ -13252,38 +13640,47 @@ sub process_extracted_files {
                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                                       $title;
-                            if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
-                                mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
-                            }
-                            if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
-                                mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
-                            }
-                            if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
-                                system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
-                                $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
-                                unless ($ishome) {
-                                    my $fetch = "$newdest{$i}/$title";
-                                    $fetch =~ s/^\Q$prefix$dir\E//;
-                                    $prompttofetch{$fetch} = 1;
+                            if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
+                                if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
+                                    mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                                 }
-                            }
-                            $LONCAPA::map::resources[$newidx]=
-                                $docstitle.':'.$url.':false:normal:res';
-                            push(@LONCAPA::map::order, $newidx);
-                            my ($outtext,$errtext)=
-                                &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
-                                                        $docuname.'/'.$folders{$outer}.
-                                                        '.'.$containers{$outer},1,1);
-                            unless ($errtext) {
-                                if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
-                                    $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
+                                if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+                                    mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                                 }
+                                if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+                                    if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
+                                        $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+                                        unless ($ishome) {
+                                            my $fetch = "$newdest{$i}/$title";
+                                            $fetch =~ s/^\Q$prefix$dir\E//;
+                                            $prompttofetch{$fetch} = 1;
+                                        }
+                                    }
+                                }
+                                $LONCAPA::map::resources[$newidx]=
+                                    $docstitle.':'.$url.':false:normal:res';
+                                push(@LONCAPA::map::order, $newidx);
+                                my ($outtext,$errtext)=
+                                    &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
+                                                            $docuname.'/'.$folders{$outer}.
+                                                            '.'.$containers{$outer},1,1);
+                                unless ($errtext) {
+                                    if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+                                        $result .= '<li>'.&mt('File: [_1] added to course',
+                                                              &HTML::Entities::encode($docstitle,'<>&"')).
+                                                   '</li>'."\n";
+                                    }
+                                }
+                            } else {
+                                $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+                                                &HTML::Entities::encode($path,'<>&"')).'<br />';
                             }
                         }
                     }
                 }
             } else {
-                $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
+                $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+                                &HTML::Entities::encode($path,'<>&"')).'<br />'; 
             }
         }
         for (my $i=1; $i<=$numitems; $i++) {
@@ -13344,7 +13741,9 @@ sub process_extracted_files {
                         }
                         if ($fullpath ne '') {
                             if (-e "$prefix$path") {
-                                system("mv $prefix$path $fullpath/$title");
+                                unless (rename("$prefix$path","$fullpath/$title")) {
+                                     $warning .= &mt('Failed to rename dependency').'<br />';
+                                }
                             }
                             if (-e "$fullpath/$title") {
                                 my $showpath;
@@ -13353,21 +13752,26 @@ sub process_extracted_files {
                                 } else {
                                     $showpath = "/$title";
                                 } 
-                                $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
-                            } 
-                            unless ($ishome) {
-                                my $fetch = "$fullpath/$title";
-                                $fetch =~ s/^\Q$prefix$dir\E//; 
-                                $prompttofetch{$fetch} = 1;
+                                $result .= '<li>'.&mt('[_1] included as a dependency',
+                                                      &HTML::Entities::encode($showpath,'<>&"')).
+                                           '</li>'."\n";
+                                unless ($ishome) {
+                                    my $fetch = "$fullpath/$title";
+                                    $fetch =~ s/^\Q$prefix$dir\E//; 
+                                    $prompttofetch{$fetch} = 1;
+                                }
                             }
                         }
                     }
                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
-                                    $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
+                                    &HTML::Entities::encode($path,'<>&"'),
+                                    &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
+                                '<br />';
                 }
             } else {
-                $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
+                $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+                                &HTML::Entities::encode($path)).'<br />';
             }
         }
         if (keys(%todelete)) {
@@ -13641,12 +14045,15 @@ sub upfile_store {
     $env{'form.upfile'}=~s/\n+/\n/gs;
     $env{'form.upfile'}=~s/\n+$//gs;
 
-    my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
-	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
+    my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
+                                     '_enroll_'.$env{'request.course.id'}.'_'.
+                                     time.'_'.$$);
+    return if ($datatoken eq '');
+
     {
         my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';
-        if ( open(my $fh,">$datafile") ) {
+        if ( open(my $fh,'>',$datafile) ) {
             print $fh $env{'form.upfile'};
             close($fh);
         }
@@ -13656,21 +14063,22 @@ sub upfile_store {
 
 =pod
 
-=item * &load_tmp_file($r)
+=item * &load_tmp_file($r,$datatoken)
 
 Load uploaded file from tmp, $r should be the HTTP Request object,
-needs $env{'form.datatoken'},
+$datatoken is the name to assign to the temporary file.
 sets $env{'form.upfile'} to the contents of the file
 
 =cut
 
 sub load_tmp_file {
-    my $r=shift;
+    my ($r,$datatoken) = @_;
+    return if ($datatoken eq '');
     my @studentdata=();
     {
         my $studentfile = $r->dir_config('lonDaemons').
-                              '/tmp/'.$env{'form.datatoken'}.'.tmp';
-        if ( open(my $fh,"<$studentfile") ) {
+                              '/tmp/'.$datatoken.'.tmp';
+        if ( open(my $fh,'<',$studentfile) ) {
             @studentdata=<$fh>;
             close($fh);
         }
@@ -13678,6 +14086,14 @@ sub load_tmp_file {
     $env{'form.upfile'}=join('',@studentdata);
 }
 
+sub valid_datatoken {
+    my ($datatoken) = @_;
+    if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
+        return $datatoken;
+    }
+    return;
+}
+
 =pod
 
 =item * &upfile_record_sep()
@@ -14564,7 +14980,14 @@ requestsmail, updatesmail, or idconflict
 defdom (domain for which to retrieve configuration settings),
 
 origmail (scalar - email address of recipient from loncapa.conf, 
-i.e., predates configuration by DC via domainprefs.pm 
+i.e., predates configuration by DC via domainprefs.pm
+
+$requname username of requester (if mailing type is helpdeskmail)
+
+$requdom domain of requester (if mailing type is helpdeskmail)
+
+$reqemail e-mail address of requester (if mailing type is helpdeskmail)
+
 
 Returns: comma separated list of addresses to which to send e-mail.
 
@@ -14575,7 +14998,7 @@ Returns: comma separated list of address
 ############################################################
 ############################################################
 sub build_recipient_list {
-    my ($defmail,$mailing,$defdom,$origmail) = @_;
+    my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
     my @recipients;
     my ($otheremails,$lastresort,$allbcc,$addtext);
     my %domconfig =
@@ -14616,11 +15039,98 @@ sub build_recipient_list {
         } elsif ($origmail ne '') {
             $lastresort = $origmail;
         }
+        if ($mailing eq 'helpdeskmail') {
+            if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
+                (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
+                my ($inststatus,$inststatus_checked);
+                if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
+                    ($env{'user.domain'} ne 'public')) {
+                    $inststatus_checked = 1;
+                    $inststatus = $env{'environment.inststatus'};
+                }
+                unless ($inststatus_checked) {
+                    if (($requname ne '') && ($requdom ne '')) {
+                        if (($requname =~ /^$match_username$/) &&
+                            ($requdom =~ /^$match_domain$/) &&
+                            (&Apache::lonnet::domain($requdom))) {
+                            my $requhome = &Apache::lonnet::homeserver($requname,
+                                                                      $requdom);
+                            unless ($requhome eq 'no_host') {
+                                my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
+                                $inststatus = $userenv{'inststatus'};
+                                $inststatus_checked = 1;
+                            }
+                        }
+                    }
+                }
+                unless ($inststatus_checked) {
+                    if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
+                        my %srch = (srchby     => 'email',
+                                    srchdomain => $defdom,
+                                    srchterm   => $reqemail,
+                                    srchtype   => 'exact');
+                        my %srch_results = &Apache::lonnet::usersearch(\%srch);
+                        foreach my $uname (keys(%srch_results)) {
+                            if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
+                                $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
+                                $inststatus_checked = 1;
+                                last;
+                            }
+                        }
+                        unless ($inststatus_checked) {
+                            my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
+                            if ($dirsrchres eq 'ok') {
+                                foreach my $uname (keys(%srch_results)) {
+                                    if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
+                                        $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
+                                        $inststatus_checked = 1;
+                                        last;
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+                if ($inststatus ne '') {
+                    foreach my $status (split(/\:/,$inststatus)) {
+                        if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
+                            my @contacts = ('adminemail','supportemail');
+                            foreach my $item (@contacts) {
+                                if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
+                                    my $addr = $domconfig{'contacts'}{'overrides'}{$status};
+                                    if (!grep(/^\Q$addr\E$/,@recipients)) {
+                                        push(@recipients,$addr);
+                                    }
+                                }
+                            }
+                            $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
+                            if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
+                                my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
+                                my @ok_bccs;
+                                foreach my $bcc (@bccs) {
+                                    $bcc =~ s/^\s+//g;
+                                    $bcc =~ s/\s+$//g;
+                                    if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
+                                        if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
+                                            push(@ok_bccs,$bcc);
+                                        }
+                                    }
+                                }
+                                if (@ok_bccs > 0) {
+                                    $allbcc = join(', ',@ok_bccs);
+                                }
+                            }
+                            $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
+                            last;
+                        }
+                    }
+                }
+            }
+        }
     } elsif ($origmail ne '') {
         $lastresort = $origmail;
     }
-
-    if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
+    if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
@@ -14700,7 +15210,7 @@ sub build_recipient_list {
             }
         }
     }
-    if ($mailing eq 'helpdesk') {
+    if ($mailing eq 'helpdeskmail') {
         if ((!@recipients) && ($lastresort ne '')) {
             push(@recipients,$lastresort);
         }
@@ -14734,6 +15244,8 @@ Inputs:
 
 from -              Sender's email address
 
+replyto -           Reply-To email address
+
 to -                Email address of recipient
 
 subject -           Subject of email
@@ -14744,8 +15256,6 @@ cc_string -         Carbon copy email ad
 
 bcc -               Blind carbon copy email address
 
-type -              File type of attachment
-
 attachment_path -   Path of file to be attached
 
 file_name -         Name of file to be attached
@@ -14762,8 +15272,9 @@ attachment_text -   The body of an attac
 ############################################################
 
 sub mime_email {
-    my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, 
-        $file_name, $attachment_text) = @_;
+    my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, 
+        $file_name,$attachment_text) = @_;
+ 
     my $msg = MIME::Lite->new(
              From    => $from,
              To      => $to,
@@ -14771,6 +15282,9 @@ sub mime_email {
              Type    =>'TEXT',
              Data    => $body,
              );
+    if ($replyto ne '') {
+        $msg->add("Reply-To" => $replyto);
+    }
     if ($cc_string ne '') {
         $msg->add("Cc" => $cc_string);
     }
@@ -14886,6 +15400,8 @@ jsarray (reference to array of categorie
 subcats (reference to hash of arrays containing all subcategories within each 
          category, -recursive)
 
+maxd (reference to hash used to hold max depth for all top-level categories).
+
 Returns: nothing
 
 Side effects: populates trails and allitems hash references.
@@ -14893,7 +15409,7 @@ Side effects: populates trails and allit
 =cut
 
 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') {
         &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {
@@ -14921,12 +15437,15 @@ sub extract_categories {
                         if (ref($subcats) eq 'HASH') {
                             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 {
                     if (ref($subcats) eq 'HASH') {
                         $subcats->{$item} = [];
                     }
+                    if (ref($maxd) eq 'HASH') {
+                        $maxd->{$name} = 1;
+                    }
                 }
             }
         }
@@ -14964,13 +15483,13 @@ Side effects: populates trails and allit
 =cut
 
 sub recurse_categories {
-    my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
+    my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
     my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
             my $name = $cats->[$depth]{$category}[$k];
             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
-            my $trailstr = join(' -&gt; ',(@{$parents},$category));
+            my $trailstr = join(' &raquo; ',(@{$parents},$category));
             if ($allitems->{$item} eq '') {
                 push(@{$trails},$trailstr);
                 $allitems->{$item} = scalar(@{$trails})-1;
@@ -14991,16 +15510,21 @@ sub recurse_categories {
                 }
             }
             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
-                                $subcats);
+                                $subcats,$maxd);
             pop(@{$parents});
         }
     } else {
         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
-        my $trailstr = join(' -&gt; ',(@{$parents},$category));
+        my $trailstr = join(' &raquo; ',(@{$parents},$category));
         if ($allitems->{$item} eq '') {
             push(@{$trails},$trailstr);
             $allitems->{$item} = scalar(@{$trails})-1;
         }
+        if (ref($maxd) eq 'HASH') {
+            if ($depth > $maxd->{$parents->[0]}) {
+                $maxd->{$parents->[0]} = $depth;
+            }
+        }
     }
     return;
 }
@@ -15032,8 +15556,8 @@ sub assign_categories_table {
     my ($cathash,$currcat,$type,$disabled) = @_;
     my $output;
     if (ref($cathash) eq 'HASH') {
-        my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
-        &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
+        my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
+        &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
         $maxdepth = scalar(@cats);
         if (@cats > 0) {
             my $itemcount = 0;
@@ -15359,7 +15883,8 @@ sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
-    my $clonemsg;
+    my $clonetitle;
+    my @clonemsg;
     my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {
@@ -15367,16 +15892,38 @@ sub check_clone {
     }
     if ($clonehome eq 'no_host') {
         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 {
-            $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 {
 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+        $clonetitle = $clonedesc{'description'};
         if ($args->{'crstype'} eq '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'});
-                return ($can_clone, $clonemsg, $cloneid, $clonehome);
+                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 course not a community.',
+                                  args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
+                                }));
+                return ($can_clone,\@clonemsg,$cloneid,$clonehome);
             }
         }
 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
@@ -15465,20 +16012,34 @@ sub check_clone {
             }
             unless ($can_clone) {
                 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 {
-                    $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 {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
-        $cnum,$category,$coderef) = @_;
-    my $outcome;
+        $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
+    my ($outcome,$msgref,$clonemsgref);
     my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {
         $linefeed = "\n";
@@ -15487,18 +16048,11 @@ sub construct_course {
 #
 # Are we cloning?
 #
-    my ($can_clone, $clonemsg, $cloneid, $clonehome);
+    my ($can_clone,$cloneid,$clonehome,$clonetitle);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
-	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
-	if ($context ne 'auto') {
-            if ($clonemsg ne '') {
-	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
-            }
-	}
-	$outcome .= $clonemsg.$linefeed;
-
+	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
         if (!$can_clone) {
-	    return (0,$outcome);
+	    return (0,$outcome,$clonemsgref);
 	}
     }
 
@@ -15521,15 +16075,20 @@ sub construct_course {
                                              $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},
                                              $args->{'crstype'},
-                                             $cnum,$context,$category);
+                                             $cnum,$context,$category,
+                                             $callercontext);
 
     # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new
     # 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:/) {
-        return (0,$outcome);
+        return (0,$outcome,$clonemsgref);
     }
 
 #
@@ -15538,23 +16097,37 @@ sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {
-        $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
-        return (0,$outcome);
+        if (($callercontext eq 'auto') && ($user_lh ne '')) {
+            $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;
 
 #
 # Do the cloning
 #   
+    my @clonemsg;
     if ($can_clone && $cloneid) {
-	$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
-	if ($context ne 'auto') {
-	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
-	}
-	$outcome .= $clonemsg.$linefeed;
+        push(@clonemsg,
+                      {
+                          mt => 'Created [_1] by cloning from [_2]',
+                          args => [$showncrstype,$clonetitle],
+                      });
 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # 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
 	$cenv{'url'}=$oldcenv{'url'};
 # Restore title
@@ -15821,12 +16394,17 @@ sub construct_course {
 # Open all assignments
 #
     if ($args->{'openall'}) {
+       my $opendate = time;
+       if ($args->{'openallfrom'} =~ /^\d+$/) {
+           $opendate = $args->{'openallfrom'};
+       }
        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
-       my %storecontent = ($storeunder         => time,
+       my %storecontent = ($storeunder         => $opendate,
                            $storeunder.'.type' => 'date_start');
-       
-       $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
-                 ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
+       $outcome .= &mt('All assignments open starting [_1]',
+                       &Apache::lonlocal::locallocaltime($opendate)).': '.
+                   &Apache::lonnet::cput
+                       ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
    }
 #
 # Set first page
@@ -15880,7 +16458,7 @@ sub construct_course {
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
     }
 
-    return (1,$outcome);
+    return (1,$outcome,\@clonemsg);
 }
 
 sub make_unique_code {
@@ -15964,13 +16542,14 @@ sub group_term {
 }
 
 sub course_types {
-    my @types = ('official','unofficial','community','textbook','placement');
+    my @types = ('official','unofficial','community','textbook','placement','lti');
     my %typename = (
                          official   => 'Official course',
                          unofficial => 'Unofficial course',
                          community  => 'Community',
                          textbook   => 'Textbook course',
                          placement  => 'Placement test',
+                         lti        => 'LTI provider',
                    );
     return (\@types,\%typename);
 }
@@ -16050,6 +16629,24 @@ sub compare_arrays {
     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
 sub init_user_environment {
     my ($r, $username, $domain, $authhost, $form, $args) = @_;
@@ -16084,7 +16681,23 @@ sub init_user_environment {
 	    opendir(DIR,$lonids);
 	    while ($filename=readdir(DIR)) {
 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
-		    unlink($lonids.'/'.$filename);
+                    if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
+                            &GDBM_READER(),0640)) {
+                        my $linkedfile;
+                        if (exists($oldenv{'user.linkedenv'})) {
+                            $linkedfile = $oldenv{'user.linkedenv'};
+                        }
+                        untie(%oldenv);
+                        if (unlink("$lonids/$filename")) {
+                            if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
+                                if (-l "$lonids/$linkedfile.id") {
+                                    unlink("$lonids/$linkedfile.id");
+                                }
+                            }
+                        }
+                    } else {
+                        unlink($lonids.'/'.$filename);
+                    }
 		}
 	    }
 	    closedir(DIR);
@@ -16190,7 +16803,7 @@ sub init_user_environment {
                                                       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} =
                     &Apache::lonnet::usertools_access($username,$domain,$crstype,
                                                       'reload','requestcourses',
@@ -17080,22 +17693,34 @@ sub needs_coursereinit {
 }
 
 sub update_content_constraints {
-    my ($cdom,$cnum,$chome,$cid) = @_;
+    my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
-    my %checkresponsetypes;
+    my (%checkresponsetypes,%checkcrsrestypes);
     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
         my ($item,$name,$value) = split(/:/,$key);
         if ($item eq 'resourcetag') {
             if ($name eq 'responsetype') {
                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
             }
+        } elsif ($item eq 'course') {
+            if ($name eq 'courserestype') {
+                $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
+            }
         }
     }
     my $navmap = Apache::lonnavmaps::navmap->new();
     if (defined($navmap)) {
-        my %allresponses;
-        foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
+        my (%allresponses,%allcrsrestypes);
+        foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
+            if ($res->is_tool()) {
+                if ($allcrsrestypes{'exttool'}) {
+                    $allcrsrestypes{'exttool'} ++;
+                } else {
+                    $allcrsrestypes{'exttool'} = 1;
+                }
+                next;
+            }
             my %responses = $res->responseTypes();
             foreach my $key (keys(%responses)) {
                 next unless(exists($checkresponsetypes{$key}));
@@ -17108,8 +17733,38 @@ sub update_content_constraints {
                 ($reqdmajor,$reqdminor) = ($major,$minor);
             }
         }
+        foreach my $key (keys(%allcrsrestypes)) {
+            my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
+            if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
+                ($reqdmajor,$reqdminor) = ($major,$minor);
+            }
+        }
         undef($navmap);
     }
+    my (@resources,@order,@resparms,@zombies);
+    if ($keeporder) {
+        use LONCAPA::map;
+        @resources = @LONCAPA::map::resources;
+        @order = @LONCAPA::map::order;
+        @resparms = @LONCAPA::map::resparms;
+        @zombies = @LONCAPA::map::zombies;
+    }
+    my $suppmap = 'supplemental.sequence';
+    my ($suppcount,$supptools,$errors) = (0,0,0);
+    ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
+                                                            $suppcount,$supptools,$errors);
+    if ($keeporder) {
+        @LONCAPA::map::resources = @resources;
+        @LONCAPA::map::order = @order;
+        @LONCAPA::map::resparms = @resparms;
+        @LONCAPA::map::zombies = @zombies;
+    }
+    if ($supptools) {
+        my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
+        if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
+            ($reqdmajor,$reqdminor) = ($major,$minor);
+        }
+    }
     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
     }
@@ -17130,7 +17785,7 @@ sub allmaps_incourse {
     if ($lastchange > $env{'request.course.tied'}) {
         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
         unless ($ferr) {
-            &update_content_constraints($cdom,$cnum,$chome,$cid);
+            &update_content_constraints($cdom,$cnum,$chome,$cid,1);
         }
     }
     my $navmap = Apache::lonnavmaps::navmap->new();
@@ -17166,7 +17821,7 @@ sub parse_supplemental_title {
 }
 
 sub recurse_supplemental {
-    my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
+    my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
     if ($suppmap) {
         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
         if ($fatal) {
@@ -17177,8 +17832,12 @@ sub recurse_supplemental {
                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                     if (($src ne '') && ($status eq 'res')) {
                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
-                            ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
+                            ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
+                                                                   $numfiles,$numexttools,$errors);
                         } else {
+                            if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
+                                $numexttools ++;
+                            }
                             $numfiles ++;
                         }
                     }
@@ -17186,7 +17845,7 @@ sub recurse_supplemental {
             }
         }
     }
-    return ($numfiles,$errors);
+    return ($numfiles,$numexttools,$errors);
 }
 
 sub symb_to_docspath {
@@ -17260,10 +17919,10 @@ sub symb_to_docspath {
 }
 
 sub captcha_display {
-    my ($context,$lonhost) = @_;
+    my ($context,$lonhost,$defdom) = @_;
     my ($output,$error);
     my ($captcha,$pubkey,$privkey,$version) = 
-        &get_captcha_config($context,$lonhost);
+        &get_captcha_config($context,$lonhost,$defdom);
     if ($captcha eq 'original') {
         $output = &create_captcha();
         unless ($output) {
@@ -17279,9 +17938,9 @@ sub captcha_display {
 }
 
 sub captcha_response {
-    my ($context,$lonhost) = @_;
+    my ($context,$lonhost,$defdom) = @_;
     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') {
         ($captcha_chk,$captcha_error) = &check_captcha();
     } elsif ($captcha eq 'recaptcha') {
@@ -17293,7 +17952,7 @@ sub captcha_response {
 }
 
 sub get_captcha_config {
-    my ($context,$lonhost) = @_;
+    my ($context,$lonhost,$dom_in_effect) = @_;
     my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
     my $hostname = &Apache::lonnet::hostname($lonhost);
     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
@@ -17341,7 +18000,28 @@ sub get_captcha_config {
         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq '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);
 }
 
@@ -17365,6 +18045,9 @@ sub create_captcha {
             last;
         }
     }
+    if ($output eq '') {
+        &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
+    }
     return $output;
 }
 
@@ -17581,6 +18264,308 @@ sub des_decrypt {
     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;
+}
+
 1;
 __END__;