--- loncom/interface/loncommon.pm	2021/12/30 15:29:57	1.1075.2.161
+++ loncom/interface/loncommon.pm	2021/12/30 21:11:56	1.1075.2.161.2.1
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1075.2.161 2021/12/30 15:29:57 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.161.2.1 2021/12/30 21:11:56 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -83,6 +83,8 @@ use Crypt::DES;
 use DynaLoader; # for Crypt::DES version
 use File::Copy();
 use File::Path();
+use String::CRC32();
+use Short::URL();
 
 # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);
@@ -4823,8 +4825,9 @@ sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.
 
     if (($activity eq 'boards' || $activity eq 'chat' ||
-         $activity eq 'groups' || $activity eq 'printout') &&
-        ($env{'request.course.id'})) {
+         $activity eq 'groups' || $activity eq 'printout' ||
+         $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'}) {
                 delete($live_courses{$key});
@@ -5158,6 +5161,10 @@ END_MYBLOCK
         $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');
     } elsif ($activity eq 'wishlist') {
@@ -5198,13 +5205,34 @@ sub check_ip_acc {
     }
 
     my $name;
-    foreach my $pattern (split(',',$acc)) {
-        $pattern =~ s/^\s*//;
-        $pattern =~ s/\s*$//;
+    my %access = (
+                     allowfrom => 1,
+                     denyfrom  => 0,
+                 );
+    my @allows;
+    my @denies;
+    foreach my $item (split(',',$acc)) {
+        $item =~ s/^\s*//;
+        $item =~ s/\s*$//;
+        if ($item =~ /^\!(.+)$/) {
+            push(@denies,$1);
+        } else {
+            push(@allows,$item);
+        }
+    }
+    my $numdenies = scalar(@denies);
+    my $numallows = scalar(@allows);
+    my $count = 0;
+    foreach my $pattern (@denies,@allows) {
+        $count ++;
+        my $acctype = 'allowfrom';
+        if ($count <= $numdenies) {
+            $acctype = 'denyfrom';
+        }
         if ($pattern =~ /\*$/) {
             #35.8.*
             $pattern=~s/\*//;
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
             #35.8.3.[34-56]
             my $low=$2;
@@ -5212,7 +5240,7 @@ sub check_ip_acc {
             $pattern=$1;
             if ($ip =~ /^\Q$pattern\E/) {
                 my $last=(split(/\./,$ip))[3];
-                if ($last <=$high && $last >=$low) { $allowed=1; }
+                if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
             }
         } elsif ($pattern =~ /^\*/) {
             #*.msu.edu
@@ -5222,10 +5250,10 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
             #127.0.0.1
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } else {
             #some.name.com
             if (!defined($name)) {
@@ -5233,9 +5261,16 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
+        }
+        if ($allowed =~ /^(0|1)$/) { last; }
+    }
+    if ($allowed eq '') {
+        if ($numdenies && !$numallows) {
+            $allowed = 1;
+        } else {
+            $allowed = 0;
         }
-        if ($allowed) { last; }
     }
     return $allowed;
 }
@@ -5656,6 +5691,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.  
@@ -5667,7 +5715,8 @@ other decorations will be returned.
 
 sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
-        $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
+        $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,
+        $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_;
 
     my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -5751,16 +5800,46 @@ sub bodytag {
 	undef($role);
     }
 
+    my $showcrstitle = 1;
+    if (($cid) && ($env{'request.lti.login'})) {
+        if (ref($ltimenu) eq 'HASH') {
+            unless ($ltimenu->{'role'}) {
+                undef($role);
+            }
+            unless ($ltimenu->{'coursetitle'}) {
+                $realm='&nbsp;';
+                $showcrstitle = 0;
+            }
+        }
+    } elsif (($cid) && ($menucoll)) {
+        if (ref($menuref) eq 'HASH') {
+            unless ($menuref->{'role'}) {
+                undef($role);
+            }
+            unless ($menuref->{'crs'}) {
+                $realm='&nbsp;';
+                $showcrstitle = 0;
+            }
+        }
+    }
+
     my $titleinfo = '<h1>'.$title.'</h1>';
     #
     # Extra info if you are the DC
     my $dc_info = '';
-    if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
+    if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info =~ s/\s+$//;
     }
 
+    my $crstype;
+    if ($cid) {
+        $crstype = $env{'course.'.$cid.'.type'};
+    } elsif ($args->{'crstype'}) {
+        $crstype = $args->{'crstype'};
+    }
+
     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
 
     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
@@ -5788,27 +5867,29 @@ sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');
 
-        my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
+        unless ($args->{'no_primary_menu'}) {
+            my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
 
-        if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
-            if ($dc_info) {
-                $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
+            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;
             }
-            $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'}) {
@@ -5816,17 +5897,22 @@ sub bodytag {
         }
         #don't show menus for public users
         if (!$public){
-            $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
+            unless ($args->{'no_inline_menu'}) {
+                $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
+                                                            $args->{'no_primary_menu'},
+                                                            $menucoll,$menuref,
+                                                            $args->{'links_disabled'});
+            }
             $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 {
                 my $forbodytag;
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
@@ -8145,7 +8231,7 @@ ADDMETA
                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
                         if (($newserver eq '') && ($offloadoth)) {
                             my @domains = &Apache::lonnet::current_machine_domains();
-                            if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
+                            if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                             }
                         }
@@ -8461,11 +8547,81 @@ sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
 
     $env{'internal.start_page'}++;
-    my ($result,@advtools);
+    my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
 
     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'});
+    } elsif ($env{'request.course.id'}) {
+        my $expiretime=600;
+        if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
+            &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
+        }
+        my ($deeplinkmenu,$menuref);
+        ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
+        if ($menucoll) {
+            if (ref($menuref) eq 'HASH') {
+                %menu = %{$menuref};
+            }
+            if ($menu{'top'} eq 'n') {
+                $args->{'no_primary_menu'} = 1;
+            }
+            if ($menu{'inline'} eq 'n') {
+                unless (&Apache::lonnet::allowed('opa')) {
+                    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+                    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+                    my $crstype = &course_type();
+                    my $now = time;
+                    my $ccrole;
+                    if ($crstype eq 'Community') {
+                        $ccrole = 'co';
+                    } else {
+                        $ccrole = 'cc';
+                    }
+                    if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
+                        my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
+                        if ((($start) && ($start<0)) ||
+                            (($end) && ($end<$now))  ||
+                            (($start) && ($now<$start))) {
+                            $args->{'no_inline_menu'} = 1;
+                        }
+                    } else {
+                        $args->{'no_inline_menu'} = 1;
+                    }
+                }
+            }
+        }
+    }
     
     if (! exists($args->{'skip_phases'}{'body'}) ) {
 	if ($args->{'frameset'}) {
@@ -8479,7 +8635,8 @@ sub start_page {
                          $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args->{'no_inline_link'},
-                         $args,                     \@advtools);
+                         $args,                     \@advtools,
+                         $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
         }
     }
 
@@ -8514,7 +8671,8 @@ sub start_page {
                 }
                 my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
-                if (exists($args->{'bread_crumbs_nomenu'})) {
+                if ((exists($args->{'bread_crumbs_nomenu'})) ||
+                    ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
                     $menulink = 0;
                 } else {
                     undef($menulink);
@@ -8522,7 +8680,7 @@ sub start_page {
 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
 		if(exists($args->{'bread_crumbs_component'})){
 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
-		}else{
+		} else {
 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
 		}
     } elsif (($env{'environment.remote'} eq 'on') &&
@@ -8566,6 +8724,103 @@ sub end_page {
     return $result;
 }
 
+sub menucoll_in_effect {
+    my ($menucoll,$deeplinkmenu,%menu);
+    if ($env{'request.course.id'}) {
+        $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
+        if ($env{'request.deeplink.login'}) {
+            my ($deeplink_symb,$deeplink,$check_login_symb);
+            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
+                if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
+                    my $navmap = Apache::lonnavmaps::navmap->new();
+                    if (ref($navmap)) {
+                        $deeplink = $navmap->get_mapparam(undef,
+                                                          &Apache::lonnet::declutter($env{'request.noversionuri'}),
+                                                          '0.deeplink');
+                    } else {
+                        $check_login_symb = 1;
+                    }
+                } else {
+                    my $symb=&Apache::lonnet::symbread();
+                    if ($symb) {
+                        $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
+                    } else {
+                        $check_login_symb = 1;
+                    }
+                }
+            } else {
+                $check_login_symb = 1;
+            }
+            if ($check_login_symb) {
+                $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
+                if ($deeplink_symb =~ /\.(page|sequence)$/) {
+                    my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
+                    my $navmap = Apache::lonnavmaps::navmap->new();
+                    if (ref($navmap)) {
+                        $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
+                    }
+                } else {
+                    $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
+                }
+            }
+            if ($deeplink ne '') {
+                my ($state,$others,$listed,$scope,$protect,$display) = split(/,/,$deeplink);
+                if ($display =~ /^\d+$/) {
+                    $deeplinkmenu = 1;
+                    $menucoll = $display;
+                }
+            }
+        }
+        if ($menucoll) {
+            %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
+        }
+    }
+    return ($menucoll,$deeplinkmenu,\%menu);
+}
+
+sub deeplink_login_symb {
+    my ($cnum,$cdom) = @_;
+    my $login_symb;
+    if ($env{'request.deeplink.login'}) {
+        $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
+    }
+    return $login_symb;
+}
+
+sub symb_from_tinyurl {
+    my ($url,$cnum,$cdom) = @_;
+    if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
+        my $key = $1;
+        my ($tinyurl,$login);
+        my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
+        if (defined($cached)) {
+            $tinyurl = $result;
+        } else {
+            my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+            my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
+            if ($currtiny{$key} ne '') {
+                $tinyurl = $currtiny{$key};
+                &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
+            }
+        }
+        if ($tinyurl ne '') {
+            my ($cnumreq,$symb) = split(/\&/,$tinyurl);
+            if (wantarray) {
+                return ($cnumreq,$symb);
+            } elsif ($cnumreq eq $cnum) {
+                return $symb;
+            }
+        }
+    }
+    if (wantarray) {
+        return ();
+    } else {
+        return;
+    }
+}
+
 sub wishlist_window {
     return(<<'ENDWISHLIST');
 <script type="text/javascript">
@@ -15283,7 +15538,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') {
@@ -15291,16 +15547,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'}) &&
@@ -15389,20 +15667,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";
@@ -15411,18 +15703,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);
 	}
     }
 
@@ -15440,15 +15725,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]',$crstype,$$courseid).$linefeed;
+    if (($callercontext eq 'auto') && ($user_lh ne '')) {
+        $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+    } else {
+        $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+    }
     if ($$courseid =~ /^error:/) {
-        return (0,$outcome);
+        return (0,$outcome,$clonemsgref);
     }
 
 #
@@ -15457,23 +15747,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]',$crstype,$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 => [$crstype,$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
@@ -15779,7 +16083,7 @@ sub construct_course {
         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
     }
 
-    return (1,$outcome);
+    return (1,$outcome,\@clonemsg);
 }
 
 sub make_unique_code {
@@ -16947,8 +17251,12 @@ sub needs_coursereinit {
         $interval = 600;
     }
     if (($now-$env{'request.course.timechecked'})>$interval) {
-        my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
+        my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
+        if ($blocked) {
+            return ();
+        }
+        my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
         if ($lastchange > $env{'request.course.tied'}) {
             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
@@ -17410,12 +17718,28 @@ sub cleanup_html {
 
 # Checks for critical messages and returns a redirect url if one exists.
 # $interval indicates how often to check for messages.
+# $context is the calling context -- roles, grades, contents, menu or flip.
 sub critical_redirect {
-    my ($interval) = @_;
+    my ($interval,$context) = @_;
     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
         return ();
     }
     if ((time-$env{'user.criticalcheck.time'})>$interval) {
+        if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
+            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
+            if ($blocked) {
+                my $checkrole = "cm./$cdom/$cnum";
+                if ($env{'request.course.sec'} ne '') {
+                    $checkrole .= "/$env{'request.course.sec'}";
+                }
+                unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+                        ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
+                    return;
+                }
+            }
+        }
         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                                         $env{'user.name'});
         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
@@ -17481,6 +17805,158 @@ 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;
+                $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);
@@ -17634,6 +18110,37 @@ sub is_nonframeable {
     return $uselink;
 }
 
+sub page_menu {
+    my ($menucolls,$menunum) = @_;
+    my %menu;
+    foreach my $item (split(/;/,$menucolls)) {
+        my ($num,$value) = split(/\%/,$item);
+        if ($num eq $menunum) {
+            my @entries = split(/\&/,$value);
+            foreach my $entry (@entries) {
+                my ($name,$fields) = split(/=/,$entry);
+                if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
+                    $menu{$name} = $fields;
+                } else {
+                    my @shown;
+                    if ($fields =~ /,/) {
+                        @shown = split(/,/,$fields);
+                    } else {
+                        @shown = ($fields);
+                    }
+                    if (@shown) {
+                        foreach my $field (@shown) {
+                            next if ($field eq '');
+                            $menu{$field} = 1;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return %menu;
+}
+
 1;
 __END__;