version 1.1442, 2021/02/08 14:50:53
|
version 1.1448, 2021/04/18 02:24:05
|
Line 740 sub check_for_valid_session {
|
Line 740 sub check_for_valid_session {
|
if (ref($userhashref) eq 'HASH') { |
if (ref($userhashref) eq 'HASH') { |
$userhashref->{'name'} = $disk_env{'user.name'}; |
$userhashref->{'name'} = $disk_env{'user.name'}; |
$userhashref->{'domain'} = $disk_env{'user.domain'}; |
$userhashref->{'domain'} = $disk_env{'user.domain'}; |
|
if ($disk_env{'request.role'}) { |
|
$userhashref->{'role'} = $disk_env{'request.role'}; |
|
} |
$userhashref->{'lti'} = $disk_env{'request.lti.login'}; |
$userhashref->{'lti'} = $disk_env{'request.lti.login'}; |
if ($userhashref->{'lti'}) { |
if ($userhashref->{'lti'}) { |
$userhashref->{'ltitarget'} = $disk_env{'request.lti.target'}; |
$userhashref->{'ltitarget'} = $disk_env{'request.lti.target'}; |
Line 3482 sub ssi_body {
|
Line 3485 sub ssi_body {
|
# --------------------------------------------------------- Server Side Include |
# --------------------------------------------------------- Server Side Include |
|
|
sub absolute_url { |
sub absolute_url { |
my ($host_name) = @_; |
my ($host_name,$unalias,$keep_proto) = @_; |
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
if ($host_name eq '') { |
if ($host_name eq '') { |
$host_name = $ENV{'SERVER_NAME'}; |
$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; |
return $protocol.$host_name; |
} |
} |
|
|
Line 3503 sub absolute_url {
|
Line 3524 sub absolute_url {
|
sub ssi { |
sub ssi { |
|
|
my ($fn,%form)=@_; |
my ($fn,%form)=@_; |
my $request; |
my ($host,$request,$response); |
|
$host = &absolute_url('',1); |
|
|
$form{'no_update_last_known'}=1; |
$form{'no_update_last_known'}=1; |
&Apache::lonenc::check_encrypt(\$fn); |
&Apache::lonenc::check_encrypt(\$fn); |
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$request=new HTTP::Request('POST',$host.$fn); |
$request->content(join('&',map { |
$request->content(join('&',map { |
my $name = escape($_); |
my $name = escape($_); |
"$name=" . ( ref($form{$_}) eq 'ARRAY' |
"$name=" . ( ref($form{$_}) eq 'ARRAY' |
Line 3516 sub ssi {
|
Line 3538 sub ssi {
|
: &escape($form{$_}) ); |
: &escape($form{$_}) ); |
} keys(%form))); |
} keys(%form))); |
} else { |
} else { |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
$request=new HTTP::Request('GET',$host.$fn); |
} |
} |
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
Line 3530 sub ssi {
|
Line 3552 sub ssi {
|
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { |
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { |
$islocal = 1; |
$islocal = 1; |
} |
} |
my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, |
$response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, |
'','','',$islocal); |
'','','',$islocal); |
|
|
if (wantarray) { |
if (wantarray) { |
return ($response->content, $response); |
return ($response->content, $response); |
Line 4074 sub clean_filename {
|
Line 4096 sub clean_filename {
|
# Replace all .\d. sequences with _\d. so they no longer look like version |
# Replace all .\d. sequences with _\d. so they no longer look like version |
# numbers |
# numbers |
$fname=~s/\.(\d+)(?=\.)/_$1/g; |
$fname=~s/\.(\d+)(?=\.)/_$1/g; |
|
# Replace three or more adjacent underscores with one for consistency |
|
# with loncfile::filename_check() so complete url can be extracted by |
|
# lonnet::decode_symb() |
|
$fname=~s/_{3,}/_/g; |
return $fname; |
return $fname; |
} |
} |
|
|
Line 9423 sub auto_validate_instcode {
|
Line 9449 sub auto_validate_instcode {
|
return ($outcome,$description,$defaultcredits); |
return ($outcome,$description,$defaultcredits); |
} |
} |
|
|
|
sub auto_validate_inst_crosslist { |
|
my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_; |
|
my ($homeserver,$response); |
|
if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { |
|
$homeserver = &homeserver($cnum,$cdom); |
|
} |
|
if (!defined($homeserver)) { |
|
if ($cdom =~ /^$match_domain$/) { |
|
$homeserver = &domain($cdom,'primary'); |
|
} |
|
} |
|
unless (($homeserver eq '') || ($homeserver eq 'no_host')) { |
|
$response=&reply('autovalidateinstcrosslist:'.$cdom.':'. |
|
&escape($instcode).':'.&escape($inst_xlist).':'. |
|
&escape($coowner),$homeserver); |
|
} |
|
return $response; |
|
} |
|
|
sub auto_create_password { |
sub auto_create_password { |
my ($cnum,$cdom,$authparam,$udom) = @_; |
my ($cnum,$cdom,$authparam,$udom) = @_; |
my ($homeserver,$response); |
my ($homeserver,$response); |
Line 10244 sub autoupdate_coowners {
|
Line 10289 sub autoupdate_coowners {
|
if ($domdesign{$cdom.'.autoassign.co-owners'}) { |
if ($domdesign{$cdom.'.autoassign.co-owners'}) { |
my %coursehash = &coursedescription($cdom.'_'.$cnum); |
my %coursehash = &coursedescription($cdom.'_'.$cnum); |
my $instcode = $coursehash{'internal.coursecode'}; |
my $instcode = $coursehash{'internal.coursecode'}; |
|
my $xlists = $coursehash{'internal.crosslistings'}; |
if ($instcode ne '') { |
if ($instcode ne '') { |
if (($start && $start <= $now) && ($end == 0) || ($end > $now)) { |
if (($start && $start <= $now) && ($end == 0) || ($end > $now)) { |
unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) { |
unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) { |
my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners); |
my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners); |
my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom); |
my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom); |
|
unless ($result eq 'valid') { |
|
if ($xlists ne '') { |
|
foreach my $xlist (split(',',$xlists)) { |
|
my ($inst_crosslist,$lcsec) = split(':',$xlist); |
|
$result = |
|
&auto_validate_inst_crosslist($cnum,$cdom,$instcode, |
|
$inst_crosslist,$uname.':'.$udom); |
|
last if ($result eq 'valid'); |
|
} |
|
} |
|
} |
if ($result eq 'valid') { |
if ($result eq 'valid') { |
if ($coursehash{'internal.co-owners'}) { |
if ($coursehash{'internal.co-owners'}) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
Line 10261 sub autoupdate_coowners {
|
Line 10318 sub autoupdate_coowners {
|
} else { |
} else { |
push(@newcoowners,$uname.':'.$udom); |
push(@newcoowners,$uname.':'.$udom); |
} |
} |
} else { |
} elsif ($coursehash{'internal.co-owners'}) { |
if ($coursehash{'internal.co-owners'}) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) { |
unless ($coowner eq $uname.':'.$udom) { |
unless ($coowner eq $uname.':'.$udom) { |
push(@newcoowners,$coowner); |
push(@newcoowners,$coowner); |
|
} |
|
} |
|
unless (@newcoowners > 0) { |
|
$delcoowners = 1; |
|
$coowners = ''; |
|
} |
} |
} |
} |
|
unless (@newcoowners > 0) { |
|
$delcoowners = 1; |
|
$coowners = ''; |
|
} |
} |
} |
if (@newcoowners || $delcoowners) { |
if (@newcoowners || $delcoowners) { |
&store_coowners($cdom,$cnum,$coursehash{'home'}, |
&store_coowners($cdom,$cnum,$coursehash{'home'}, |
Line 14303 sub get_requestor_ip {
|
Line 14358 sub get_requestor_ip {
|
my ($r,$nolookup,$noproxy) = @_; |
my ($r,$nolookup,$noproxy) = @_; |
my $from_ip; |
my $from_ip; |
if (ref($r)) { |
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 { |
} else { |
$from_ip = $ENV{'REMOTE_ADDR'}; |
$from_ip = $ENV{'REMOTE_ADDR'}; |
} |
} |