--- loncom/auth/lonlogin.pm 2002/09/17 19:45:11 1.22 +++ loncom/auth/lonlogin.pm 2010/02/09 17:46:44 1.106.4.4 @@ -1,7 +1,7 @@ # The LearningOnline Network # Login Screen # -# $Id: lonlogin.pm,v 1.22 2002/09/17 19:45:11 matthew Exp $ +# $Id: lonlogin.pm,v 1.106.4.4 2010/02/09 17:46:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,62 +25,143 @@ # # 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 -# -# 7/10/02 Jeremy Bowers 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=~/^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 - my $iconpath= $r->dir_config('lonIconsURL'); - my $domain = $r->dir_config('lonDefDomain'); + # ---------------------------- 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 $textbrowsers=$r->dir_config('lonTextBrowsers'); + my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + + foreach (split(/\:/,$textbrowsers)) { + if ($httpbrowser=~/$_/i) { + $env{'form.interface'}='textual'; + } + } + + my $fullgraph=($env{'form.interface'} ne 'textual'); + + 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 (($loadpercent>100.0)) { - $otherserver=Apache::lonnet::spareserver($loadpercent); +# ------------------------------------------------------- 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', @@ -101,84 +182,272 @@ 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); - my $domainlogo=&Apache::loncommon::domainlogo(); -# --------------------------------------------------- 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=&Apache::loncommon::designparm('login.pgbg'); - my $font=&Apache::loncommon::designparm('login.font'); - my $link=&Apache::loncommon::designparm('login.link'); - my $vlink=&Apache::loncommon::designparm('login.vlink'); - my $alink=&Apache::loncommon::designparm('login.alink'); - my $mainbg=&Apache::loncommon::designparm('login.mainbg'); - my $sidebg=&Apache::loncommon::designparm('login.sidebg'); - my $logo=&Apache::loncommon::designparm('login.logo'); - my $img=&Apache::loncommon::designparm('login.img'); +# ------------------- If we cannot talk to ourselves, we are in serious trouble + 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; + } -# ---------------------------------------------------------- Serve rest of page - $r->print(</g; - +# ----------------------------------------------------------- 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 $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 $textcol = + ($fullgraph?&Apache::loncommon::designparm('login.textcol',$domain):'#000000'); + my $bgcol = + ($fullgraph?&Apache::loncommon::designparm('login.bgcol',$domain):'#FFFFFF'); + my $logo=&Apache::loncommon::designparm('login.logo',$domain); + my $img=&Apache::loncommon::designparm('login.img',$domain); + my $domainlogo=&Apache::loncommon::domainlogo($domain); + my $login=&Apache::loncommon::designparm('login.login',$domain); + if ($login eq '') { + $login = $iconpath.'/'.&mt('userauthentication.gif'); + } + 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=&Apache::loncommon::designparm('login.adminmail',$domain); + my $showcoursecat = + &Apache::loncommon::designparm('login.coursecatalog',$domain); + my $loginheader =&Apache::loncommon::designparm('login.loginheader',$domain); + my $shownewuserlink = + &Apache::loncommon::designparm('login.newuser',$domain); + my $now=time; + my $js = (< + + ENDSCRIPT +# --------------------------------------------------- Print login screen header + + my %add_entries = (topmargin => "0", + leftmargin => "0", + marginheight => "0", + marginwidth => "0", + bgcolor => "$pgbg", + 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', + 'load' => 'Server Load', + 'userload' => 'User Load', + 'about' => 'About LON-CAPA', + 'access' => 'Accessibility Options', + 'catalog' => 'Course Catalog', + 'log' => 'Log in', + 'help' => 'Log-in Help', + 'serv' => 'Server', + 'servadm' => 'Server Administration', + 'helpdesk' => 'Contact Helpdesk', + 'forgotpw' => 'Forgot password?', + 'newuser' => 'New User?', + 'options_headline' => 'Select Accessibility Options', + 'sprs_img' => 'Suppress rendering of images', + 'sprs_applet' => 'Suppress Java applets', + 'sprs_embed' => 'Suppress rendering of embedded multimedia', + 'sprs_font' => 'Increase font size', + 'sprs_blackwhite' => 'Switch to black and white mode', + 'remember' => 'Remember these settings for next login'); +# -------------------------------------------------- Change password field name + my $forgotpw = &forgotpwdisplay(%lt); + my $loginhelp = &loginhelpdisplay(%lt); + +# ---------------------------------------------------- Serve out DES JavaScript + { + my $jsh=Apache::File->new($include."/londes.js"); + $r->print(<$jsh>); + } +# ---------------------------------------------------------- Serve rest of page + if ($fullgraph) { $r->print( - ''); + '
'); } $r->print(< - - - - - - + + + + + + + + + + + + + + + + ENDSERVERFORM - if ($fullgraph) { $r->print(<print(< - + @@ -198,24 +467,39 @@ ENDSERVERFORM - + - - - '; + } else { + $logintitle = ''; + } + my $noscript_warning=''; $r->print(< - - + + -
The Learning Online Network with CAPA +HEADER + if ($showbanner) { + $r->print(< +ENDBANNER + } + $r->print(<
- Accessibility Options -
- About LON-CAPA + 		+ + + + + + + + + $coursecatalog + + + +
 $lt{'access'}
 $lt{'about'}
 
 + +ENDSTART + if ($showmainlogo) { + $r->print(< +ENDLOGO + } + $r->print(< @@ -227,31 +511,77 @@ ENDSERVERFORM ENDTOP -} + } else { + $r->print('

The LearningOnline Network with CAPA

' + .'

'.&mt('Text-based Interface Login').'

' + .$announcements); + } + $r->print('
'); + unless ($fullgraph) { + $r->print(<$lt{'options_headline'} +
+
+
+
+
+
+ $lt{'remember'}
+ENDACCESSOPTIONS + } else { + $r->print(< + + + + + +ENDNOOPT + } + my $logintitle; + if ($loginheader eq 'text') { + $logintitle = '
   '.$lt{'log'}.''. + &mt('User Authentication').'' + .'
- +
User Authentication
+ $logintitle + $noscript_warning - - + + - - + + - - + + + + + + -

   User Name:

   :
   Password:   :
   Domain:   :
  +
+ +
+ + $loginhelp + $forgotpw + $newuserlink
-
@@ -259,12 +589,18 @@ ENDTOP ENDLOGIN if ($fullgraph) { + my $helpdeskscript; + my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail, + $version,$authdomain,\$helpdeskscript); $r->print(< + +$announcements + @@ -273,39 +609,42 @@ ENDLOGIN
- +
- - - - + + + +
-    Domain:  +    $lt{'dom'}:  +  $domain
-    Server:  +    $lt{'serv'}:  +  $lonhost ($role)
-    Load:  + +    $lt{'load'}:  -  $loadpercent percent + +  $loadpercent% +
+    $lt{'userload'}:  + +  $userloadpercent%

- -    System Administration:
-       $sysadm
-    Server Administration:
-       $servadm
  - + $contactblock @@ -335,11 +674,90 @@ $domainlogo + +$helpdeskscript + ENDDOCUMENT } - $r->print(''); + 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.