Return to lontrans.pm CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lontrans.pm between versions 1.14.10.2 and 1.14.10.2.2.1

version 1.14.10.2, 2021/12/14 20:59:19	version 1.14.10.2.2.1, 2022/01/02 20:43:50
Line 33 use Apache::Constants qw(:common :remote	Line 33 use Apache::Constants qw(:common :remote
use Apache::lonnet();	use Apache::lonnet();
use Apache::loncommon;	use Apache::loncommon;
use Apache::File();	use Apache::File();
use LONCAPA;	use LONCAPA qw(:DEFAULT :match);


sub handler {	sub handler {
my $r = shift;	my $r = shift;
Line 59 sub handler {	Line 58 sub handler {
my ($redirect,$remote_ip);	my ($redirect,$remote_ip);
if ($hdrhost eq $alias) {	if ($hdrhost eq $alias) {
$remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);	$remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
if (($vpnext && &Apache::lonnet::ip_match($remote_ip,$vpnext))) {	if (($vpnext && &Apache::lonnet::ip_match($remote_ip,$vpnext)) &&
	($r->uri !~ m{^/adm/(lti\|launch)/})) {
$redirect = $hostname;	$redirect = $hostname;
}	}
if ($r->uri eq $ssourl) {	if ($r->uri eq $ssourl) {
Line 76 sub handler {	Line 76 sub handler {
$remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);	$remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);
unless (($remote_ip eq '127.0.0.1') \|\| ($remote_ip eq '::1') \|\|	unless (($remote_ip eq '127.0.0.1') \|\| ($remote_ip eq '::1') \|\|
($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) \|\|	($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) \|\|
	($r->uri=~m{^/adm/(lti\|launch)/}) \|\|
($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {	($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {
$redirect = $alias;	$redirect = $alias;
if (($r->uri=~m{^/raw/}) \|\| ($r->uri=~m{^/adm/dns/})) {	if (($r->uri=~m{^/raw/}) \|\| ($r->uri=~m{^/adm/dns/})) {
Line 119 sub handler {	Line 120 sub handler {
$uri = $1.&escape($2).$3;	$uri = $1.&escape($2).$3;
}	}
my $location = $protocol.'://'.$redirect.$uri;	my $location = $protocol.'://'.$redirect.$uri;
if ($r->args) {	if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
	my $token = &set_token($r,$r->uri);
	unless ($token eq '') {
	$location .= '?ttoken='.$token;
	}
	} elsif ($r->args) {
$location .= '?'.$r->args;	$location .= '?'.$r->args;
}	}
$r->header_out(Location => $location);	$r->header_out(Location => $location);
Line 127 sub handler {	Line 133 sub handler {
}	}
}	}
}	}
	if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
	my $token = &set_token($r,$r->uri);
	unless ($token eq '') {
	$r->args('ttoken='.$token);
	}
	}
if ($r->uri=~m\|^(/raw)?/uploaded/\|) {	if ($r->uri=~m\|^(/raw)?/uploaded/\|) {
my $fn = $r->uri();	my $fn = $r->uri();
$fn=~s/^\/raw//;	$fn=~s/^\/raw//;
Line 165 sub set_token {	Line 177 sub set_token {
foreach my $pair (split(/&/,$r->args)) {	foreach my $pair (split(/&/,$r->args)) {
my ($name,$value) = split(/=/,$pair);	my ($name,$value) = split(/=/,$pair);
$name = &LONCAPA::unescape($name);	$name = &LONCAPA::unescape($name);
next unless (($name eq 'role') \|\| ($name eq 'symb'));	next unless (($name eq 'role') \|\| ($name eq 'symb') \|\|
	($name eq 'ltoken') \|\| ($name eq 'linkkey') \|\|
	($name eq 'ttoken'));
$value =~ tr/+/ /;	$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$info{$name} = $value;	$info{$name} = $value;
}	}
	if ($info{'ttoken'}) {
	my %current = &Apache::lonnet::tmpget($info{'ttoken'});
	delete($info{'ttoken'});
	if ($current{'origurl'} eq $r->uri) {
	return if (keys(%current));
	}
	}
	}
	#
	# To be able to support deep-linking for a shortened URL, i.e.,
	# /tiny/$dom/$id with (a) linkkey included in POSTed data and
	# data and (b) non-Shibboleth SSO in use, ltoken (or linkprot
	# if sending to /adm/migrateuser), or linkkey are written to a
	# .tmp file in /home/httpd/perl/tmp and the query string is
	# replaced with ttoken=tokenid. This does mean other POSTed
	# data will be discarded.
	#
	if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
	unless (($info{'ltoken'}) \|\| ($info{'linkkey'} ne '')) {
	&Apache::lonacc::get_posted_cgi($r,['linkkey']);
	if ($env{'form.linkkey'} ne '') {
	$info{'linkkey'} = $env{'form.linkkey'};
	}
	}
}	}
if ($dest eq '/adm/migrateuser') {	if ($dest eq '/adm/migrateuser') {
	if ($info{'ltoken'}) {
	my %link_info = &Apache::lonnet::tmpget($info{'ltoken'});
	if ($link_info{'linkprot'}) {
	$info{'linkprot'} = $link_info{'linkprot'};
	}
	&Apache::lonnet::tmpdel($info{'ltoken'});;
	delete($info{'ltoken'});
	}
unless ($info{'role'}) {	unless ($info{'role'}) {
if ($user{'role'} ne '') {	if ($user{'role'} ne '') {
$info{'role'} = $user{'role'};	$info{'role'} = $user{'role'};
Line 199 sub set_token {	Line 245 sub set_token {
1;	1;
__END__	__END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.14.10.2
changed lines
	Added in v.1.14.10.2.2.1