--- loncom/auth/lonlogin.pm 2005/06/14 20:09:13 1.67 +++ loncom/auth/lonlogin.pm 2022/02/24 16:43:39 1.158.2.13.2.3 @@ -1,7 +1,7 @@ # The LearningOnline Network # Login Screen # -# $Id: lonlogin.pm,v 1.67 2005/06/14 20:09:13 albertel Exp $ +# $Id: lonlogin.pm,v 1.158.2.13.2.3 2022/02/24 16:43:39 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,102 +30,361 @@ package Apache::lonlogin; use strict; use Apache::Constants qw(:common); -use CGI::Cookie(); use Apache::File (); use Apache::lonnet; use Apache::loncommon(); use Apache::lonauth(); use Apache::lonlocal; - +use Apache::migrateuser(); +use lib '/home/httpd/lib/perl/'; +use LONCAPA qw(:DEFAULT :match); +use URI::Escape; +use HTML::Entities(); +use CGI::Cookie(); + sub handler { my $r = shift; + + &Apache::loncommon::get_unprocessed_cgi + (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'}, + $ENV{'REDIRECT_QUERY_STRING'}), + ['interface','username','domain','firsturl','localpath','localres', + '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 %cookies=CGI::Cookie->parse($r->header_in('Cookie')); - my $lonid=$cookies{'lonID'}; - my $cookie; - if ($lonid) { - my $handle=$lonid->value; - $handle=~s/\W//g; - my $lonidsdir=$r->dir_config('lonIDsDir'); - if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) { -# Indeed, a valid token is found - my $bodytag=&Apache::loncommon::bodytag('Already logged in'); - $r->print(< - -Already logged in - -$bodytag -

You are already logged in

-

Please either continue the current session or -logout.

-

-Problems?

- - -ENDFAILED - return OK; - } + 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('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 - &Apache::loncommon::get_unprocessed_cgi - ($ENV{'QUERY_STRING'}.'&'.$env{'request.querystring'}, - ['interface','username','domain','firsturl','localpath','localres']); - +# ---------------------------- 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 $textbrowsers=$r->dir_config('lonTextBrowsers'); - my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; - - foreach (split(/\:/,$textbrowsers)) { - if ($httpbrowser=~/$_/i) { - $env{'form.interface'}='textual'; + (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(); + my $defdom = $domain; + if ($lonhost ne '') { + unless ($sessiondata{'sessionserver'}) { + my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie); + if ($redirect) { + $r->print($redirect); + return OK; + } } } - my $fullgraph=($env{'form.interface'} ne 'textual'); - my $port_to_use=$r->dir_config('lonhttpdPort'); - if (!defined($port_to_use)) { - $port_to_use='8080'; - } - my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':'.$port_to_use. - $r->dir_config('lonIconsURL'); - my $domain = $r->dir_config('lonDefDomain'); - if (($env{'form.domain'}) && - ($Apache::lonnet::domaindescription{$env{'form.domain'}})) { + 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 $sysadm = $r->dir_config('lonSysEMail'); - my $lonhost = $r->dir_config('lonHostID'); my $tabdir = $r->dir_config('lonTabDir'); my $include = $r->dir_config('lonIncludes'); my $expire = $r->dir_config('lonExpire'); my $version = $r->dir_config('lonVersion'); + 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,19 +393,17 @@ ENDFAILED $loadavg=<$loadfile>; } $loadavg =~ s/\s.*//g; - my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); - my $userloadpercent=&Apache::lonnet::userload(); -# ------------------------------------------------------- Do the load balancing - my $otherserver='http://'.$ENV{'SERVER_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 access server and overloaded? - if (($role eq 'access') && - (($userloadpercent>100.0)||($loadpercent>100.0))) { - my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent); - if ($unloaded) { $otherserver=$unloaded; } - } # ----------------------------------------------------------- Get announcements my $announcements=&Apache::lonnet::getannounce(); @@ -171,427 +428,725 @@ ENDFAILED 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); - next if ($last eq $Apache::lonnet::hostname{$hostid}); - $spares.='
'. - $Apache::lonnet::hostname{$hostid}.''. - ' (preferred)'.$/; - $last=$Apache::lonnet::hostname{$hostid}; + $hostname.''. + ' '.&mt('(preferred)').''.$/; + } + if ($spares) { + $spares.= '
'; } - $spares.= '
'; + my %all_hostnames = &Apache::lonnet::all_hostnames(); foreach my $hostid (sort - { - $Apache::lonnet::hostname{$a} cmp - $Apache::lonnet::hostname{$b}; - } - keys(%Apache::lonnet::hostname)) { - next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid}); - next if ($last eq $Apache::lonnet::hostname{$hostid}); - $spares.='
'. - $Apache::lonnet::hostname{$hostid}.''; - $last=$Apache::lonnet::hostname{$hostid}; + { + &Apache::lonnet::hostname($a) cmp + &Apache::lonnet::hostname($b); + } + keys(%all_hostnames)) { + next if ($hostid eq $lonhost); + my $hostname = &Apache::lonnet::hostname($hostid); + next if (($hostname eq '') || ($spareservers{$hostname})); + $spareservers{$hostname} = 1; + my $protocol = $Apache::lonnet::protocol{$hostid}; + $protocol = 'http' if ($protocol ne 'https'); + $spares.='
'. + $hostname.''; + } + $r->print( + '' + .'' + .'' + .&mt('The LearningOnline Network with CAPA') + .'' + .'' + .'

'.&mt('The LearningOnline Network with CAPA').'

' + .'broken icon' + .'

'.&mt('This LON-CAPA server is temporarily not available for login.').'

'); + if ($spares) { + $r->print('

'.&mt('Please attempt to login to one of the following servers:') + .'

' + .$spares); } - $r->print(< -The LearningOnline Network with CAPA - - -

This LON-CAPA server is temporarily not available for login

-

Please attempt to login to one of the following servers:

$spares -

If the problem persists, please contact $servadm.

- - -ENDTROUBLE + $r->print('' + .'' + ); return OK; } # ----------------------------------------------- Apparently we are in business - - my $domainlogo=&Apache::loncommon::domainlogo($domain); $servadm=~s/\,/\
/g; - $sysadm=~s/\,/\
/g; - -# --------------------------------------------------- Print login screen header - $r->print(< - - -The LearningOnline Network with CAPA Login - -ENDHEADER -# ---------------------------------------------------- Serve out DES JavaScript - { - my $jsh=Apache::File->new($include."/londes.js"); - $r->print(<$jsh>); - } # ----------------------------------------------------------- Front page design - my $pgbg= - ($fullgraph?&Apache::loncommon::designparm('login.pgbg',$domain):'#FFFFFF'); - my $font= - ($fullgraph?&Apache::loncommon::designparm('login.font',$domain):'#000000'); - my $link= - ($fullgraph?&Apache::loncommon::designparm('login.link',$domain):'#0000FF'); - my $vlink= - ($fullgraph?&Apache::loncommon::designparm('login.vlink',$domain):'#0000FF'); + my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain); + my $font=&Apache::loncommon::designparm('login.font',$domain); + my $link=&Apache::loncommon::designparm('login.link',$domain); + my $vlink=&Apache::loncommon::designparm('login.vlink',$domain); my $alink=&Apache::loncommon::designparm('login.alink',$domain); - my $mainbg= - ($fullgraph?&Apache::loncommon::designparm('login.mainbg',$domain):'#FFFFFF'); - my $sidebg= - ($fullgraph?&Apache::loncommon::designparm('login.sidebg',$domain):'#FFFFFF'); + my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain); + my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain); + my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain); + my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain); my $logo=&Apache::loncommon::designparm('login.logo',$domain); my $img=&Apache::loncommon::designparm('login.img',$domain); + my $domainlogo=&Apache::loncommon::domainlogo($domain); + my $showbanner = 1; + my $showmainlogo = 1; + if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) { + $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain); + } + if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) { + $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain); + } + my $showadminmail; + my @possdoms = &Apache::lonnet::current_machine_domains(); + if (grep(/^\Q$domain\E$/,@possdoms)) { + $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain); + } + my $showcoursecat = + &Apache::loncommon::designparm('login.coursecatalog',$domain); + my $shownewuserlink = + &Apache::loncommon::designparm('login.newuser',$domain); + my $showhelpdesk = + &Apache::loncommon::designparm('login.helpdesk',$domain); + my $now=time; + my $js = (< +// 'Username', - 'pw' => 'Password', - 'dom' => 'Domain', - 'perc' => 'percent', - 'load' => 'Load', - 'userload' => 'User Load', - 'about' => 'aboutlon.gif', - 'access' => 'accessbutton.gif', - 'auth' => 'userauthentication.gif', - 'log' => 'Log in', - 'help' => 'Help', - 'serv' => 'Server', - 'servadm' => 'Server Administration', - 'sysadm' => 'System Administration', - 'helpdesk' => 'Contact Helpdesk'); -# -------------------------------------------------- Change password field name - my $now=time; -# ---------------------------------------------------------- Serve rest of page - $r->print(< +this.document.client.elements.uname.value=''; +this.document.client.elements.upass$now.value=''; - + +ENDSCRIPT - this.document.server.elements.imagesuppress.value - =this.document.client.elements.imagesuppress.checked; + my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing, + $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip); + %defaultdomconf = &Apache::loncommon::get_domainconf($defdom); + @hosts = &Apache::lonnet::current_machine_ids(); + $lonhost_in_use = $lonhost; + if (@hosts > 1) { + foreach my $hostid (@hosts) { + if (&Apache::lonnet::host_domain($hostid) eq $defdom) { + $lonhost_in_use = $hostid; + last; + } + } + } + $saml_prefix = $defdom.'.login.saml_'; + if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) { + $saml_landing = 1; + $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use}; + $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use}; + $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use}; + $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use}; + $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use}; + $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use}; + } + if ($saml_landing) { + if ($samlssotext eq '') { + $samlssotext = 'SSO Login'; + } + if ($samlnonsso eq '') { + $samlnonsso = 'Non-SSO Login'; + } + $js .= <<"ENDSAMLJS"; - this.document.server.elements.embedsuppress.value - =this.document.client.elements.embedsuppress.checked; + - this.document.server.elements.fontenhance.value - =this.document.client.elements.fontenhance.checked; +ENDSAMLJS + } - this.document.server.elements.blackwhite.value - =this.document.client.elements.blackwhite.checked; +# --------------------------------------------------- Print login screen header - this.document.server.elements.remember.value - =this.document.client.elements.remember.checked; + my %add_entries = ( + bgcolor => "$mainbg", + text => "$font", + link => "$link", + vlink => "$vlink", + alink => "$alink", + onload => 'javascript:enableInput();',); + + my ($headextra,$headextra_exempt); + $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost_in_use}; + $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost_in_use}; + if ($headextra) { + my $omitextra; + if ($headextra_exempt ne '') { + my @exempt = split(',',$headextra_exempt); + my $ip = &Apache::lonnet::get_requestor_ip(); + if (grep(/^\Q$ip\E$/,@exempt)) { + $omitextra = 1; + } + } + unless ($omitextra) { + my $confname = $defdom.'-domainconfig'; + if ($headextra =~ m{^\Q/res/$defdom/$confname/login/headtag/$lonhost_in_use/\E}) { + my $extra = &Apache::lonnet::getfile(&Apache::lonnet::filelocation("",$headextra)); + unless ($extra eq '-1') { + $js .= "\n".$extra."\n"; + } + } + } + } - uextkey=this.document.client.elements.uextkey.value; - lextkey=this.document.client.elements.lextkey.value; - initkeys(); + $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js, + { 'redirect' => [$expire,'/adm/roles'], + 'add_entries' => \%add_entries, + 'only_body' => 1,})); - this.document.server.elements.upass0.value - =crypted(this.document.client.elements.upass$now.value.substr(0,15)); - this.document.server.elements.upass1.value - =crypted(this.document.client.elements.upass$now.value.substr(15,15)); - this.document.server.elements.upass2.value - =crypted(this.document.client.elements.upass$now.value.substr(30,15)); +# ----------------------------------------------------------------------- Texts - this.document.client.elements.uname.value=''; - this.document.client.elements.upass$now.value=''; + my %lt=&Apache::lonlocal::texthash( + 'un' => 'Username', + 'pw' => 'Password', + 'dom' => 'Domain', + 'perc' => 'percent', + 'load' => 'Server Load', + 'userload' => 'User Load', + 'catalog' => 'Course/Community Catalog', + 'log' => 'Log in', + 'help' => 'Log-in Help', + 'serv' => 'Server', + 'servadm' => 'Server Administration', + 'helpdesk' => 'Contact Helpdesk', + 'forgotpw' => 'Forgot password?', + 'newuser' => 'New User?', + 'change' => 'Change?', + ); +# -------------------------------------------------- Change password field name - this.document.server.submit(); - return false; + my $forgotpw = &forgotpwdisplay(%lt); + $forgotpw .= '
' if $forgotpw; + my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain); + if ($loginhelp) { + $loginhelp = ''.$lt{'help'}.'
'; } - -ENDSCRIPT - if ($fullgraph) { - $r->print( - ''); +# ---------------------------------------------------- Serve out DES JavaScript + { + my $jsh=Apache::File->new($include."/londes.js"); + $r->print(<$jsh>); } +# ---------------------------------------------------------- Serve rest of page + + $r->print( + '
' +); $r->print(< +
- - - - - - - - - ENDSERVERFORM - if ($fullgraph) { $r->print(< -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The Learning Online Network with CAPA
 
- Accessibility Options -
- About LON-CAPA - 		-
- -
-
-ENDTOP -} else { - $r->print('

The LearningOnline Network with CAPA

Text-based Interface Login

'.$announcements); -} - $r->print('
'); - unless ($fullgraph) { - $r->print(<Select Accessibility Options -
-
-
-
-
-

If you have accessibility needs that are not addressed by this interface, -please -contact the system administrator at $sysadm.


- Remember these settings for next login
-ENDACCESSOPTIONS -} else { - $r->print(< - - - - - -ENDNOOPT -} + my $coursecatalog; + if (($showcoursecat eq '') || ($showcoursecat)) { + $coursecatalog = &coursecatalog_link($lt{'catalog'}).'
'; + } + my $newuserlink; + if ($shownewuserlink) { + $newuserlink = &newuser_link($lt{'newuser'}).'
'; + } + my $logintitle = + '

' + .$lt{'log'} + .'

'; + + my $noscript_warning=''; + my $helpdeskscript; + my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail, + $authdomain,\$helpdeskscript, + $showhelpdesk,\@possdoms); + + my $mobileargs; + if ($clientmobile) { + $mobileargs = 'autocapitalize="off" autocorrect="off"'; + } + my $loginform=(< + + + :
+
+ :
+
+ :
+
+ + +LFORM + + if ($showbanner) { + my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain); + if ($alttext eq '') { + $alttext = 'The Learning Online Network with CAPA'; + } + $r->print(< +
+ $alttext +
+HEADER + } + + my $stdauthformstyle = 'inline-block'; + my $ssoauthstyle = 'none'; + my $logintype; + $r->print('
'); + if ($saml_landing) { + $ssoauthstyle = 'inline-block'; + $stdauthformstyle = 'none'; + $logintype = $samlssotext; + my $ssologin = '/adm/sso'; + if ($samlssourl ne '') { + $ssologin = $samlssourl; + } + 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,"'"); + } + 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 '') { + $ssohref = ''. + ''.$samlssoalt.''; + } else { + $ssohref = ''.$samlssotext.''; + } + if (($env{'form.saml'} eq 'no') || + (($env{'form.username'} ne '') && ($env{'form.domain'} ne ''))) { + $ssoauthstyle = 'none'; + $stdauthformstyle = 'inline-block'; + $logintype = $samlnonsso; + } + $r->print(< +Log-in type: +$logintype
+$lt{'change'} +

+
+
+$ssohref +$noscript_warning +
+
+$loginhelp +$contactblock +$coursecatalog +
+
+ENDSAML + } else { + if ($env{'form.ltoken'}) { + &Apache::lonnet::tmpdel($env{'form.ltoken'}); + delete($env{'form.ltoken'}); + } + } + $r->print(< - +
+
+ $logintitle + $loginform + $noscript_warning +
+ +
+ $loginhelp + $forgotpw + $contactblock + $newuserlink + $coursecatalog +
+
- - - - - - - - - - - - - - - - - - - -
User Authentication

   $lt{'un'}:
   $lt{'pw'}:
   $lt{'dom'}:
   $lt{'help'} -
- -
- - ENDLOGIN - if ($fullgraph) { - my $helpdeskscript; - my $contactblock = &contactdisplay(\%lt,$sysadm,$servadm,$version,$authdomain,\$helpdeskscript); - $r->print(< - - -
$announcements
-
- + $r->print('
'."\n"); + if ($showmainlogo) { + my $alttext = &Apache::loncommon::designparm('login.alttext_logo',$domain); + $r->print(' '."\n"); + } +$r->print(< +
+ENDTOP + my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow); + $domainrow = <<"END";
- - +END + $serverrow = <<"END"; - - +END + if ($loadlim) { + $loadrow = <<"END"; - - +END + } + if ($uloadlim) { + $userloadrow = <<"END"; - - +END + } + if (($version ne '') && ($version ne '')) { + $versionrow = <<"END"; + + + +END + } + + $r->print(< +
-    $lt{'dom'}:  + + $lt{'dom'}:  +  $domain
-    $lt{'serv'}:  + + $lt{'serv'}:  +  $lonhost ($role)
-    $lt{'load'}:  + + $lt{'load'}:  +  $loadpercent $lt{'perc'}
-    $lt{'userload'}:  + + $lt{'userload'}:  +  $userloadpercent $lt{'perc'}
+ $version +
+$domainrow +$serverrow +$loadrow +$userloadrow +$versionrow
-
- $contactblock - 		-$domainlogo -
 
+ +
+ $domainlogo +
+
+ $helpdeskscript ENDDOCUMENT -} - $r->print(''); + my %endargs = ( 'noredirectlink' => 1, ); + $r->print(&Apache::loncommon::end_page(\%endargs)); return OK; } +sub check_loginvia { + my ($domain,$lonhost,$lonidsdir,$balcookie) = @_; + if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') { + return; + } + my %domconfhash = &Apache::loncommon::get_domainconf($domain); + my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost}; + my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost}; + my $output; + if ($loginvia ne '') { + my $noredirect; + my $ip = &Apache::lonnet::get_requestor_ip(); + if ($ip eq '127.0.0.1') { + $noredirect = 1; + } else { + if ($loginvia_exempt ne '') { + my @exempt = split(',',$loginvia_exempt); + if (grep(/^\Q$ip\E$/,@exempt)) { + $noredirect = 1; + } + } + } + unless ($noredirect) { + my ($newhost,$path); + if ($loginvia =~ /:/) { + ($newhost,$path) = split(':',$loginvia); + } else { + $newhost = $loginvia; + } + if ($newhost ne $lonhost) { + if (&Apache::lonnet::hostname($newhost) ne '') { + if ($balcookie) { + my ($balancer,$cookie) = split(/:/,$balcookie); + if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) { + my ($udom,$uname,$cookieid) = ($1,$2,$3); + unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') { + if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) { + while (my $filename=readdir($dh)) { + if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) { + my $handle = $1; + my %hash = + &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir, + ['request.balancercookie', + 'user.linkedenv']); + if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") { + if (unlink("$lonidsdir/$filename")) { + if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) && + (-l "$lonidsdir/$hash{'user.linkedenv'}.id") && + (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) { + unlink("$lonidsdir/$hash{'user.linkedenv'}.id"); + } + } + } + last; + } + } + closedir($dh); + } + } + } + } + $output = &redirect_page($newhost,$path); + } + } + } + } + return $output; +} + +sub redirect_page { + my ($desthost,$path) = @_; + my $hostname = &Apache::lonnet::hostname($desthost); + my $protocol = $Apache::lonnet::protocol{$desthost}; + $protocol = 'http' if ($protocol ne 'https'); + unless ($path =~ m{^/}) { + $path = '/'.$path; + } + my $url = $protocol.'://'.$hostname.$path; + if ($env{'form.firsturl'} ne '') { + my $querystring; + 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,"'"); + $url .='?firsturl='.$querystring; + } + if (($env{'form.ltoken'}) || ($env{'form.linkkey'} ne '')) { + my %link_info; + if ($env{'form.ltoken'}) { + $link_info{'ltoken'} = $env{'form.ltoken'}; + } elsif ($env{'form.linkkey'} ne '') { + $link_info{'linkkey'} = $env{'form.linkkey'}; + } + my $token = &Apache::lonnet::tmpput(\%link_info,$desthost,'link'); + unless (($token eq 'con_lost') || ($token eq 'refused') || + ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) { + $url .= (($url=~/\?/)?'&':'?') . 'ttoken='.$token; + } + } + my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef, + {'redirect' => [0,$url],}); + my $end_page = &Apache::loncommon::end_page(); + return $start_page.$end_page; +} + sub contactdisplay { - my ($lt,$sysadm,$servadm,$version,$authdomain,$helpdeskscript) = @_; + my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk, + $possdoms) = @_; my $contactblock; - my $showsysadm = 1; - my $showservadm = 1; - my $showhelpdesk = 0; - my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'}; - if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) { - $showhelpdesk = 1; - } - if ($showsysadm) { - $contactblock .= '   '.$$lt{'sysadm'}.':
'. - '      '.$sysadm.'
'; - } - if ($showservadm) { - $contactblock .= '   '.$$lt{'servadm'}.':
'. - '      '.$servadm.'
 
'; + my $origmail; + if (ref($possdoms) eq 'ARRAY') { + if (grep(/^\Q$authdomain\E$/,@{$possdoms})) { + $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'}; + } + } + my $requestmail = + &Apache::loncommon::build_recipient_list(undef,'helpdeskmail', + $authdomain,$origmail); + unless ($showhelpdesk eq '0') { + if ($requestmail =~ m/[^\@]+\@[^\@]+/) { + $showhelpdesk = 1; + } else { + $showhelpdesk = 0; + } + } + if ($servadm && $showadminmail) { + $contactblock .= $$lt{'servadm'}.':
'. + ''.$servadm.'
'; } if ($showhelpdesk) { - $contactblock .= '   '.$$lt{'helpdesk'}.'
'; - my $thisurl = &Apache::lonnet::escape('/adm/login'); + $contactblock .= ''.$lt->{'helpdesk'}.'
'; + my $thisurl = &escape('/adm/login'); $$helpdeskscript = <<"ENDSCRIPT"; ENDSCRIPT } - $contactblock .= <<"ENDBLOCK"; -    $version -ENDBLOCK return $contactblock; } - + +sub forgotpwdisplay { + my (%lt) = @_; + my $prompt_for_resetpw = 1; + if ($prompt_for_resetpw) { + return ''.$lt{'forgotpw'}.''; + } + return; +} + +sub coursecatalog_link { + my ($linkname) = @_; + return <<"END"; + $linkname +END +} + +sub newuser_link { + my ($linkname) = @_; + return ''.$linkname.''; +} + +sub decode_token { + my ($info) = @_; + my ($firsturl,@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__ 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.