--- loncom/interface/loncommon.pm	2019/05/02 02:12:18	1.1328
+++ loncom/interface/loncommon.pm	2021/01/29 02:28:32	1.1353
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1328 2019/05/02 02:12:18 raeburn Exp $
+# $Id: loncommon.pm,v 1.1353 2021/01/29 02:28:32 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -80,7 +80,6 @@ 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;
@@ -436,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) {
@@ -451,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';
@@ -483,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)."'";
@@ -494,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.');">'.
@@ -3567,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                 ##
 ###############################################################
@@ -4812,6 +4893,59 @@ sub get_student_view_with_retries {
     }
 }
 
+sub css_links {
+    my ($currsymb,$level) = @_;
+    my ($links,@symbs,%cssrefs,%httpref);
+    if ($level eq 'map') {
+        my $navmap = Apache::lonnavmaps::navmap->new();
+        if (ref($navmap)) {
+            my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
+            my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
+            foreach my $res (@resources) {
+                if (ref($res) && $res->symb()) {
+                    push(@symbs,$res->symb());
+                }
+            }
+        }
+    } else {
+        @symbs = ($currsymb);
+    }
+    foreach my $symb (@symbs) {
+        my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
+        if ($css_href =~ /\S/) {
+            unless ($css_href =~ m{https?://}) {
+                my $url = (&Apache::lonnet::decode_symb($symb))[-1];
+                my $proburl =  &Apache::lonnet::clutter($url);
+                my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
+                unless ($css_href =~ m{^/}) {
+                    $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
+                }
+                if ($css_href =~ m{^/(res|uploaded)/}) {
+                    unless (($httpref{'httpref.'.$css_href}) ||
+                            (&Apache::lonnet::is_on_map($css_href))) {
+                        my $thisurl = $proburl;
+                        if ($env{'httpref.'.$proburl}) {
+                            $thisurl = $env{'httpref.'.$proburl};
+                        }
+                        $httpref{'httpref.'.$css_href} = $thisurl;
+                    }
+                }
+            }
+            $cssrefs{$css_href} = 1;
+        }
+    }
+    if (keys(%httpref)) {
+        &Apache::lonnet::appenv(\%httpref);
+    }
+    if (keys(%cssrefs)) {
+        foreach my $css_href (keys(%cssrefs)) {
+            next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
+            $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
+        }
+    }
+    return $links;
+}
+
 =pod
 
 =item * &get_student_answers() 
@@ -5067,13 +5201,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 {
@@ -5091,7 +5225,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'}) {
@@ -5201,7 +5336,7 @@ sub blockcheck {
         # 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;
@@ -5221,7 +5356,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 = '';
@@ -5234,7 +5369,13 @@ 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,$noenccheck);
+        if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
+            $blocked = 1;
+            $nosymbcache = 1;
+            $noenccheck = 1;
+        }
+        @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
         foreach my $block (@blockers) {
             if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;
@@ -5362,12 +5503,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;
@@ -5378,12 +5519,17 @@ sub blocking_status {
 
 # build a link to a popup window containing the details
     my $querystring  = "?activity=$activity";
-# $uname and $udom decide whose portfolio the user is trying to look at
-    if (($activity eq 'port') || ($activity eq 'passwd')) {
+# $uname and $udom decide whose portfolio (or information page) the user is trying to look at
+    if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
         $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';
@@ -5408,10 +5554,16 @@ 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') {
         $text = &mt('Checking Course Update Blocked');
+    } elsif ($activity eq 'about') {
+        $text = &mt('Access to User Information Pages Blocked');
     }
     $output .= <<"END_BLOCK";
 <div class='$class'>
@@ -5435,8 +5587,14 @@ 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 {
+        my $remote_ip = &Apache::lonnet::get_requestor_ip();
+        $ip = $remote_ip || $env{'request.host'} || $clientip;
+    }
 
     my $name;
     my %access = (
@@ -7185,7 +7343,8 @@ table.LC_prior_tries td {
   padding: 6px;
 }
 
-.LC_answer_unknown {
+.LC_answer_unknown,
+.LC_answer_warning {
   background: orange;
   color: black;
   padding: 6px;
@@ -8181,6 +8340,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
 */
@@ -8431,43 +8598,99 @@ 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,$offloadoth);
                     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();
+                            $offload = 1;
+                            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'})) {
+                                    $offloadoth = 1;
+                                    $dom_in_use = $env{'user.domain'};
                                 }
-                                my $disable_submit = 0;
-                                if ($requrl =~ /$LONCAPA::assess_re/) {
-                                    $disable_submit = 1;
+                            }
+                        }
+                    }
+                    unless ($offload) {
+                        if (ref($domdefs{'offloadoth'}) eq 'HASH') {
+                            if ($domdefs{'offloadoth'}{$lonhost}) {
+                                if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
+                                    (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
+                                    unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
+                                        $offload = 1;
+                                        $offloadoth = 1;
+                                        $dom_in_use = $env{'user.domain'};
+                                    }
                                 }
-                                if ($locknum) {
-                                    my @lockinfo = sort(values(%locks));
-                                    $msg = &mt('Once the following tasks are complete: ')."\\n".
-                                           join(", ",sort(values(%locks)))."\\n".
-                                           &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 eq '') && ($offloadoth)) {
+                            my @domains = &Apache::lonnet::current_machine_domains();
+                            if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
+                                ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
+                            }
+                        }
+                        if (($newserver) && ($newserver ne $lonhost)) {
+                            my $numsec = 5;
+                            my $timeout = $numsec * 1000;
+                            my ($newurl,$locknum,%locks,$msg);
+                            if ($env{'request.role.adv'}) {
+                                ($locknum,%locks) = &Apache::lonnet::get_locks();
+                            }
+                            my $disable_submit = 0;
+                            if ($requrl =~ /$LONCAPA::assess_re/) {
+                                $disable_submit = 1;
+                            }
+                            if ($locknum) {
+                                my @lockinfo = sort(values(%locks));
+                                $msg = &mt('Once the following tasks are complete: ')."\n".
+                                       join(", ",sort(values(%locks)))."\n";
+                                if (&show_course()) {
+                                    $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
                                 } else {
-                                    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[
@@ -8488,7 +8711,6 @@ function LC_Offload_Now() {
 // ]]>
 </script>
 OFFLOAD
-                            }
                         }
                     }
                 }
@@ -8937,8 +9159,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
 }
 
@@ -15094,6 +15315,8 @@ Inputs:
 
 from -              Sender's email address
 
+replyto -           Reply-To email address
+
 to -                Email address of recipient
 
 subject -           Subject of email
@@ -15104,8 +15327,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
@@ -15122,8 +15343,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,
@@ -15131,6 +15353,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);
     }
@@ -15729,7 +15954,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') {
@@ -15737,16 +15963,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'}) &&
@@ -15835,20 +16083,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";
@@ -15857,18 +16119,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);
 	}
     }
 
@@ -15891,15 +16146,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);
     }
 
 #
@@ -15908,23 +16168,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
@@ -16191,12 +16465,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
@@ -16250,7 +16529,7 @@ sub construct_course {
                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum); 
     }
 
-    return (1,$outcome);
+    return (1,$outcome,\@clonemsg);
 }
 
 sub make_unique_code {
@@ -16539,6 +16818,7 @@ sub init_user_environment {
 # --------------------------------------------------------- Write first profile
 
     {
+        my $ip = &Apache::lonnet::get_requestor_ip($r);
 	my %initial_env = 
 	    ("user.name"          => $username,
 	     "user.domain"        => $domain,
@@ -16557,7 +16837,7 @@ sub init_user_environment {
 	     "request.course.sec" => '',
 	     "request.role"       => 'cm',
 	     "request.role.adv"   => $env{'user.adv'},
-	     "request.host"       => $ENV{'REMOTE_ADDR'},);
+	     "request.host"       => $ip,);
 
         if ($form->{'localpath'}) {
 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
@@ -17896,11 +18176,12 @@ sub create_recaptcha {
 sub check_recaptcha {
     my ($privkey,$version) = @_;
     my $captcha_chk;
+    my $ip = &Apache::lonnet::get_requestor_ip();
     if ($version >= 2) {
         my %info = (
                      secret   => $privkey, 
                      response => $env{'form.g-recaptcha-response'},
-                     remoteip => $ENV{'REMOTE_ADDR'},
+                     remoteip => $ip,
                    );
         my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
         $request->content(join('&',map {
@@ -17923,7 +18204,7 @@ sub check_recaptcha {
         my $captcha_result =
             $captcha->check_answer(
                                     $privkey,
-                                    $ENV{'REMOTE_ADDR'},
+                                    $ip,
                                     $env{'form.recaptcha_challenge_field'},
                                     $env{'form.recaptcha_response_field'},
                                   );
@@ -18056,24 +18337,37 @@ sub des_decrypt {
     return $plaintext;
 }
 
-sub make_short_symbs {
+sub get_requested_shorturls {
     my ($cdom,$cnum,$navmap) = @_;
     return unless (ref($navmap));
-    my ($numnew,@errors);
+    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);
-        my %tocreate;
         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);
@@ -18081,9 +18375,11 @@ sub make_short_symbs {
             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" => $env{'user.name'}.
-                                                ':'.$env{'user.domain'},
+                                "lock\0$now" => $lockuser,
                             };
             my $tries = 0;
             my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
@@ -18193,7 +18489,26 @@ sub shorten_symbs {
 }
 
 sub is_nonframeable {
-    my ($url,$absolute,$hostname,$ip) = @_;
+    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);
@@ -18203,8 +18518,7 @@ sub is_nonframeable {
         $secpolicy =~ s/^\s+|\s+$//g;
         $xframeop =~ s/^\s+|\s+$//g;
         if (($secpolicy ne '') || ($xframeop ne '')) {
-            my ($remotehost) = ($url =~ m{^(https?\://[^/?#]+)});
-            $remotehost = lc($remotehost);
+            my $remotehost = $remprotocol.'://'.$remhost;
             my ($origin,$protocol,$port);
             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                 $port = $ENV{'SERVER_PORT'};
@@ -18302,10 +18616,29 @@ sub is_nonframeable {
             }
         }
     }
+    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__;