--- loncom/interface/loncommon.pm	2019/05/02 02:12:18	1.1328
+++ loncom/interface/loncommon.pm	2019/11/20 22:53:32	1.1334
@@ -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.1334 2019/11/20 22:53:32 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3567,6 +3567,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','ls','num','spec') {
+            if (grep(/^$rule$/,@brokerule)) {
+                $warning .= '<li>'.$rulenames{$rule}.'</li>';
+            }
+        }
+        $warning .= '</ul>';
+    }
+    if (wantarray) {
+        return @brokerule;
+    }
+    return $warning;
+}
+
 ###############################################################
 ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################
@@ -7185,7 +7258,8 @@ table.LC_prior_tries td {
   padding: 6px;
 }
 
-.LC_answer_unknown {
+.LC_answer_unknown,
+.LC_answer_warning {
   background: orange;
   color: black;
   padding: 6px;
@@ -18193,7 +18267,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 +18296,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 +18394,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__;