--- loncom/lonnet/perl/lonnet.pm 2021/04/18 02:08:47 1.1447 +++ 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.1447 2021/04/18 02:08:47 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; @@ -740,6 +741,9 @@ sub check_for_valid_session { if (ref($userhashref) eq 'HASH') { $userhashref->{'name'} = $disk_env{'user.name'}; $userhashref->{'domain'} = $disk_env{'user.domain'}; + if ($disk_env{'request.role'}) { + $userhashref->{'role'} = $disk_env{'request.role'}; + } $userhashref->{'lti'} = $disk_env{'request.lti.login'}; if ($userhashref->{'lti'}) { $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'}; @@ -973,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 @@ -1018,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; } } @@ -2778,7 +2784,7 @@ sub get_domain_defaults { } } if (ref($domconfig{'wafproxy'}) eq 'HASH') { - foreach my $item ('ipheader','trusted','vpnint','vpnext') { + foreach my $item ('ipheader','trusted','vpnint','vpnext','sslopt') { if ($domconfig{'wafproxy'}{$item}) { $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item}; } @@ -2848,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}; @@ -2858,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; @@ -8235,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; } @@ -8248,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; } @@ -8523,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; @@ -8555,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 '. @@ -14351,6 +14391,22 @@ sub uses_sts { return; } +sub waf_allssl { + my ($host_name) = @_; + my $alias = &get_proxy_alias(); + if ($host_name eq '') { + $host_name = $ENV{'SERVER_NAME'}; + } + if (($host_name ne '') && ($alias eq $host_name)) { + my $serverhomedom = &host_domain($perlvar{'lonHostID'}); + my %defdomdefaults = &get_domain_defaults($serverhomedom); + if ($defdomdefaults{'waf_sslopt'}) { + return $defdomdefaults{'waf_sslopt'}; + } + } + return; +} + sub get_requestor_ip { my ($r,$nolookup,$noproxy) = @_; my $from_ip; @@ -14419,6 +14475,7 @@ sub get_proxy_settings { trusted => $domdefaults{'waf_trusted'}, vpnint => $domdefaults{'waf_vpnint'}, vpnext => $domdefaults{'waf_vpnext'}, + sslopt => $domdefaults{'waf_sslopt'}, }; return $proxyinfo; } @@ -14433,13 +14490,19 @@ sub ip_match { } sub get_proxy_alias { - my $lonhost = $perlvar{'lonHostID'}; - if ($lonhost ne '') { - my ($alias,$cached) = &is_cached_new('proxyalias',$lonhost); + my ($lonid) = @_; + if ($lonid eq '') { + $lonid = $perlvar{'lonHostID'}; + } + if (!defined(&hostname($lonid))) { + return; + } + if ($lonid ne '') { + my ($alias,$cached) = &is_cached_new('proxyalias',$lonid); if ($cached) { return $alias; } - my $dom = &Apache::lonnet::host_domain($lonhost); + my $dom = &Apache::lonnet::host_domain($lonid); if ($dom ne '') { my $cachetime = 60*60*24; my %domconfig = @@ -14447,10 +14510,32 @@ sub get_proxy_alias { my $alias; if (ref($domconfig{'wafproxy'}) eq 'HASH') { if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') { - $alias = $domconfig{'wafproxy'}{'alias'}{$lonhost}; + $alias = $domconfig{'wafproxy'}{'alias'}{$lonid}; } } - return &do_cache_new('proxyalias',$lonhost,$alias,$cachetime); + return &do_cache_new('proxyalias',$lonid,$alias,$cachetime); + } + } + return; +} + +sub use_proxy_alias { + my ($r,$lonid) = @_; + my $alias = &get_proxy_alias($lonid); + if ($alias) { + my $dom = &host_domain($lonid); + if ($dom ne '') { + my $proxyinfo = &get_proxy_settings($dom ); + my ($vpnint,$remote_ip); + if (ref($proxyinfo) eq 'HASH') { + $vpnint = $proxyinfo->{'vpnint'}; + if ($vpnint) { + $remote_ip = &get_requestor_ip($r,1,1); + } + } + unless ($vpnint && &ip_match($remote_ip,$vpnint)) { + return $alias; + } } } return; @@ -14595,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); } @@ -14690,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 |")) { @@ -14758,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;