[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1328 and 1.1332

version 1.1328, 2019/05/02 02:12:18 version 1.1332, 2019/05/11 21:34:01
Line 3567  sub get_assignable_auth { Line 3567  sub get_assignable_auth {
     return ($authnum,%can_assign);      return ($authnum,%can_assign);
 }  }
   
   sub check_passwd_rules {
       my ($domain,$plainpass) = @_;
       my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
       my ($min,$max,@chars,@brokerule,$warning);
       if (ref($passwdconf{'chars'}) eq 'ARRAY') {
           if ($passwdconf{'min'} =~ /^\d+$/) {
               $min = $passwdconf{'min'};
           }
           if ($passwdconf{'max'} =~ /^\d+$/) {
               $max = $passwdconf{'max'};
           }
           @chars = @{$passwdconf{'chars'}};
       } else {
           $min = 7;
       }
       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                 ##  ##    Get Kerberos Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 18193  sub shorten_symbs { Line 18265  sub shorten_symbs {
 }  }
   
 sub is_nonframeable {  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 $uselink;
     my $request = new HTTP::Request('HEAD',$url);      my $request = new HTTP::Request('HEAD',$url);
     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);      my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
Line 18203  sub is_nonframeable { Line 18294  sub is_nonframeable {
         $secpolicy =~ s/^\s+|\s+$//g;          $secpolicy =~ s/^\s+|\s+$//g;
         $xframeop =~ s/^\s+|\s+$//g;          $xframeop =~ s/^\s+|\s+$//g;
         if (($secpolicy ne '') || ($xframeop ne '')) {          if (($secpolicy ne '') || ($xframeop ne '')) {
             my ($remotehost) = ($url =~ m{^(https?\://[^/?#]+)});              my $remotehost = $remprotocol.'://'.$remhost;
             $remotehost = lc($remotehost);  
             my ($origin,$protocol,$port);              my ($origin,$protocol,$port);
             if ($ENV{'SERVER_PORT'} =~/^\d+$/) {              if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
                 $port = $ENV{'SERVER_PORT'};                  $port = $ENV{'SERVER_PORT'};
Line 18302  sub is_nonframeable { Line 18392  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;      return $uselink;
 }  }
   
   
 1;  1;
 __END__;  __END__;
   
Removed from v.1.1328  
changed lines
  Added in v.1.1332

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>