[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /auth lonauth.pm
raeburn
raeburn at source.lon-capa.org
Sat Dec 11 20:48:40 EST 2021
raeburn Sun Dec 12 01:48:40 2021 EDT
Modified files: (Branch: version_2_11_X)
/loncom/auth lonauth.pm
Log:
- For 2.11
Backport 1.163, 1.168 (part), 1.169 (part) 1.170
-------------- next part --------------
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.121.2.21 loncom/auth/lonauth.pm:1.121.2.22
--- loncom/auth/lonauth.pm:1.121.2.21 Mon Jan 4 03:48:29 2021
+++ loncom/auth/lonauth.pm Sun Dec 12 01:48:40 2021
@@ -1,7 +1,7 @@
# The LearningOnline Network
# User Authentication Module
#
-# $Id: lonauth.pm,v 1.121.2.21 2021/01/04 03:48:29 raeburn Exp $
+# $Id: lonauth.pm,v 1.121.2.22 2021/12/12 01:48:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -45,7 +45,7 @@
# ------------------------------------------------------------ Successful login
sub success {
my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
- $form,$cid) = @_;
+ $form,$cid,$expirepub) = @_;
# ------------------------------------------------------------ Get cookie ready
my $cookie =
@@ -173,6 +173,12 @@
if ($defaultcookie) {
$r->headers_out->add('Set-cookie' => $defaultcookie);
}
+ if ($expirepub) {
+ my $c = new CGI::Cookie(-name => 'lonPubID',
+ -value => '',
+ -expires => '-10y',);
+ $r->headers_out->add('Set-cookie' => $c);
+ }
$r->send_http_header;
my %lt=&Apache::lonlocal::texthash(
@@ -203,7 +209,7 @@
# --------------------------------------------------------------- Failed login!
sub failed {
- my ($r,$message,$form) = @_;
+ my ($r,$message,$form,$authhost) = @_;
(undef,undef,undef,my $clientmathml,my $clientunicode) =
&Apache::loncommon::decode_user_agent();
my $args = {};
@@ -224,17 +230,37 @@
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;
+ 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};
+ }
+ }
+ }
+ }
}
+ } elsif ($querystr ne '') {
+ $retry .= (($retry=~/\?/)?'&':'?').$querystr;
}
my $end_page = &Apache::loncommon::end_page();
&Apache::loncommon::content_type($r,'text/html');
@@ -297,8 +323,24 @@
my $end_page =
&Apache::loncommon::end_page();
my $dest = '/adm/roles';
- if ($env{'form.firsturl'} ne '') {
- $dest = $env{'form.firsturl'};
+ my %form = &get_form_items($r);
+ if ($form{'logtoken'}) {
+ my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
+ $form{'serverid'});
+ unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
+ ($tmpinfo eq 'no_such_host')) {
+ my ($des_key,$firsturl, at rest)=split(/&/,$tmpinfo)l
+ $firsturl = &unescape($firsturl);
+ my %info;
+ foreach my $item (@rest) {
+ my ($key,$value) = split(/=/,$item);
+ $info{$key} = &unescape($value);
+ }
+ if ($firsturl ne '') {
+ $info{'firsturl'} = $firsturl;
+ $dest = $firsturl;
+ }
+ }
}
$r->print(
$start_page
@@ -314,19 +356,7 @@
# ---------------------------------------------------- No valid token, continue
-
- my $buffer;
- if ($r->header_in('Content-length') > 0) {
- $r->read($buffer,$r->header_in('Content-length'),0);
- }
- my %form;
- foreach my $pair (split(/&/,$buffer)) {
- my ($name,$value) = split(/=/,$pair);
- $value =~ tr/+/ /;
- $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- $form{$name}=$value;
- }
-
+ my %form = &get_form_items($r);
if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
&failed($r,'Username, password and domain need to be specified.',
\%form);
@@ -370,26 +400,12 @@
return OK;
}
- my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr)=split(/&/,$tmpinfo);
- if ($rolestr) {
- $rolestr = &unescape($rolestr);
- }
- if ($symbstr) {
- $symbstr= &unescape($symbstr);
- }
- if ($iptokenstr) {
- $iptokenstr = &unescape($iptokenstr);
- }
- if ($rolestr =~ /^role=/) {
- (undef,$form{'role'}) = split('=',$rolestr);
- }
- if ($symbstr =~ /^symb=/) {
- (undef,$form{'symb'}) = split('=',$symbstr);
+ my ($des_key,$firsturl, at rest)=split(/&/,$tmpinfo);
+ $firsturl = &unescape($firsturl);
+ foreach my $item (@rest) {
+ my ($key,$value) = split(/=/,$item);
+ $form{$key} = &unescape($value);
}
- if ($iptokenstr =~ /^iptoken=/) {
- (undef,$form{'iptoken'}) = split('=',$iptokenstr);
- }
-
my $upass = &Apache::loncommon::des_decrypt($key,$form{'upass0'});
# ---------------------------------------------------------------- Authenticate
@@ -548,7 +564,7 @@
my $lowest_load;
($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});
if ($lowest_load > 100) {
- $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$form{'udom'});
+ $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$form{'udom'});
}
}
if ($otherserver ne '') {
@@ -621,7 +637,7 @@
# ---------------------------------------------------------- Are we overloaded?
if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
- my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'});
+ my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'});
if (!$unloaded) {
($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
}
@@ -635,12 +651,70 @@
if (($is_balancer) && ($hosthere)) {
$form{'noloadbalance'} = $hosthere;
}
+ my $extra_env;
+ if (($hosthere) && ($sessiondata{'sessionserver'} ne '')) {
+ if ($sessiondata{'origurl'} ne '') {
+ $firsturl = $sessiondata{'origurl'};
+ $form{'firsturl'} = $sessiondata{'origurl'};
+ my @names = ('role','symb','linkprot','linkkey');
+ foreach my $item (@names) {
+ if ($sessiondata{$item} ne '') {
+ $form{$item} = $sessiondata{$item};
+ }
+ }
+ }
+ }
&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
\%form);
return OK;
}
}
+sub get_form_items {
+ my ($r) = @_;
+ my $buffer;
+ if ($r->header_in('Content-length') > 0) {
+ $r->read($buffer,$r->header_in('Content-length'),0);
+ }
+ my %form;
+ foreach my $pair (split(/&/,$buffer)) {
+ my ($name,$value) = split(/=/,$pair);
+ $value =~ tr/+/ /;
+ $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ $form{$name}=$value;
+ }
+ return %form;
+}
+
+sub set_retry_token {
+ my ($form,$lonhost,$querystr) = @_;
+ if (ref($form) eq 'HASH') {
+ my ($firsturl,$token,$extras, at names);
+ @names = ('role','symb','iptoken');
+ 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');
@@ -681,6 +755,8 @@
if ($login_host ne '') {
my $protocol = $Apache::lonnet::protocol{$login_host};
$protocol = 'http' if ($protocol ne 'https');
+ my $alias = &Apache::lonnet::use_proxy_alias($r,$login_host);
+ $hostname = $alias if ($alias ne '');
my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
$r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
'<h3>'.&mt('Account creation').'</h3>'.
More information about the LON-CAPA-cvs
mailing list