[LON-CAPA-cvs] cvs: loncom / lond /auth lonacc.pm lonauth.pm lonlogin.pm lonshibauth.pm
raeburn
raeburn at source.lon-capa.org
Tue Oct 26 11:52:55 EDT 2021
raeburn Tue Oct 26 15:52:55 2021 EDT
Modified files:
/loncom/auth lonacc.pm lonauth.pm lonlogin.pm lonshibauth.pm
/loncom lond
Log:
- Use token to store role, symb, linkprot, and/or linkkey when dual log-in
page to support SSO (Shibboleth) and non-SSO is in use, and for "log in
again" retry link for failed login, instead of using query string directly.
- When digest is used by tmpput handler in lond to generate an id, only use
id which does not already exist in LON-CAPA's tmp directory.
-------------- next part --------------
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.198 loncom/auth/lonacc.pm:1.199
--- loncom/auth/lonacc.pm:1.198 Tue Oct 26 14:17:21 2021
+++ loncom/auth/lonacc.pm Tue Oct 26 15:52:54 2021
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Cookie Based Access Handler
#
-# $Id: lonacc.pm,v 1.198 2021/10/26 14:17:21 raeburn Exp $
+# $Id: lonacc.pm,v 1.199 2021/10/26 15:52:54 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -305,7 +305,7 @@
my $query = $r->args;
my %form;
if ($query) {
- my @items = ('role','symb','iptoken','origurl','ltoken','linkkey');
+ my @items = ('role','symb','iptoken','origurl','ltoken','linkkey','logtoken');
&Apache::loncommon::get_unprocessed_cgi($query,\@items);
foreach my $item (@items) {
if (defined($env{'form.'.$item})) {
@@ -324,6 +324,20 @@
}
my ($linkprot,$linkkey);
+ if ($form{'logtoken'}) {
+ my ($firsturl, at rest);
+ my $lonhost = $r->dir_config('lonHostID');
+ my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'},$lonhost);
+ my $delete = &Apache::lonnet::tmpdel($form{'logtoken'});
+ (undef,$firsturl, at rest) = split(/&/,$tmpinfo);
+ foreach my $item (@rest) {
+ my ($key,$value) = split(/=/,$item);
+ $form{$key} = &unescape($value);
+ }
+ if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
+ $form{'origurl'} = $firsturl;
+ }
+ }
if ($form{'ltoken'}) {
my %link_info = &Apache::lonnet::tmpget($form{'ltoken'});
$linkprot = $link_info{'linkprot'};
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.167 loncom/auth/lonauth.pm:1.168
--- loncom/auth/lonauth.pm:1.167 Tue Oct 26 15:10:34 2021
+++ loncom/auth/lonauth.pm Tue Oct 26 15:52:54 2021
@@ -1,7 +1,7 @@
# The LearningOnline Network
# User Authentication Module
#
-# $Id: lonauth.pm,v 1.167 2021/10/26 15:10:34 raeburn Exp $
+# $Id: lonauth.pm,v 1.168 2021/10/26 15:52:54 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -298,37 +298,44 @@
if ($udom) {
$retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom;
}
- if (exists($form->{role})) {
- my $role = &Apache::loncommon::cleanup_html($form->{role});
- if ($role ne '') {
- $retry .= (($retry=~/\?/)?'&':'?').'role='.$role;
- }
- }
- if (exists($form->{symb})) {
- my $symb = &Apache::loncommon::cleanup_html($form->{symb});
- if ($symb ne '') {
- $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb;
- }
- }
- if (exists($form->{firsturl})) {
- my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
- if ($firsturl ne '') {
- $retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl;
- if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
- unless (exists($form->{linkprot})) {
- if (exists($form->{linkkey})) {
- $retry .= 'linkkey='.$form->{linkkey};
+ my $lonhost = $r->dir_config('lonHostID');
+ my $querystr;
+ my $result = &set_retry_token($form,$lonhost,\$querystr);
+ if ($result eq 'fail') {
+ if (exists($form->{role})) {
+ my $role = &Apache::loncommon::cleanup_html($form->{role});
+ if ($role ne '') {
+ $retry .= (($retry=~/\?/)?'&':'?').'role='.$role;
+ }
+ }
+ if (exists($form->{symb})) {
+ my $symb = &Apache::loncommon::cleanup_html($form->{symb});
+ if ($symb ne '') {
+ $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb;
+ }
+ }
+ if (exists($form->{firsturl})) {
+ my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
+ if ($firsturl ne '') {
+ $retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl;
+ if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) {
+ unless (exists($form->{linkprot})) {
+ if (exists($form->{linkkey})) {
+ $retry .= 'linkkey='.$form->{linkkey};
+ }
}
}
}
}
- }
- if (exists($form->{linkprot})) {
- my $ltoken = &Apache::lonnet::tmpput({linkprot => $form->{'linkprot'}},
- $r->dir_config('lonHostID'));
- if ($ltoken) {
- $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
+ if (exists($form->{linkprot})) {
+ my $ltoken = &Apache::lonnet::tmpput({linkprot => $form->{'linkprot'}},
+ $r->dir_config('lonHostID'));
+ if ($ltoken) {
+ $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
+ }
}
+ } elsif ($querystr ne '') {
+ $retry .= (($retry=~/\?/)?'&':'?').$querystr;
}
my $end_page = &Apache::loncommon::end_page();
&Apache::loncommon::content_type($r,'text/html');
@@ -492,37 +499,14 @@
return OK;
}
- my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr,$linkstr)=split(/&/,$tmpinfo);
- if ($rolestr) {
- $rolestr = &unescape($rolestr);
- }
- if ($symbstr) {
- $symbstr= &unescape($symbstr);
- }
- if ($iptokenstr) {
- $iptokenstr = &unescape($iptokenstr);
- }
- if ($linkstr) {
- $linkstr = &unescape($linkstr);
+ my ($key,$firsturl, at rest)=split(/&/,$tmpinfo);
+ foreach my $item (@rest) {
+ my ($key,$value) = split(/=/,$item);
+ $form{$key} = &unescape($value);
}
if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
$form{'firsturl'} = $firsturl;
}
- if ($rolestr =~ /^role=/) {
- (undef,$form{'role'}) = split('=',$rolestr);
- }
- if ($symbstr =~ /^symb=/) {
- (undef,$form{'symb'}) = split('=',$symbstr);
- }
- if ($iptokenstr =~ /^iptoken=/) {
- (undef,$form{'iptoken'}) = split('=',$iptokenstr);
- }
- if ($linkstr =~ /^linkprot=/) {
- (undef,$form{'linkprot'}) = split('=',$linkstr);
- } elsif ($linkstr =~ /^linkkey=/) {
- (undef,$form{'linkkey'}) = split('=',$linkstr);
- }
-
my $upass = $ENV{HTTPS} ? $form{'upass0'}
: &Apache::loncommon::des_decrypt($key,$form{'upass0'});
@@ -555,7 +539,8 @@
return OK;
}
my $start_page =
- &Apache::loncommon::start_page('Create a user account in LON-CAPA');
+ &Apache::loncommon::start_page('Create a user account in LON-CAPA',
+ '',{'no_inline_link' => 1,});
my $lonhost = $r->dir_config('lonHostID');
my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
my $contacts =
@@ -699,7 +684,7 @@
\%form);
my $switchto = '/adm/switchserver?otherserver='.$otherserver;
if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
- $switchto .= '&origurl='.$firsturl; #should escape
+ $switchto .= '&origurl='.$firsturl;
}
if ($form{'role'}) {
$switchto .= '&role='.$form{'role'};
@@ -730,7 +715,7 @@
\%form);
my $switchto = '/adm/switchserver?otherserver='.$otherserver;
if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
- $switchto .= '&origurl='.$firsturl; #should escape
+ $switchto .= '&origurl='.$firsturl;
}
if ($form{'role'}) {
$switchto .= '&role='.$form{'role'};
@@ -875,6 +860,35 @@
return;
}
+sub set_retry_token {
+ my ($form,$lonhost,$querystr) = @_;
+ if (ref($form) eq 'HASH') {
+ my ($firsturl,$token,$extras, at names);
+ @names = ('role','symb','linkprot','linkkey');
+ foreach my $name (@names) {
+ if ($form->{$name} ne '') {
+ $extras .= '&'.$name.'='.&escape($form->{$name});
+ last if ($name eq 'linkprot');
+ }
+ }
+ my $firsturl = $form->{'firsturl'};
+ if (($firsturl ne '') || ($extras ne '')) {
+ $extras .= ':retry';
+ $token = &Apache::lonnet::reply('tmpput:'.&escape($firsturl).
+ $extras,$lonhost);
+ if (($token eq 'con_lost') || ($token eq 'no_such_host')) {
+ return 'fail';
+ } else {
+ if (ref($querystr)) {
+ $$querystr = 'retry='.$token;
+ }
+ return 'ok';
+ }
+ }
+ }
+ return;
+}
+
sub check_can_host {
my ($r,$form,$authhost,$domdesc) = @_;
return unless (ref($form) eq 'HASH');
@@ -935,13 +949,13 @@
} else {
&success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef,
$form);
+ if ($form->{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
+ $env{'request.deeplink.login'} = $form->{'firsturl'};
+ }
if ($form->{'linkprot'}) {
$env{'request.linkprot'} = $form->{'linkprot'};
- } elsif ($form->{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
- if ($form->{'linkkey'} ne '') {
- $env{'request.linkkey'} = $form->{'linkkey'};
- }
- $env{'request.deeplink.login'} = $form->{'firsturl'};
+ } elsif ($form->{'linkkey'} ne '') {
+ $env{'request.linkkey'} = $form->{'linkkey'};
}
my ($otherserver) = &Apache::lonnet::choose_server($udom);
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.191 loncom/auth/lonlogin.pm:1.192
--- loncom/auth/lonlogin.pm:1.191 Sun Oct 10 23:22:30 2021
+++ loncom/auth/lonlogin.pm Tue Oct 26 15:52:54 2021
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Login Screen
#
-# $Id: lonlogin.pm,v 1.191 2021/10/10 23:22:30 raeburn Exp $
+# $Id: lonlogin.pm,v 1.192 2021/10/26 15:52:54 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,21 +49,45 @@
(join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
$ENV{'REDIRECT_QUERY_STRING'}),
['interface','username','domain','firsturl','localpath','localres',
- 'token','role','symb','iptoken','btoken','ltoken','linkkey','saml']);
- if (!defined($env{'form.firsturl'})) {
- &Apache::lonacc::get_posted_cgi($r,['firsturl']);
- }
- if (!defined($env{'form.firsturl'})) {
- if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
- $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
+ 'token','role','symb','iptoken','btoken','ltoken','linkkey','saml',
+ 'sso','retry']);
+ my $lonhost = $r->dir_config('lonHostID');
+ my $linkkey;
+ if (($env{'form.sso'}) || ($env{'form.retry'})) {
+ my $infotoken;
+ if ($env{'form.sso'}) {
+ $infotoken = $env{'form.sso'};
+ } else {
+ $infotoken = $env{'form.retry'};
+ }
+ my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
+ unless (($data=~/^error/) || ($data eq 'con_lost') ||
+ ($data eq 'no_such_host')) {
+ my %info = &decode_token($data);
+ foreach my $item (keys(%info)) {
+ $env{'form.'.$item} = $info{$item};
+ }
+ &Apache::lonnet::tmpdel($infotoken);
+ }
+ } else {
+ if ($env{'form.linkkey'}) {
+ $linkkey = $env{'form.linkkey'};
+ }
+ if (!defined($env{'form.firsturl'})) {
+ &Apache::lonacc::get_posted_cgi($r,['firsturl']);
+ }
+ if (!defined($env{'form.firsturl'})) {
+ if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
+ $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
+ }
+ }
+ if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
+ (!$env{'form.ltoken'}) && (!$env{'form.linkkey'})) {
+ &Apache::lonacc::get_posted_cgi($r,['linkkey']);
+ }
+ if ($env{'form.firsturl'} eq '/adm/logout') {
+ delete($env{'form.firsturl'});
}
- }
- if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
- (!$env{'form.ltoken'}) && (!$env{'form.linkkey'})) {
- &Apache::lonacc::get_posted_cgi($r,['linkkey']);
- }
- if ($env{'form.firsturl'} eq '/adm/logout') {
- delete($env{'form.firsturl'});
}
# -- check if they are a migrating user
@@ -115,8 +139,6 @@
return OK;
}
- my $lonhost = $r->dir_config('lonHostID');
-
# Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
@@ -306,7 +328,7 @@
$env{'form.interface'}=~s/\W//g;
(undef,undef,undef,undef,undef,undef,my $clientmobile) =
- &Apache::loncommon::decode_user_agent();
+ &Apache::loncommon::decode_user_agent($r);
my $iconpath=
&Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
@@ -315,7 +337,8 @@
my $defdom = $domain;
if ($lonhost ne '') {
unless ($sessiondata{'sessionserver'}) {
- my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie,$linkprot);
+ my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie,
+ $linkprot,$linkkey);
if ($redirect) {
$r->print($redirect);
return OK;
@@ -399,35 +422,27 @@
if ($uextkey>2147483647) { $uextkey-=4294967296; }
# -------------------------------------------------------- Store away log token
- my $tokenextras;
- if ($env{'form.role'}) {
- $tokenextras = '&role='.&escape($env{'form.role'});
- }
- if ($env{'form.symb'}) {
- if (!$tokenextras) {
- $tokenextras = '&';
- }
- $tokenextras .= '&symb='.&escape($env{'form.symb'});
- }
- if ($env{'form.iptoken'}) {
- if (!$tokenextras) {
- $tokenextras = '&&';
- }
- $tokenextras .= '&iptoken='.&escape($env{'form.iptoken'});
- }
- if ($env{'form.ltoken'}) {
- my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
- if ($info{'linkprot'}) {
- if (!$tokenextras) {
- $tokenextras = '&&&';
+ my ($tokenextras,$tokentype);
+ my @names = ('role','symb','iptoken','ltoken','linkkey');
+ foreach my $name (@names) {
+ if ($env{'form.'.$name} ne '') {
+ if ($name eq 'ltoken') {
+ my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
+ if ($info{'linkprot'}) {
+ $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
+ $tokentype = 'link';
+ last;
+ }
+ } else {
+ $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
+ if ($name eq 'linkkey') {
+ $tokentype = 'link';
+ }
}
- $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
- }
- } elsif ($env{'form.linkkey'}) {
- if (!$tokenextras) {
- $tokenextras = '&&&';
}
- $tokenextras .= '&linkkey='.&escape($env{'form.linkkey'});
+ }
+ if ($tokentype) {
+ $tokenextras .= ":$tokentype";
}
my $logtoken=Apache::lonnet::reply(
'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
@@ -811,22 +826,29 @@
if ($samlssourl ne '') {
$ssologin = $samlssourl;
}
- if ($env{'form.firsturl'} ne '') {
- my $querystring = 'origurl=';
- if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
- $querystring .= &uri_escape_utf8($env{'form.firsturl'});
- } else {
- $querystring .= &uri_escape($env{'form.firsturl'});
+ if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
+ my $querystring;
+ if ($env{'form.firsturl'} ne '') {
+ $querystring = 'origurl=';
+ if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
+ $querystring .= &uri_escape_utf8($env{'form.firsturl'});
+ } else {
+ $querystring .= &uri_escape($env{'form.firsturl'});
+ }
+ $querystring = &HTML::Entities::encode($querystring,"'");
}
- $querystring = &HTML::Entities::encode($querystring,"'");
- $ssologin .= (($ssologin=~/\?/)?'&':'?') . $querystring;
- }
- if ($env{'form.ltoken'} ne '') {
- $querystring .= (($querystring eq '')?'':'&') . 'ltoken='.
- &HTML::Entities::encode(&uri_escape($env{'form.ltoken'}));
- } elsif ($env{'form.linkkey'}) {
- $querystring .= (($querystring eq '')?'':'&') . 'linkkey='.
- &HTML::Entities::encode(&uri_escape($env{'form.linkkey'}));
+ if ($env{'form.ltoken'} ne '') {
+ $querystring .= (($querystring eq '')?'':'&') . 'ltoken='.
+ &HTML::Entities::encode(&uri_escape($env{'form.ltoken'}));
+ } elsif ($env{'form.linkkey'}) {
+ $querystring .= (($querystring eq '')?'':'&') . 'linkkey='.
+ &HTML::Entities::encode(&uri_escape($env{'form.linkkey'}));
+ }
+ if ($querystring ne '') {
+ $ssologin .= (($ssologin=~/\?/)?'&':'?') . $querystring;
+ }
+ } elsif ($logtoken ne '') {
+ $ssologin .= (($ssologin=~/\?/)?'&':'?') . 'logtoken='.$logtoken;
}
my $ssohref;
if ($samlssoimg ne '') {
@@ -978,7 +1000,7 @@
}
sub check_loginvia {
- my ($domain,$lonhost,$lonidsdir,$balcookie,$linkprot) = @_;
+ my ($domain,$lonhost,$lonidsdir,$balcookie,$linkprot,$linkkey) = @_;
if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
return;
}
@@ -1038,7 +1060,7 @@
}
}
}
- $output = &redirect_page($newhost,$path,$linkprot);
+ $output = &redirect_page($newhost,$path,$linkprot,$linkkey);
}
}
}
@@ -1047,7 +1069,7 @@
}
sub redirect_page {
- my ($desthost,$path,$linkprot) = @_;
+ my ($desthost,$path,$linkprot,$linkkey) = @_;
my $hostname = &Apache::lonnet::hostname($desthost);
my $protocol = $Apache::lonnet::protocol{$desthost};
$protocol = 'http' if ($protocol ne 'https');
@@ -1063,13 +1085,15 @@
$querystring = &uri_escape($env{'form.firsturl'});
}
$querystring = &HTML::Entities::encode($querystring,"'");
- $url .='?firsturl='.$querystring
+ $url .='?firsturl='.$querystring;
}
if ($linkprot) {
my $ltoken = &Apache::lonnet::tmpput({linkprot => $linkprot},$desthost);
if ($ltoken) {
$url .= (($url =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
}
+ } elsif ($linkkey) {
+ $url .= (($url =~ /\?/) ? '&' : '?').'linkkey='.&uri_escape($linkkey);
}
my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
{'redirect' => [0,$url],});
@@ -1145,5 +1169,19 @@
return '<a href="/adm/createaccount">'.$linkname.'</a>';
}
+sub decode_token {
+ my ($info) = @_;
+ my ($firsturl, at rest)=split(/\&/,$info);
+ my %form;
+ if ($firsturl ne '') {
+ $form{'firsturl'} = &unescape($firsturl);
+ }
+ foreach my $item (@rest) {
+ my ($key,$value) = split(/=/,$item);
+ $form{$key} = &unescape($value);
+ }
+ return %form;
+}
+
1;
__END__
Index: loncom/auth/lonshibauth.pm
diff -u loncom/auth/lonshibauth.pm:1.10 loncom/auth/lonshibauth.pm:1.11
--- loncom/auth/lonshibauth.pm:1.10 Sun Oct 10 23:59:19 2021
+++ loncom/auth/lonshibauth.pm Tue Oct 26 15:52:54 2021
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Redirect Shibboleth authentication to designated URL (/adm/sso).
#
-# $Id: lonshibauth.pm,v 1.10 2021/10/10 23:59:19 raeburn Exp $
+# $Id: lonshibauth.pm,v 1.11 2021/10/26 15:52:54 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -68,8 +68,10 @@
use strict;
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
+use Apache::loncommon;
+use Apache::lonacc;
use Apache::Constants qw(:common REDIRECT);
-use LONCAPA qw(:DEFAULT);
+use LONCAPA qw(:DEFAULT :match);
sub handler {
my $r = shift;
@@ -77,8 +79,7 @@
if (&Apache::lonnet::get_saml_landing()) {
$target = '/adm/login';
}
- my $uri = $r->uri;
- if (($r->user eq '') && ($uri ne $target) && ($uri ne '/adm/sso')) {
+ if (($r->user eq '') && ($r->uri ne $target) && ($r->uri ne '/adm/sso')) {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
my $hostname = &Apache::lonnet::hostname($lonhost);
if (!$hostname) { $hostname = $r->hostname(); }
@@ -90,19 +91,29 @@
$hostname = $alias;
}
my $dest = $protocol.'://'.$hostname.$target;
- if ($r->args ne '') {
- $dest .= (($dest=~/\?/)?'&':'?').$r->args;
- }
- unless (($uri eq '/adm/roles') || ($uri eq '/adm/logout')) {
- if ($target eq '/adm/login') {
- unless ($ENV{'QUERY_STRING'} =~ /firsturl=/) {
- $dest.=(($dest=~/\?/)?'&':'?').'firsturl='.$uri;
- }
- } else {
- unless ($ENV{'QUERY_STRING'} =~ /origurl=/) {
+ if ($target eq '/adm/login') {
+ my $querystring = &set_token($r,$lonhost);
+ if ($querystring ne '') {
+ $dest .= '?'.$querystring;
+ }
+ } else {
+ my $uri = $r->uri;
+ if ($r->args ne '') {
+ $dest .= (($dest=~/\?/)?'&':'?').$r->args;
+ }
+ unless (($uri eq '/adm/roles') || ($uri eq '/adm/logout')) {
+ unless ($r->args =~ /origurl=/) {
$dest.=(($dest=~/\?/)?'&':'?').'origurl='.$uri;
}
}
+ if ($uri =~ m{^/tiny/$match_domain/\w+$}) {
+ unless (($r->args =~ /ltoken=/) || ($r->args =~ /linkkey=/)) {
+ &Apache::lonacc::get_posted_cgi($r,['linkkey']);
+ if ($env{'form.linkkey'} ne '') {
+ $dest.=(($dest=~/\?/)?'&':'?').'linkkey='.$env{'form.linkkey'};
+ }
+ }
+ }
}
$r->header_out(Location => $dest);
return REDIRECT;
@@ -111,5 +122,53 @@
}
}
+sub set_token {
+ my ($r,$lonhost) = @_;
+ my ($firsturl,$querystring,$ssotoken, at names,%token);
+ @names = ('role','symb','ltoken','linkkey');
+ map { $token{$_} = 1; } @names;
+ unless (($r->uri eq '/adm/roles') || ($r->uri eq '/adm/logout')) {
+ $firsturl = $r->uri;
+ }
+ if ($r->args ne '') {
+ &Apache::loncommon::get_unprocessed_cgi($r->args);
+ }
+ if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
+ unless (($env{'form.ltoken'}) || ($env{'form.linkkey'})) {
+ &Apache::lonacc::get_posted_cgi($r,['linkkey']);
+ }
+ }
+ my $extras;
+ foreach my $name (@names) {
+ if ($env{'form.'.$name} ne '') {
+ if ($name eq 'ltoken') {
+ my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
+ if ($info{'linkprot'}) {
+ $extras .= '&linkprot='.&escape($info{'linkprot'});
+ last;
+ }
+ } else {
+ $extras .= '&'.$name.'='.&escape($env{'form.'.$name});
+ }
+ }
+ }
+ if (($firsturl ne '') || ($extras ne '')) {
+ $extras .= ':sso';
+ $ssotoken = &Apache::lonnet::reply('tmpput:'.&escape($firsturl).
+ $extras,$lonhost);
+ $querystring = 'sso='.$ssotoken;
+ }
+ if ($r->args ne '') {
+ foreach my $key (sort(keys(%env))) {
+ if ($key =~ /^form\.(.+)$/) {
+ my $name = $1;
+ next if ($token{$name});
+ $querystring .= '&'.$name.'='.$env{$key};
+ }
+ }
+ }
+ return $querystring;
+}
+
1;
__END__
Index: loncom/lond
diff -u loncom/lond:1.568 loncom/lond:1.569
--- loncom/lond:1.568 Sun Aug 1 19:28:10 2021
+++ loncom/lond Tue Oct 26 15:52:55 2021
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.568 2021/08/01 19:28:10 raeburn Exp $
+# $Id: lond,v 1.569 2021/10/26 15:52:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,7 +65,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.568 $'; #' stupid emacs
+my $VERSION='$Revision: 1.569 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -5609,15 +5609,23 @@
}
my ($id,$store);
$tmpsnum++;
- if (($context eq 'resetpw') || ($context eq 'createaccount')) {
- $id = &md5_hex(&md5_hex(time.{}.rand().$$));
+ my $numtries = 0;
+ my $execdir=$perlvar{'lonDaemons'};
+ if (($context eq 'resetpw') || ($context eq 'createaccount') ||
+ ($context eq 'sso') || ($context eq 'link') || ($context eq 'retry')) {
+ $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
+ while ((-e "$execdir/tmp/$id.tmp") && ($numtries <10)) {
+ undef($id);
+ $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
+ $numtries ++;
+ }
} else {
$id = $$.'_'.$clientip.'_'.$tmpsnum;
}
$id=~s/\W/\_/g;
$record=~s/\n//g;
- my $execdir=$perlvar{'lonDaemons'};
- if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
+ if (($id ne '') &&
+ ($store=IO::File->new(">$execdir/tmp/$id.tmp"))) {
print $store $record;
close $store;
&Reply($client, \$id, $userinput);
@@ -7983,7 +7991,7 @@
Debug("Main: Got $user_input\n");
$keep_going = &process_request($user_input);
alarm(0);
- &status('Listening to '.$clientname." ($keymode)");
+ &status('Listening to '.$clientname." ($keymode)");
}
# --------------------------------------------- client unknown or fishy, refuse
@@ -7999,8 +8007,8 @@
&logthis("<font color='red'>CRITICAL: "
."Disconnect from $clientip ($clientname)</font>");
-
-
+
+
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
More information about the LON-CAPA-cvs
mailing list