# The LearningOnline Network
# User Authentication Module
#
# $Id: lonauth.pm,v 1.101.8.9.2.2 2012/02/09 22:01:34 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::lonauth;
use strict;
use LONCAPA;
use Apache::Constants qw(:common);
use CGI qw(:standard);
use DynaLoader; # for Crypt::DES version
use Crypt::DES;
use Apache::loncommon();
use Apache::lonnet;
use Apache::lonmenu();
use Apache::createaccount;
use Fcntl qw(:flock);
use Apache::lonlocal;
use Apache::File();
use HTML::Entities;
# ------------------------------------------------------------ Successful login
sub success {
my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
$form) = @_;
# ------------------------------------------------------------ Get cookie ready
my $cookie =
&Apache::loncommon::init_user_environment($r, $username, $domain,
$authhost, $form,
{'extra_env' => $extra_env,});
my $public=($username eq 'public' && $domain eq 'public');
if ($public or $lowerurl eq 'noredirect') { return $cookie; }
# -------------------------------------------------------------------- Log this
&Apache::lonnet::log($domain,$username,$authhost,
"Login $ENV{'REMOTE_ADDR'}");
# ------------------------------------------------- Check for critical messages
my @what=&Apache::lonnet::dump('critical',$domain,$username);
if ($what[0]) {
if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
$lowerurl='/adm/email?critical=display';
}
}
# ------------------------------------------------------------ Get cookie ready
$cookie="lonID=$cookie; path=/";
# -------------------------------------------------------- Menu script and info
my $destination = $lowerurl;
if (defined($form->{role})) {
my $envkey = 'user.role.'.$form->{role};
my $now=time;
my $then=$env{'user.login.time'};
my $refresh=$env{'user.refresh.time'};
my $update=$env{'user.update.time'};
if (!$update) {
$update = $then;
}
if (exists($env{$envkey})) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus);
&Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
\$trolecode,\$tstatus,\$tstart,\$tend);
if ($tstatus eq 'is') {
$destination .= ($destination =~ /\?/) ? '&' : '?';
my $newrole = &HTML::Entities::encode($form->{role},'"<>&');
$destination .= 'selectrole=1&'.$newrole.'=1';
}
}
}
if (defined($form->{symb})) {
my $destsymb = $form->{symb};
$destination .= ($destination =~ /\?/) ? '&' : '?';
if ($destsymb =~ /___/) {
# FIXME Need to deal with encrypted symbs and urls as needed.
my ($map,$resid,$desturl)=split(/___/,$destsymb);
unless ($desturl=~/^(adm|uploaded|editupload|public)/) {
$desturl = &Apache::lonnet::clutter($desturl);
}
$desturl = &HTML::Entities::encode($desturl,'"<>&');
$destsymb = &HTML::Entities::encode($destsymb,'"<>&');
$destination .= '&destinationurl='.$desturl.
'&destsymb='.$destsymb;
} else {
$destsymb = &HTML::Entities::encode($destsymb,'"<>&');
$destination .= '&destinationurl='.$destsymb;
}
}
if ($destination =~ m{^/adm/roles}) {
$destination .= ($destination =~ /\?/) ? '&' : '?';
$destination .= 'source=login';
}
my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
my $startupremote=&Apache::lonmenu::startupremote($destination);
my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl);
my $setflags=&Apache::lonmenu::setflags();
my $maincall=&Apache::lonmenu::maincall();
my $brcrum = [{'href' => '',
'text' => 'Successful Login'},];
my $start_page=&Apache::loncommon::start_page('Successful Login',
$startupremote,
{'no_inline_link' => 1,
'bread_crumbs' => $brcrum,});
my $end_page =&Apache::loncommon::end_page();
my $continuelink;
if ($env{'environment.remote'} eq 'off') {
$continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
}
# ------------------------------------------------- Output for successful login
&Apache::loncommon::content_type($r,'text/html');
$r->header_out('Set-cookie' => $cookie);
$r->send_http_header;
my %lt=&Apache::lonlocal::texthash(
'wel' => 'Welcome',
'pro' => 'Login problems?',
'log' => 'loginproblems.html',
);
my $welcome = &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>');
$r->print(<<ENDSUCCESS);
$start_page
$setflags
$windowinfo
<h1>$lt{'wel'}</h1>
$welcome<p>
<a href="/adm/$lt{'log'}">$lt{'pro'}</a></p>
$remoteinfo
$maincall
$continuelink
$end_page
ENDSUCCESS
}
# --------------------------------------------------------------- Failed login!
sub failed {
my ($r,$message,$form) = @_;
my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,
{'no_inline_link' => 1,});
my $retry = '/adm/login?username='.$form->{'uname'}.
'&domain='.$form->{'udom'};
if (exists($form->{role})) {
$retry .= '&role='.$form->{role};
}
if (exists($form->{symb})) {
$retry .= '&symb='.$form->{symb};
}
my $end_page = &Apache::loncommon::end_page();
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print(
$start_page
.'<h1>'.&mt('Sorry ...').'</h1>'
.'<p class="LC_warning">'.&mt($message).'</p>'
.'<p>'.&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>')
.'</p>'
.'<p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'
.$end_page
);
}
# ------------------------------------------------------------------ Rerouting!
sub reroute {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $msg='<h1>'.&mt('Sorry ...').'</h1>'
.&mt('Please [_1]log in again[_2].');
&Apache::loncommon::simple_error_page($r,'Rerouting',$msg);
}
# ---------------------------------------------------------------- Main handler
sub handler {
my $r = shift;
my $form;
# Are we re-routing?
if (-e '/home/httpd/html/lon-status/reroute.txt') {
&reroute($r);
return OK;
}
&Apache::lonlocal::get_language_handle($r);
# -------------------------------- Prevent users from attempting to login twice
my $handle = &Apache::lonnet::check_for_valid_session($r);
if ($handle ne '') {
my $lonidsdir=$r->dir_config('lonIDsDir');
if ($handle=~/^publicuser\_/) {
# For "public user" - remove it, we apparently really want to login
unlink($r->dir_config('lonIDsDir')."/$handle.id");
} else {
# Indeed, a valid token is found
&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
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
.'<h1>'.&mt('You are already logged in!').'</h1>'
.'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
.'</p>'
.$end_page
);
return OK;
}
}
# ---------------------------------------------------- No valid token, continue
my $buffer;
if ($r->header_in('Content-length') > 0) {
$r->read($buffer,$r->header_in('Content-length'),0);
}
my %form;
foreach my $pair (split(/&/,$buffer)) {
my ($name,$value) = split(/=/,$pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$form{$name}=$value;
}
if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
&failed($r,'Username, password and domain need to be specified.',
\%form);
return OK;
}
# split user logging in and "su"-user
($form{'uname'},$form{'suname'})=split(/\:/,$form{'uname'});
$form{'uname'} = &LONCAPA::clean_username($form{'uname'});
$form{'suname'}= &LONCAPA::clean_username($form{'suname'});
$form{'udom'} = &LONCAPA::clean_domain( $form{'udom'});
my $role = $r->dir_config('lonRole');
my $domain = $r->dir_config('lonDefDomain');
my $prodir = $r->dir_config('lonUsersDir');
my $contact_name = &mt('LON-CAPA helpdesk');
# ---------------------------------------- Get the information from login token
my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
$form{'serverid'});
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
($tmpinfo eq 'no_such_host')) {
&failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
return OK;
} else {
my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'},
$form{'serverid'});
if ( $reply ne 'ok' ) {
&failed($r,'Session could not be opened.',\%form);
&Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token");
return OK;
}
}
if (!&Apache::lonnet::domain($form{'udom'})) {
&failed($r,'The domain you provided is not a valid LON-CAPA domain.',\%form);
return OK;
}
my ($key,$firsturl,$rolestr,$symbstr)=split(/&/,$tmpinfo);
if ($rolestr) {
$rolestr = &unescape($rolestr);
}
if ($symbstr) {
$symbstr= &unescape($symbstr);
}
if ($rolestr =~ /^role=/) {
(undef,$form{'role'}) = split('=',$rolestr);
}
if ($symbstr =~ /^symb=/) {
(undef,$form{'symb'}) = split('=',$symbstr);
}
my $keybin=pack("H16",$key);
my $cipher;
if ($Crypt::DES::VERSION>=2.03) {
$cipher=new Crypt::DES $keybin;
}
else {
$cipher=new DES $keybin;
}
my $upass='';
for (my $i=0;$i<=2;$i++) {
my $chunk=
$cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},0,16))));
$chunk.=
$cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},16,16))));
$chunk=substr($chunk,1,ord(substr($chunk,0,1)));
$upass.=$chunk;
}
# ---------------------------------------------------------------- Authenticate
my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
my ($cancreate,$statustocreate) =
&Apache::createaccount::get_creation_controls($form{'udom'},$domconfig{'usercreation'});
my $defaultauth;
if (ref($cancreate) eq 'ARRAY') {
if (grep(/^login$/,@{$cancreate})) {
$defaultauth = 1;
}
}
my $clientcancheckhost = 1;
my $uname = $form{'uname'};
my $authhost=Apache::lonnet::authenticate($uname,$upass,
$form{'udom'},$defaultauth,
$clientcancheckhost);
# --------------------------------------------------------------------- Failed?
if ($authhost eq 'no_host') {
my $lc_uname = lc($uname);
if ($uname eq $lc_uname) {
&failed($r,'Username and/or password could not be authenticated.',
\%form);
return OK;
} else {
$authhost=Apache::lonnet::authenticate($lc_uname,$upass,
$form{'udom'},$defaultauth);
if ($authhost eq 'no_host') {
&failed($r,'Username (in lower case) and/or password could not be authenticated.',
\%form);
return OK;
} elsif ($authhost eq 'no_account_on_host') {
&create_account($r,\%form,$cancreate,$lc_uname,$contact_name,$domdesc);
return OK;
} else {
$form{'uname'} = $lc_uname;
}
}
} elsif ($authhost eq 'no_account_on_host') {
&create_account($r,\%form,$cancreate,$uname,$contact_name,$domdesc);
return OK;
}
if (($firsturl eq '') ||
($firsturl=~/^\/adm\/(logout|remote)/)) {
$firsturl='/adm/roles';
}
# --------------------------------- Are we attempting to login as somebody else?
if ($form{'suname'}) {
# ------------ see if the original user has enough privileges to pull this stunt
if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'})) {
# ---------------------------------------------------- see if the su-user exists
unless (&Apache::lonnet::homeserver($form{'suname'},$form{'udom'})
eq 'no_host') {
&Apache::lonnet::logthis(&Apache::lonnet::homeserver($form{'suname'},$form{'udom'}));
# ------------------------------ see if the su-user is not too highly privileged
unless (&Apache::lonnet::privileged($form{'suname'},$form{'udom'})) {
# -------------------------------------------------------- actually switch users
&Apache::lonnet::logperm('User '.$form{'uname'}.' at '.$form{'udom'}.
' logging in as '.$form{'suname'});
$form{'uname'}=$form{'suname'};
} else {
&Apache::lonnet::logthis('Attempted switch user to privileged user');
}
}
} else {
&Apache::lonnet::logthis('Non-privileged user attempting switch user');
}
}
if ($r->dir_config("lonBalancer") eq 'yes') {
my $otherserver = &Apache::lonnet::spareserver(30000,undef,1,$form{'udom'});
if (!$otherserver) {
($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
}
if ($otherserver) {
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
\%form);
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl);
} else {
$r->print(&noswitch());
}
return OK;
} else {
if (!&check_can_host($r,\%form,$authhost,$domdesc)) {
my ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
if ($otherserver) {
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
\%form);
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl);
} else {
$r->print(&noswitch());
}
return OK;
}
# ------------------------------------------------------- Do the load balancing
# ---------------------------------------------------------- Determine own load
my $loadlim = $r->dir_config('lonLoadLim');
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();
# ---------------------------------------------------------- Are we overloaded?
if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'});
if (!$unloaded) {
($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
}
if ($unloaded) {
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',
undef,\%form);
$r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl);
return OK;
}
}
&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
\%form);
return OK;
}
}
sub check_can_host {
my ($r,$form,$authhost,$domdesc) = @_;
return unless (ref($form) eq 'HASH');
my $canhost = 1;
my $lonhost = $r->dir_config('lonHostID');
my $udom = $form->{'udom'};
my @intdoms;
my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
if (ref($internet_names) eq 'ARRAY') {
@intdoms = @{$internet_names};
}
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
my $machine_dom = &Apache::lonnet::host_domain($lonhost);
my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
my $loncaparev;
if ($authhost eq 'no_account_on_host') {
$loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom);
} else {
$loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom,$lonhost);
}
$canhost = &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
$udomdefaults{'remotesessions'},
$defdomdefaults{'hostedsessions'});
}
unless ($canhost) {
if ($authhost eq 'no_account_on_host') {
my $checkloginvia = 1;
my ($login_host,$hostname) =
&Apache::lonnet::choose_server($udom,$checkloginvia);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($login_host ne '') {
my $protocol = $Apache::lonnet::protocol{$login_host};
$protocol = 'http' if ($protocol ne 'https');
my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
$r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
'<h3>'.&mt('Account creation').'</h3>'.
&mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
'<p>'.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'</p>'.
'<p>'.&mt('[_1]Log in[_2]','<a href="'.$newurl.'">','</a>').
&Apache::loncommon::end_page());
} else {
$r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable').
'<h3>'.&mt('Account creation unavailable').'</h3>'.
&mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
'<p>'.&mt('Currently a LON-CAPA server is not available within the [_1] domain for you to log-in to, to create an account.',$domdesc).'</p>'.
&Apache::loncommon::end_page());
}
} else {
&success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef,
$form);
my ($otherserver) = &Apache::lonnet::choose_server($udom);
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
}
}
return $canhost;
}
sub noswitch {
my $result = &Apache::loncommon::start_page('Access to LON-CAPA unavailable').
'<h3>'.&mt('Session unavailable').'</h3>'.
&mt('This LON-CAPA server is unable to host your session.').'<br />'.
'<p>'.&mt('Currently no other LON-CAPA server is available to host your session either.').'</p>'.
&Apache::loncommon::end_page();
return $result;
}
sub create_account {
my ($r,$form,$cancreate,$uname,$contact_name,$domdesc) = @_;
return unless((ref($form) eq 'HASH') && (ref($cancreate) eq 'ARRAY'));
my %domconfig =
&Apache::lonnet::get_dom('configuration',['usercreation'],$form->{'udom'});
if (&check_can_host($r,$form,'no_account_on_host',$domdesc)) {
my $start_page =
&Apache::loncommon::start_page('Create a user account in LON-CAPA',
'',{'no_inline_link' => 1,});
my $lonhost = $r->dir_config('lonHostID');
my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
my $contacts =
&Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
$form->{'udom'},$origmail);
my ($contact_email) = split(',',$contacts);
my $output =
&Apache::createaccount::username_check($uname,$form->{'udom'},
$domdesc,'',$lonhost,
$contact_email,$contact_name);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::createaccount::print_header($r,$start_page);
$r->print('<h3>'.&mt('Account creation').'</h3>'.
&mt('Although your username and password were authenticated, you do not currently have a LON-CAPA account at this institution.').'<br />'.
$output.&Apache::loncommon::end_page());
} else {
&failed($r,'Although your username and password were authenticated, you do not currently have a LON-CAPA account in this domain, and you are not permitted to create one.',$form);
}
return;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonauth.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / auth