# The LearningOnline Network # Login Screen # # $Id: lonlogin.pm,v 1.73 2006/02/28 16:44:19 albertel 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; use Apache::migrateuser(); sub handler { my $r = shift; &Apache::loncommon::get_unprocessed_cgi ($ENV{'QUERY_STRING'}.'&'.$env{'request.querystring'}, ['interface','username','domain','firsturl','localpath','localres', 'token']); # -- 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; # 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") { # Is there an existing token file? if ($handle=~/^publicuser\_/) { # For "public user" - remove it, we apparently really want to login unlink("$lonidsdir/$handle.id"); } elsif ($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 # ---------------------------- 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 $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'); my $testdomain=(split(/\./,$ENV{'HTTP_HOST'}))[0]; foreach my $posdom (&Apache::lonnet::current_machine_domains()) { if (lc($posdom) eq lc($testdomain)) { $domain=$posdom; } } 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=''; my $last; foreach my $hostid (sort { $Apache::lonnet::hostname{$a} cmp $Apache::lonnet::hostname{$b}; } keys(%Apache::lonnet::spareid)) { next if ($hostid eq $lonhost); next if ($last eq $Apache::lonnet::hostname{$hostid}); $spares.='
'. $Apache::lonnet::hostname{$hostid}.''. ' (preferred)'.$/; $last=$Apache::lonnet::hostname{$hostid}; } $spares.= '
'; foreach my $hostid (sort { $Apache::lonnet::hostname{$a} cmp $Apache::lonnet::hostname{$b}; } keys(%Apache::lonnet::hostname)) { next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid}); next if ($last eq $Apache::lonnet::hostname{$hostid}); $spares.='
'. $Apache::lonnet::hostname{$hostid}.''; $last=$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'); # -------------------------------------------------- Change password field name my $now=time; # ---------------------------------------------------------- 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




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__