$lt{'wel'}
$welcome
$lt{'pro'}
$continuelink
$end_page
ENDSUCCESS
}
# --------------------------------------------------------------- Failed login!
sub failed {
my ($r,$message,$form) = @_;
my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef);
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
.''.&mt('Sorry ...').'
'
.''.&mt($message).'
'
.''.&mt('Please [_1]log in again[_2].','','')
.'
'
.''.&mt('Login problems?').'
'
.$end_page
);
}
# ------------------------------------------------------------------ Rerouting!
sub reroute {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $msg=''.&mt('Sorry ...').'
'
.&mt('Please [_1]log in again[_2].');
&Apache::loncommon::simple_error_page($r,'Rerouting',$msg);
}
# ---------------------------------------------------------------- Main handler
sub handler {
my $r = shift;
my $londocroot = $r->dir_config('lonDocRoot');
my $form;
# Are we re-routing?
if (-e "$londocroot/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
.''.&mt('You are already logged in!').'
'
.''.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
,'','','','')
.'
'
.$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 ($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 $authhost=Apache::lonnet::authenticate($form{'uname'},$upass,
$form{'udom'},$defaultauth,
$clientcancheckhost);
# --------------------------------------------------------------------- Failed?
if ($authhost eq 'no_host') {
&failed($r,'Username and/or password could not be authenticated.',
\%form);
return OK;
} elsif ($authhost eq 'no_account_on_host') {
if ($defaultauth) {
my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
unless (&check_can_host($r,\%form,'no_account_on_host',$domdesc)) {
return OK;
}
my $start_page =
&Apache::loncommon::start_page('Create a user account in LON-CAPA');
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($form{'uname'},$form{'udom'},
$domdesc,'',$lonhost,
$contact_email,$contact_name,
undef,$statustocreate);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::createaccount::print_header($r,$start_page);
$r->print(''.&mt('Account creation').'
'.
&mt('Although your username and password were authenticated, you do not currently have a LON-CAPA account at this institution.').'
'.
$output.&Apache::loncommon::end_page());
return OK;
} 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 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');
}
}
my ($is_balancer,$otherserver) =
&Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'});
if ($is_balancer) {
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)) {
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').
''.&mt('Account creation').'
'.
&mt('You do not currently have a LON-CAPA account at this institution.').'
'.
''.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'
'.
''.&mt('[_1]Log in[_2]','','').
&Apache::loncommon::end_page());
} else {
$r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable').
'
'.&mt('Account creation unavailable').'
'.
&mt('You do not currently have a LON-CAPA account at this institution.').'
'.
''.&mt('Currently a LON-CAPA server is not available within the [_1] domain for you to log-in to, to create an account.',$domdesc).'
'.
&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').
''.&mt('Session unavailable').'
'.
&mt('This LON-CAPA server is unable to host your session.').'
'.
''.&mt('Currently no other LON-CAPA server is available to host your session either.').'
'.
&Apache::loncommon::end_page();
return $result;
}
1;
__END__