--- loncom/interface/loncommon.pm	2021/11/17 19:55:15	1.1370
+++ loncom/interface/loncommon.pm	2022/05/30 00:17:38	1.1382
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1370 2021/11/17 19:55:15 raeburn Exp $
+# $Id: loncommon.pm,v 1.1382 2022/05/30 00:17:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1257,7 +1257,7 @@ END
 
 =pod
 
-=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
+=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
 
 Returns a string corresponding to an HTML link to the given help
 $topic, where $topic corresponds to the name of a .tex file in
@@ -1281,10 +1281,12 @@ $imgid is the id of the img tag used for
 used in a javascript call to switch the image src.  See 
 lonhtmlcommon::htmlareaselectactive() for an example.
 
+$links_target will optionally be set to a target (_top, _parent or _self).
+
 =cut
 
 sub help_open_topic {
-    my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
+    my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
     $text = "" if (not defined $text);
     $stayOnPage = 0 if (not defined $stayOnPage);
     $width = 500 if (not defined $width);
@@ -1307,10 +1309,13 @@ sub help_open_topic {
 
     # Add the text
     my $target = ' target="_top"';
-    if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
+    if ($links_target) {
+        $target = ' target="'.$links_target.'"';
+    } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
+             (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
         $target = '';
     }
-    if ($text ne "") {	
+    if ($text ne "") {
 	$template.='<span class="LC_help_open_topic">'
                   .'<a'.$target.' href="'.$link.'">'
                   .$text.'</a>';
@@ -1395,20 +1400,20 @@ ENDOUTPUT
 
 # now just updates the help link and generates a blue icon
 sub help_open_menu {
-    my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
+    my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target) 
 	= @_;    
     $stayOnPage = 1;
     my $output;
     if ($component_help) {
 	if (!$text) {
 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
-				       $width,$height);
+				       $width,$height,'',$links_target);
 	} else {
 	    my $help_text;
 	    $help_text=&unescape($topic);
 	    $output='<table><tr><td>'.
 		&help_open_topic($component_help,$help_text,$stayOnPage,
-				 $width,$height).'</td></tr></table>';
+				 $width,$height,'',$links_target).'</td></tr></table>';
 	}
     }
     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
@@ -1516,23 +1521,25 @@ sub help_open_bug {
 	$link = $url;
     }
 
-    my $target = ' target="_top"';
-    if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
-        $target = '';
+    my $target = '_top';
+    if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
+        (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
+        $target = '_blank';
     }
+
     # Add the text
     if ($text ne "")
     {
 	$template .= 
   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
-  "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
+  "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
     }
 
     # Add the graphic
     my $title = &mt('Report a Bug');
     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";
- <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
+ <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };
     return $template;
@@ -3648,6 +3655,155 @@ sub check_passwd_rules {
     return $warning;
 }
 
+sub passwd_validation_js {
+    my ($currpasswdval,$domain,$context,$id) = @_;
+    my (%passwdconf,$alertmsg);
+    if ($context eq 'linkprot') {
+        my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
+        if (ref($domconfig{'ltisec'}) eq 'HASH') {
+            if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
+                %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
+            }
+        }
+        if ($id eq 'add') {
+            $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
+        } elsif ($id =~ /^\d+$/) {
+            my $pos = $id+1;
+            $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
+        } else {
+            $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
+        }
+    } else {
+        %passwdconf = &Apache::lonnet::get_passwdconf($domain);
+        $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
+    }
+    my ($min,$max,@chars,$numrules,$intargjs,%alert);
+    $numrules = 0;
+    $min = $Apache::lonnet::passwdmin;
+    if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+        if ($passwdconf{'min'} =~ /^\d+$/) {
+            if ($passwdconf{'min'} > $min) {
+                $min = $passwdconf{'min'};
+            }
+        }
+        if ($passwdconf{'max'} =~ /^\d+$/) {
+            $max = $passwdconf{'max'};
+            $numrules ++;
+        }
+        @chars = @{$passwdconf{'chars'}};
+        if (@chars) {
+            $numrules ++;
+        }
+    }
+    if ($min > 0) {
+        $numrules ++;
+    }
+    if (($min > 0) || ($max ne '') || (@chars > 0)) {
+        if ($min) {
+            $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
+        }
+        if ($max) {
+            $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
+        }
+        my (@charalerts,@charrules);
+        if (@chars) {
+            if (grep(/^uc$/,@chars)) {
+                push(@charalerts,&mt('contain at least one upper case letter'));
+                push(@charrules,'uc');
+            }
+            if (grep(/^lc$/,@chars)) {
+                push(@charalerts,&mt('contain at least one lower case letter'));
+                push(@charrules,'lc');
+            }
+            if (grep(/^num$/,@chars)) {
+                push(@charalerts,&mt('contain at least one number'));
+                push(@charrules,'num');
+            }
+            if (grep(/^spec$/,@chars)) {
+                push(@charalerts,&mt('contain at least one non-alphanumeric'));
+                push(@charrules,'spec');
+            }
+        }
+        $intargjs = qq|            var rulesmsg = '';\n|.
+                    qq|            var currpwval = $currpasswdval;\n|;
+            if ($min) {
+                $intargjs .= qq|
+            if (currpwval.length < $min) {
+                rulesmsg += ' - $alert{min}';
+            }
+|;
+            }
+            if ($max) {
+                $intargjs .= qq|
+            if (currpwval.length > $max) {
+                rulesmsg += ' - $alert{max}';
+            }
+|;
+            }
+            if (@chars > 0) {
+                my $charrulestr = '"'.join('","',@charrules).'"';
+                my $charalertstr = '"'.join('","',@charalerts).'"';
+                $intargjs .= qq|            var brokerules = new Array();\n|.
+                             qq|            var charrules = new Array($charrulestr);\n|.
+                             qq|            var charalerts = new Array($charalertstr);\n|;
+                my %rules;
+                map { $rules{$_} = 1; } @chars;
+                if ($rules{'uc'}) {
+                    $intargjs .= qq|
+            var ucRegExp = /[A-Z]/;
+            if (!ucRegExp.test(currpwval)) {
+                brokerules.push('uc');
+            }
+|;
+                }
+                if ($rules{'lc'}) {
+                    $intargjs .= qq|
+            var lcRegExp = /[a-z]/;
+            if (!lcRegExp.test(currpwval)) {
+                brokerules.push('lc');
+            }
+|;
+                }
+                if ($rules{'num'}) {
+                     $intargjs .= qq|
+            var numRegExp = /[0-9]/;
+            if (!numRegExp.test(currpwval)) {
+                brokerules.push('num');
+            }
+|;
+                }
+                if ($rules{'spec'}) {
+                     $intargjs .= q|
+            var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
+            if (!specRegExp.test(currpwval)) {
+                brokerules.push('spec');
+            }
+|;
+                }
+                $intargjs .= qq|
+            if (brokerules.length > 0) {
+                for (var i=0; i<brokerules.length; i++) {
+                    for (var j=0; j<charrules.length; j++) {
+                        if (brokerules[i] == charrules[j]) {
+                            rulesmsg += ' - '+charalerts[j]+'\\n';
+                            break;
+                        }
+                    }
+                }
+            }
+|;
+            }
+            $intargjs .= qq|
+            if (rulesmsg != '') {
+                rulesmsg = '$alertmsg'+rulesmsg;
+                alert(rulesmsg);
+                return false;
+            }
+|;
+    }
+    return ($numrules,$intargjs);
+}
+
 ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################
@@ -5201,8 +5357,90 @@ sub findallcourses {
 ###############################################
 
 sub blockcheck {
-    my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
-
+    my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+    unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
+        my ($has_evb,$check_ipaccess);
+        my $dom = $env{'user.domain'};
+        if ($env{'request.course.id'}) {
+            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            my $checkrole = "cm./$cdom/$cnum";
+            my $sec = $env{'request.course.sec'};
+            if ($sec ne '') {
+                $checkrole .= "/$sec";
+            }
+            if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+                ($env{'request.role'} !~ /^st/)) {
+                $has_evb = 1;
+            }
+            unless ($has_evb) {
+                if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
+                    ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
+                    if ($udom eq $cdom) {
+                        $check_ipaccess = 1;
+                    }
+                }
+            }
+        } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
+                ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
+            my $checkrole;
+            if ($env{'request.role.domain'} eq '') {
+                $checkrole = "cm./$env{'user.domain'}/";
+            } else {
+                $checkrole = "cm./$env{'request.role.domain'}/";
+            }
+            if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
+                $has_evb = 1;
+            }
+        }
+        unless ($has_evb || $check_ipaccess) {
+            my @machinedoms = &Apache::lonnet::current_machine_domains();
+            if (($dom eq 'public') && ($activity eq 'port')) {
+                $dom = $udom;
+            }
+            if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
+                $check_ipaccess = 1;
+            } else {
+                my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+                my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+                my $prim = &Apache::lonnet::domain($dom,'primary');
+                my $intdom = &Apache::lonnet::internet_dom($prim);
+                if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
+                    if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
+                        $check_ipaccess = 1;
+                    }
+                }
+            }
+        }
+        if ($check_ipaccess) {
+            my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
+            unless (defined($cached)) {
+                my %domconfig =
+                    &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
+                $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
+            }
+            if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
+                foreach my $id (keys(%{$ipaccessref})) {
+                    if (ref($ipaccessref->{$id}) eq 'HASH') {
+                        my $range = $ipaccessref->{$id}->{'ip'};
+                        if ($range) {
+                            if (&Apache::lonnet::ip_match($clientip,$range)) {
+                                if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
+                                    if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
+                                        return ('','','',$id,$dom);
+                                        last;
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+        if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+            return ();
+        }
+    }
     if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.
         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
@@ -5218,7 +5456,10 @@ sub blockcheck {
     my $startblock = 0;
     my $endblock = 0;
     my $triggerblock = '';
-    my %live_courses = &findallcourses(undef,$uname,$udom);
+    my %live_courses;
+    unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+        %live_courses = &findallcourses(undef,$uname,$udom);
+    }
 
     # If uname is for a user, and activity is course-specific, i.e.,
     # boards, chat or groups, check for blocking in current course only.
@@ -5503,14 +5744,17 @@ sub parse_block_record {
 }
 
 sub blocking_status {
-    my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+    my ($activity,$clientip,$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,$symb,$caller);
+    if ($clientip eq '') {
+        $clientip = &Apache::lonnet::get_requestor_ip();
+    }
+    my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
+        &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
     my $blocked = 0;
-    if ($startblock && $endblock) {
+    if (($startblock && $endblock) || ($by_ip)) {
         $blocked = 1;
     }
 
@@ -5564,6 +5808,10 @@ END_MYBLOCK
         $text = &mt('Checking Course Update Blocked');
     } elsif ($activity eq 'about') {
         $text = &mt('Access to User Information Pages Blocked');
+    } elsif ($activity eq 'wishlist') {
+        $text = &mt('Access to Stored Links Blocked');
+    } elsif ($activity eq 'annotate') {
+        $text = &mt('Access to Annotations Blocked');
     }
     $output .= <<"END_BLOCK";
 <div class='$class'>
@@ -5860,8 +6108,12 @@ sub domainlogo {
 		&Apache::lonnet::repcopy($local_name);
 	    }
 	   $imgsrc = &lonhttpdurl($imgsrc);
-        } 
-        return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
+        }
+        my $alttext = $domain;
+        if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
+            $alttext = $designhash{$domain.'.login.alttext_domlogo'};
+        }
+        return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
         return &Apache::lonnet::domain($domain,'description');
     } else {
@@ -5979,6 +6231,10 @@ sub head_subbox {
 Input: (optional) filename from which breadcrumb trail is built.
        In most cases no input as needed, as $env{'request.filename'}
        is appropriate for use in building the breadcrumb trail.
+       frameset flag
+       If page header is being requested for use in a frameset, then
+       the second (option) argument -- frameset will be true, and
+       the target attribute set for links should be target="_parent".
 
 Returns: HTML div with CSTR path and recent box
          To be included on Authoring Space pages
@@ -5986,7 +6242,7 @@ Returns: HTML div with CSTR path and rec
 =cut
 
 sub CSTR_pageheader {
-    my ($trailfile) = @_;
+    my ($trailfile,$frameset) = @_;
     if ($trailfile eq '') {
         $trailfile = $env{'request.filename'};
     }
@@ -6019,10 +6275,16 @@ 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')) {
+    my ($target,$crumbtarget) = (' target="_top"','_top');
+    if ($frameset) {
+        $target = ' target="_parent"';
+        $crumbtarget = '_parent';
+    } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
         $target = '';
         $crumbtarget = '';
+    } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
+        $target = ' target="'.$env{'request.deeplink.target'}.'"';
+        $crumbtarget = $env{'request.deeplink.target'};
     }
 
     my $output =
@@ -6040,14 +6302,14 @@ sub CSTR_pageheader {
     }
 
     if ($crsauthor) {
-        $output .= '</form>'.&Apache::lonmenu::constspaceform();
+        $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
     } else {
         $output .=
              '<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();
+            .&Apache::lonmenu::constspaceform($frameset);
     }
     $output .= '</div>';
 
@@ -6267,7 +6529,8 @@ sub bodytag {
 
         unless ($args->{'no_primary_menu'}) {
             my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
-                                                              $args->{'links_disabled'});
+                                                              $args->{'links_disabled'},
+                                                              $args->{'links_target'});
 
             if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
                 if ($dc_info) {
@@ -6300,7 +6563,8 @@ sub bodytag {
                 $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
                                                             $args->{'no_primary_menu'},
                                                             $menucoll,$menuref,
-                                                            $args->{'links_disabled'});
+                                                            $args->{'links_disabled'},
+                                                            $args->{'links_target'});
             }
             $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
@@ -8858,7 +9122,8 @@ sub print_suppression {
         }
         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-        my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
+        my $clientip = &Apache::lonnet::get_requestor_ip();
+        my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
         if ($blocked) {
             my $checkrole = "cm./$cdom/$cnum";
             if ($env{'request.course.sec'} ne '') {
@@ -8980,6 +9245,7 @@ $args - additional optional args support
              links_disabled -> Links in primary and secondary menus are disabled
                                (Can enable them once page has loaded - see lonroles.pm
                                for an example).
+             links_target   -> Target for links, e.g., _parent (optional).
 
 =back
 
@@ -9208,7 +9474,7 @@ sub menucoll_in_effect {
                 }
             }
             if ($deeplink ne '') {
-                my ($state,$others,$listed,$scope,$protect,$display) = split(/,/,$deeplink);
+                my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
                 if ($display =~ /^\d+$/) {
                     $deeplinkmenu = 1;
                     $menucoll = $display;
@@ -16452,6 +16718,9 @@ sub construct_course {
     if ($args->{'crstype'}) {
         $cenv{'type'}=$args->{'crstype'};
     }
+    if ($args->{'lti'}) {
+        $cenv{'internal.lti'}=$args->{'lti'};
+    }
     if ($args->{'crsid'}) {
         $cenv{'courseid'}=$args->{'crsid'};
     }
@@ -17951,7 +18220,7 @@ sub needs_coursereinit {
     }
     if (($now-$env{'request.course.timechecked'})>$interval) {
         &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
-        my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
+        my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
         if ($blocked) {
             return ();
         }
@@ -18478,7 +18747,7 @@ sub critical_redirect {
         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);
+            my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
             if ($blocked) {
                 my $checkrole = "cm./$cdom/$cnum";
                 if ($env{'request.course.sec'} ne '') {