--- loncom/auth/lonlogin.pm 2002/05/25 22:15:03 1.18 +++ loncom/auth/lonlogin.pm 2010/08/25 16:34:32 1.140 @@ -1,7 +1,7 @@ # The LearningOnline Network # Login Screen # -# $Id: lonlogin.pm,v 1.18 2002/05/25 22:15:03 www Exp $ +# $Id: lonlogin.pm,v 1.140 2010/08/25 16:34:32 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,60 +25,137 @@ # # http://www.lon-capa.org/ # -# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, -# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9, -# 1/17/01 Gerd Kortemeyer -# -# 2/7/02,2/8,2/12,2/14,2/15,2/19 Josh Brunskole package Apache::lonlogin; use strict; use Apache::Constants qw(:common); use Apache::File (); -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); - +use Apache::lonauth(); +use Apache::lonlocal; +use Apache::migrateuser(); +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + sub handler { my $r = shift; - $r->content_type('text/html'); + + &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']); + if (!defined($env{'form.firsturl'})) { + &Apache::lonacc::get_posted_cgi($r,['firsturl']); + } + +# -- check if they are a migrating user + if (defined($env{'form.token'})) { + return &Apache::migrateuser::handler($r); + } + &Apache::loncommon::no_cache($r); + &Apache::lonlocal::get_language_handle($r); + &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; - &Apache::loncommon::get_unprocessed_cgi - ($ENV{'QUERY_STRING'},['interface']); +# Are we re-routing? + if (-e '/home/httpd/html/lon-status/reroute.txt') { + &Apache::lonauth::reroute($r); + return OK; + } - $ENV{'form.interface'}=~s/\W//g; - my $fullgraph=($ENV{'form.interface'} ne 'textual'); +# -------------------------------- Prevent users from attempting to login twice + my $handle = &Apache::lonnet::check_for_valid_session($r); + if ($handle ne '') { + my $lonidsdir=$r->dir_config('lonIDsDir'); + if ($handle=~/^publicuser\_/) { +# For "public user" - remove it, we apparently really want to login + unlink($r->dir_config('lonIDsDir')."/$handle.id"); + } else { +# Indeed, a valid token is found + &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 = $env{'form.firsturl'}; + } + $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 + + # ---------------------------- Not possible to really login to domain "public" + if ($env{'form.domain'} eq 'public') { + $env{'form.domain'}=''; + $env{'form.username'}=''; + } +# ----------------------------------------------------------- Process Interface + $env{'form.interface'}=~s/\W//g; - my $iconpath= $r->dir_config('lonIconsURL'); - my $domain = $r->dir_config('lonDefDomain'); + my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + + my $iconpath= + &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL')); + + my $lonhost = $r->dir_config('lonHostID'); + my $domain = &Apache::lonnet::default_login_domain(); + if ($lonhost ne '') { + my $redirect = &check_loginvia($domain,$lonhost); + if ($redirect) { + $r->print($redirect); + return OK; + } + } + + if (($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 $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); - my $loadavg; - { - my $loadfile=Apache::File->new('/proc/loadavg'); - $loadavg=<$loadfile>; - } - $loadavg =~ s/\s.*//g; - my $loadpercent=100*$loadavg/$loadlim; +# --------------------------------------------- Default values for login fields + + my $authusername=($env{'form.username'}?$env{'form.username'}:''); + my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain); - my $otherserver='http://'.$ENV{'SERVER_NAME'}; - my $firsturl=$ENV{'request.firsturl'}; -# ---------------------------------------- Are we access server and overloaded? - if (($role eq 'access') && ($loadpercent>100.0)) { - $otherserver=Apache::lonnet::spareserver(); +# ---------------------------------------------------------- Determine own load + my $loadavg; + { + my $loadfile=Apache::File->new('/proc/loadavg'); + $loadavg=<$loadfile>; } + $loadavg =~ s/\s.*//g; + my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); + my $userloadpercent=&Apache::lonnet::userload(); + my $firsturl= + ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'}); +# ----------------------------------------------------------- Get announcements + my $announcements=&Apache::lonnet::getannounce(); # -------------------------------------------------------- Set login parameters my @hexstr=('0','1','2','3','4','5','6','7', @@ -99,229 +176,476 @@ sub handler { my $uextkey=hex($ukey); 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'}); + } my $logtoken=Apache::lonnet::reply( - 'tmpput:'.$ukey.$lkey.'&'.$firsturl, + 'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras, $lonhost); -# --------------------------------------------------- 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>); - } -# ---------------------------------------------------------- Serve rest of page - $r->print(< + if ($logtoken eq 'con_lost') { + my $spares=''; + my $last; + foreach my $hostid (sort + { + &Apache::lonnet::hostname($a) cmp + &Apache::lonnet::hostname($b); + } + keys(%Apache::lonnet::spareid)) { + next if ($hostid eq $lonhost); + my $hostname = &Apache::lonnet::hostname($hostid); + next if ($last eq $hostname); + $spares.='
'. + $hostname.''. + ' '.&mt('(preferred)').''.$/; + $last=$hostname; + } +$spares.= '
'; +my %all_hostnames = &Apache::lonnet::all_hostnames(); +foreach my $hostid (sort + { + &Apache::lonnet::hostname($a) cmp + &Apache::lonnet::hostname($b); + } + keys(%all_hostnames)) { + next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid}); + my $hostname = &Apache::lonnet::hostname($hostid); + next if ($last eq $hostname); + $spares.='
'. + $hostname.''; + $last=$hostname; +} +$r->print( + '' + .'' + .&mt('The LearningOnline Network with CAPA') + .'' + .'' + .'

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

' + .'' + .'

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

' + .'

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

' + .$spares + .'' + .'' +); +return OK; +} - - this.document.server.submit(); - } - ENDSCRIPT - if ($fullgraph) { - $r->print( - ''); - } +# --------------------------------------------------- Print login screen header + +my %add_entries = ( + bgcolor => "$mainbg", + text => "$font", + link => "$link", + vlink => "$vlink", + alink => "$alink", + onload => 'javascript:enableInput();',); + +$r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js, + { 'redirect' => [$expire,'/adm/roles'], + 'add_entries' => \%add_entries, + 'only_body' => 1,})); + +# ----------------------------------------------------------------------- Texts + +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 password field name + +my $forgotpw = &forgotpwdisplay(%lt); +$forgotpw .= '
' if $forgotpw; +my $loginhelp = &loginhelpdisplay($authdomain,%lt); +$loginhelp .= '
' if $loginhelp; - $r->print(< - - - - - - +# ---------------------------------------------------- Serve out DES JavaScript +{ +my $jsh=Apache::File->new($include."/londes.js"); +$r->print(<$jsh>); +} +# ---------------------------------------------------------- Serve rest of page + +$r->print( + '
' +); + +# +# If the loadbalancing yielded just http:// because perhaps there's no loadbalancing? +# then just us a relative link to authenticate: +# + +$r->print(< + + + + + + + + + ENDSERVERFORM - if ($fullgraph) { $r->print(< -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
- -
- - 		-
- -
-
-ENDTOP +my $coursecatalog; +if (($showcoursecat eq '') || ($showcoursecat)) { + $coursecatalog = &coursecatalog_link($lt{'catalog'}).'
'; } - $r->print(< - - - - - - - - - - - - - - +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); + +my $loginform=(< + + + :
+
+ :
+
+ :
+
+ + +LFORM + + if ($showbanner) { + $r->print(< +
+ The Learning Online Network with CAPA +
+HEADER + } + $r->print(< +
+ $logintitle + $loginform + $noscript_warning +
+ +
+ $loginhelp + $forgotpw + $contactblock + $newuserlink + $coursecatalog +
+ + +
+ENDTOP + if ($showmainlogo) { + $r->print(' '."\n"); + } +$r->print(< +
+ENDTOP + +$r->print(<
- - + + - + -

   User Name:
   Password:
   Domain: + $lt{'dom'}:  + +  $domain +
-
- + 		+ $lt{'serv'}:  + +  $lonhost ($role)
- - -ENDLOGIN - if ($fullgraph) { - $r->print(< - - -
-
- - - - - - -
-    Domain:  + + $lt{'load'}:  -  $domain + +  $loadpercent $lt{'perc'}
-    Server:  + + $lt{'userload'}:  -  $lonhost ($role) + +  $userloadpercent $lt{'perc'}
-    Load:  - -  $loadpercent percent + + $version
-
- -    System Administration:
-       $sysadm
-    Server Administration:
-       $servadm - -
 
+ + + +$helpdeskscript ENDDOCUMENT -} - $r->print(''); + my %endargs = ( 'noredirectlink' => 1, ); + $r->print(&Apache::loncommon::end_page(\%endargs)); return OK; -} +} + +sub check_loginvia { + my ($domain,$lonhost) = @_; + if ($domain eq '' || $lonhost 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 = $ENV{'REMOTE_ADDR'}; + 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 '') { + $output = &redirect_page($newhost,$path); + } + } + } + } + return $output; +} + +sub redirect_page { + my ($desthost,$path) = @_; + my $protocol = $Apache::lonnet::protocol{$desthost}; + $protocol = 'http' if ($protocol ne 'https'); + unless ($path =~ m{^/}) { + $path = '/'.$path; + } + my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path; + if ($env{'form.firsturl'} ne '') { + $url .='?firsturl='.$env{'form.firsturl'}; + } + 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,$servadm,$showadminmail,$authdomain,$helpdeskscript) = @_; + my $contactblock; + my $showhelpdesk = 0; + my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'}; + if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) { + $showhelpdesk = 1; + } + if ($servadm && $showadminmail) { + $contactblock .= $$lt{'servadm'}.':
'. + ''.$servadm.'
'; + } + if ($showhelpdesk) { + $contactblock .= ''.$lt->{'helpdesk'}.'
'; + my $thisurl = &escape('/adm/login'); + $$helpdeskscript = <<"ENDSCRIPT"; + +ENDSCRIPT + } + return $contactblock; +} + +sub forgotpwdisplay { + my (%lt) = @_; + my $prompt_for_resetpw = 1; + if ($prompt_for_resetpw) { + return ''.$lt{'forgotpw'}.''; + } + return; +} + +sub loginhelpdisplay { + my ($authdomain,%lt) = @_; + my $login_help = 1; + if ($login_help) { + my $dom = $authdomain; + if ($dom eq '') { + $dom = &Apache::lonnet::default_login_domain(); + } + my %helpconfig = &Apache::lonnet::get_dom('configuration',['helpsettings'],$dom); + my $loginhelp_url = $helpconfig{'helpsettings'}{'loginhelpurl'}; + if ($loginhelp_url ne '') { + return ''.$lt{'help'}.''; + } else { + return ''.$lt{'help'}.''; + } + } + return; +} + +sub coursecatalog_link { + my ($linkname) = @_; + return <<"END"; + $linkname +END +} + +sub newuser_link { + my ($linkname) = @_; + return ''.$linkname.''; +} 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.