# The LearningOnline Network # Login Screen # # $Id: lonlogin.pm,v 1.62 2004/12/30 16:04:37 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # 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; sub handler { my $r = shift; &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; # 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 %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; } } # ---------------------------------------------------- No valid token, continue &Apache::loncommon::get_unprocessed_cgi ($ENV{'QUERY_STRING'}.'&'.$ENV{'request.querystring'}, ['interface','username','domain','firsturl','localpath','localres']); # ----------------------------------------------------------- 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 $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'}})) { $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'); # --------------------------------------------- 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>; } $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 $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(); # -------------------------------------------------------- Set login parameters my @hexstr=('0','1','2','3','4','5','6','7', '8','9','a','b','c','d','e','f'); my $lkey=''; for (0..7) { $lkey.=$hexstr[rand(15)]; } my $ukey=''; for (0..7) { $ukey.=$hexstr[rand(15)]; } my $lextkey=hex($lkey); if ($lextkey>2147483647) { $lextkey-=4294967296; } my $uextkey=hex($ukey); if ($uextkey>2147483647) { $uextkey-=4294967296; } # -------------------------------------------------------- Store away log token my $logtoken=Apache::lonnet::reply( 'tmpput:'.$ukey.$lkey.'&'.$firsturl, $lonhost); # ------------------- If we cannot talk to ourselves, we are in serious trouble if ($logtoken eq 'con_lost') { my $spares=''; foreach my $hostid (keys(%Apache::lonnet::spareid)) { next if ($hostid eq $lonhost); $spares.='
'. $Apache::lonnet::hostname{$hostid}.''. ' (preferred)'.$/; } $spares.= '
'; foreach my $hostid (keys(%Apache::lonnet::hostname)) { next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid}); $spares.='
'. $Apache::lonnet::hostname{$hostid}.''; } $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 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 $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 $logo=&Apache::loncommon::designparm('login.logo',$domain); my $img=&Apache::loncommon::designparm('login.img',$domain); # ----------------------------------------------------------------------- Texts my %lt=&Apache::lonlocal::texthash( 'un' => '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'); # ---------------------------------------------------------- Serve rest of page $r->print(< ENDSCRIPT if ($fullgraph) { $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 Suppress rendering of images
Suppress Java applets
Suppress rendering of embedded multimedia
Increase font size
Switch to black and white mode

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 } $r->print(<
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

   $lt{'dom'}:   $domain
   $lt{'serv'}:   $lonhost ($role)
   $lt{'load'}:   $loadpercent $lt{'perc'}
   $lt{'userload'}:   $userloadpercent $lt{'perc'}

$contactblock 		$domainlogo
 
$helpdeskscript ENDDOCUMENT } $r->print(''); return OK; } sub contactdisplay { my ($lt,$sysadm,$servadm,$version,$authdomain,$helpdeskscript) = @_; 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.'
 
'; } if ($showhelpdesk) { $contactblock .= '   '.$$lt{'helpdesk'}.'
'; my $thisurl = &Apache::lonnet::escape('/adm/login'); $$helpdeskscript = <<"ENDSCRIPT"; ENDSCRIPT } $contactblock .= <<"ENDBLOCK";    $version ENDBLOCK return $contactblock; } 1; __END__