loncom/auth/lonauth.pm - view

File: [LON-CAPA] / loncom / auth / lonauth.pm
Revision 1.153: download - view: text, annotated - select for diffs
Sun Jul 1 00:03:42 2018 UTC (5 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Bug 6754 LON-CAPA as LTI Provider
  - If LTI Consumer does not provide 'launch_presentation_document_target'
    set $env{'request.lti.target'} to iframe, if LON-CAPA display in iframe.

1: # The LearningOnline Network 2: # User Authentication Module 3: # 4: # $Id: lonauth.pm,v 1.153 2018/07/01 00:03:42 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonauth; 30: 31: use strict; 32: use LONCAPA qw(:DEFAULT :match); 33: use Apache::Constants qw(:common); 34: use CGI qw(:standard); 35: use Apache::loncommon(); 36: use Apache::lonnet; 37: use Apache::lonmenu(); 38: use Apache::createaccount; 39: use Apache::ltiauth; 40: use Fcntl qw(:flock); 41: use Apache::lonlocal; 42: use Apache::File(); 43: use HTML::Entities; 44: use Digest::MD5; 45: 46: # ------------------------------------------------------------ Successful login 47: sub success { 48: my ($r, $username, $domain, $authhost, $lowerurl, $extra_env, 49: $form,$skipcritical) = @_; 50: 51: # ------------------------------------------------------------ Get cookie ready 52: my $cookie = 53: &Apache::loncommon::init_user_environment($r, $username, $domain, 54: $authhost, $form, 55: {'extra_env' => $extra_env,}); 56: 57: my $public=($username eq 'public' && $domain eq 'public'); 58: 59: if ($public or $lowerurl eq 'noredirect') { return $cookie; } 60: 61: # -------------------------------------------------------------------- Log this 62: 63: &Apache::lonnet::log($domain,$username,$authhost, 64: "Login $ENV{'REMOTE_ADDR'}"); 65: 66: # ------------------------------------------------- Check for critical messages 67: 68: unless ($skipcritical) { 69: my @what=&Apache::lonnet::dump('critical',$domain,$username); 70: if ($what[0]) { 71: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) { 72: $lowerurl='/adm/email?critical=display'; 73: } 74: } 75: } 76: 77: # ----------------------------------------------------------- Get cookies ready 78: my ($securecookie,$defaultcookie); 79: if ($ENV{'SERVER_PORT'} == 443) { 80: $securecookie="lonID=$cookie; path=/; HttpOnly; secure"; 81: my $lonidsdir=$r->dir_config('lonIDsDir'); 82: if (($lonidsdir) && (-e "$lonidsdir/$cookie.id")) { 83: my $linkname=substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex(time(). {}. rand(). $$)), 0, 32).'_linked'; 84: if (-e "$lonidsdir/$linkname.id") { 85: unlink("$lonidsdir/$linkname.id"); 86: } 87: my $made_symlink = eval { symlink("$lonidsdir/$cookie.id", 88: "$lonidsdir/$linkname.id"); 1 }; 89: if ($made_symlink) { 90: $defaultcookie = "lonLinkID=$linkname; path=/; HttpOnly;"; 91: &Apache::lonnet::appenv({'user.linkedenv' => "$lonidsdir/$linkname.id"}); 92: } 93: } 94: } else { 95: $defaultcookie = "lonID=$cookie; path=/; HttpOnly;"; 96: } 97: # -------------------------------------------------------- Menu script and info 98: my $destination = $lowerurl; 99: if ($env{'request.lti.login'}) { 100: if (($env{'request.lti.reqcrs'}) && ($env{'request.lti.reqrole'} eq 'cc')) { 101: &Apache::loncommon::content_type($r,'text/html'); 102: if ($securecookie) { 103: $r->headers_out->add('Set-cookie' => $securecookie); 104: } 105: if ($defaultcookie) { 106: $r->headers_out->add('Set-cookie' => $defaultcookie); 107: } 108: $r->send_http_header; 109: if (ref($form) eq 'HASH') { 110: $form->{'lti.reqcrs'} = $env{'request.lti.reqcrs'}; 111: $form->{'lti.reqrole'} = $env{'request.lti.reqrole'}; 112: $form->{'lti.sourcecrs'} = $env{'request.lti.sourcecrs'}; 113: } 114: &Apache::ltiauth::lti_reqcrs($r,$domain,$form,$username,$domain); 115: return; 116: } 117: if ($env{'request.lti.selfenrollrole'}) { 118: if (&Apache::ltiauth::lti_enroll($username,$domain, 119: $env{'request.lti.selfenrollrole'}) eq 'ok') { 120: $form->{'role'} = $env{'request.lti.selfenrollrole'}; 121: &Apache::lonnet::delenv('request.lti.selfenrollrole'); 122: } else { 123: &Apache::ltiauth::invalid_request($r,24); 124: } 125: } 126: } 127: if (defined($form->{role})) { 128: my $envkey = 'user.role.'.$form->{role}; 129: my $now=time; 130: my $then=$env{'user.login.time'}; 131: my $refresh=$env{'user.refresh.time'}; 132: my $update=$env{'user.update.time'}; 133: if (!$update) { 134: $update = $then; 135: } 136: if (exists($env{$envkey})) { 137: my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus); 138: &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where, 139: \$trolecode,\$tstatus,\$tstart,\$tend); 140: if ($tstatus eq 'is') { 141: $destination .= ($destination =~ /\?/) ? '&' : '?'; 142: my $newrole = &HTML::Entities::encode($form->{role},'"<>&'); 143: $destination .= 'selectrole=1&'.$newrole.'=1'; 144: } 145: } 146: } 147: if (defined($form->{symb})) { 148: my $destsymb = $form->{symb}; 149: $destination .= ($destination =~ /\?/) ? '&' : '?'; 150: if ($destsymb =~ /___/) { 151: # FIXME Need to deal with encrypted symbs and urls as needed. 152: my ($map,$resid,$desturl)=split(/___/,$destsymb); 153: $desturl = &Apache::lonnet::clutter($desturl); 154: $desturl = &HTML::Entities::encode($desturl,'"<>&'); 155: $destsymb = &HTML::Entities::encode($destsymb,'"<>&'); 156: $destination .= 'destinationurl='.$desturl. 157: '&destsymb='.$destsymb; 158: } else { 159: $destsymb = &HTML::Entities::encode($destsymb,'"<>&'); 160: $destination .= 'destinationurl='.$destsymb; 161: } 162: } 163: if ($destination =~ m{^/adm/roles}) { 164: $destination .= ($destination =~ /\?/) ? '&' : '?'; 165: $destination .= 'source=login'; 166: } 167: 168: my $windowname = 'loncapaclient'; 169: if ($env{'request.lti.login'}) { 170: $windowname .= 'lti'; 171: } 172: my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";'); 173: my $brcrum = [{'href' => '', 174: 'text' => 'Successful Login'},]; 175: my $args = {'bread_crumbs' => $brcrum,}; 176: unless ((defined($form->{role})) || (defined($form->{symb}))) { 177: my $update=$env{'user.update.time'}; 178: if (!$update) { 179: $update = $env{'user.login.time'}; 180: } 181: my %roles_in_env; 182: my $showcount = &Apache::lonroles::roles_from_env(\%roles_in_env,$update); 183: if ($showcount == 1) { 184: foreach my $rolecode (keys(%roles_in_env)) { 185: my ($cid) = ($rolecode =~ m{^\Quser.role.st./\E($match_domain/$match_courseid)(?:/|$)}); 186: if ($cid) { 187: my %coursedescription = 188: &Apache::lonnet::coursedescription($cid,{'one_time' => '1'}); 189: if ($coursedescription{'type'} eq 'Placement') { 190: $args->{'crstype'} = 'Placement'; 191: } 192: last; 193: } 194: } 195: } 196: } 197: 198: # ------------------------------------------------- Output for successful login 199: 200: &Apache::loncommon::content_type($r,'text/html'); 201: if ($securecookie) { 202: $r->headers_out->add('Set-cookie' => $securecookie); 203: } 204: if ($defaultcookie) { 205: $r->headers_out->add('Set-cookie' => $defaultcookie); 206: } 207: $r->send_http_header; 208: 209: my ($start_page,$js,$pagebody,$end_page); 210: if ($env{'request.lti.login'}) { 211: $args = {'only_body' => 1}; 212: if ($env{'request.lti.target'} eq '') { 213: my $ltitarget = (($destination =~ /\?/) ? '&' : '?'). 214: 'ltitarget=iframe'; 215: $js = <<"ENDJS"; 216: 217: <script type="text/javascript"> 218: // <![CDATA[ 219: function setLTItarget() { 220: var newloc = '$destination'; 221: if (parent !== window) { 222: newloc += '$ltitarget'; 223: } 224: window.location.href=newloc; 225: } 226: // ]]> 227: </script> 228: 229: ENDJS 230: $args->{'add_entries'} = {'onload' => "javascript:setLTItarget();"}; 231: $pagebody = '<noscript><span class="LC_warning">' 232: .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.') 233: .'</span></noscript>'; 234: } else { 235: $args->{'redirect'} = [0,$destination,1]; 236: } 237: $start_page=&Apache::loncommon::start_page('',$js,$args); 238: } else { 239: $args->{'redirect'} = [0,$destination]; 240: $start_page=&Apache::loncommon::start_page('Successful Login', 241: $js,$args); 242: 243: my %lt=&Apache::lonlocal::texthash( 244: 'wel' => 'Welcome', 245: 'pro' => 'Login problems?', 246: ); 247: $pagebody = "<h1>$lt{'wel'}</h1>\n". 248: &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>'); 249: my $loginhelp = &loginhelpdisplay($domain); 250: if ($loginhelp) { 251: $pagebody .= '<p><a href="'.$loginhelp.'">'.$lt{'pro'}.'</a></p>'; 252: } 253: } 254: $end_page = &Apache::loncommon::end_page(); 255: $r->print(<<ENDSUCCESS); 256: $start_page 257: $windowinfo 258: $pagebody 259: $end_page 260: ENDSUCCESS 261: return; 262: } 263: 264: # --------------------------------------------------------------- Failed login! 265: 266: sub failed { 267: my ($r,$message,$form) = @_; 268: (undef,undef,undef,my $clientmathml,my $clientunicode) = 269: &Apache::loncommon::decode_user_agent(); 270: my $args = {}; 271: if ($clientunicode && !$clientmathml) { 272: $args = {'browser.unicode' => 1}; 273: } 274: 275: my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args); 276: my $uname = &Apache::loncommon::cleanup_html($form->{'uname'}); 277: my $udom = &Apache::loncommon::cleanup_html($form->{'udom'}); 278: if (&Apache::lonnet::domain($udom,'description') eq '') { 279: undef($udom); 280: } 281: my $retry = '/adm/login'; 282: if ($uname eq $form->{'uname'}) { 283: $retry .= '?username='.$uname; 284: } 285: if ($udom) { 286: $retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom; 287: } 288: if (exists($form->{role})) { 289: my $role = &Apache::loncommon::cleanup_html($form->{role}); 290: if ($role ne '') { 291: $retry .= (($retry=~/\?/)?'&':'?').'role='.$role; 292: } 293: } 294: if (exists($form->{symb})) { 295: my $symb = &Apache::loncommon::cleanup_html($form->{symb}); 296: if ($symb ne '') { 297: $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb; 298: } 299: } 300: my $end_page = &Apache::loncommon::end_page(); 301: &Apache::loncommon::content_type($r,'text/html'); 302: $r->send_http_header; 303: my @actions = 304: (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>')); 305: my $loginhelp = &loginhelpdisplay($udom); 306: if ($loginhelp) { 307: push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>'); 308: } 309: #FIXME: link to helpdesk might be added here 310: 311: $r->print( 312: $start_page 313: .'<h2>'.&mt('Sorry ...').'</h2>' 314: .&Apache::lonhtmlcommon::confirm_success(&mt($message),1).'<br /><br />' 315: .&Apache::lonhtmlcommon::actionbox(\@actions) 316: .$end_page 317: ); 318: } 319: 320: # ------------------------------------------------------------------ Rerouting! 321: 322: sub reroute { 323: my ($r) = @_; 324: &Apache::loncommon::content_type($r,'text/html'); 325: $r->send_http_header; 326: my $msg='<b>'.&mt('Sorry ...').'</b><br />' 327: .&mt('Please [_1]log in again[_2].'); 328: &Apache::loncommon::simple_error_page($r,'Rerouting',$msg,{'no_auto_mt_msg' => 1}); 329: } 330: 331: # ---------------------------------------------------------------- Main handler 332: 333: sub handler { 334: my $r = shift; 335: my $londocroot = $r->dir_config('lonDocRoot'); 336: # Are we re-routing? 337: if (-e "$londocroot/lon-status/reroute.txt") { 338: &reroute($r); 339: return OK; 340: } 341: 342: &Apache::lonlocal::get_language_handle($r); 343: 344: # -------------------------------- Prevent users from attempting to login twice 345: my $handle = &Apache::lonnet::check_for_valid_session($r); 346: if ($handle ne '') { 347: my $lonidsdir=$r->dir_config('lonIDsDir'); 348: if ($handle=~/^publicuser\_/) { 349: # For "public user" - remove it, we apparently really want to login 350: unlink($r->dir_config('lonIDsDir')."/$handle.id"); 351: } else { 352: # Indeed, a valid token is found 353: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle); 354: &Apache::loncommon::content_type($r,'text/html'); 355: $r->send_http_header; 356: my $start_page = 357: &Apache::loncommon::start_page('Already logged in'); 358: my $end_page = 359: &Apache::loncommon::end_page(); 360: my $dest = '/adm/roles'; 361: if ($env{'form.firsturl'} ne '') { 362: $dest = $env{'form.firsturl'}; 363: } 364: $r->print( 365: $start_page 366: .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>' 367: .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].' 368: ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>') 369: .'</p>' 370: .$end_page 371: ); 372: return OK; 373: } 374: } 375: 376: # ---------------------------------------------------- No valid token, continue 377: 378: 379: my $buffer; 380: if ($r->header_in('Content-length') > 0) { 381: $r->read($buffer,$r->header_in('Content-length'),0); 382: } 383: my %form; 384: foreach my $pair (split(/&/,$buffer)) { 385: my ($name,$value) = split(/=/,$pair); 386: $value =~ tr/+/ /; 387: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 388: $form{$name}=$value; 389: } 390: 391: if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) { 392: &failed($r,'Username, password and domain need to be specified.', 393: \%form); 394: return OK; 395: } 396: 397: # split user logging in and "su"-user 398: 399: ($form{'uname'},$form{'suname'},$form{'sudom'})=split(/\:/,$form{'uname'}); 400: $form{'uname'} = &LONCAPA::clean_username($form{'uname'}); 401: $form{'suname'}= &LONCAPA::clean_username($form{'suname'}); 402: $form{'udom'} = &LONCAPA::clean_domain($form{'udom'}); 403: $form{'sudom'} = &LONCAPA::clean_domain($form{'sudom'}); 404: 405: my $role = $r->dir_config('lonRole'); 406: my $domain = $r->dir_config('lonDefDomain'); 407: my $prodir = $r->dir_config('lonUsersDir'); 408: my $contact_name = &mt('LON-CAPA helpdesk'); 409: 410: # ---------------------------------------- Get the information from login token 411: 412: my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'}, 413: $form{'serverid'}); 414: 415: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') || 416: ($tmpinfo eq 'no_such_host')) { 417: &failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form); 418: return OK; 419: } else { 420: my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'}, 421: $form{'serverid'}); 422: if ( $reply ne 'ok' ) { 423: &failed($r,'Session could not be opened.',\%form); 424: &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token"); 425: return OK; 426: } 427: } 428: 429: if (!&Apache::lonnet::domain($form{'udom'})) { 430: &failed($r,'The domain you provided is not a valid LON-CAPA domain.',\%form); 431: return OK; 432: } 433: 434: my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr)=split(/&/,$tmpinfo); 435: if ($rolestr) { 436: $rolestr = &unescape($rolestr); 437: } 438: if ($symbstr) { 439: $symbstr= &unescape($symbstr); 440: } 441: if ($iptokenstr) { 442: $iptokenstr = &unescape($iptokenstr); 443: } 444: if ($rolestr =~ /^role=/) { 445: (undef,$form{'role'}) = split('=',$rolestr); 446: } 447: if ($symbstr =~ /^symb=/) { 448: (undef,$form{'symb'}) = split('=',$symbstr); 449: } 450: if ($iptokenstr =~ /^iptoken=/) { 451: (undef,$form{'iptoken'}) = split('=',$iptokenstr); 452: } 453: 454: my $upass = $ENV{HTTPS} ? $form{'upass0'} 455: : &Apache::loncommon::des_decrypt($key,$form{'upass0'}); 456: 457: # ---------------------------------------------------------------- Authenticate 458: 459: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'}); 460: my ($cancreate,$statustocreate) = 461: &Apache::createaccount::get_creation_controls($form{'udom'},$domconfig{'usercreation'}); 462: my $defaultauth; 463: if (ref($cancreate) eq 'ARRAY') { 464: if (grep(/^login$/,@{$cancreate})) { 465: $defaultauth = 1; 466: } 467: } 468: my $clientcancheckhost = 1; 469: my $authhost=Apache::lonnet::authenticate($form{'uname'},$upass, 470: $form{'udom'},$defaultauth, 471: $clientcancheckhost); 472: 473: # --------------------------------------------------------------------- Failed? 474: 475: if ($authhost eq 'no_host') { 476: &failed($r,'Username and/or password could not be authenticated.', 477: \%form); 478: return OK; 479: } elsif ($authhost eq 'no_account_on_host') { 480: if ($defaultauth) { 481: my $domdesc = &Apache::lonnet::domain($form{'udom'},'description'); 482: unless (&check_can_host($r,\%form,'no_account_on_host',$domdesc)) { 483: return OK; 484: } 485: my $start_page = 486: &Apache::loncommon::start_page('Create a user account in LON-CAPA'); 487: my $lonhost = $r->dir_config('lonHostID'); 488: my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'}; 489: my $contacts = 490: &Apache::loncommon::build_recipient_list(undef,'helpdeskmail', 491: $form{'udom'},$origmail); 492: my ($contact_email) = split(',',$contacts); 493: my $output = 494: &Apache::createaccount::username_check($form{'uname'},$form{'udom'}, 495: $domdesc,'',$lonhost, 496: $contact_email,$contact_name, 497: undef,$statustocreate); 498: &Apache::loncommon::content_type($r,'text/html'); 499: $r->send_http_header; 500: &Apache::createaccount::print_header($r,$start_page); 501: $r->print('<h3>'.&mt('Account creation').'</h3>'. 502: &mt('Although your username and password were authenticated, you do not currently have a LON-CAPA account at this institution.').'<br />'. 503: $output.&Apache::loncommon::end_page()); 504: return OK; 505: } else { 506: &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); 507: return OK; 508: } 509: } 510: 511: if (($firsturl eq '') || 512: ($firsturl=~/^\/adm\/(logout|remote)/)) { 513: $firsturl='/adm/roles'; 514: } 515: 516: my $hosthere; 517: if ($form{'iptoken'}) { 518: my %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'}); 519: my $delete = &Apache::lonnet::tmpdel($form{'iptoken'}); 520: if (($sessiondata{'domain'} eq $form{'udom'}) && 521: ($sessiondata{'username'} eq $form{'uname'})) { 522: $hosthere = 1; 523: } 524: } 525: 526: # --------------------------------- Are we attempting to login as somebody else? 527: if ($form{'suname'}) { 528: my ($suname,$sudom,$sudomref); 529: $suname = $form{'suname'}; 530: $sudom = $form{'udom'}; 531: if ($form{'sudom'}) { 532: unless ($sudom eq $form{'sudom'}) { 533: if (&Apache::lonnet::domain($form{'sudom'})) { 534: $sudomref = [$form{'sudom'}]; 535: $sudom = $form{'sudom'}; 536: } 537: } 538: } 539: # ------------ see if the original user has enough privileges to pull this stunt 540: if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'},$sudomref)) { 541: # ---------------------------------------------------- see if the su-user exists 542: unless (&Apache::lonnet::homeserver($suname,$sudom) eq 'no_host') { 543: # ------------------------------ see if the su-user is not too highly privileged 544: if (&Apache::lonnet::privileged($suname,$sudom)) { 545: &Apache::lonnet::logthis('Attempted switch user to privileged user'); 546: } else { 547: my $noprivswitch; 548: # 549: # su-user's home server and user's home server must have one of: 550: # (a) same domain 551: # (b) same primary library server for the two domains 552: # (c) same "internet domain" for primary library server(s) for home servers' domains 553: # 554: my $suprim = &Apache::lonnet::domain($sudom,'primary'); 555: my $suintdom = &Apache::lonnet::internet_dom($suprim); 556: unless ($sudom eq $form{'udom'}) { 557: my $uprim = &Apache::lonnet::domain($form{'udom'},'primary'); 558: my $uintdom = &Apache::lonnet::internet_dom($uprim); 559: unless ($suprim eq $uprim) { 560: unless ($suintdom eq $uintdom) { 561: &Apache::lonnet::logthis('Attempted switch user ' 562: .'to user with different "internet domain".'); 563: $noprivswitch = 1; 564: } 565: } 566: } 567: 568: unless ($noprivswitch) { 569: # 570: # server where log-in occurs must have same "internet domain" as su-user's home 571: # server 572: # 573: my $lonhost = $r->dir_config('lonHostID'); 574: my $hostintdom = &Apache::lonnet::internet_dom($lonhost); 575: if ($hostintdom ne $suintdom) { 576: &Apache::lonnet::logthis('Attempted switch user on a ' 577: .'server with a different "internet domain".'); 578: } else { 579: 580: # -------------------------------------------------------- actually switch users 581: 582: &Apache::lonnet::logperm('User '.$form{'uname'}.' at '. 583: $form{'udom'}.' logging in as '.$suname.':'.$sudom); 584: $form{'uname'}=$suname; 585: if ($form{'udom'} ne $sudom) { 586: $form{'udom'}=$sudom; 587: } 588: } 589: } 590: } 591: } 592: } else { 593: &Apache::lonnet::logthis('Non-privileged user attempting switch user'); 594: } 595: } 596: 597: my ($is_balancer,$otherserver); 598: 599: unless ($hosthere) { 600: ($is_balancer,$otherserver) = 601: &Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'},'login'); 602: if ($is_balancer) { 603: if ($otherserver eq '') { 604: my $lowest_load; 605: ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'}); 606: if ($lowest_load > 100) { 607: $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$form{'udom'}); 608: } 609: } 610: if ($otherserver ne '') { 611: my @hosts = &Apache::lonnet::current_machine_ids(); 612: if (grep(/^\Q$otherserver\E$/,@hosts)) { 613: $hosthere = $otherserver; 614: } 615: } 616: } 617: } 618: 619: if (($is_balancer) && (!$hosthere)) { 620: if ($otherserver) { 621: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, 622: \%form); 623: my $switchto = '/adm/switchserver?otherserver='.$otherserver; 624: if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) { 625: $switchto .= '&origurl='.$firsturl; 626: } 627: if ($form{'role'}) { 628: $switchto .= '&role='.$form{'role'}; 629: } 630: if ($form{'symb'}) { 631: $switchto .= '&symb='.$form{'symb'}; 632: } 633: $r->internal_redirect($switchto); 634: } else { 635: $r->print(&noswitch()); 636: } 637: return OK; 638: } else { 639: if (!&check_can_host($r,\%form,$authhost)) { 640: my ($otherserver) = &Apache::lonnet::choose_server($form{'udom'}); 641: if ($otherserver) { 642: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef, 643: \%form); 644: my $switchto = '/adm/switchserver?otherserver='.$otherserver; 645: if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) { 646: $switchto .= '&origurl='.$firsturl; 647: } 648: if ($form{'role'}) { 649: $switchto .= '&role='.$form{'role'}; 650: } 651: if ($form{'symb'}) { 652: $switchto .= '&symb='.$form{'symb'}; 653: } 654: $r->internal_redirect($switchto); 655: } else { 656: $r->print(&noswitch()); 657: } 658: return OK; 659: } 660: 661: # ------------------------------------------------------- Do the load balancing 662: 663: # ---------------------------------------------------------- Determine own load 664: my $loadlim = $r->dir_config('lonLoadLim'); 665: my $loadavg; 666: { 667: my $loadfile=Apache::File->new('/proc/loadavg'); 668: $loadavg=<$loadfile>; 669: } 670: $loadavg =~ s/\s.*//g; 671: my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim); 672: my $userloadpercent=&Apache::lonnet::userload(); 673: 674: # ---------------------------------------------------------- Are we overloaded? 675: if ((($userloadpercent>100.0)||($loadpercent>100.0))) { 676: my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'}); 677: if (!$unloaded) { 678: ($unloaded) = &Apache::lonnet::choose_server($form{'udom'}); 679: } 680: if ($unloaded) { 681: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect', 682: undef,\%form); 683: $r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl); 684: return OK; 685: } 686: } 687: if (($is_balancer) && ($hosthere)) { 688: $form{'noloadbalance'} = $hosthere; 689: } 690: &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef, 691: \%form); 692: return OK; 693: } 694: } 695: 696: sub check_can_host { 697: my ($r,$form,$authhost,$domdesc) = @_; 698: return unless (ref($form) eq 'HASH'); 699: my $canhost = 1; 700: my $lonhost = $r->dir_config('lonHostID'); 701: my $udom = $form->{'udom'}; 702: my @intdoms; 703: my $internet_names = &Apache::lonnet::get_internet_names($lonhost); 704: if (ref($internet_names) eq 'ARRAY') { 705: @intdoms = @{$internet_names}; 706: } 707: my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); 708: my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); 709: unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) { 710: my $machine_dom = &Apache::lonnet::host_domain($lonhost); 711: my $hostname = &Apache::lonnet::hostname($lonhost); 712: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); 713: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); 714: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); 715: my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom); 716: my $loncaparev; 717: if ($authhost eq 'no_account_on_host') { 718: $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom); 719: } else { 720: $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom,$lonhost); 721: } 722: $canhost = &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev, 723: $udomdefaults{'remotesessions'}, 724: $defdomdefaults{'hostedsessions'}); 725: } 726: unless ($canhost) { 727: if ($authhost eq 'no_account_on_host') { 728: my $checkloginvia = 1; 729: my ($login_host,$hostname) = 730: &Apache::lonnet::choose_server($udom,$checkloginvia); 731: &Apache::loncommon::content_type($r,'text/html'); 732: $r->send_http_header; 733: if ($login_host ne '') { 734: my $protocol = $Apache::lonnet::protocol{$login_host}; 735: $protocol = 'http' if ($protocol ne 'https'); 736: my $newurl = $protocol.'://'.$hostname.'/adm/createaccount'; 737: $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA'). 738: '<h3>'.&mt('Account creation').'</h3>'. 739: &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'. 740: '<p>'.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'</p>'. 741: '<p>'.&mt('[_1]Log in[_2]','<a href="'.$newurl.'">','</a>'). 742: &Apache::loncommon::end_page()); 743: } else { 744: $r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable'). 745: '<h3>'.&mt('Account creation unavailable').'</h3>'. 746: &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'. 747: '<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>'. 748: &Apache::loncommon::end_page()); 749: } 750: } else { 751: &success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef, 752: $form); 753: my ($otherserver) = &Apache::lonnet::choose_server($udom); 754: $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver); 755: } 756: } 757: return $canhost; 758: } 759: 760: sub noswitch { 761: my $result = &Apache::loncommon::start_page('Access to LON-CAPA unavailable'). 762: '<h3>'.&mt('Session unavailable').'</h3>'. 763: &mt('This LON-CAPA server is unable to host your session.').'<br />'. 764: '<p>'.&mt('Currently no other LON-CAPA server is available to host your session either.').'</p>'. 765: &Apache::loncommon::end_page(); 766: return $result; 767: } 768: 769: sub loginhelpdisplay { 770: my ($authdomain) = @_; 771: my $login_help = 1; 772: my $lang = &Apache::lonlocal::current_language(); 773: if ($login_help) { 774: my $dom = $authdomain; 775: if ($dom eq '') { 776: $dom = &Apache::lonnet::default_login_domain(); 777: } 778: my %domconfhash = &Apache::loncommon::get_domainconf($dom); 779: my $loginhelp_url; 780: if ($lang) { 781: $loginhelp_url = $domconfhash{$dom.'.login.helpurl_'.$lang}; 782: if ($loginhelp_url ne '') { 783: return $loginhelp_url; 784: } 785: } 786: $loginhelp_url = $domconfhash{$dom.'.login.helpurl_nolang'}; 787: if ($loginhelp_url ne '') { 788: return $loginhelp_url; 789: } else { 790: return '/adm/loginproblems.html'; 791: } 792: } 793: return; 794: } 795: 796: 1; 797: __END__ 798: 799: