version 1.1075.2.137, 2019/08/22 00:11:04
|
version 1.1075.2.141.2.2, 2020/02/04 22:28:29
|
Line 83 use Crypt::DES;
|
Line 83 use Crypt::DES;
|
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use File::Copy(); |
use File::Copy(); |
use File::Path(); |
use File::Path(); |
|
use String::CRC32(); |
|
use Short::URL(); |
|
|
# ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
Line 3175 sub check_passwd_rules {
|
Line 3177 sub check_passwd_rules {
|
my ($domain,$plainpass) = @_; |
my ($domain,$plainpass) = @_; |
my %passwdconf = &Apache::lonnet::get_passwdconf($domain); |
my %passwdconf = &Apache::lonnet::get_passwdconf($domain); |
my ($min,$max,@chars,@brokerule,$warning); |
my ($min,$max,@chars,@brokerule,$warning); |
|
$min = $Apache::lonnet::passwdmin; |
if (ref($passwdconf{'chars'}) eq 'ARRAY') { |
if (ref($passwdconf{'chars'}) eq 'ARRAY') { |
if ($passwdconf{'min'} =~ /^\d+$/) { |
if ($passwdconf{'min'} =~ /^\d+$/) { |
$min = $passwdconf{'min'}; |
if ($passwdconf{'min'} > $min) { |
|
$min = $passwdconf{'min'}; |
|
} |
} |
} |
if ($passwdconf{'max'} =~ /^\d+$/) { |
if ($passwdconf{'max'} =~ /^\d+$/) { |
$max = $passwdconf{'max'}; |
$max = $passwdconf{'max'}; |
} |
} |
@chars = @{$passwdconf{'chars'}}; |
@chars = @{$passwdconf{'chars'}}; |
} else { |
|
$min = 7; |
|
} |
} |
if (($min) && (length($plainpass) < $min)) { |
if (($min) && (length($plainpass) < $min)) { |
push(@brokerule,'min'); |
push(@brokerule,'min'); |
Line 5025 sub check_ip_acc {
|
Line 5028 sub check_ip_acc {
|
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
return 1; |
return 1; |
} |
} |
my $allowed=0; |
my $allowed; |
my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
|
|
my $name; |
my $name; |
foreach my $pattern (split(',',$acc)) { |
my %access = ( |
$pattern =~ s/^\s*//; |
allowfrom => 1, |
$pattern =~ s/\s*$//; |
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 =~ /\*$/) { |
if ($pattern =~ /\*$/) { |
#35.8.* |
#35.8.* |
$pattern=~s/\*//; |
$pattern=~s/\*//; |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
#35.8.3.[34-56] |
#35.8.3.[34-56] |
my $low=$2; |
my $low=$2; |
Line 5043 sub check_ip_acc {
|
Line 5067 sub check_ip_acc {
|
$pattern=$1; |
$pattern=$1; |
if ($ip =~ /^\Q$pattern\E/) { |
if ($ip =~ /^\Q$pattern\E/) { |
my $last=(split(/\./,$ip))[3]; |
my $last=(split(/\./,$ip))[3]; |
if ($last <=$high && $last >=$low) { $allowed=1; } |
if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } |
} |
} |
} elsif ($pattern =~ /^\*/) { |
} elsif ($pattern =~ /^\*/) { |
#*.msu.edu |
#*.msu.edu |
Line 5053 sub check_ip_acc {
|
Line 5077 sub check_ip_acc {
|
my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
($name)=gethostbyaddr($netaddr,AF_INET); |
($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+/) { |
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
#127.0.0.1 |
#127.0.0.1 |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
} else { |
} else { |
#some.name.com |
#some.name.com |
if (!defined($name)) { |
if (!defined($name)) { |
Line 5064 sub check_ip_acc {
|
Line 5088 sub check_ip_acc {
|
my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
($name)=gethostbyaddr($netaddr,AF_INET); |
($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; |
return $allowed; |
} |
} |
Line 6752 table.LC_prior_tries td {
|
Line 6783 table.LC_prior_tries td {
|
padding: 6px; |
padding: 6px; |
} |
} |
|
|
.LC_answer_unknown { |
.LC_answer_unknown, |
|
.LC_answer_warning { |
background: orange; |
background: orange; |
color: black; |
color: black; |
padding: 6px; |
padding: 6px; |
Line 7743 ul.LC_funclist li {
|
Line 7775 ul.LC_funclist li {
|
cursor:pointer; |
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 by TTH when "Default set of options to pass to tth/m |
styles used by TTH when "Default set of options to pass to tth/m |
when converting TeX" in course settings has been set |
when converting TeX" in course settings has been set |
Line 14179 defdom (domain for which to retrieve con
|
Line 14219 defdom (domain for which to retrieve con
|
origmail (scalar - email address of recipient from loncapa.conf, |
origmail (scalar - email address of recipient from loncapa.conf, |
i.e., predates configuration by DC via domainprefs.pm |
i.e., predates configuration by DC via domainprefs.pm |
|
|
|
$requname username of requester (if mailing type is helpdeskmail) |
|
|
|
$requdom domain of requester (if mailing type is helpdeskmail) |
|
|
|
$reqemail e-mail address of requester (if mailing type is helpdeskmail) |
|
|
Returns: comma separated list of addresses to which to send e-mail. |
Returns: comma separated list of addresses to which to send e-mail. |
|
|
=back |
=back |
Line 14188 Returns: comma separated list of address
|
Line 14234 Returns: comma separated list of address
|
############################################################ |
############################################################ |
############################################################ |
############################################################ |
sub build_recipient_list { |
sub build_recipient_list { |
my ($defmail,$mailing,$defdom,$origmail) = @_; |
my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; |
my @recipients; |
my @recipients; |
my ($otheremails,$lastresort,$allbcc,$addtext); |
my ($otheremails,$lastresort,$allbcc,$addtext); |
my %domconfig = |
my %domconfig = |
Line 14229 sub build_recipient_list {
|
Line 14275 sub build_recipient_list {
|
} elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
$lastresort = $origmail; |
$lastresort = $origmail; |
} |
} |
|
if ($mailing eq 'helpdeskmail') { |
|
if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && |
|
(keys(%{$domconfig{'contacts'}{'overrides'}}))) { |
|
my ($inststatus,$inststatus_checked); |
|
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && |
|
($env{'user.domain'} ne 'public')) { |
|
$inststatus_checked = 1; |
|
$inststatus = $env{'environment.inststatus'}; |
|
} |
|
unless ($inststatus_checked) { |
|
if (($requname ne '') && ($requdom ne '')) { |
|
if (($requname =~ /^$match_username$/) && |
|
($requdom =~ /^$match_domain$/) && |
|
(&Apache::lonnet::domain($requdom))) { |
|
my $requhome = &Apache::lonnet::homeserver($requname, |
|
$requdom); |
|
unless ($requhome eq 'no_host') { |
|
my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); |
|
$inststatus = $userenv{'inststatus'}; |
|
$inststatus_checked = 1; |
|
} |
|
} |
|
} |
|
} |
|
unless ($inststatus_checked) { |
|
if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { |
|
my %srch = (srchby => 'email', |
|
srchdomain => $defdom, |
|
srchterm => $reqemail, |
|
srchtype => 'exact'); |
|
my %srch_results = &Apache::lonnet::usersearch(\%srch); |
|
foreach my $uname (keys(%srch_results)) { |
|
if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { |
|
$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); |
|
$inststatus_checked = 1; |
|
last; |
|
} |
|
} |
|
unless ($inststatus_checked) { |
|
my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); |
|
if ($dirsrchres eq 'ok') { |
|
foreach my $uname (keys(%srch_results)) { |
|
if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { |
|
$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); |
|
$inststatus_checked = 1; |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if ($inststatus ne '') { |
|
foreach my $status (split(/\:/,$inststatus)) { |
|
if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { |
|
my @contacts = ('adminemail','supportemail'); |
|
foreach my $item (@contacts) { |
|
if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { |
|
my $addr = $domconfig{'contacts'}{'overrides'}{$status}; |
|
if (!grep(/^\Q$addr\E$/,@recipients)) { |
|
push(@recipients,$addr); |
|
} |
|
} |
|
} |
|
$otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; |
|
if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { |
|
my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); |
|
my @ok_bccs; |
|
foreach my $bcc (@bccs) { |
|
$bcc =~ s/^\s+//g; |
|
$bcc =~ s/\s+$//g; |
|
if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { |
|
if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { |
|
push(@ok_bccs,$bcc); |
|
} |
|
} |
|
} |
|
if (@ok_bccs > 0) { |
|
$allbcc = join(', ',@ok_bccs); |
|
} |
|
} |
|
$addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
} elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
$lastresort = $origmail; |
$lastresort = $origmail; |
} |
} |
|
|
if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { |
if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { |
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { |
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
Line 17061 sub des_decrypt {
|
Line 17194 sub des_decrypt {
|
return $plaintext; |
return $plaintext; |
} |
} |
|
|
|
sub make_short_symbs { |
|
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); |
|
my %tocreate; |
|
if (keys(%resources)) { |
|
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
|
my $symb = $resources{$item}; |
|
if ($symb) { |
|
$tocreate{$cnum.'&'.$symb} = 1; |
|
} |
|
} |
|
} |
|
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; |
|
my $lockhash = { |
|
"lock\0$now" => $env{'user.name'}. |
|
':'.$env{'user.domain'}, |
|
}; |
|
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')); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
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 { |
sub is_nonframeable { |
my ($url,$absolute,$hostname,$ip,$nocache) = @_; |
my ($url,$absolute,$hostname,$ip,$nocache) = @_; |
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); |
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); |
Line 17084 sub is_nonframeable {
|
Line 17342 sub is_nonframeable {
|
} |
} |
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 $ua = LWP::UserAgent->new; |
|
$ua->timeout(5); |
|
my $response=$ua->request($request); |
if ($response->is_success()) { |
if ($response->is_success()) { |
my $secpolicy = lc($response->header('content-security-policy')); |
my $secpolicy = lc($response->header('content-security-policy')); |
my $xframeop = lc($response->header('x-frame-options')); |
my $xframeop = lc($response->header('x-frame-options')); |