--- loncom/auth/lonlogin.pm 2002/02/19 21:20:48 1.12 +++ loncom/auth/lonlogin.pm 2009/09/11 23:04:45 1.125 @@ -1,7 +1,7 @@ # The LearningOnline Network # Login Screen # -# $Id: lonlogin.pm,v 1.12 2002/02/19 21:20:48 albertel Exp $ +# $Id: lonlogin.pm,v 1.125 2009/09/11 23:04:45 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,50 +25,134 @@ # # 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 -# + 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; - my $iconpath= $r->dir_config('lonIconsURL'); - my $domain = $r->dir_config('lonDefDomain'); + +# Are we re-routing? + if (-e '/home/httpd/html/lon-status/reroute.txt') { + &Apache::lonauth::reroute($r); + 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 + 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].', + '','','','').'

' + .'

'.&mt('Login problems?').'

' + .$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 $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + + my $iconpath= + &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL')); + + my $domain = &Apache::lonnet::default_login_domain(); + 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); + +# --------------------------------------------- Default values for login fields + my $authusername=($env{'form.username'}?$env{'form.username'}:''); + my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain); + +# ---------------------------------------------------------- Determine own load my $loadavg; - { - my $loadfile=Apache::File->new('/proc/loadavg'); - $loadavg=<$loadfile>; - } + { + my $loadfile=Apache::File->new('/proc/loadavg'); + $loadavg=<$loadfile>; + } $loadavg =~ s/\s.*//g; - my $loadpercent=100*$loadavg/$loadlim; + my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); + my $userloadpercent=&Apache::lonnet::userload(); - 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(); +# ------------------------------------------------------- Do the load balancing + my $otherserver= &Apache::lonnet::absolute_url($host_name); + 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(); # -------------------------------------------------------- Set login parameters my @hexstr=('0','1','2','3','4','5','6','7', @@ -84,106 +168,410 @@ sub handler { } my $lextkey=hex($lkey); + if ($lextkey>2147483647) { $lextkey-=4294967296; } + my $uextkey=hex($ukey); - my $logtoken=Apache::lonnet::reply( - 'tmpput:'.$ukey.$lkey.'&'.$firsturl, - $lonhost); + if ($uextkey>2147483647) { $uextkey-=4294967296; } -# --------------------------------------------------- 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>); +# -------------------------------------------------------- Store away log token + my $tokenextras; + if ($env{'form.role'}) { + $tokenextras = '&role='.&escape($env{'form.role'}); } -# ---------------------------------------------------------- Serve rest of page - $r->print(< +# ------------------- If we cannot talk to ourselves, we are in serious trouble - - function send() { - this.document.server.elements.uname.value - =this.document.client.elements.uname.value; +ENDSCRIPT - this.document.server.elements.udom.value - =this.document.client.elements.udom.value; +# --------------------------------------------------- Print login screen header - uextkey=this.document.client.elements.uextkey.value; - lextkey=this.document.client.elements.lextkey.value; - initkeys(); +my %add_entries = ( + bgcolor => "$mainbg", + text => "$font", + link => "$link", + vlink => "$vlink", + alink => "$alink",); + +$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 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); +my $loginhelp = &loginhelpdisplay(%lt); - this.document.server.elements.upass.value - =crypted(this.document.client.elements.upass.value); +# ---------------------------------------------------- Serve out DES JavaScript +{ +my $jsh=Apache::File->new($include."/londes.js"); +$r->print(<$jsh>); +} +# ---------------------------------------------------------- Serve rest of page - this.document.server.submit(); - } +$r->print( + '
'); - +# +# If the loadbalancing yielded just http:// because perhaps there's no loadbalancing? +# then just us a relative link to authenticate: +# -Accessibility Options -   -About LON-CAPA

- - - -
- -User Authentication

- -

- - - - - -
- -
- - - - +$r->print(< + + + + + + + + + + +ENDSERVERFORM +my $coursecatalog; +if (($showcoursecat eq '') || ($showcoursecat)) { + $coursecatalog = &coursecatalog_link($lt{'catalog'}); +} +my $newuserlink; +if ($shownewuserlink) { + $newuserlink = &newuser_link($lt{'newuser'}).'
'; +} +my $logintitle; +if ($loginheader eq 'text') { + $logintitle ='

'.$lt{'log'}.'

'; +} else { + $logintitle = ''.
+                  &mt('User Authentication').''; +} + +my $noscript_warning=''; +my $helpdeskscript; +my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail, + $version,$authdomain,\$helpdeskscript); + +my $loginform=(< + + + :
+
+ :
+
+ :
+
+ + +LFORM + + if ($showbanner) { + $r->print(< +
Username:
Password:
Domain:
+ + - -
+ The Learning Online Network with CAPA +
- - - - -
- - - - - - - -
Domain:$domainSystem Administration:
- $sysadm
- Server Administration:
- $servadm
Server:$lonhost ($role)
Load:$loadpercent percent
-
- -Laboratory for
-Instructional
-Technology in
-Education
-
- - +HEADER + } + $r->print(< 

+
+
+ $logintitle + + + + +
+ $loginform +
+ $noscript_warning +
+ +
+ $loginhelp
+ $forgotpw
+ $contactblock
+ $newuserlink + $coursecatalog +
+
+ENDTOP + if ($showmainlogo) { + $r->print(' '."\n"); + } +$r->print(<  +ENDTOP + +$r->print(< + + +    $lt{'dom'}:  + + +  $domain + + + + +    $lt{'serv'}:  + + +  $lonhost ($role) + + + + +    $lt{'load'}:  + + +  $loadpercent $lt{'perc'} + + + + +    $lt{'userload'}:  + + +  $userloadpercent $lt{'perc'} + + + + + + +$helpdeskscript + ENDDOCUMENT + my %endargs = ( 'noredirectlink' => 1, ); + $r->print(&Apache::loncommon::end_page(\%endargs)); return OK; -} +} + +sub contactdisplay { + my ($lt,$servadm,$showadminmail,$version,$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 + } + $contactblock .= <<"ENDBLOCK"; +    $version +ENDBLOCK + return $contactblock; +} + +sub forgotpwdisplay { + my (%lt) = @_; + my $prompt_for_resetpw = 1; + if ($prompt_for_resetpw) { + return ''.$lt{'forgotpw'}.''; + } + return; +} + +sub loginhelpdisplay { + my (%lt) = @_; + my $login_help = 1; + if ($login_help) { + 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.