# The LearningOnline Network # Login Screen # # $Id: lonlogin.pm,v 1.16 2023/03/22 16:32:51 gci 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 Apache::File(); use Apache::lonnet; use Apache::loncommon(); use Apache::lonauth(); use Apache::lonlocal; use Apache::migrateuser(); use lib '/home/httpd/lib/perl/'; use LONCAPA; use HTML::Entities(); sub handler { my $r = shift; &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; # 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.role'}) { $dest .= '?selectrole=1&'.$env{'form.role'}.'=1'; } if ($env{'form.symb'}) { $dest .= ($dest =~ /\?/) ? '&' : '?'; $dest .= 'destinationurl='.&HTML::Entities::encode($env{'form.symb'},'"&<>'); } 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 $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 %longname = ( GCI => 'Geoscience Concept Inventory', SLCI => 'Science Literacy Concept Inventory', ); my %allnums = &Apache::loncommon::get_faculty_cnums(); my ($inventory,$uc_inventory,$testdom); if ($domain =~ /^(\w+ci)test$/) { $inventory = $1; $testdom = $domain; } else { $inventory = $domain; $testdom = $domain.'test'; } $uc_inventory = uc($inventory); my $sitename; = $uc_inventory.' WebCenter'; my $shortsitename = 'WebCenter'; my $existing = 'Existing WebCenter user?'; my $sitedesc = &mt('The [_1]WebCenter[_2] is a place to comment on existing concept questions, or submit new ones, and is also a place to build and manage Concept Tests which your students will complete via the [_3]Testing Center[_2].',$longname{$inventory}.' ('.$uc_inventory.') ','',''); my $role = $r->dir_config('lonRole'); my $loadlim = $r->dir_config('lonLoadLim'); my $servadm = $r->dir_config('lonAdmEMail'); 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); if ($domain =~ /^(\w+ci)test$/) { $lonhost = $domain.'l1'; $host_name = $domain.'.lite.msu.edu'; $sitename = $inventory.' Testing Center'; $shortsitename = 'Testing Center'; $existing = 'Student with Testing Center account?'; $sitedesc = &mt('The [_1] Testing Center is used by [_2]students[_3] to complete online concept tests created by their instructors using questions available in the [_4].',$inventory,'','',$longname{$inventory}); } # --------------------------------------------- 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= &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', '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 $tokenextras; if ($env{'form.role'}) { $tokenextras = '&role='.&escape($env{'form.role'}); } if ($domain !~ /^\w+citest$/) { unless ($env{'form.symb'} eq '/adm/statistics') { $env{'form.symb'} = '/adm/ci_info'; } } if ($env{'form.symb'}) { if (!$tokenextras) { $tokenextras = '&'; } $tokenextras .= '&symb='.&escape($env{'form.symb'}); } my $logtoken=Apache::lonnet::reply( 'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras, $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); 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("The $sitename server is temporarily not available for login.").'

' .'' .'' ); return OK; } # ----------------------------------------------- Apparently we are in business $servadm=~s/\,/\
/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", onload => "if ( document.client.uname ) { document.client.uname.focus(); }", marginheight => "0",); my $css_url = "/css/$domain/login.css"; $js .= "\n".''."\n"; $r->print(&Apache::loncommon::start_page($uc_inventory.' WebCenter 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', 'tbli' => 'Text-based Interface 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 my $coursecatalog; if (($showcoursecat eq '') || ($showcoursecat)) { $coursecatalog = &coursecatalog_link($lt{'catalog'},$fullgraph); } my $newuserlink; if ($shownewuserlink) { $newuserlink = &newuser_link($lt{'newuser'}); } if ($fullgraph) { $r->print(<<"END_OF_BLOCK1");

$uc_inventory
 
 
New to the $sitename?

$sitedesc

The $shortsitename runs on LON-CAPA - an open source freeware distributed learning content management and assessment system.


END_OF_BLOCK1 if ($domain !~ /^\w+citest$/) { my $review; if (ref($allnums{$domain}) eq 'HASH') { $review = $domain.'_'.$allnums{$domain}{'review'}; } $r->print(<<"END_OF_BLOCK2"); Create a $uc_inventory WebCenter ID – use your ID to submit comments or new content, or to create a new test. If you are already a $uc_inventory WebCenter user, please log-in.


END_OF_BLOCK2 } else { $r->print(''. &mt("If you are already a $sitename user, please log-in.").' '.&mt('If not, contact your instructor to request a username and password.'). '


'); } $r->print(<<"END_OF_BLOCK3");
 
 
 
 

$existing
Please log-in.


:
:
 




Forgot your password?

 
 
 
  Note:
If log-in fails, it may be because your browser is not accepting session cookies, or javascript is disabled. Learn more.
 
 

 

 

END_OF_BLOCK3 } else { $r->print(<The LearningOnline Network with CAPA

$lt{'tbli'}

$announcements

$lt{'options_headline'}







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

   :

   :
 
$loginhelp $forgotpw $newuserlink $coursecatalog
ENDTEXTUAL } $r->print(<<"ENDLOGIN");
ENDLOGIN if ($fullgraph) { my $helpdeskscript; my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail, $version,$authdomain,\$helpdeskscript); } 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,$fullgraph) = @_; my $link = '/adm/coursecatalog'; if (!$fullgraph) { $link.= '?interface=textual'; } return '   '.$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.