--- loncom/lonnet/perl/lonnet.pm 2021/05/10 18:13:50 1.1453 +++ loncom/lonnet/perl/lonnet.pm 2021/06/06 23:18:59 1.1457 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1453 2021/05/10 18:13:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.1457 2021/06/06 23:18:59 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; @@ -8530,11 +8531,39 @@ 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 ($needlockcheck,$now,$crsonly); if ($thisallowed=~/L/) { - my $now = time; + $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; @@ -8566,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 '. @@ -14651,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); } @@ -14746,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 |")) { @@ -14814,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;