version 1.121.2.2, 2012/08/27 11:55:26
|
version 1.121.2.24, 2021/12/30 05:11:28
|
Line 32 use strict;
|
Line 32 use strict;
|
use LONCAPA; |
use LONCAPA; |
use Apache::Constants qw(:common); |
use Apache::Constants qw(:common); |
use CGI qw(:standard); |
use CGI qw(:standard); |
use DynaLoader; # for Crypt::DES version |
|
use Crypt::DES; |
|
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::lonmenu(); |
use Apache::lonmenu(); |
Line 42 use Fcntl qw(:flock);
|
Line 40 use Fcntl qw(:flock);
|
use Apache::lonlocal; |
use Apache::lonlocal; |
use Apache::File(); |
use Apache::File(); |
use HTML::Entities; |
use HTML::Entities; |
|
use Digest::MD5; |
|
use CGI::Cookie(); |
|
|
# ------------------------------------------------------------ Successful login |
# ------------------------------------------------------------ Successful login |
sub success { |
sub success { |
my ($r, $username, $domain, $authhost, $lowerurl, $extra_env, |
my ($r, $username, $domain, $authhost, $lowerurl, $extra_env, |
$form) = @_; |
$form,$cid,$expirepub) = @_; |
|
|
# ------------------------------------------------------------ Get cookie ready |
# ------------------------------------------------------------ Get cookie ready |
my $cookie = |
my $cookie = |
Line 60 sub success {
|
Line 60 sub success {
|
|
|
# -------------------------------------------------------------------- Log this |
# -------------------------------------------------------------------- Log this |
|
|
|
my $ip = &Apache::lonnet::get_requestor_ip(); |
&Apache::lonnet::log($domain,$username,$authhost, |
&Apache::lonnet::log($domain,$username,$authhost, |
"Login $ENV{'REMOTE_ADDR'}"); |
"Login $ip"); |
|
|
# ------------------------------------------------- Check for critical messages |
# ------------------------------------------------- Check for critical messages |
|
|
Line 72 sub success {
|
Line 73 sub success {
|
} |
} |
} |
} |
|
|
# ------------------------------------------------------------ Get cookie ready |
# ------------------------------------------------------------ Get cookies ready |
$cookie="lonID=$cookie; path=/"; |
my ($securecookie,$defaultcookie); |
|
my $ssl = $r->subprocess_env('https'); |
|
if ($ssl) { |
|
$securecookie="lonSID=$cookie; path=/; HttpOnly; secure"; |
|
my $lonidsdir=$r->dir_config('lonIDsDir'); |
|
if (($lonidsdir) && (-e "$lonidsdir/$cookie.id")) { |
|
my $linkname=substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex(time(). {}. rand(). $$)), 0, 32).'_linked'; |
|
if (-e "$lonidsdir/$linkname.id") { |
|
unlink("$lonidsdir/$linkname.id"); |
|
} |
|
my $made_symlink = eval { symlink("$lonidsdir/$cookie.id", |
|
"$lonidsdir/$linkname.id"); 1 }; |
|
if ($made_symlink) { |
|
$defaultcookie = "lonLinkID=$linkname; path=/; HttpOnly;"; |
|
&Apache::lonnet::appenv({'user.linkedenv' => $linkname}); |
|
} |
|
} |
|
} else { |
|
$defaultcookie = "lonID=$cookie; path=/; HttpOnly;"; |
|
} |
# -------------------------------------------------------- Menu script and info |
# -------------------------------------------------------- Menu script and info |
my $destination = $lowerurl; |
my $destination = $lowerurl; |
|
|
Line 99 sub success {
|
Line 119 sub success {
|
} |
} |
if (defined($form->{symb})) { |
if (defined($form->{symb})) { |
my $destsymb = $form->{symb}; |
my $destsymb = $form->{symb}; |
|
my $encrypted; |
|
if ($destsymb =~ m{^/enc/}) { |
|
$encrypted = 1; |
|
if ($cid) { |
|
$destsymb = &Apache::lonenc::unencrypted($destsymb,$cid); |
|
} |
|
} |
$destination .= ($destination =~ /\?/) ? '&' : '?'; |
$destination .= ($destination =~ /\?/) ? '&' : '?'; |
if ($destsymb =~ /___/) { |
if ($destsymb =~ /___/) { |
# FIXME Need to deal with encrypted symbs and urls as needed. |
|
my ($map,$resid,$desturl)=split(/___/,$destsymb); |
my ($map,$resid,$desturl)=split(/___/,$destsymb); |
unless ($desturl=~/^(adm|uploaded|editupload|public)/) { |
$desturl = &Apache::lonnet::clutter($desturl); |
$desturl = &Apache::lonnet::clutter($desturl); |
if ($encrypted) { |
|
$desturl = &Apache::lonenc::encrypted($desturl,1,$cid); |
|
$destsymb = $form->{symb}; |
} |
} |
$desturl = &HTML::Entities::encode($desturl,'"<>&'); |
$desturl = &HTML::Entities::encode($desturl,'"<>&'); |
$destsymb = &HTML::Entities::encode($destsymb,'"<>&'); |
$destsymb = &HTML::Entities::encode($destsymb,'"<>&'); |
$destination .= '&destinationurl='.$desturl. |
$destination .= 'destinationurl='.$desturl. |
'&destsymb='.$destsymb; |
'&destsymb='.$destsymb; |
} else { |
} elsif (!$encrypted) { |
$destsymb = &HTML::Entities::encode($destsymb,'"<>&'); |
$destsymb = &HTML::Entities::encode($destsymb,'"<>&'); |
$destination .= '&destinationurl='.$destsymb; |
$destination .= 'destinationurl='.$destsymb; |
} |
} |
} |
} |
if ($destination =~ m{^/adm/roles}) { |
if ($destination =~ m{^/adm/roles}) { |
Line 140 sub success {
|
Line 168 sub success {
|
# ------------------------------------------------- Output for successful login |
# ------------------------------------------------- Output for successful login |
|
|
&Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->header_out('Set-cookie' => $cookie); |
if ($securecookie) { |
|
$r->headers_out->add('Set-cookie' => $securecookie); |
|
} |
|
if ($defaultcookie) { |
|
$r->headers_out->add('Set-cookie' => $defaultcookie); |
|
} |
|
if ($expirepub) { |
|
my $c = new CGI::Cookie(-name => 'lonPubID', |
|
-value => '', |
|
-expires => '-10y',); |
|
$r->headers_out->add('Set-cookie' => $c); |
|
} |
$r->send_http_header; |
$r->send_http_header; |
|
|
my %lt=&Apache::lonlocal::texthash( |
my %lt=&Apache::lonlocal::texthash( |
Line 165 $maincall
|
Line 204 $maincall
|
$continuelink |
$continuelink |
$end_page |
$end_page |
ENDSUCCESS |
ENDSUCCESS |
|
return; |
} |
} |
|
|
# --------------------------------------------------------------- Failed login! |
# --------------------------------------------------------------- Failed login! |
|
|
sub failed { |
sub failed { |
my ($r,$message,$form) = @_; |
my ($r,$message,$form,$authhost) = @_; |
my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef); |
(undef,undef,undef,my $clientmathml,my $clientunicode) = |
my $retry = '/adm/login?username='.$form->{'uname'}. |
&Apache::loncommon::decode_user_agent(); |
'&domain='.$form->{'udom'}; |
my $args = {}; |
if (exists($form->{role})) { |
if ($clientunicode && !$clientmathml) { |
$retry .= '&role='.$form->{role}; |
$args = {'browser.unicode' => 1}; |
|
} |
|
|
|
my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args); |
|
my $uname = &Apache::loncommon::cleanup_html($form->{'uname'}); |
|
my $udom = &Apache::loncommon::cleanup_html($form->{'udom'}); |
|
if (&Apache::lonnet::domain($udom,'description') eq '') { |
|
undef($udom); |
|
} |
|
my $retry = '/adm/login'; |
|
if ($uname eq $form->{'uname'}) { |
|
$retry .= '?username='.$uname; |
|
} |
|
if ($udom) { |
|
$retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom; |
} |
} |
if (exists($form->{symb})) { |
my $lonhost = $r->dir_config('lonHostID'); |
$retry .= '&symb='.$form->{symb}; |
my $querystr; |
|
my $result = &set_retry_token($form,$lonhost,\$querystr); |
|
if ($result eq 'fail') { |
|
if (exists($form->{role})) { |
|
my $role = &Apache::loncommon::cleanup_html($form->{role}); |
|
if ($role ne '') { |
|
$retry .= (($retry=~/\?/)?'&':'?').'role='.$role; |
|
} |
|
} |
|
if (exists($form->{symb})) { |
|
my $symb = &Apache::loncommon::cleanup_html($form->{symb}); |
|
if ($symb ne '') { |
|
$retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb; |
|
} |
|
} |
|
if (exists($form->{firsturl})) { |
|
my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl}); |
|
if ($firsturl ne '') { |
|
$retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl; |
|
} |
|
} |
|
} elsif ($querystr ne '') { |
|
$retry .= (($retry=~/\?/)?'&':'?').$querystr; |
} |
} |
my $end_page = &Apache::loncommon::end_page(); |
my $end_page = &Apache::loncommon::end_page(); |
&Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->send_http_header; |
$r->send_http_header; |
my $loginhelp = &loginhelpdisplay($form->{'udom'}); |
my @actions = |
|
(&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>')); |
|
my $loginhelp = &loginhelpdisplay($udom); |
if ($loginhelp) { |
if ($loginhelp) { |
$loginhelp = '<p><a href="'.$loginhelp.'">'.&mt('Login problems?').'</a></p>'; |
push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>'); |
} |
} |
|
#FIXME: link to helpdesk might be added here |
|
|
$r->print( |
$r->print( |
$start_page |
$start_page |
.'<h1>'.&mt('Sorry ...').'</h1>' |
.'<h2>'.&mt('Sorry ...').'</h2>' |
.'<p class="LC_warning">'.&mt($message).'</p>' |
.&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'<br /><br />' |
.'<p>'.&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>') |
.&Apache::lonhtmlcommon::actionbox(\@actions) |
.'</p>' |
|
.$loginhelp |
|
.$end_page |
.$end_page |
); |
); |
} |
} |
Line 205 sub reroute {
|
Line 282 sub reroute {
|
my ($r) = @_; |
my ($r) = @_; |
&Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->send_http_header; |
$r->send_http_header; |
my $msg='<h1>'.&mt('Sorry ...').'</h1>' |
my $msg='<b>'.&mt('Sorry ...').'</b><br />' |
.&mt('Please [_1]log in again[_2].'); |
.&mt('Please [_1]log in again[_2].'); |
&Apache::loncommon::simple_error_page($r,'Rerouting',$msg); |
&Apache::loncommon::simple_error_page($r,'Rerouting',$msg,{'no_auto_mt_msg' => 1}); |
} |
} |
|
|
# ---------------------------------------------------------------- Main handler |
# ---------------------------------------------------------------- Main handler |
Line 215 sub reroute {
|
Line 292 sub reroute {
|
sub handler { |
sub handler { |
my $r = shift; |
my $r = shift; |
my $londocroot = $r->dir_config('lonDocRoot'); |
my $londocroot = $r->dir_config('lonDocRoot'); |
my $form; |
|
# Are we re-routing? |
# Are we re-routing? |
if (-e "$londocroot/lon-status/reroute.txt") { |
if (-e "$londocroot/lon-status/reroute.txt") { |
&reroute($r); |
&reroute($r); |
Line 241 sub handler {
|
Line 317 sub handler {
|
my $end_page = |
my $end_page = |
&Apache::loncommon::end_page(); |
&Apache::loncommon::end_page(); |
my $dest = '/adm/roles'; |
my $dest = '/adm/roles'; |
if ($env{'form.firsturl'} ne '') { |
my %form = &get_form_items($r); |
$dest = $env{'form.firsturl'}; |
if ($form{'logtoken'}) { |
|
my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'}, |
|
$form{'serverid'}); |
|
unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') || |
|
($tmpinfo eq 'no_such_host')) { |
|
my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo); |
|
$firsturl = &unescape($firsturl); |
|
my %info; |
|
foreach my $item (@rest) { |
|
my ($key,$value) = split(/=/,$item); |
|
$info{$key} = &unescape($value); |
|
} |
|
if ($firsturl ne '') { |
|
$info{'firsturl'} = $firsturl; |
|
$dest = $firsturl; |
|
} |
|
} |
} |
} |
$r->print( |
$r->print( |
$start_page |
$start_page |
.'<p class="LC_warning>"'.&mt('You are already logged in!').'</p>' |
.'<p class="LC_warning">'.&mt('You are already logged in!').'</p>' |
.'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].' |
.'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].' |
,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>') |
,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>') |
.'</p>' |
.'</p>' |
Line 258 sub handler {
|
Line 350 sub handler {
|
|
|
# ---------------------------------------------------- No valid token, continue |
# ---------------------------------------------------- No valid token, continue |
|
|
|
my %form = &get_form_items($r); |
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'})) { |
if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) { |
&failed($r,'Username, password and domain need to be specified.', |
&failed($r,'Username, password and domain need to be specified.', |
\%form); |
\%form); |
Line 279 sub handler {
|
Line 359 sub handler {
|
|
|
# split user logging in and "su"-user |
# split user logging in and "su"-user |
|
|
($form{'uname'},$form{'suname'})=split(/\:/,$form{'uname'}); |
($form{'uname'},$form{'suname'},$form{'sudom'})=split(/\:/,$form{'uname'}); |
$form{'uname'} = &LONCAPA::clean_username($form{'uname'}); |
$form{'uname'} = &LONCAPA::clean_username($form{'uname'}); |
$form{'suname'}= &LONCAPA::clean_username($form{'suname'}); |
$form{'suname'}= &LONCAPA::clean_username($form{'suname'}); |
$form{'udom'} = &LONCAPA::clean_domain( $form{'udom'}); |
$form{'udom'} = &LONCAPA::clean_domain($form{'udom'}); |
|
$form{'sudom'} = &LONCAPA::clean_domain($form{'sudom'}); |
|
|
my $role = $r->dir_config('lonRole'); |
my $role = $r->dir_config('lonRole'); |
my $domain = $r->dir_config('lonDefDomain'); |
my $domain = $r->dir_config('lonDefDomain'); |
Line 313 sub handler {
|
Line 394 sub handler {
|
return OK; |
return OK; |
} |
} |
|
|
my ($key,$firsturl,$rolestr,$symbstr)=split(/&/,$tmpinfo); |
my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo); |
if ($rolestr) { |
$firsturl = &unescape($firsturl); |
$rolestr = &unescape($rolestr); |
foreach my $item (@rest) { |
} |
my ($key,$value) = split(/=/,$item); |
if ($symbstr) { |
$form{$key} = &unescape($value); |
$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; |
|
} |
} |
|
my $upass = &Apache::loncommon::des_decrypt($des_key,$form{'upass0'}); |
|
|
# ---------------------------------------------------------------- Authenticate |
# ---------------------------------------------------------------- Authenticate |
|
|
Line 407 sub handler {
|
Line 461 sub handler {
|
($firsturl=~/^\/adm\/(logout|remote)/)) { |
($firsturl=~/^\/adm\/(logout|remote)/)) { |
$firsturl='/adm/roles'; |
$firsturl='/adm/roles'; |
} |
} |
|
|
|
my ($hosthere,%sessiondata); |
|
if ($form{'iptoken'}) { |
|
%sessiondata = &Apache::lonnet::tmpget($form{'iptoken'}); |
|
my $delete = &Apache::lonnet::tmpdel($form{'iptoken'}); |
|
if (($sessiondata{'domain'} eq $form{'udom'}) && |
|
($sessiondata{'username'} eq $form{'uname'})) { |
|
$hosthere = 1; |
|
} |
|
} |
|
|
# --------------------------------- Are we attempting to login as somebody else? |
# --------------------------------- Are we attempting to login as somebody else? |
if ($form{'suname'}) { |
if ($form{'suname'}) { |
|
my ($suname,$sudom,$sudomref); |
|
$suname = $form{'suname'}; |
|
$sudom = $form{'udom'}; |
|
if ($form{'sudom'}) { |
|
unless ($sudom eq $form{'sudom'}) { |
|
if (&Apache::lonnet::domain($form{'sudom'})) { |
|
$sudomref = [$form{'sudom'}]; |
|
$sudom = $form{'sudom'}; |
|
} |
|
} |
|
} |
# ------------ see if the original user has enough privileges to pull this stunt |
# ------------ see if the original user has enough privileges to pull this stunt |
if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'})) { |
if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'},$sudomref)) { |
# ---------------------------------------------------- see if the su-user exists |
# ---------------------------------------------------- see if the su-user exists |
unless (&Apache::lonnet::homeserver($form{'suname'},$form{'udom'}) |
unless (&Apache::lonnet::homeserver($suname,$sudom) eq 'no_host') { |
eq 'no_host') { |
|
&Apache::lonnet::logthis(&Apache::lonnet::homeserver($form{'suname'},$form{'udom'})); |
|
# ------------------------------ see if the su-user is not too highly privileged |
# ------------------------------ see if the su-user is not too highly privileged |
unless (&Apache::lonnet::privileged($form{'suname'},$form{'udom'})) { |
if (&Apache::lonnet::privileged($suname,$sudom)) { |
|
&Apache::lonnet::logthis('Attempted switch user to privileged user'); |
|
} else { |
|
my $noprivswitch; |
|
# |
|
# su-user's home server and user's home server must have one of: |
|
# (a) same domain |
|
# (b) same primary library server for the two domains |
|
# (c) same "internet domain" for primary library server(s) for home servers' domains |
|
# |
|
my $suprim = &Apache::lonnet::domain($sudom,'primary'); |
|
my $suintdom = &Apache::lonnet::internet_dom($suprim); |
|
unless ($sudom eq $form{'udom'}) { |
|
my $uprim = &Apache::lonnet::domain($form{'udom'},'primary'); |
|
my $uintdom = &Apache::lonnet::internet_dom($uprim); |
|
unless ($suprim eq $uprim) { |
|
unless ($suintdom eq $uintdom) { |
|
&Apache::lonnet::logthis('Attempted switch user ' |
|
.'to user with different "internet domain".'); |
|
$noprivswitch = 1; |
|
} |
|
} |
|
} |
|
|
|
unless ($noprivswitch) { |
|
# |
|
# server where log-in occurs must have same "internet domain" as su-user's home |
|
# server |
|
# |
|
my $lonhost = $r->dir_config('lonHostID'); |
|
my $hostintdom = &Apache::lonnet::internet_dom($lonhost); |
|
if ($hostintdom ne $suintdom) { |
|
&Apache::lonnet::logthis('Attempted switch user on a ' |
|
.'server with a different "internet domain".'); |
|
} else { |
|
|
# -------------------------------------------------------- actually switch users |
# -------------------------------------------------------- actually switch users |
&Apache::lonnet::logperm('User '.$form{'uname'}.' at '.$form{'udom'}. |
|
' logging in as '.$form{'suname'}); |
&Apache::lonnet::logperm('User '.$form{'uname'}.' at '. |
$form{'uname'}=$form{'suname'}; |
$form{'udom'}.' logging in as '.$suname.':'.$sudom); |
} else { |
$form{'uname'}=$suname; |
&Apache::lonnet::logthis('Attempted switch user to privileged user'); |
if ($form{'udom'} ne $sudom) { |
|
$form{'udom'}=$sudom; |
|
} |
|
} |
|
} |
} |
} |
} |
} |
} else { |
} else { |
Line 430 sub handler {
|
Line 543 sub handler {
|
} |
} |
} |
} |
|
|
my ($is_balancer,$otherserver) = |
my ($is_balancer,$otherserver); |
&Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'}); |
|
|
|
if ($is_balancer) { |
unless ($hosthere) { |
if (!$otherserver) { |
($is_balancer,$otherserver) = |
($otherserver) = &Apache::lonnet::choose_server($form{'udom'}); |
&Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'},'login'); |
|
if ($is_balancer) { |
|
# Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer) |
|
my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r); |
|
if (($found_server) && ($balancer_cookie =~ /^\Q$env{'user.domain'}\E_\Q$env{'user.name'}\E_/)) { |
|
$otherserver = $found_server; |
|
} |
|
if ($otherserver eq '') { |
|
my $lowest_load; |
|
($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'}); |
|
if ($lowest_load > 100) { |
|
$otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$form{'udom'}); |
|
} |
|
} |
|
if ($otherserver ne '') { |
|
my @hosts = &Apache::lonnet::current_machine_ids(); |
|
if (grep(/^\Q$otherserver\E$/,@hosts)) { |
|
$hosthere = $otherserver; |
|
} |
|
} |
} |
} |
|
} |
|
|
|
if (($is_balancer) && (!$hosthere)) { |
if ($otherserver) { |
if ($otherserver) { |
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, |
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, |
\%form); |
\%form); |
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl); |
my $switchto = '/adm/switchserver?otherserver='.$otherserver; |
|
if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) { |
|
$switchto .= '&origurl='.$firsturl; |
|
} |
|
if ($form{'role'}) { |
|
$switchto .= '&role='.$form{'role'}; |
|
} |
|
if ($form{'symb'}) { |
|
$switchto .= '&symb='.$form{'symb'}; |
|
} |
|
$r->internal_redirect($switchto); |
} else { |
} else { |
|
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
$r->print(&noswitch()); |
$r->print(&noswitch()); |
} |
} |
return OK; |
return OK; |
Line 451 sub handler {
|
Line 597 sub handler {
|
if ($otherserver) { |
if ($otherserver) { |
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, |
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, |
\%form); |
\%form); |
$r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl); |
my $switchto = '/adm/switchserver?otherserver='.$otherserver; |
|
if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) { |
|
$switchto .= '&origurl='.$firsturl; |
|
} |
|
if ($form{'role'}) { |
|
$switchto .= '&role='.$form{'role'}; |
|
} |
|
if ($form{'symb'}) { |
|
$switchto .= '&symb='.$form{'symb'}; |
|
} |
|
$r->internal_redirect($switchto); |
} else { |
} else { |
|
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
$r->print(&noswitch()); |
$r->print(&noswitch()); |
} |
} |
return OK; |
return OK; |
Line 473 sub handler {
|
Line 631 sub handler {
|
|
|
# ---------------------------------------------------------- Are we overloaded? |
# ---------------------------------------------------------- Are we overloaded? |
if ((($userloadpercent>100.0)||($loadpercent>100.0))) { |
if ((($userloadpercent>100.0)||($loadpercent>100.0))) { |
my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'}); |
my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'}); |
if (!$unloaded) { |
if (!$unloaded) { |
($unloaded) = &Apache::lonnet::choose_server($form{'udom'}); |
($unloaded) = &Apache::lonnet::choose_server($form{'udom'}); |
} |
} |
Line 484 sub handler {
|
Line 642 sub handler {
|
return OK; |
return OK; |
} |
} |
} |
} |
|
if (($is_balancer) && ($hosthere)) { |
|
$form{'noloadbalance'} = $hosthere; |
|
} |
|
my $extra_env; |
|
if (($hosthere) && ($sessiondata{'sessionserver'} ne '')) { |
|
if ($sessiondata{'origurl'} ne '') { |
|
$firsturl = $sessiondata{'origurl'}; |
|
$form{'firsturl'} = $sessiondata{'origurl'}; |
|
my @names = ('role','symb','linkprot','linkkey'); |
|
foreach my $item (@names) { |
|
if ($sessiondata{$item} ne '') { |
|
$form{$item} = $sessiondata{$item}; |
|
} |
|
} |
|
} |
|
} |
&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef, |
&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef, |
\%form); |
\%form); |
return OK; |
return OK; |
} |
} |
} |
} |
|
|
|
sub get_form_items { |
|
my ($r) = @_; |
|
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; |
|
} |
|
return %form; |
|
} |
|
|
|
sub set_retry_token { |
|
my ($form,$lonhost,$querystr) = @_; |
|
if (ref($form) eq 'HASH') { |
|
my ($firsturl,$token,$extras,@names); |
|
@names = ('role','symb','iptoken'); |
|
foreach my $name (@names) { |
|
if ($form->{$name} ne '') { |
|
$extras .= '&'.$name.'='.&escape($form->{$name}); |
|
last if ($name eq 'linkprot'); |
|
} |
|
} |
|
my $firsturl = $form->{'firsturl'}; |
|
if (($firsturl ne '') || ($extras ne '')) { |
|
$extras .= ':retry'; |
|
$token = &Apache::lonnet::reply('tmpput:'.&escape($firsturl). |
|
$extras,$lonhost); |
|
if (($token eq 'con_lost') || ($token eq 'no_such_host')) { |
|
return 'fail'; |
|
} else { |
|
if (ref($querystr)) { |
|
$$querystr = 'retry='.$token; |
|
} |
|
return 'ok'; |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
sub check_can_host { |
sub check_can_host { |
my ($r,$form,$authhost,$domdesc) = @_; |
my ($r,$form,$authhost,$domdesc) = @_; |
return unless (ref($form) eq 'HASH'); |
return unless (ref($form) eq 'HASH'); |
Line 530 sub check_can_host {
|
Line 749 sub check_can_host {
|
if ($login_host ne '') { |
if ($login_host ne '') { |
my $protocol = $Apache::lonnet::protocol{$login_host}; |
my $protocol = $Apache::lonnet::protocol{$login_host}; |
$protocol = 'http' if ($protocol ne 'https'); |
$protocol = 'http' if ($protocol ne 'https'); |
|
my $alias = &Apache::lonnet::use_proxy_alias($r,$login_host); |
|
$hostname = $alias if ($alias ne ''); |
my $newurl = $protocol.'://'.$hostname.'/adm/createaccount'; |
my $newurl = $protocol.'://'.$hostname.'/adm/createaccount'; |
$r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA'). |
$r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA'). |
'<h3>'.&mt('Account creation').'</h3>'. |
'<h3>'.&mt('Account creation').'</h3>'. |