--- loncom/auth/lonlogin.pm 2009/05/22 17:01:28 1.122 +++ loncom/auth/lonlogin.pm 2022/01/16 23:31:27 1.158.2.13.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # Login Screen # -# $Id: lonlogin.pm,v 1.122 2009/05/22 17:01:28 bisitz Exp $ +# $Id: lonlogin.pm,v 1.158.2.13.2.2 2022/01/16 23:31:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,10 @@ use Apache::lonauth(); use Apache::lonlocal; use Apache::migrateuser(); use lib '/home/httpd/lib/perl/'; -use LONCAPA; +use LONCAPA qw(:DEFAULT :match); +use URI::Escape; +use HTML::Entities(); +use CGI::Cookie(); sub handler { my $r = shift; @@ -46,76 +49,321 @@ sub handler { (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'}, $ENV{'REDIRECT_QUERY_STRING'}), ['interface','username','domain','firsturl','localpath','localres', - 'token']); - if (!defined($env{'form.firsturl'})) { - &Apache::lonacc::get_posted_cgi($r,['firsturl']); - } + 'token','role','symb','iptoken','btoken','ltoken','ttoken','linkkey', + 'saml','sso','retry']); # -- check if they are a migrating user if (defined($env{'form.token'})) { return &Apache::migrateuser::handler($r); } + my $lonhost = $r->dir_config('lonHostID'); + if ($env{'form.ttoken'}) { + my %info = &Apache::lonnet::tmpget($env{'form.ttoken'}); + &Apache::lonnet::tmpdel($env{'form.ttoken'}); + if ($info{'origurl'}) { + $env{'form.firsturl'} = $info{'origurl'}; + } + if ($info{'ltoken'}) { + $env{'form.ltoken'} = $info{'ltoken'}; + } elsif ($info{'linkprot'}) { + $env{'form.linkprot'} = $info{'linkprot'}; + } elsif ($info{'linkkey'} ne '') { + $env{'form.linkkey'} = $info{'linkkey'}; + } + } elsif (($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 (!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.linkprot'}) && (!$env{'form.linkkey'})) { + &Apache::lonacc::get_posted_cgi($r,['linkkey']); + } + if ($env{'form.firsturl'} eq '/adm/logout') { + delete($env{'form.firsturl'}); + } + } + +# For "public user" - remove any exising "public" cookie, as user really wants to log-in + my ($handle,$lonidsdir,$expirepub,$userdom); + $lonidsdir=$r->dir_config('lonIDsDir'); + unless ($r->header_only) { + $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom); + if ($handle ne '') { + if ($handle=~/^publicuser\_/) { + unlink($r->dir_config('lonIDsDir')."/$handle.id"); + undef($handle); + undef($userdom); + $expirepub = 1; + } + } + } + &Apache::loncommon::no_cache($r); &Apache::lonlocal::get_language_handle($r); &Apache::loncommon::content_type($r,'text/html'); + if ($expirepub) { + my $c = new CGI::Cookie(-name => 'lonPubID', + -value => '', + -expires => '-10y',); + $r->header_out('Set-cookie' => $c); + } elsif (($handle eq '') && ($userdom ne '')) { + my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); + foreach my $name (keys(%cookies)) { + next unless ($name =~ /^lon(|S|Link|Pub)ID$/); + my $c = new CGI::Cookie(-name => $name, + -value => '', + -expires => '-10y',); + $r->headers_out->add('Set-cookie' => $c); + } + } $r->send_http_header; return OK if $r->header_only; # Are we re-routing? - if (-e '/home/httpd/html/lon-status/reroute.txt') { + my $londocroot = $r->dir_config('lonDocRoot'); + if (-e "$londocroot/lon-status/reroute.txt") { &Apache::lonauth::reroute($r); return OK; } +# 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); + if ($found_server) { + my $hostname = &Apache::lonnet::hostname($found_server); + if ($hostname ne '') { + my $protocol = $Apache::lonnet::protocol{$found_server}; + $protocol = 'http' if ($protocol ne 'https'); + my $dest = '/adm/roles'; + if ($env{'form.firsturl'} ne '') { + $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&'); + } + my %info = ( + balcookie => $lonhost.':'.$balancer_cookie, + ); + if ($env{'form.role'}) { + $info{'role'} = $env{'form.role'}; + } + if ($env{'form.symb'}) { + $info{'symb'} = $env{'form.symb'}; + } + my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server); + unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') || + ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) { + $dest .= (($dest=~/\?/)?'&':'?') . 'btoken='.$balancer_token; + } + if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { + my %link_info; + if ($env{'form.ltoken'}) { + $link_info{'ltoken'} = $env{'form.ltoken'}; + } elsif ($env{'form.linkprot'}) { + $link_info{'linkprot'} = $env{'form.linkprot'}; + } elsif ($env{'form.linkkey'} ne '') { + $link_info{'linkkey'} = $env{'form.linkkey'}; + } + if (keys(%link_info)) { + $link_info{'origurl'} = $env{'form.firsturl'}; + my $token = &Apache::lonnet::tmpput(\%link_info,$found_server,'link'); + unless (($token eq 'con_lost') || ($token eq 'refused') || + ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) { + $dest .= (($dest=~/\?/)?'&':'?') . 'ttoken='.$token; + } + } + } + unless ($found_server eq $lonhost) { + my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server); + $hostname = $alias if ($alias ne ''); + } + my $url = $protocol.'://'.$hostname.$dest; + my $start_page = + &Apache::loncommon::start_page('Switching Server ...',undef, + {'redirect' => [0,$url],}); + my $end_page = &Apache::loncommon::end_page(); + $r->print($start_page.$end_page); + return OK; + } + } + +# +# Check if a LON-CAPA load balancer sent user here because user's browser sent +# it a balancer cookie for an active session on this server. +# + + my $balcookie; + if ($env{'form.btoken'}) { + my %info = &Apache::lonnet::tmpget($env{'form.btoken'}); + $balcookie = $info{'balcookie'}; + &Apache::lonnet::tmpdel($env{'form.btoken'}); + delete($env{'form.btoken'}); + } + +# +# If browser sent an old cookie for which the session file had been removed +# check if configuration for user's domain has a portal URL set. If so +# switch user's log-in to the portal. +# + + if (($handle eq '') && ($userdom ne '')) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom); + if ($domdefaults{'portal_def'} =~ /^https?\:/) { + my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef, + {'redirect' => [0,$domdefaults{'portal_def'}],}); + my $end_page = &Apache::loncommon::end_page(); + $r->print($start_page.$end_page); + return OK; + } + } # -------------------------------- Prevent users from attempting to login twice - my $handle = &Apache::lonnet::check_for_valid_session($r); - if ($handle=~/^publicuser\_/) { -# For "public user" - remove it, we apparently really want to login - unlink($r->dir_config('lonIDsDir')."/$handle.id"); - } elsif ($handle ne '') { -# Indeed, a valid token is found + if ($handle ne '') { + &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle); my $start_page = &Apache::loncommon::start_page('Already logged in'); my $end_page = &Apache::loncommon::end_page(); + my $dest = '/adm/roles'; + if ($env{'form.firsturl'} ne '') { + $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&'); + } + if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) { + my $linkprot; + if ($env{'form.ltoken'}) { + my %info = &Apache::lonnet::tmpget($env{'form.ltoken'}); + $linkprot = $info{'linkprot'}; + my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'}); + } else { + $linkprot = $env{'form.linkprot'}; + } + if ($linkprot) { + my ($linkprotector,$deeplink) = split(/:/,$linkprot,2); + if ($env{'user.linkprotector'}) { + my @protectors = split(/,/,$env{'user.linkprotector'}); + unless (grep(/^\Q$linkprotector\E$/,@protectors)) { + push(@protectors,$linkprotector); + @protectors = sort { $a <=> $b } @protectors; + &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)}); + } + } else { + &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector }); + } + if ($env{'user.linkproturi'}) { + my @proturis = split(/,/,$env{'user.linkproturi'}); + unless (grep(/^\Q$deeplink\E$/,@proturis)) { + push(@proturis,$deeplink); + @proturis = sort @proturis; + &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)}); + } + } else { + &Apache::lonnet::appenv({'user.linkproturi' => $deeplink}); + } + } + } elsif ($env{'form.linkkey'} ne '') { + if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { + my $linkkey = $env{'form.linkkey'}; + if ($env{'user.deeplinkkey'}) { + my @linkkeys = split(/,/,$env{'user.deeplinkkey'}); + unless (grep(/^\Q$linkkey\E$/,@linkkeys)) { + push(@linkkeys,$linkkey); + &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))}); + } + } else { + &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey}); + } + my $deeplink = $env{'form.firsturl'}; + if ($env{'user.keyedlinkuri'}) { + my @keyeduris = split(/,/,$env{'user.keyedlinkuri'}); + unless (grep(/^\Q$deeplink\E$/,@keyeduris)) { + push(@keyeduris,$deeplink); + &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))}); + } + } else { + &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink}); + } + } + } $r->print( - $start_page - .'
'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].', - '','','','').'
' - .'' - .$end_page - ); + $start_page + .''.&mt('You are already logged in!').'
' + .''.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].', + '','','','').'
' + .$end_page + ); return OK; } # ---------------------------------------------------- No valid token, continue - # ---------------------------- Not possible to really login to domain "public" +# ---------------------------- Not possible to really login to domain "public" if ($env{'form.domain'} eq 'public') { $env{'form.domain'}=''; $env{'form.username'}=''; } + +# ------ Is this page requested because /adm/migrateuser detected an IP change? + my %sessiondata; + if ($env{'form.iptoken'}) { + %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'}); + unless ($sessiondata{'sessionserver'}) { + my $delete = &Apache::lonnet::tmpdel($env{'form.iptoken'}); + delete($env{'form.iptoken'}); + } + } # ----------------------------------------------------------- Process Interface $env{'form.interface'}=~s/\W//g; - my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + (undef,undef,undef,undef,undef,undef,my $clientmobile) = + &Apache::loncommon::decode_user_agent($r); my $iconpath= &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL')); my $domain = &Apache::lonnet::default_login_domain(); - if (($env{'form.domain'}) && + my $defdom = $domain; + if ($lonhost ne '') { + unless ($sessiondata{'sessionserver'}) { + my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie); + if ($redirect) { + $r->print($redirect); + return OK; + } + } + } + + if (($sessiondata{'domain'}) && + (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) { + $domain=$sessiondata{'domain'}; + } elsif (($env{'form.domain'}) && (&Apache::lonnet::domain($env{'form.domain'},'description'))) { $domain=$env{'form.domain'}; } + my $role = $r->dir_config('lonRole'); my $loadlim = $r->dir_config('lonLoadLim'); + my $uloadlim= $r->dir_config('lonUserLoadLim'); my $servadm = $r->dir_config('lonAdmEMail'); - my $lonhost = $r->dir_config('lonHostID'); my $tabdir = $r->dir_config('lonTabDir'); my $include = $r->dir_config('lonIncludes'); my $expire = $r->dir_config('lonExpire'); @@ -123,9 +371,20 @@ sub handler { my $host_name = &Apache::lonnet::hostname($lonhost); # --------------------------------------------- Default values for login fields - - my $authusername=($env{'form.username'}?$env{'form.username'}:''); - my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain); + + my ($authusername,$authdomain); + if ($sessiondata{'username'}) { + $authusername=$sessiondata{'username'}; + } else { + $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'}); + $authusername=($env{'form.username'}?$env{'form.username'}:''); + } + if ($sessiondata{'domain'}) { + $authdomain=$sessiondata{'domain'}; + } else { + $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'}); + $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain); + } # ---------------------------------------------------------- Determine own load my $loadavg; @@ -134,18 +393,17 @@ sub handler { $loadavg=<$loadfile>; } $loadavg =~ s/\s.*//g; - my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); - my $userloadpercent=&Apache::lonnet::userload(); -# ------------------------------------------------------- Do the load balancing - my $otherserver= &Apache::lonnet::absolute_url($host_name); + my ($loadpercent,$userloadpercent); + if ($loadlim) { + $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); + } + if ($uloadlim) { + $userloadpercent=&Apache::lonnet::userload(); + } + my $firsturl= ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'}); -# ---------------------------------------------------------- Are we overloaded? - if ((($userloadpercent>100.0)||($loadpercent>100.0))) { - my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent); - if ($unloaded) { $otherserver=$unloaded; } - } # ----------------------------------------------------------- Get announcements my $announcements=&Apache::lonnet::getannounce(); @@ -170,98 +428,154 @@ sub handler { if ($uextkey>2147483647) { $uextkey-=4294967296; } # -------------------------------------------------------- Store away log token + my ($tokenextras,$tokentype); + my @names = ('role','symb','iptoken','ltoken','linkprot','linkkey'); + foreach my $name (@names) { + if ($env{'form.'.$name} ne '') { + if ($name eq 'ltoken') { + my %info = &Apache::lonnet::tmpget($env{'form.'.$name}); + if ($info{'linkprot'}) { + $tokenextras .= '&linkprot='.&escape($info{'linkprot'}); + $tokentype = 'link'; + last; + } + } else { + $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name}); + if (($name eq 'linkkey') || ($name eq 'linkprot')) { + $tokentype = 'link'; + } + } + } + } + if ($tokentype) { + $tokenextras .= ":$tokentype"; + } my $logtoken=Apache::lonnet::reply( - 'tmpput:'.$ukey.$lkey.'&'.$firsturl, + 'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras, $lonhost); -# ------------------- If we cannot talk to ourselves, we are in serious trouble +# -- If we cannot talk to ourselves, or hostID does not map to a hostname +# we are in serious trouble - if ($logtoken eq 'con_lost') { + if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) { + if ($logtoken eq 'no_such_host') { + &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab'); + } + if ($env{'form.ltoken'}) { + &Apache::lonnet::tmpdel($env{'form.ltoken'}); + delete($env{'form.ltoken'}); + } my $spares=''; - my $last; - foreach my $hostid (sort - { - &Apache::lonnet::hostname($a) cmp - &Apache::lonnet::hostname($b); - } - keys(%Apache::lonnet::spareid)) { + my (@sparehosts,%spareservers); + my $sparesref = &Apache::lonnet::this_host_spares($defdom); + if (ref($sparesref) eq 'HASH') { + foreach my $key (keys(%{$sparesref})) { + if (ref($sparesref->{$key}) eq 'ARRAY') { + my @sorted = sort { &Apache::lonnet::hostname($a) cmp + &Apache::lonnet::hostname($b); + } @{$sparesref->{$key}}; + if (@sorted) { + if ($key eq 'primary') { + unshift(@sparehosts,@sorted); + } elsif ($key eq 'default') { + push(@sparehosts,@sorted); + } + } + } + } + } + foreach my $hostid (@sparehosts) { next if ($hostid eq $lonhost); my $hostname = &Apache::lonnet::hostname($hostid); - next if ($last eq $hostname); - $spares.=''.&mt('Please attempt to login to one of the following servers:').'
' - .$spares - .'' - .'' -); -return OK; -} + .'' + .''.&mt('Please attempt to login to one of the following servers:') + .'
' + .$spares); + } + $r->print('' + .'' + ); + return OK; + } # ----------------------------------------------- Apparently we are in business -$servadm=~s/\,/\- - | -
- $loginform - | -
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.