--- loncom/auth/lonauth.pm 2022/08/30 12:10:43 1.121.2.24.2.5 +++ loncom/auth/lonauth.pm 2012/08/27 00:52:45 1.122 @@ -1,7 +1,7 @@ # The LearningOnline Network # User Authentication Module # -# $Id: lonauth.pm,v 1.121.2.24.2.5 2022/08/30 12:10:43 raeburn Exp $ +# $Id: lonauth.pm,v 1.122 2012/08/27 00:52:45 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,9 +29,11 @@ package Apache::lonauth; use strict; -use LONCAPA qw(:DEFAULT :match); +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(); @@ -40,13 +42,11 @@ use Fcntl qw(:flock); use Apache::lonlocal; use Apache::File(); use HTML::Entities; -use Digest::MD5; -use CGI::Cookie(); # ------------------------------------------------------------ Successful login sub success { my ($r, $username, $domain, $authhost, $lowerurl, $extra_env, - $form,$cid,$expirepub,$write_to_opener) = @_; + $form) = @_; # ------------------------------------------------------------ Get cookie ready my $cookie = @@ -60,9 +60,8 @@ sub success { # -------------------------------------------------------------------- Log this - my $ip = &Apache::lonnet::get_requestor_ip(); &Apache::lonnet::log($domain,$username,$authhost, - "Login $ip"); + "Login $ENV{'REMOTE_ADDR'}"); # ------------------------------------------------- Check for critical messages @@ -73,27 +72,8 @@ sub success { } } -# ------------------------------------------------------------ Get cookies ready - 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;"; - } +# ------------------------------------------------------------ Get cookie ready + $cookie="lonID=$cookie; path=/"; # -------------------------------------------------------- Menu script and info my $destination = $lowerurl; @@ -119,28 +99,20 @@ sub success { } if (defined($form->{symb})) { my $destsymb = $form->{symb}; - my $encrypted; - if ($destsymb =~ m{^/enc/}) { - $encrypted = 1; - if ($cid) { - $destsymb = &Apache::lonenc::unencrypted($destsymb,$cid); - } - } $destination .= ($destination =~ /\?/) ? '&' : '?'; if ($destsymb =~ /___/) { + # FIXME Need to deal with encrypted symbs and urls as needed. my ($map,$resid,$desturl)=split(/___/,$destsymb); - $desturl = &Apache::lonnet::clutter($desturl); - if ($encrypted) { - $desturl = &Apache::lonenc::encrypted($desturl,1,$cid); - $destsymb = $form->{symb}; + unless ($desturl=~/^(adm|uploaded|editupload|public)/) { + $desturl = &Apache::lonnet::clutter($desturl); } $desturl = &HTML::Entities::encode($desturl,'"<>&'); $destsymb = &HTML::Entities::encode($destsymb,'"<>&'); - $destination .= 'destinationurl='.$desturl. + $destination .= '&destinationurl='.$desturl. '&destsymb='.$destsymb; - } elsif (!$encrypted) { + } else { $destsymb = &HTML::Entities::encode($destsymb,'"<>&'); - $destination .= 'destinationurl='.$destsymb; + $destination .= '&destinationurl='.$destsymb; } } if ($destination =~ m{^/adm/roles}) { @@ -148,202 +120,66 @@ sub success { $destination .= 'source=login'; } + my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";'); + my $header = ''; my $brcrum = [{'href' => '', 'text' => 'Successful Login'},]; - my $args = {'no_inline_link' => 1, - 'bread_crumbs' => $brcrum,}; - if (($env{'request.deeplink.login'} eq $lowerurl) && - (($env{'request.linkprot'}) || ($env{'request.linkkey'} ne ''))) { - my %info; - if ($env{'request.linkprot'}) { - $info{'linkprot'} = $env{'request.linkprot'}; - foreach my $item ('linkprotuser','linkprotexit') { - if ($form->{$item}) { - $info{$item} = $form->{$item}; - } - } - $args = {'only_body' => 1,}; - } elsif ($env{'request.linkkey'} ne '') { - $info{'linkkey'} = $env{'request.linkkey'}; - } - $info{'origurl'} = $lowerurl; - my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link'); - unless (($token eq 'con_lost') || ($token eq 'refused') || - ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) { - $destination .= (($destination =~ /\?/) ? '&' : '?') . 'ttoken='.$token; - } - } - if ($env{'request.deeplink.login'}) { - if ($env{'environment.remote'} eq 'on') { - &Apache::lonnet::appenv({'environment.remote' => 'off'}); - } - } - my $startupremote; - if ($write_to_opener) { - if ($env{'environment.remote'} eq 'on') { - &Apache::lonnet::appenv({'environment.remote' => 'off'}); - } - $args->{'redirect'} = [0,$destination,'',$write_to_opener]; - } else { - $startupremote=&Apache::lonmenu::startupremote($destination); - } - - my $windowinfo=&Apache::lonmenu::open($env{'browser.os'}); - my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl); - my $setflags=&Apache::lonmenu::setflags(); - my $maincall=&Apache::lonmenu::maincall(); my $start_page=&Apache::loncommon::start_page('Successful Login', - $startupremote,$args); + $header, + {'bread_crumbs' => $brcrum,}); my $end_page =&Apache::loncommon::end_page(); - my $continuelink; - if ($env{'environment.remote'} eq 'off') { - unless ($write_to_opener) { - $continuelink=''.&mt('Continue').''; - } - } + my $continuelink=''.&mt('Continue').''; # ------------------------------------------------- Output for successful login &Apache::loncommon::content_type($r,'text/html'); - 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->header_out('Set-cookie' => $cookie); $r->send_http_header; - if ($env{'request.linkprot'}) { - $r->print(<$continuelink -$end_page -END - } else { - my %lt=&Apache::lonlocal::texthash( - 'wel' => 'Welcome', - 'pro' => 'Login problems?', - ); - my $loginhelp = &loginhelpdisplay($domain); - if ($loginhelp) { - $loginhelp = '

'.$lt{'pro'}.'

'; - } + my %lt=&Apache::lonlocal::texthash( + 'wel' => 'Welcome', + 'pro' => 'Login problems?', + ); + my $loginhelp = &loginhelpdisplay($domain); + if ($loginhelp) { + $loginhelp = '

'.$lt{'pro'}.'

'; + } - my $welcome = &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','',''); - $r->print(<',''); + $r->print(<$lt{'wel'} $welcome $loginhelp -$remoteinfo -$maincall $continuelink $end_page ENDSUCCESS - } - return; } # --------------------------------------------------------------- Failed login! sub failed { - my ($r,$message,$form,$authhost) = @_; - (undef,undef,undef,my $clientmathml,my $clientunicode) = - &Apache::loncommon::decode_user_agent(); - my $args = {}; - if ($clientunicode && !$clientmathml) { - $args = {'browser.unicode' => 1}; - } - if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) { - if ($form->{linkprot}) { - $args->{only_body} = 1; - } + 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}; } - - 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})) { + $retry .= '&symb='.$form->{symb}; } - my $lonhost = $r->dir_config('lonHostID'); - 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; - if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) { - unless (exists($form->{linkprot})) { - if (exists($form->{linkkey})) { - $retry .= 'linkkey='.$form->{linkkey}; - } - } - } - } - } - if (exists($form->{linkprot})) { - my %info = ( - 'linkprot' => $form->{'linkprot'}, - ); - foreach my $item ('linkprotuser','linkprotexit') { - if ($form->{$item} ne '') { - $info{$item} = $form->{$item}; - } - } - my $ltoken = &Apache::lonnet::tmpput(\%info, - $r->dir_config('lonHostID'),'retry'); - if ($ltoken) { - $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken; - } - } - } 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'); $r->send_http_header; - my @actions = - (&mt('Please [_1]log in again[_2].','','')); - my $loginhelp = &loginhelpdisplay($udom); - if ($loginhelp) { - push(@actions, ''.&mt('Login problems?').''); - } - #FIXME: link to helpdesk might be added here - $r->print( $start_page - .'

'.&mt('Sorry ...').'

' - .&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'

' - .&Apache::lonhtmlcommon::actionbox(\@actions) + .'

'.&mt('Sorry ...').'

' + .'

'.&mt($message).'

' + .'

'.&mt('Please [_1]log in again[_2].','','') + .'

' + .'

'.&mt('Login problems?').'

' .$end_page ); } @@ -354,9 +190,9 @@ sub reroute { my ($r) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - my $msg=''.&mt('Sorry ...').'
' + my $msg='

'.&mt('Sorry ...').'

' .&mt('Please [_1]log in again[_2].'); - &Apache::loncommon::simple_error_page($r,'Rerouting',$msg,{'no_auto_mt_msg' => 1}); + &Apache::loncommon::simple_error_page($r,'Rerouting',$msg); } # ---------------------------------------------------------------- Main handler @@ -364,6 +200,7 @@ sub reroute { 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); @@ -389,80 +226,12 @@ sub handler { my $end_page = &Apache::loncommon::end_page(); my $dest = '/adm/roles'; - my %form = &get_form_items($r); - 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; - my $relogin; - if ($dest =~ m{^/tiny/$match_domain/\w+$}) { - if ($env{'request.course.id'}) { - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $symb = &Apache::loncommon::symb_from_tinyurl($dest,$cnum,$cdom); - if ($symb) { - unless (&set_deeplink_login(%info) eq 'ok') { - $relogin = 1; - } - } - } - if ($relogin) { - $r->print( - $start_page - .'

'.&mt('You are already logged in!').'

' - .'

'.&mt('Please [_1]log out[_2] first, and then try your access again', - '','') - .'

' - .$end_page); - } else { - if (($info{'linkprot'}) || ($info{'linkkey'} ne '')) { - if (($info{'linkprot'}) && ($info{'linkprotuser'} ne '')) { - unless ($info{'linkprotuser'} eq $env{'user.name'}.':'.$env{'user.domain'}) { - $r->print( - $start_page - .'

'.&mt('You are already logged in, but as a different user from the one expected for the link you followed from another system').'

' - .'

'.&mt('Please [_1]log out[_2] first, and then try following the link again from the other system', - '','') - - .'

' - .$end_page); - return OK; - } - } - my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link'); - unless (($token eq 'con_lost') || ($token eq 'refused') || - ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) { - $dest .= (($dest =~ /\?/) ? '&' : '?') . 'ttoken='.$token; - } - } - $r->print( - $start_page - .'

'.&mt('You are already logged in!').'

' - .'

'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4] first, and then try your access again', - '','', - '','') - .'

' - .$end_page); - } - return OK; - } - } - } + 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].' ,'','','','') .'

' @@ -474,7 +243,19 @@ sub handler { # ---------------------------------------------------- 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'})) { &failed($r,'Username, password and domain need to be specified.', \%form); @@ -483,11 +264,10 @@ sub handler { # split user logging in and "su"-user - ($form{'uname'},$form{'suname'},$form{'sudom'})=split(/\:/,$form{'uname'}); + ($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'}); - $form{'sudom'} = &LONCAPA::clean_domain($form{'sudom'}); + $form{'udom'} = &LONCAPA::clean_domain( $form{'udom'}); my $role = $r->dir_config('lonRole'); my $domain = $r->dir_config('lonDefDomain'); @@ -518,16 +298,40 @@ sub handler { return OK; } - my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo); - $firsturl = &unescape($firsturl); - foreach my $item (@rest) { - my ($key,$value) = split(/=/,$item); - $form{$key} = &unescape($value); + 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; } - if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) { - $form{'firsturl'} = $firsturl; + 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 @@ -548,33 +352,9 @@ sub handler { # --------------------------------------------------------------------- Failed? if ($authhost eq 'no_host') { - my $pwdverify; - if (&Apache::lonnet::homeserver($form{'uname'},$form{'udom'}) eq 'no_host') { - my %possunames = &alternate_unames_check($form{'uname'},$form{'udom'}); - if (keys(%possunames) > 0) { - foreach my $rulematch (keys(%possunames)) { - my $possuname = $possunames{$rulematch}; - if (($possuname ne '') && ($possuname =~ /^$match_username$/)) { - $authhost=Apache::lonnet::authenticate($possuname,$upass, - $form{'udom'},undef, - $clientcancheckhost); - if (($authhost eq 'no_host') || ($authhost eq 'no_account_on_host')) { - next; - } elsif (($authhost ne '') && (&Apache::lonnet::hostname($authhost) ne '')) { - $pwdverify = 1; - &Apache::lonnet::logthis("Authenticated user: $possuname was submitted as: $form{'uname'}"); - $form{'uname'} = $possuname; - last; - } - } - } - } - } - unless ($pwdverify) { - &failed($r,'Username and/or password could not be authenticated.', - \%form); - return OK; - } + &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'); @@ -582,8 +362,7 @@ sub handler { return OK; } my $start_page = - &Apache::loncommon::start_page('Create a user account in LON-CAPA', - '',{'no_inline_link' => 1,}); + &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 = @@ -612,81 +391,22 @@ sub handler { ($firsturl=~/^\/adm\/(logout|remote)/)) { $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? 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 - if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'},$sudomref)) { + if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'})) { # ---------------------------------------------------- see if the su-user exists - unless (&Apache::lonnet::homeserver($suname,$sudom) eq 'no_host') { + 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 - 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 { - + unless (&Apache::lonnet::privileged($form{'suname'},$form{'udom'})) { # -------------------------------------------------------- actually switch users - - &Apache::lonnet::logperm('User '.$form{'uname'}.' at '. - $form{'udom'}.' logging in as '.$suname.':'.$sudom); - $form{'uname'}=$suname; - if ($form{'udom'} ne $sudom) { - $form{'udom'}=$sudom; - } - } - } + &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 { @@ -694,76 +414,18 @@ sub handler { } } - if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - if (($form{'linkprot'}) && ($form{'linkprotuser'} ne '')) { - unless($form{'linkprotuser'} eq $form{'uname'}.':'.$form{'udom'}) { - delete($form{'udom'}); - delete($form{'uname'}); - &failed($r,'Username and/or domain are different to that expected for the link you followed from another system', - \%form,$authhost); - return OK; - } - } - } - - my ($is_balancer,$otherserver); + my ($is_balancer,$otherserver) = + &Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'}); - unless ($hosthere) { - ($is_balancer,$otherserver) = - &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) { + if (!$otherserver) { + ($otherserver) = &Apache::lonnet::choose_server($form{'udom'}); } - } - - if (($is_balancer) && (!$hosthere)) { if ($otherserver) { &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, \%form); - 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'}; - } - if ($form{'linkprot'}) { - $env{'request.linkprot'} = $form{'linkprot'}; - foreach my $item ('linkprotuser','linkprotexit') { - if ($form{$item}) { - $env{'request.'.$item} = $form{$item}; - } - } - } elsif ($form{'linkkey'} ne '') { - $env{'request.linkkey'} = $form{'linkkey'}; - } - if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - &set_deeplink_login(%form); - } - $r->internal_redirect($switchto); + $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl); } else { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; $r->print(&noswitch()); } return OK; @@ -773,33 +435,8 @@ sub handler { if ($otherserver) { &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, \%form); - 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'}; - } - if ($form{'linkprot'}) { - $env{'request.linkprot'} = $form{'linkprot'}; - foreach my $item ('linkprotuser','linkprotexit') { - if ($form{$item}) { - $env{'request.'.$item} = $form{$item}; - } - } - } elsif ($form{'linkkey'} ne '') { - $env{'request.linkkey'} = $form{'linkkey'}; - } - if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - &set_deeplink_login(%form); - } - $r->internal_redirect($switchto); + $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver.'&origurl='.$firsturl); } else { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; $r->print(&noswitch()); } return OK; @@ -820,175 +457,23 @@ sub handler { # ---------------------------------------------------------- Are we overloaded? if ((($userloadpercent>100.0)||($loadpercent>100.0))) { - my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'}); + 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); - if ($form{'linkprot'}) { - $env{'request.linkprot'} = $form{'linkprot'}; - } elsif ($form{'linkkey'} ne '') { - $env{'request.linkkey'} = $form{'linkkey'}; - } - if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - &set_deeplink_login(%form); - } $r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl); 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}; - } - } - } - } - if ($form{'linkprot'}) { - my ($linkprotector,$uri) = split(/:/,$form{'linkprot'},2); - if ($linkprotector) { - $extra_env = {'user.linkprotector' => $linkprotector, - 'user.linkproturi' => $uri}; - } - } elsif ($form{'linkkey'} ne '') { - $extra_env = {'user.deeplinkkey' => $form{'linkkey'}, - 'user.keyedlinkuri' => $form{'firsturl'}}; - } - if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - &set_deeplink_login(%form); - if ($form{'linkprot'}) { - if (ref($extra_env) eq 'HASH') { - %{$extra_env} = ( %{$extra_env}, 'request.linkprot' => $form{'linkprot'} ); - } else { - $extra_env = {'request.linkprot' => $form{'linkprot'}}; - } - if ($form{'linkprotexit'}) { - $extra_env->{'request.linkprotexit'} = $form{'linkprotexit'}; - } - } elsif ($form{'linkkey'} ne '') { - if (ref($extra_env) eq 'HASH') { - %{$extra_env} = ( %{$extra_env}, 'request.linkkey' => $form{'linkkey'} ); - } else { - $extra_env = {'request.linkkey' => $form{'linkkey'}}; - } - } - if ($env{'request.deeplink.login'}) { - if (ref($extra_env) eq 'HASH') { - %{$extra_env} = ( %{$extra_env}, 'request.deeplink.login' => $form{'firsturl'} ); - } else { - $extra_env = {'request.deeplink.login' => $form{'firsturl'}}; - } - } - } - &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,$extra_env, + &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef, \%form); 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_deeplink_login { - my (%form) = @_; - my $disallow; - if ($form{'firsturl'} =~ m{^/tiny/($match_domain)/\w+$}) { - my $cdom = $1; - my ($cnum,$symb) = &Apache::loncommon::symb_from_tinyurl($form{'firsturl'},'',$cdom); - if ($symb) { - if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { - my $deeplink; - if ($symb =~ /\.(page|sequence)$/) { - my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]); - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink'); - } - } else { - $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb); - } - if ($deeplink ne '') { - my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink); - if (($protect ne 'none') && ($protect ne '')) { - my ($acctype,$item) = split(/:/,$protect); - if ($acctype =~ /lti(c|d)$/) { - unless ($form{'linkprot'} eq $item.$1.':'.$env{'request.deeplink.login'}) { - $disallow = 1; - } - } elsif ($acctype eq 'key') { - unless ($form{'linkkey'} eq $item) { - $disallow = 1; - } - } - } - } - unless ($disallow) { - $env{'request.deeplink.login'} = $form{'firsturl'}; - } - } else { - $env{'request.deeplink.login'} = $form{'firsturl'}; - } - } - } - if ($disallow) { - return; - } - return 'ok'; -} - -sub set_retry_token { - my ($form,$lonhost,$querystr) = @_; - if (ref($form) eq 'HASH') { - my ($firsturl,$token,$extras,@names); - @names = ('role','symb','linkprotuser','linkprotexit','linkprot','linkkey','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 { my ($r,$form,$authhost,$domdesc) = @_; return unless (ref($form) eq 'HASH'); @@ -1029,10 +514,7 @@ sub check_can_host { if ($login_host ne '') { my $protocol = $Apache::lonnet::protocol{$login_host}; $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'; -#FIXME Should preserve where user was going and linkprot by setting ltoken at $login_host $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.').'
'. @@ -1049,14 +531,6 @@ sub check_can_host { } else { &success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef, $form); - if ($form->{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) { - $env{'request.deeplink.login'} = $form->{'firsturl'}; - } - if ($form->{'linkprot'}) { - $env{'request.linkprot'} = $form->{'linkprot'}; - } elsif ($form->{'linkkey'} ne '') { - $env{'request.linkkey'} = $form->{'linkkey'}; - } my ($otherserver) = &Apache::lonnet::choose_server($udom); $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver); } @@ -1100,20 +574,6 @@ sub loginhelpdisplay { return; } -sub alternate_unames_check { - my ($uname,$udom) = @_; - my %possunames; - my %domdefs = &Apache::lonnet::get_domain_defaults($udom); - if (ref($domdefs{'unamemap_rule'}) eq 'ARRAY') { - if (@{$domdefs{'unamemap_rule'}} > 0) { - %possunames = - &Apache::lonnet::inst_rulecheck($udom,$uname,undef, - 'unamemap',$domdefs{'unamemap_rule'}); - } - } - return %possunames; -} - 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.