--- loncom/lonnet/perl/lonnet.pm 2021/03/31 02:19:59 1.1444 +++ 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.1444 2021/03/31 02:19:59 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; @@ -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; @@ -3482,11 +3490,29 @@ sub ssi_body { # --------------------------------------------------------- Server Side Include sub absolute_url { - my ($host_name) = @_; + my ($host_name,$unalias,$keep_proto) = @_; my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); if ($host_name eq '') { $host_name = $ENV{'SERVER_NAME'}; } + if ($unalias) { + my $alias = &get_proxy_alias(); + if ($alias eq $host_name) { + my $lonhost = $perlvar{'lonHostID'}; + my $hostname = &hostname($lonhost); + my $lcproto; + if (($keep_proto) || ($hostname eq '')) { + $lcproto = $protocol; + } else { + $lcproto = $protocol{$lonhost}; + $lcproto = 'http' if ($lcproto ne 'https'); + $lcproto .= '://'; + } + unless ($hostname eq '') { + return $lcproto.$hostname; + } + } + } return $protocol.$host_name; } @@ -3503,12 +3529,13 @@ sub absolute_url { sub ssi { my ($fn,%form)=@_; - my $request; + my ($host,$request,$response); + $host = &absolute_url('',1); $form{'no_update_last_known'}=1; &Apache::lonenc::check_encrypt(\$fn); if (%form) { - $request=new HTTP::Request('POST',&absolute_url().$fn); + $request=new HTTP::Request('POST',$host.$fn); $request->content(join('&',map { my $name = escape($_); "$name=" . ( ref($form{$_}) eq 'ARRAY' @@ -3516,7 +3543,7 @@ sub ssi { : &escape($form{$_}) ); } keys(%form))); } else { - $request=new HTTP::Request('GET',&absolute_url().$fn); + $request=new HTTP::Request('GET',$host.$fn); } $request->header(Cookie => $ENV{'HTTP_COOKIE'}); @@ -3530,8 +3557,8 @@ sub ssi { ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { $islocal = 1; } - my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, - '','','',$islocal); + $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, + '','','',$islocal); if (wantarray) { return ($response->content, $response); @@ -8216,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; } @@ -8229,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; } @@ -8504,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; @@ -8536,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 '. @@ -9441,7 +9500,7 @@ sub auto_validate_inst_crosslist { unless (($homeserver eq '') || ($homeserver eq 'no_host')) { $response=&reply('autovalidateinstcrosslist:'.$cdom.':'. &escape($instcode).':'.&escape($inst_xlist).':'. - &escape($coowner),$homeserver))); + &escape($coowner),$homeserver); } return $response; } @@ -10278,10 +10337,9 @@ sub autoupdate_coowners { foreach my $xlist (split(',',$xlists)) { my ($inst_crosslist,$lcsec) = split(':',$xlist); $result = - &Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$instcode, - $inst_crosslist,$uname.':'.$udom); - last if ($result eq 'valid'); - } + &auto_validate_inst_crosslist($cnum,$cdom,$instcode, + $inst_crosslist,$uname.':'.$udom); + last if ($result eq 'valid'); } } } @@ -14333,11 +14391,37 @@ 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; if (ref($r)) { - $from_ip = $r->get_remote_host($nolookup); + if ($r->can('useragent_ip')) { + if ($noproxy && $r->can('client_ip')) { + $from_ip = $r->client_ip(); + } else { + $from_ip = $r->useragent_ip(); + } + } elsif ($r->connection->can('remote_ip')) { + $from_ip = $r->connection->remote_ip(); + } else { + $from_ip = $r->get_remote_host($nolookup); + } } else { $from_ip = $ENV{'REMOTE_ADDR'}; } @@ -14391,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; } @@ -14405,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 = @@ -14419,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; @@ -14567,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); } @@ -14662,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 |")) { @@ -14730,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;