--- loncom/lonnet/perl/lonnet.pm 2021/05/03 15:27:45 1.1450 +++ loncom/lonnet/perl/lonnet.pm 2021/06/06 23:14:18 1.1456 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1450 2021/05/03 15:27:45 raeburn Exp $ +# $Id: lonnet.pm,v 1.1456 2021/06/06 23:14:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -97,6 +97,7 @@ use Digest::MD5; use Math::Random; use File::MMagic; use Net::CIDR; +use Sys::Hostname::FQDN(); use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; use LONCAPA::lonmetadata; @@ -976,7 +977,7 @@ sub userload { # ------------------------------ Find server with least workload from spare.tab sub spareserver { - my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_; + my ($r,$loadpercent,$userloadpercent,$want_server_name,$udom) = @_; my $spare_server; if ($userloadpercent !~ /\d/) { $userloadpercent=0; } my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent @@ -1021,6 +1022,8 @@ sub spareserver { if ($protocol{$spare_server} eq 'https') { $protocol = $protocol{$spare_server}; } + my $alias = &Apache::lonnet::use_proxy_alias($r,$spare_server); + $hostname = $alias if ($alias ne ''); $spare_server = $protocol.'://'.$hostname; } } @@ -2851,7 +2854,7 @@ sub retrieve_instcodes { } sub course_portal_url { - my ($cnum,$cdom) = @_; + my ($cnum,$cdom,$r) = @_; my $chome = &homeserver($cnum,$cdom); my $hostname = &hostname($chome); my $protocol = $protocol{$chome}; @@ -2861,6 +2864,8 @@ sub course_portal_url { if ($domdefaults{'portal_def'}) { $firsturl = $domdefaults{'portal_def'}; } else { + my $alias = &Apache::lonnet::use_proxy_alias($r,$chome); + $hostname = $alias if ($alias ne ''); $firsturl = $protocol.'://'.$hostname; } return $firsturl; @@ -8238,8 +8243,8 @@ sub allowed { my $adom = $1; foreach my $key (keys(%env)) { if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) { - my ($start,$end) = split('.',$env{$key}); - if (($now >= $start) && (!$end || $end < $now)) { + my ($start,$end) = split(/\./,$env{$key}); + if (($now >= $start) && (!$end || $end > $now)) { $ownaccess = 1; last; } @@ -8251,8 +8256,8 @@ sub allowed { foreach my $role ('ca','aa') { if ($env{"user.role.$role./$adom/$aname"}) { my ($start,$end) = - split('.',$env{"user.role.$role./$adom/$aname"}); - if (($now >= $start) && (!$end || $end < $now)) { + split(/\./,$env{"user.role.$role./$adom/$aname"}); + if (($now >= $start) && (!$end || $end > $now)) { $ownaccess = 1; last; } @@ -8526,16 +8531,48 @@ sub allowed { # # Possibly locked functionality, check all courses +# In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma. # Locks might take effect only after 10 minutes cache expiration for other -# courses, and 2 minutes for current course +# courses, and 2 minutes for current course, in which user has st or ta role +# which is neither expired nor a future role (unless current course). - my $envkey; + my ($needlockcheck,$now,$crsonly); if ($thisallowed=~/L/) { - foreach $envkey (keys(%env)) { + $now = time; + if ($priv eq 'bre') { + if ($uri ne '') { + if ($orguri =~ m{^/+res/}) { + if ($uri =~ m{^lib/templates/}) { + if ($env{'request.course.id'}) { + $crsonly = 1; + $needlockcheck = 1; + } + } else { + $needlockcheck = 1; + } + } elsif ($env{'request.course.id'}) { + my ($crsdom,$crsnum) = split('_',$env{'request.course.id'}); + if (($uri =~ m{^(adm|uploaded|public)/$crsdom/$crsnum/}) || + ($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg|bulletinboard)$})) { + $crsonly = 1; + } + $needlockcheck = 1; + } + } + } elsif (($priv eq 'pch') || ($priv eq 'plc') || ($priv eq 'pac') || ($priv eq 'sma')) { + $needlockcheck = 1; + } + } + if ($needlockcheck) { + foreach my $envkey (keys(%env)) { if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { my $courseid=$2; my $roleid=$1.'.'.$2; $courseid=~s/^\///; + unless ($env{'request.role'} eq $roleid) { + my ($start,$end) = split(/\./,$env{$envkey}); + next unless (($now >= $start) && (!$end || $end > $now)); + } my $expiretime=600; if ($env{'request.role'} eq $roleid) { $expiretime=120; @@ -8558,7 +8595,7 @@ sub allowed { } if (($env{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/) || ($env{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) { - if ($env{'priv.'.$priv.'.lock.expire'}>time) { + if ($env{$prefix.'priv.'.$priv.'.lock.expire'}>time) { &log($env{'user.domain'},$env{'user.name'}, $env{'user.home'}, 'Locked by priv: '.$priv.' for '.$uri.' due to '. @@ -14643,14 +14680,33 @@ sub get_dns { } while (%alldns) { my ($dns) = sort { $b cmp $a } keys(%alldns); - my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); - my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0); - delete($alldns{$dns}); - next if ($response->is_error()); + my ($contents,@content); + if ($dns eq Sys::Hostname::FQDN::fqdn()) { + my $command = (split('/',$url))[3]; + my ($dir,$file) = &parse_getdns_url($command,$url); + delete($alldns{$dns}); + next if (($dir eq '') || ($file eq '')); + if (open(my $config,'<',"$dir/$file")) { + @content = <$config>); + close($config); + } + if ($url eq '/adm/dns/loncapaCRL') { + $contents = join('',@content); + } + } else { + my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0); + delete($alldns{$dns}); + next if ($response->is_error()); + if ($url eq '/adm/dns/loncapaCRL') { + $contents = $response->content; + } else { + @content = split("\n",$response->content); + } + } if ($url eq '/adm/dns/loncapaCRL') { - return &$func($response); + return &$func($contents); } else { - my @content = split("\n",$response->content); unless ($nocache) { &do_cache_new('dns',$url,\@content,30*24*60*60); } @@ -14738,14 +14794,14 @@ sub fetch_crl_pemfile { } sub save_crl_pem { - my ($response) = @_; + my ($content) = @_; my ($msg,$hadchanges); - if (ref($response)) { + if ($content ne '') { my $now = time; my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'}; my $tmpcrl = $tmpdir.'/'.$perlvar{'lonnetCertRevocationList'}.'_'.$now.'.'.$$.'.tmp'; if (open(my $fh,'>',"$tmpcrl")) { - print $fh $response->content; + print $fh $content; close($fh); if (-e $lonca) { if (open(PIPE,"openssl crl -in $tmpcrl -inform pem -CAfile $lonca -noout 2>&1 |")) { @@ -14806,6 +14862,24 @@ sub save_crl_pem { return ($msg,$hadchanges); } +sub parse_getdns_url { + my ($command,$url) = @_; + my $dir = $perlvar{'lonTabDir'}; + my $file; + if ($command eq 'hosts') { + $file = 'dns_hosts.tab'; + } elsif ($command eq 'domain') { + $file = 'dns_domain.tab'; + } elsif ($command eq 'checksums') { + my $version = (split('/',$url))[4]; + $file = "dns_checksums/$version.tab", + } elsif ($command eq 'loncapaCRL') { + $dir = $perlvar{'lonCertificateDirectory'}; + $file = $perlvar{'lonnetCertRevocationList'}; + } + return ($dir,$file); +} + # ------------------------------------------------------------ Read domain file { my $loaded;