--- loncom/lonnet/perl/lonnet.pm 2021/03/31 02:19:59 1.1444
+++ loncom/lonnet/perl/lonnet.pm 2021/05/10 18:13:50 1.1453
@@ -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.1453 2021/05/10 18:13:50 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -740,6 +740,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 +976,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 +1021,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 +2783,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 +2853,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 +2863,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 +3489,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 +3528,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 +3542,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 +3556,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 +8242,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 +8255,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;
}
@@ -8507,13 +8533,17 @@ sub allowed {
# Locks might take effect only after 10 minutes cache expiration for other
# courses, and 2 minutes for current course
- my $envkey;
if ($thisallowed=~/L/) {
- foreach $envkey (keys(%env)) {
+ my $now = time;
+ 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;
@@ -9441,7 +9471,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 +10308,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 +14362,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 +14446,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 +14461,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 +14481,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;