--- loncom/auth/lonlogin.pm 2003/01/16 01:37:26 1.28
+++ loncom/auth/lonlogin.pm 2008/12/10 10:14:55 1.111
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Login Screen
#
-# $Id: lonlogin.pm,v 1.28 2003/01/16 01:37:26 www Exp $
+# $Id: lonlogin.pm,v 1.111 2008/12/10 10:14:55 muellerd Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,63 +25,139 @@
#
# 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']);
+ 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();
+ $r->print(
+ $start_page
+ .'
'.&mt('You are already logged in!').'
'
+ .''.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].',
+ '','','','').'
'
+ .''.&mt('Login problems?').'
'
+ .$end_page
+ );
+ return OK;
+ }
- my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':8080'.
- $r->dir_config('lonIconsURL');
- my $domain = $r->dir_config('lonDefDomain');
+# ---------------------------------------------------- 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 $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 (($role eq 'access') && ($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',
@@ -102,251 +178,407 @@ sub handler {
my $uextkey=hex($ukey);
if ($uextkey>2147483647) { $uextkey-=4294967296; }
+# -------------------------------------------------------- Store away log token
my $logtoken=Apache::lonnet::reply(
'tmpput:'.$ukey.$lkey.'&'.$firsturl,
$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 $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 = (<
+function send()
+{
+this.document.server.elements.uname.value
+=this.document.client.elements.uname.value;
+
+this.document.server.elements.udom.value
+=this.document.client.elements.udom.value;
+
+uextkey=this.document.client.elements.uextkey.value;
+lextkey=this.document.client.elements.lextkey.value;
+initkeys();
+
+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));
-
- uextkey=this.document.client.elements.uextkey.value;
- lextkey=this.document.client.elements.lextkey.value;
- initkeys();
+ENDSCRIPT
- this.document.server.elements.upass.value
- =crypted(this.document.client.elements.upass.value);
+# --------------------------------------------------- Print login screen header
- this.document.server.submit();
- return false;
- }
-
-ENDSCRIPT
+my %add_entries = (topmargin => "0",
+ leftmargin => "0",
+ marginheight => "0",
+ marginwidth => "0",
+ 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',
+ 'about' => 'About LON-CAPA',
+ '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);
- 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(<
-
-
-
-
-
-
+if ($fullgraph) {
+$r->print(
+ '');
+}
+
+$r->print(<
+
+
+
+
+
+
+
+
+
ENDSERVERFORM
- if ($fullgraph) { $r->print(<
-
-
-
- |
-
-
-
-
-
-
- |
-
-
- |
-
-
- |
-
-
- |
-
-
-
-
-
-
-
-
-
- |
-
-
-
- |
-
-
-
-
-
-
-
- |
-
-
- |
-
-
-
-
-
-
-ENDTOP
+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 = '';
}
- $r->print(<
-
-
-
-
+ $noscript_warning
+
+
+
+
+ $loginhelp
+ $forgotpw
+ $newuserlink
+ $coursecatalog
+ $lt{'about'}
+ $contactblock
+
+
+
+$announcements
+ENDTOP
+}
+
+if($announcements){$r->print(' ');}
+
+if ($fullgraph) {
+$r->print(<
-
- Domain:
+ |
+ $lt{'dom'}:
|
-
+ |
$domain
|
-
- Server:
+ |
+ $lt{'serv'}:
|
-
+ |
$lonhost ($role)
|
-
- Load:
+ |
+ $lt{'load'}:
+ |
+
+ $loadpercent $lt{'perc'}
+ |
+
+
+
+ $lt{'userload'}:
|
-
- $loadpercent percent
+ |
+ $userloadpercent $lt{'perc'}
|
|
-
-
- System Administration:
- $sysadm
- Server Administration:
- $servadm
-
-
-
-
- |
-
-
-
-$domainlogo
- |
-
-
- |
-
-
-
-
- |
-
-
- |
-
-
- |
-
-
- |
-
-
+
-
+$helpdeskscript
ENDDOCUMENT
}
- $r->print('