Annotation of loncom/auth/lonauth.pm, revision 1.121.2.24.2.8
1.1 albertel 1: # The LearningOnline Network
2: # User Authentication Module
1.27 www 3: #
1.121.2.24.2. (raeburn 4:): # $Id: lonauth.pm,v 1.121.2.24.2.7 2023/07/05 17:33:03 raeburn Exp $
1.27 www 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: #
1.1 albertel 28:
29: package Apache::lonauth;
30:
1.18 albertel 31: use strict;
1.121.2.24.2. (raeburn 32:): use LONCAPA qw(:DEFAULT :match);
1.1 albertel 33: use Apache::Constants qw(:common);
34: use CGI qw(:standard);
1.45 matthew 35: use Apache::loncommon();
1.66 albertel 36: use Apache::lonnet;
1.12 www 37: use Apache::lonmenu();
1.90 raeburn 38: use Apache::createaccount;
1.121.2.24.2. (raeburn 39:): use Apache::ltiauth;
1.18 albertel 40: use Fcntl qw(:flock);
1.56 www 41: use Apache::lonlocal;
1.119 raeburn 42: use Apache::File();
1.101 raeburn 43: use HTML::Entities;
1.121.2.18 raeburn 44: use Digest::MD5;
1.121.2.24 raeburn 45: use CGI::Cookie();
1.85 albertel 46:
1.1 albertel 47: # ------------------------------------------------------------ Successful login
1.85 albertel 48: sub success {
49: my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
1.121.2.24.2. (raeburn 50:): $form,$skipcritical,$cid,$expirepub,$write_to_opener) = @_;
1.1 albertel 51:
1.85 albertel 52: # ------------------------------------------------------------ Get cookie ready
53: my $cookie =
54: &Apache::loncommon::init_user_environment($r, $username, $domain,
55: $authhost, $form,
1.86 albertel 56: {'extra_env' => $extra_env,});
1.4 www 57:
1.69 albertel 58: my $public=($username eq 'public' && $domain eq 'public');
59:
1.85 albertel 60: if ($public or $lowerurl eq 'noredirect') { return $cookie; }
1.78 albertel 61:
1.7 www 62: # -------------------------------------------------------------------- Log this
63:
1.121.2.21 raeburn 64: my $ip = &Apache::lonnet::get_requestor_ip();
1.7 www 65: &Apache::lonnet::log($domain,$username,$authhost,
1.121.2.21 raeburn 66: "Login $ip");
1.4 www 67:
1.14 www 68: # ------------------------------------------------- Check for critical messages
69:
1.121.2.24.2. (raeburn 70:): unless ($skipcritical) {
71:): my @what=&Apache::lonnet::dump('critical',$domain,$username);
72:): if ($what[0]) {
73:): if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
74:): $lowerurl='/adm/email?critical=display';
75:): }
1.14 www 76: }
77: }
78:
1.121.2.18 raeburn 79: # ------------------------------------------------------------ Get cookies ready
80: my ($securecookie,$defaultcookie);
81: my $ssl = $r->subprocess_env('https');
82: if ($ssl) {
83: $securecookie="lonSID=$cookie; path=/; HttpOnly; secure";
84: my $lonidsdir=$r->dir_config('lonIDsDir');
85: if (($lonidsdir) && (-e "$lonidsdir/$cookie.id")) {
86: my $linkname=substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex(time(). {}. rand(). $$)), 0, 32).'_linked';
87: if (-e "$lonidsdir/$linkname.id") {
88: unlink("$lonidsdir/$linkname.id");
89: }
90: my $made_symlink = eval { symlink("$lonidsdir/$cookie.id",
91: "$lonidsdir/$linkname.id"); 1 };
92: if ($made_symlink) {
93: $defaultcookie = "lonLinkID=$linkname; path=/; HttpOnly;";
94: &Apache::lonnet::appenv({'user.linkedenv' => $linkname});
95: }
96: }
97: } else {
98: $defaultcookie = "lonID=$cookie; path=/; HttpOnly;";
99: }
1.12 www 100: # -------------------------------------------------------- Menu script and info
1.100 raeburn 101: my $destination = $lowerurl;
1.121.2.24.2. (raeburn 102:): if ($env{'request.lti.login'}) {
103:): if (($env{'request.lti.reqcrs'}) && ($env{'request.lti.reqrole'} eq 'cc')) {
104:): &Apache::loncommon::content_type($r,'text/html');
105:): if ($securecookie) {
106:): $r->headers_out->add('Set-cookie' => $securecookie);
107:): }
108:): if ($defaultcookie) {
109:): $r->headers_out->add('Set-cookie' => $defaultcookie);
110:): }
111:): $r->send_http_header;
112:): if (ref($form) eq 'HASH') {
113:): $form->{'lti.login'} = $env{'request.lti.login'};
114:): $form->{'lti.reqcrs'} = $env{'request.lti.reqcrs'};
115:): $form->{'lti.reqrole'} = $env{'request.lti.reqrole'};
116:): $form->{'lti.sourcecrs'} = $env{'request.lti.sourcecrs'};
117:): }
118:): &Apache::ltiauth::lti_reqcrs($r,$domain,$form,$username,$domain);
119:): return;
120:): }
121:): if ($env{'request.lti.selfenrollrole'}) {
122:): if (&Apache::ltiauth::lti_enroll($username,$domain,
123:): $env{'request.lti.selfenrollrole'}) eq 'ok') {
124:): $form->{'role'} = $env{'request.lti.selfenrollrole'};
125:): &Apache::lonnet::delenv('request.lti.selfenrollrole');
126:): } else {
127:): &Apache::ltiauth::invalid_request($r,24);
128:): }
129:): }
130:): }
1.100 raeburn 131: if (defined($form->{role})) {
132: my $envkey = 'user.role.'.$form->{role};
133: my $now=time;
134: my $then=$env{'user.login.time'};
135: my $refresh=$env{'user.refresh.time'};
1.111 raeburn 136: my $update=$env{'user.update.time'};
137: if (!$update) {
138: $update = $then;
139: }
1.100 raeburn 140: if (exists($env{$envkey})) {
141: my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus);
1.111 raeburn 142: &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
1.100 raeburn 143: \$trolecode,\$tstatus,\$tstart,\$tend);
144: if ($tstatus eq 'is') {
1.101 raeburn 145: $destination .= ($destination =~ /\?/) ? '&' : '?';
146: my $newrole = &HTML::Entities::encode($form->{role},'"<>&');
147: $destination .= 'selectrole=1&'.$newrole.'=1';
1.100 raeburn 148: }
149: }
1.121.2.24.2. (raeburn 150:): } elsif (defined($form->{display})) {
151:): if ($destination =~ m{^/adm/email($|\?)}) {
152:): $destination .= ($destination =~ /\?/) ? '&' : '?' .'display='.&escape($form->{display});
153:): }
1.100 raeburn 154: }
1.101 raeburn 155: if (defined($form->{symb})) {
156: my $destsymb = $form->{symb};
1.121.2.19 raeburn 157: my $encrypted;
158: if ($destsymb =~ m{^/enc/}) {
159: $encrypted = 1;
160: if ($cid) {
161: $destsymb = &Apache::lonenc::unencrypted($destsymb,$cid);
162: }
163: }
1.101 raeburn 164: $destination .= ($destination =~ /\?/) ? '&' : '?';
165: if ($destsymb =~ /___/) {
166: my ($map,$resid,$desturl)=split(/___/,$destsymb);
1.121.2.13 raeburn 167: $desturl = &Apache::lonnet::clutter($desturl);
1.121.2.19 raeburn 168: if ($encrypted) {
169: $desturl = &Apache::lonenc::encrypted($desturl,1,$cid);
170: $destsymb = $form->{symb};
171: }
1.101 raeburn 172: $desturl = &HTML::Entities::encode($desturl,'"<>&');
173: $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
1.121.2.8 raeburn 174: $destination .= 'destinationurl='.$desturl.
1.101 raeburn 175: '&destsymb='.$destsymb;
1.121.2.19 raeburn 176: } elsif (!$encrypted) {
1.101 raeburn 177: $destsymb = &HTML::Entities::encode($destsymb,'"<>&');
1.121.2.8 raeburn 178: $destination .= 'destinationurl='.$destsymb;
1.101 raeburn 179: }
180: }
1.111 raeburn 181: if ($destination =~ m{^/adm/roles}) {
182: $destination .= ($destination =~ /\?/) ? '&' : '?';
183: $destination .= 'source=login';
184: }
1.100 raeburn 185:
1.121.2.24.2. (raeburn 186:): my $brcrum = [{'href' => '',
187:): 'text' => 'Successful Login'},];
188:): my $args = {'no_inline_link' => 1,
189:): 'bread_crumbs' => $brcrum,};
190:): if (($env{'request.deeplink.login'} eq $lowerurl) &&
191:): (($env{'request.linkprot'}) || ($env{'request.linkkey'} ne ''))) {
192:): my %info;
193:): if ($env{'request.linkprot'}) {
194:): $info{'linkprot'} = $env{'request.linkprot'};
195:): foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
196:): if ($form->{$item}) {
197:): $info{$item} = $form->{$item};
198:): }
199:): }
200:): $args = {'only_body' => 1,};
201:): } elsif ($env{'request.linkkey'} ne '') {
202:): $info{'linkkey'} = $env{'request.linkkey'};
203:): }
204:): $info{'origurl'} = $lowerurl;
205:): my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link');
206:): unless (($token eq 'con_lost') || ($token eq 'refused') ||
207:): ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
208:): $destination .= (($destination =~ /\?/) ? '&' : '?') . 'ttoken='.$token;
209:): }
210:): }
211:): if (($env{'request.deeplink.login'}) || ($env{'request.lti.login'})) {
212:): if ($env{'environment.remote'} eq 'on') {
213:): &Apache::lonnet::appenv({'environment.remote' => 'off'});
214:): }
215:): }
216:): my $startupremote;
217:): if ($write_to_opener) {
218:): if ($env{'environment.remote'} eq 'on') {
219:): &Apache::lonnet::appenv({'environment.remote' => 'off'});
220:): }
221:): $args->{'redirect'} = [0,$destination,'',$write_to_opener];
222:): } else {
223:): if ($env{'environment.remote'} eq 'on') {
224:): my $checkexempt;
225:): if ($env{'user.loadbalexempt'} eq $r->dir_config('lonHostID')) {
226:): if ($env{'user.loadbalcheck.time'} + 600 > time) {
227:): $checkexempt = 1;
228:): }
229:): }
230:): if ($env{'user.noloadbalance'} eq $r->dir_config('lonHostID')) {
231:): $checkexempt = 1;
232:): }
233:): unless (($checkexempt) ||
234:): (($destination =~ m{^/adm/switchserver}) && (!$r->is_initial_req()))) {
235:): my ($is_balancer,$otherserver) =
236:): &Apache::lonnet::check_loadbalancing($env{'user.name'},
237:): $env{'user.domain'});
238:): if (($is_balancer) && ($otherserver ne '') &&
239:): ($otherserver ne $r->dir_config('lonHostID'))) {
240:): $env{'environment.remote'} = 'off';
241:): }
242:): }
243:): }
244:): $startupremote=&Apache::lonmenu::startupremote($destination);
245:): }
246:):
1.121.2.1 raeburn 247: my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
248: my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl);
249: my $setflags=&Apache::lonmenu::setflags();
250: my $maincall=&Apache::lonmenu::maincall();
1.74 albertel 251: my $start_page=&Apache::loncommon::start_page('Successful Login',
1.121.2.24.2. (raeburn 252:): $startupremote,$args);
1.74 albertel 253: my $end_page =&Apache::loncommon::end_page();
254:
1.121.2.1 raeburn 255: my $continuelink;
256: if ($env{'environment.remote'} eq 'off') {
1.121.2.24.2. (raeburn 257:): unless ($write_to_opener) {
258:): $continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
259:): }
1.121.2.1 raeburn 260: }
1.5 www 261: # ------------------------------------------------- Output for successful login
262:
1.74 albertel 263: &Apache::loncommon::content_type($r,'text/html');
1.121.2.18 raeburn 264: if ($securecookie) {
265: $r->headers_out->add('Set-cookie' => $securecookie);
266: }
267: if ($defaultcookie) {
268: $r->headers_out->add('Set-cookie' => $defaultcookie);
269: }
1.121.2.22 raeburn 270: if ($expirepub) {
271: my $c = new CGI::Cookie(-name => 'lonPubID',
272: -value => '',
273: -expires => '-10y',);
274: $r->headers_out->add('Set-cookie' => $c);
275: }
1.74 albertel 276: $r->send_http_header;
1.1 albertel 277:
1.121.2.24.2. (raeburn 278:): if (($env{'request.linkprot'}) || ($env{'request.lti.login'})) {
279:): $r->print(<<END);
280:): $start_page
281:): <br />$continuelink
282:): $end_page
283:): END
284:): } else {
285:): my %lt=&Apache::lonlocal::texthash(
286:): 'wel' => 'Welcome',
287:): 'pro' => 'Login problems?',
288:): );
289:): my $loginhelp = &loginhelpdisplay($domain);
290:): if ($loginhelp) {
291:): $loginhelp = '<p><a href="'.$loginhelp.'">'.$lt{'pro'}.'</a></p>';
292:): }
1.121.2.2 raeburn 293:
1.121.2.24.2. (raeburn 294:): my $welcome = &mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>');
295:): $r->print(<<ENDSUCCESS);
1.74 albertel 296: $start_page
1.121.2.1 raeburn 297: $setflags
1.19 www 298: $windowinfo
1.58 www 299: <h1>$lt{'wel'}</h1>
1.121.2.2 raeburn 300: $welcome
301: $loginhelp
1.121.2.1 raeburn 302: $remoteinfo
303: $maincall
1.64 albertel 304: $continuelink
1.74 albertel 305: $end_page
1.1 albertel 306: ENDSUCCESS
1.121.2.24.2. (raeburn 307:): }
1.121.2.11 raeburn 308: return;
1.1 albertel 309: }
310:
311: # --------------------------------------------------------------- Failed login!
312:
313: sub failed {
1.121.2.22 raeburn 314: my ($r,$message,$form,$authhost) = @_;
1.121.2.7 raeburn 315: (undef,undef,undef,my $clientmathml,my $clientunicode) =
316: &Apache::loncommon::decode_user_agent();
317: my $args = {};
318: if ($clientunicode && !$clientmathml) {
319: $args = {'browser.unicode' => 1};
320: }
1.121.2.24.2. (raeburn 321:): if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) {
322:): if ($form->{linkprot}) {
323:): $args->{only_body} = 1;
324:): }
325:): }
1.121.2.7 raeburn 326:
1.121.2.24.2. (raeburn 327:): my @actions;
1.121.2.7 raeburn 328: my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,$args);
329: my $uname = &Apache::loncommon::cleanup_html($form->{'uname'});
330: my $udom = &Apache::loncommon::cleanup_html($form->{'udom'});
331: if (&Apache::lonnet::domain($udom,'description') eq '') {
332: undef($udom);
333: }
1.121.2.24.2. (raeburn 334:): my $authtype;
335:): if (($udom ne '') && ($uname ne '') && ($authhost eq 'no_host')) {
336:): $authtype = &Apache::lonnet::queryauthenticate($uname,$udom);
337:): }
1.121.2.7 raeburn 338: my $retry = '/adm/login';
1.121.2.24.2. (raeburn 339:): if (($uname eq $form->{'uname'}) && ($authtype !~ /^lti:/)) {
1.121.2.7 raeburn 340: $retry .= '?username='.$uname;
341: }
342: if ($udom) {
343: $retry .= (($retry=~/\?/)?'&':'?').'domain='.$udom;
344: }
1.121.2.22 raeburn 345: my $lonhost = $r->dir_config('lonHostID');
346: my $querystr;
347: my $result = &set_retry_token($form,$lonhost,\$querystr);
348: if ($result eq 'fail') {
349: if (exists($form->{role})) {
350: my $role = &Apache::loncommon::cleanup_html($form->{role});
351: if ($role ne '') {
352: $retry .= (($retry=~/\?/)?'&':'?').'role='.$role;
353: }
354: }
355: if (exists($form->{symb})) {
356: my $symb = &Apache::loncommon::cleanup_html($form->{symb});
357: if ($symb ne '') {
358: $retry .= (($retry=~/\?/)?'&':'?').'symb='.$symb;
359: }
360: }
361: if (exists($form->{firsturl})) {
362: my $firsturl = &Apache::loncommon::cleanup_html($form->{firsturl});
363: if ($firsturl ne '') {
364: $retry .= (($retry=~/\?/)?'&':'?').'firsturl='.$firsturl;
1.121.2.24.2. (raeburn 365:): if ($form->{firsturl} =~ m{^/tiny/$match_domain/\w+$}) {
366:): unless (exists($form->{linkprot})) {
367:): if (exists($form->{linkkey})) {
368:): $retry .= 'linkkey='.$form->{linkkey};
369:): }
370:): }
371:): }
372:): }
373:): }
374:): if (exists($form->{linkprot})) {
375:): my %info = (
376:): 'linkprot' => $form->{'linkprot'},
377:): );
378:): foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
379:): if ($form->{$item} ne '') {
380:): $info{$item} = $form->{$item};
381:): }
382:): }
383:): my $ltoken = &Apache::lonnet::tmpput(\%info,
384:): $r->dir_config('lonHostID'),'retry');
385:): if ($ltoken) {
386:): $retry .= (($retry =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
1.121.2.22 raeburn 387: }
1.121.2.7 raeburn 388: }
1.121.2.22 raeburn 389: } elsif ($querystr ne '') {
390: $retry .= (($retry=~/\?/)?'&':'?').$querystr;
1.100 raeburn 391: }
1.121.2.7 raeburn 392: my $end_page = &Apache::loncommon::end_page();
1.74 albertel 393: &Apache::loncommon::content_type($r,'text/html');
394: $r->send_http_header;
1.121.2.24.2. (raeburn 395:): if ($authtype =~ /^lti:/) {
396:): $message = &mt('Direct login is not supported with the username you entered.').
397:): '<br /><br />'.
398:): &mt('You likely need to launch LON-CAPA from within a course in a different Learning Management System.').
399:): '<br />'.
400:): &mt('You can also try to log in with a different username.');
401:): @actions =
402:): (&mt('Try your [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
403:): } else {
404:): $message = &mt($message);
405:): @actions =
406:): (&mt('Please [_1]log in again[_2].','<a href="'.$retry.'">','</a>'));
407:): }
1.121.2.7 raeburn 408: my $loginhelp = &loginhelpdisplay($udom);
1.121.2.2 raeburn 409: if ($loginhelp) {
1.121.2.9 raeburn 410: push(@actions, '<a href="'.$loginhelp.'">'.&mt('Login problems?').'</a>');
1.121.2.2 raeburn 411: }
1.121.2.9 raeburn 412: #FIXME: link to helpdesk might be added here
1.92 bisitz 413: $r->print(
414: $start_page
1.121.2.9 raeburn 415: .'<h2>'.&mt('Sorry ...').'</h2>'
1.121.2.24.2. (raeburn 416:): .&Apache::lonhtmlcommon::confirm_success($message,1).'<br /><br />'
1.121.2.9 raeburn 417: .&Apache::lonhtmlcommon::actionbox(\@actions)
1.92 bisitz 418: .$end_page
419: );
420: }
1.60 www 421:
1.55 www 422: # ------------------------------------------------------------------ Rerouting!
423:
424: sub reroute {
1.74 albertel 425: my ($r) = @_;
426: &Apache::loncommon::content_type($r,'text/html');
427: $r->send_http_header;
1.121.2.5 raeburn 428: my $msg='<b>'.&mt('Sorry ...').'</b><br />'
1.92 bisitz 429: .&mt('Please [_1]log in again[_2].');
1.121.2.5 raeburn 430: &Apache::loncommon::simple_error_page($r,'Rerouting',$msg,{'no_auto_mt_msg' => 1});
1.55 www 431: }
432:
1.1 albertel 433: # ---------------------------------------------------------------- Main handler
434:
435: sub handler {
436: my $r = shift;
1.120 raeburn 437: my $londocroot = $r->dir_config('lonDocRoot');
1.55 www 438: # Are we re-routing?
1.120 raeburn 439: if (-e "$londocroot/lon-status/reroute.txt") {
1.55 www 440: &reroute($r);
441: return OK;
442: }
1.56 www 443:
1.57 www 444: &Apache::lonlocal::get_language_handle($r);
1.1 albertel 445:
1.59 www 446: # -------------------------------- Prevent users from attempting to login twice
1.89 albertel 447: my $handle = &Apache::lonnet::check_for_valid_session($r);
448: if ($handle ne '') {
1.103 raeburn 449: my $lonidsdir=$r->dir_config('lonIDsDir');
450: if ($handle=~/^publicuser\_/) {
451: # For "public user" - remove it, we apparently really want to login
452: unlink($r->dir_config('lonIDsDir')."/$handle.id");
453: } else {
1.59 www 454: # Indeed, a valid token is found
1.103 raeburn 455: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
456: &Apache::loncommon::content_type($r,'text/html');
457: $r->send_http_header;
458: my $start_page =
459: &Apache::loncommon::start_page('Already logged in');
460: my $end_page =
461: &Apache::loncommon::end_page();
1.105 raeburn 462: my $dest = '/adm/roles';
1.121.2.22 raeburn 463: my %form = &get_form_items($r);
464: if ($form{'logtoken'}) {
465: my $tmpinfo = &Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
466: $form{'serverid'});
467: unless (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
468: ($tmpinfo eq 'no_such_host')) {
1.121.2.23 raeburn 469: my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
1.121.2.22 raeburn 470: $firsturl = &unescape($firsturl);
471: my %info;
472: foreach my $item (@rest) {
473: my ($key,$value) = split(/=/,$item);
474: $info{$key} = &unescape($value);
475: }
476: if ($firsturl ne '') {
477: $info{'firsturl'} = $firsturl;
478: $dest = $firsturl;
1.121.2.24.2. (raeburn 479:): my $relogin;
480:): if ($dest =~ m{^/tiny/$match_domain/\w+$}) {
481:): if ($env{'request.course.id'}) {
482:): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
483:): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
484:): my $symb = &Apache::loncommon::symb_from_tinyurl($dest,$cnum,$cdom);
485:): if ($symb) {
486:): unless (&set_deeplink_login(%info) eq 'ok') {
487:): $relogin = 1;
488:): }
489:): }
490:): }
491:): if ($relogin) {
492:): $r->print(
493:): $start_page
494:): .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
495:): .'<p>'.&mt('Please [_1]log out[_2] first, and then try your access again',
496:): '<a href="/adm/logout">','</a>')
497:): .'</p>'
498:): .$end_page);
499:): } else {
500:): if (($info{'linkprot'}) || ($info{'linkkey'} ne '')) {
501:): if (($info{'linkprot'}) && ($info{'linkprotuser'} ne '')) {
502:): unless ($info{'linkprotuser'} eq $env{'user.name'}.':'.$env{'user.domain'}) {
503:): $r->print(
504:): $start_page
505:): .'<p class="LC_warning">'.&mt('You are already logged in, but as a different user from the one expected for the link you followed from another system').'</p>'
506:): .'<p>'.&mt('Please [_1]log out[_2] first, and then try following the link again from the other system',
507:): '<a href="/adm/logout">','</a>')
508:):
509:): .'</p>'
510:): .$end_page);
511:): return OK;
512:): }
513:): }
514:): my $token = &Apache::lonnet::tmpput(\%info,$r->dir_config('lonHostID'),'link');
515:): unless (($token eq 'con_lost') || ($token eq 'refused') ||
516:): ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
517:): $dest .= (($dest =~ /\?/) ? '&' : '?') . 'ttoken='.$token;
518:): }
519:): }
520:): $r->print(
521:): $start_page
522:): .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
523:): .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4] first, and then try your access again',
524:): '<a href="'.$dest.'">','</a>',
525:): '<a href="/adm/logout">','</a>')
526:): .'</p>'
527:): .$end_page);
528:): }
529:): return OK;
530:): }
1.121.2.22 raeburn 531: }
532: }
1.105 raeburn 533: }
1.103 raeburn 534: $r->print(
535: $start_page
1.121.2.4 raeburn 536: .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
1.103 raeburn 537: .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
1.105 raeburn 538: ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
1.103 raeburn 539: .'</p>'
540: .$end_page
541: );
542: return OK;
543: }
1.59 www 544: }
545:
546: # ---------------------------------------------------- No valid token, continue
547:
1.121.2.22 raeburn 548: my %form = &get_form_items($r);
1.85 albertel 549: if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
550: &failed($r,'Username, password and domain need to be specified.',
551: \%form);
1.1 albertel 552: return OK;
553: }
1.61 www 554:
555: # split user logging in and "su"-user
556:
1.121.2.17 raeburn 557: ($form{'uname'},$form{'suname'},$form{'sudom'})=split(/\:/,$form{'uname'});
1.87 albertel 558: $form{'uname'} = &LONCAPA::clean_username($form{'uname'});
559: $form{'suname'}= &LONCAPA::clean_username($form{'suname'});
1.121.2.17 raeburn 560: $form{'udom'} = &LONCAPA::clean_domain($form{'udom'});
561: $form{'sudom'} = &LONCAPA::clean_domain($form{'sudom'});
1.1 albertel 562:
563: my $role = $r->dir_config('lonRole');
564: my $domain = $r->dir_config('lonDefDomain');
565: my $prodir = $r->dir_config('lonUsersDir');
1.93 raeburn 566: my $contact_name = &mt('LON-CAPA helpdesk');
1.1 albertel 567:
1.8 www 568: # ---------------------------------------- Get the information from login token
569:
1.85 albertel 570: my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
571: $form{'serverid'});
1.121.2.7 raeburn 572:
1.114 raeburn 573: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
574: ($tmpinfo eq 'no_such_host')) {
1.85 albertel 575: &failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
1.8 www 576: return OK;
1.44 www 577: } else {
1.85 albertel 578: my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'},
579: $form{'serverid'});
1.77 albertel 580: if ( $reply ne 'ok' ) {
1.85 albertel 581: &failed($r,'Session could not be opened.',\%form);
582: &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token");
1.77 albertel 583: return OK;
1.44 www 584: }
1.8 www 585: }
1.100 raeburn 586:
1.93 raeburn 587: if (!&Apache::lonnet::domain($form{'udom'})) {
588: &failed($r,'The domain you provided is not a valid LON-CAPA domain.',\%form);
589: return OK;
590: }
1.100 raeburn 591:
1.121.2.22 raeburn 592: my ($des_key,$firsturl,@rest)=split(/&/,$tmpinfo);
593: $firsturl = &unescape($firsturl);
594: foreach my $item (@rest) {
595: my ($key,$value) = split(/=/,$item);
596: $form{$key} = &unescape($value);
1.100 raeburn 597: }
1.121.2.24.2. (raeburn 598:): if ($firsturl =~ m{^/tiny/$match_domain/\w+$}) {
599:): $form{'firsturl'} = $firsturl;
600:): }
1.121.2.23 raeburn 601: my $upass = &Apache::loncommon::des_decrypt($des_key,$form{'upass0'});
1.8 www 602:
1.1 albertel 603: # ---------------------------------------------------------------- Authenticate
1.119 raeburn 604:
1.90 raeburn 605: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
1.119 raeburn 606: my ($cancreate,$statustocreate) =
607: &Apache::createaccount::get_creation_controls($form{'udom'},$domconfig{'usercreation'});
608: my $defaultauth;
609: if (ref($cancreate) eq 'ARRAY') {
610: if (grep(/^login$/,@{$cancreate})) {
611: $defaultauth = 1;
1.90 raeburn 612: }
613: }
1.105 raeburn 614: my $clientcancheckhost = 1;
1.90 raeburn 615: my $authhost=Apache::lonnet::authenticate($form{'uname'},$upass,
1.105 raeburn 616: $form{'udom'},$defaultauth,
617: $clientcancheckhost);
1.1 albertel 618:
619: # --------------------------------------------------------------------- Failed?
620:
621: if ($authhost eq 'no_host') {
1.121.2.24.2. (raeburn 622:): my $pwdverify;
623:): if (&Apache::lonnet::homeserver($form{'uname'},$form{'udom'}) eq 'no_host') {
624:): my %possunames = &alternate_unames_check($form{'uname'},$form{'udom'});
625:): if (keys(%possunames) > 0) {
626:): foreach my $rulematch (keys(%possunames)) {
627:): my $possuname = $possunames{$rulematch};
628:): if (($possuname ne '') && ($possuname =~ /^$match_username$/)) {
629:): $authhost=Apache::lonnet::authenticate($possuname,$upass,
630:): $form{'udom'},undef,
631:): $clientcancheckhost);
632:): if (($authhost eq 'no_host') || ($authhost eq 'no_account_on_host')) {
633:): next;
634:): } elsif (($authhost ne '') && (&Apache::lonnet::hostname($authhost) ne '')) {
635:): $pwdverify = 1;
636:): &Apache::lonnet::logthis("Authenticated user: $possuname was submitted as: $form{'uname'}");
637:): $form{'uname'} = $possuname;
638:): last;
639:): }
640:): }
641:): }
642:): }
643:): }
644:): unless ($pwdverify) {
645:): &failed($r,'Username and/or password could not be authenticated.',
646:): \%form,$authhost);
647:): return OK;
648:): }
1.90 raeburn 649: } elsif ($authhost eq 'no_account_on_host') {
1.119 raeburn 650: if ($defaultauth) {
1.105 raeburn 651: my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
1.110 raeburn 652: unless (&check_can_host($r,\%form,'no_account_on_host',$domdesc)) {
653: return OK;
654: }
1.90 raeburn 655: my $start_page =
1.121.2.1 raeburn 656: &Apache::loncommon::start_page('Create a user account in LON-CAPA',
657: '',{'no_inline_link' => 1,});
1.93 raeburn 658: my $lonhost = $r->dir_config('lonHostID');
659: my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
660: my $contacts =
661: &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
662: $form{'udom'},$origmail);
663: my ($contact_email) = split(',',$contacts);
1.119 raeburn 664: my $output =
665: &Apache::createaccount::username_check($form{'uname'},$form{'udom'},
666: $domdesc,'',$lonhost,
667: $contact_email,$contact_name,
668: undef,$statustocreate);
1.90 raeburn 669: &Apache::loncommon::content_type($r,'text/html');
670: $r->send_http_header;
671: &Apache::createaccount::print_header($r,$start_page);
1.94 raeburn 672: $r->print('<h3>'.&mt('Account creation').'</h3>'.
673: &mt('Although your username and password were authenticated, you do not currently have a LON-CAPA account at this institution.').'<br />'.
674: $output.&Apache::loncommon::end_page());
1.90 raeburn 675: return OK;
676: } else {
677: &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);
678: return OK;
679: }
1.1 albertel 680: }
681:
1.59 www 682: if (($firsturl eq '') ||
683: ($firsturl=~/^\/adm\/(logout|remote)/)) {
1.24 www 684: $firsturl='/adm/roles';
1.7 www 685: }
1.121.2.6 raeburn 686:
1.121.2.23 raeburn 687: my ($hosthere,%sessiondata);
1.121.2.6 raeburn 688: if ($form{'iptoken'}) {
1.121.2.23 raeburn 689: %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
1.121.2.12 raeburn 690: my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
1.121.2.6 raeburn 691: if (($sessiondata{'domain'} eq $form{'udom'}) &&
692: ($sessiondata{'username'} eq $form{'uname'})) {
693: $hosthere = 1;
694: }
695: }
696:
1.61 www 697: # --------------------------------- Are we attempting to login as somebody else?
1.85 albertel 698: if ($form{'suname'}) {
1.121.2.17 raeburn 699: my ($suname,$sudom,$sudomref);
700: $suname = $form{'suname'};
701: $sudom = $form{'udom'};
702: if ($form{'sudom'}) {
703: unless ($sudom eq $form{'sudom'}) {
704: if (&Apache::lonnet::domain($form{'sudom'})) {
705: $sudomref = [$form{'sudom'}];
706: $sudom = $form{'sudom'};
707: }
708: }
709: }
1.61 www 710: # ------------ see if the original user has enough privileges to pull this stunt
1.121.2.17 raeburn 711: if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'},$sudomref)) {
1.61 www 712: # ---------------------------------------------------- see if the su-user exists
1.121.2.17 raeburn 713: unless (&Apache::lonnet::homeserver($suname,$sudom) eq 'no_host') {
1.61 www 714: # ------------------------------ see if the su-user is not too highly privileged
1.121.2.17 raeburn 715: if (&Apache::lonnet::privileged($suname,$sudom)) {
716: &Apache::lonnet::logthis('Attempted switch user to privileged user');
717: } else {
718: my $noprivswitch;
719: #
720: # su-user's home server and user's home server must have one of:
721: # (a) same domain
722: # (b) same primary library server for the two domains
723: # (c) same "internet domain" for primary library server(s) for home servers' domains
724: #
725: my $suprim = &Apache::lonnet::domain($sudom,'primary');
726: my $suintdom = &Apache::lonnet::internet_dom($suprim);
727: unless ($sudom eq $form{'udom'}) {
728: my $uprim = &Apache::lonnet::domain($form{'udom'},'primary');
729: my $uintdom = &Apache::lonnet::internet_dom($uprim);
730: unless ($suprim eq $uprim) {
731: unless ($suintdom eq $uintdom) {
732: &Apache::lonnet::logthis('Attempted switch user '
733: .'to user with different "internet domain".');
734: $noprivswitch = 1;
735: }
736: }
737: }
738:
739: unless ($noprivswitch) {
740: #
741: # server where log-in occurs must have same "internet domain" as su-user's home
742: # server
743: #
744: my $lonhost = $r->dir_config('lonHostID');
745: my $hostintdom = &Apache::lonnet::internet_dom($lonhost);
746: if ($hostintdom ne $suintdom) {
747: &Apache::lonnet::logthis('Attempted switch user on a '
748: .'server with a different "internet domain".');
749: } else {
750:
1.61 www 751: # -------------------------------------------------------- actually switch users
1.121.2.17 raeburn 752:
753: &Apache::lonnet::logperm('User '.$form{'uname'}.' at '.
754: $form{'udom'}.' logging in as '.$suname.':'.$sudom);
755: $form{'uname'}=$suname;
756: if ($form{'udom'} ne $sudom) {
757: $form{'udom'}=$sudom;
758: }
759: }
760: }
1.61 www 761: }
762: }
763: } else {
764: &Apache::lonnet::logthis('Non-privileged user attempting switch user');
765: }
766: }
1.85 albertel 767:
1.121.2.24.2. (raeburn 768:): if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
769:): if (($form{'linkprot'}) && ($form{'linkprotuser'} ne '')) {
770:): unless($form{'linkprotuser'} eq $form{'uname'}.':'.$form{'udom'}) {
771:): delete($form{'udom'});
772:): delete($form{'uname'});
773:): &failed($r,'Username and/or domain are different to that expected for the link you followed from another system',
774:): \%form,$authhost);
775:): return OK;
776:): }
777:): }
778:): }
779:):
1.121.2.6 raeburn 780: my ($is_balancer,$otherserver);
781:
782: unless ($hosthere) {
783: ($is_balancer,$otherserver) =
1.121.2.15 raeburn 784: &Apache::lonnet::check_loadbalancing($form{'uname'},$form{'udom'},'login');
785: if ($is_balancer) {
1.121.2.20 raeburn 786: # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
787: my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r);
788: if (($found_server) && ($balancer_cookie =~ /^\Q$env{'user.domain'}\E_\Q$env{'user.name'}\E_/)) {
789: $otherserver = $found_server;
790: }
1.121.2.15 raeburn 791: if ($otherserver eq '') {
792: my $lowest_load;
793: ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});
794: if ($lowest_load > 100) {
1.121.2.22 raeburn 795: $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$form{'udom'});
1.121.2.15 raeburn 796: }
797: }
798: if ($otherserver ne '') {
799: my @hosts = &Apache::lonnet::current_machine_ids();
800: if (grep(/^\Q$otherserver\E$/,@hosts)) {
801: $hosthere = $otherserver;
802: }
803: }
804: }
1.121.2.6 raeburn 805: }
1.117 raeburn 806:
1.121.2.15 raeburn 807: if (($is_balancer) && (!$hosthere)) {
1.115 raeburn 808: if ($otherserver) {
809: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
810: \%form);
1.121.2.8 raeburn 811: my $switchto = '/adm/switchserver?otherserver='.$otherserver;
812: if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
813: $switchto .= '&origurl='.$firsturl;
814: }
815: if ($form{'role'}) {
816: $switchto .= '&role='.$form{'role'};
817: }
818: if ($form{'symb'}) {
819: $switchto .= '&symb='.$form{'symb'};
820: }
1.121.2.24.2. (raeburn 821:): if ($form{'linkprot'}) {
822:): $env{'request.linkprot'} = $form{'linkprot'};
823:): foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
824:): if ($form{$item}) {
825:): $env{'request.'.$item} = $form{$item};
826:): }
827:): }
828:): } elsif ($form{'linkkey'} ne '') {
829:): $env{'request.linkkey'} = $form{'linkkey'};
830:): }
831:): if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
832:): &set_deeplink_login(%form);
833:): } elsif ($firsturl eq '/adm/email') {
834:): if ($form{'display'} && ($form{'mailrecip'} eq "$form{'uname'}:$form{'udom'}")) {
835:): $env{'request.display'} = $form{'display'};
836:): $env{'request.mailrecip'} = $form{'mailrecip'};
837:): }
838:): }
1.121.2.8 raeburn 839: $r->internal_redirect($switchto);
1.115 raeburn 840: } else {
1.121.2.20 raeburn 841: &Apache::loncommon::content_type($r,'text/html');
842: $r->send_http_header;
1.115 raeburn 843: $r->print(&noswitch());
844: }
1.110 raeburn 845: return OK;
1.81 albertel 846: } else {
1.115 raeburn 847: if (!&check_can_host($r,\%form,$authhost)) {
1.118 raeburn 848: my ($otherserver) = &Apache::lonnet::choose_server($form{'udom'});
1.115 raeburn 849: if ($otherserver) {
850: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
851: \%form);
1.121.2.8 raeburn 852: my $switchto = '/adm/switchserver?otherserver='.$otherserver;
853: if (($firsturl) && ($firsturl ne '/adm/switchserver') && ($firsturl ne '/adm/roles')) {
854: $switchto .= '&origurl='.$firsturl;
855: }
856: if ($form{'role'}) {
857: $switchto .= '&role='.$form{'role'};
858: }
859: if ($form{'symb'}) {
860: $switchto .= '&symb='.$form{'symb'};
861: }
1.121.2.24.2. (raeburn 862:): if ($form{'linkprot'}) {
863:): $env{'request.linkprot'} = $form{'linkprot'};
864:): foreach my $item ('linkprotuser','linkprotexit','linkprotpbid','linkprotpburl') {
865:): if ($form{$item}) {
866:): $env{'request.'.$item} = $form{$item};
867:): }
868:): }
869:): } elsif ($form{'linkkey'} ne '') {
870:): $env{'request.linkkey'} = $form{'linkkey'};
871:): }
872:): if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
873:): &set_deeplink_login(%form);
874:): } elsif ($firsturl eq '/adm/email') {
875:): if ($form{'display'} && ($form{'mailrecip'} eq "$form{'uname'}:$form{'udom'}")) {
876:): $env{'request.display'} = $form{'display'};
877:): $env{'request.mailrecip'} = $form{'mailrecip'};
878:): }
879:): }
1.121.2.8 raeburn 880: $r->internal_redirect($switchto);
1.115 raeburn 881: } else {
1.121.2.20 raeburn 882: &Apache::loncommon::content_type($r,'text/html');
883: $r->send_http_header;
1.115 raeburn 884: $r->print(&noswitch());
885: }
886: return OK;
887: }
888:
1.109 raeburn 889: # ------------------------------------------------------- Do the load balancing
890:
891: # ---------------------------------------------------------- Determine own load
892: my $loadlim = $r->dir_config('lonLoadLim');
893: my $loadavg;
894: {
895: my $loadfile=Apache::File->new('/proc/loadavg');
896: $loadavg=<$loadfile>;
897: }
898: $loadavg =~ s/\s.*//g;
899: my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
900: my $userloadpercent=&Apache::lonnet::userload();
901:
902: # ---------------------------------------------------------- Are we overloaded?
903: if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
1.121.2.22 raeburn 904: my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'});
1.115 raeburn 905: if (!$unloaded) {
1.118 raeburn 906: ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
1.115 raeburn 907: }
1.109 raeburn 908: if ($unloaded) {
909: &success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',
910: undef,\%form);
1.121.2.24.2. (raeburn 911:): if ($form{'linkprot'}) {
912:): $env{'request.linkprot'} = $form{'linkprot'};
913:): } elsif ($form{'linkkey'} ne '') {
914:): $env{'request.linkkey'} = $form{'linkkey'};
915:): }
916:): if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
917:): &set_deeplink_login(%form);
918:): } elsif ($firsturl eq '/adm/email') {
919:): if ($form{'display'} && ($form{'mailrecip'} eq "$form{'uname'}:$form{'udom'}")) {
920:): $env{'request.display'} = $form{'display'};
921:): $env{'request.mailrecip'} = $form{'mailrecip'};
922:): }
923:): }
1.109 raeburn 924: $r->internal_redirect('/adm/switchserver?otherserver='.$unloaded.'&origurl='.$firsturl);
1.110 raeburn 925: return OK;
1.109 raeburn 926: }
927: }
1.121.2.15 raeburn 928: if (($is_balancer) && ($hosthere)) {
929: $form{'noloadbalance'} = $hosthere;
930: }
1.121.2.22 raeburn 931: my $extra_env;
932: if (($hosthere) && ($sessiondata{'sessionserver'} ne '')) {
933: if ($sessiondata{'origurl'} ne '') {
934: $firsturl = $sessiondata{'origurl'};
935: $form{'firsturl'} = $sessiondata{'origurl'};
936: my @names = ('role','symb','linkprot','linkkey');
937: foreach my $item (@names) {
938: if ($sessiondata{$item} ne '') {
939: $form{$item} = $sessiondata{$item};
940: }
941: }
1.121.2.24.2. (raeburn 942:): if ($sessiondata{'origurl'} eq '/adm/email') {
943:): if (($sessiondata{'display'}) && ($sessiondata{'mailrecip'})) {
944:): if (&unescape($sessiondata{'mailrecip'}) eq "$form{'uname'}:$form{'udom'}") {
945:): $form{'display'} = &unescape($sessiondata{'display'});
946:): $form{'mailrecip'} = &unescape($sessiondata{'mailrecip'});
947:): }
948:): }
949:): }
1.121.2.22 raeburn 950: }
951: }
1.121.2.24.2. (raeburn 952:): if ($form{'linkprot'}) {
953:): my ($linkprotector,$uri) = split(/:/,$form{'linkprot'},2);
954:): if ($linkprotector) {
955:): $extra_env = {'user.linkprotector' => $linkprotector,
956:): 'user.linkproturi' => $uri};
957:): }
958:): } elsif ($form{'linkkey'} ne '') {
959:): $extra_env = {'user.deeplinkkey' => $form{'linkkey'},
960:): 'user.keyedlinkuri' => $form{'firsturl'}};
961:): }
962:): if ($form{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
963:): &set_deeplink_login(%form);
964:): if ($form{'linkprot'}) {
965:): if (ref($extra_env) eq 'HASH') {
966:): %{$extra_env} = ( %{$extra_env}, 'request.linkprot' => $form{'linkprot'} );
967:): } else {
968:): $extra_env = {'request.linkprot' => $form{'linkprot'}};
969:): }
970:): if ($form{'linkprotexit'}) {
971:): $extra_env->{'request.linkprotexit'} = $form{'linkprotexit'};
972:): }
973:): if ($form{'linkprotpbid'}) {
974:): $extra_env->{'request.linkprotpbid'} = $form{'linkprotpbid'};
975:): }
976:): if ($form{'linkprotpburl'}) {
977:): $extra_env->{'request.linkprotpburl'} = $form{'linkprotpburl'};
978:): }
979:): } elsif ($form{'linkkey'} ne '') {
980:): if (ref($extra_env) eq 'HASH') {
981:): %{$extra_env} = ( %{$extra_env}, 'request.linkkey' => $form{'linkkey'} );
982:): } else {
983:): $extra_env = {'request.linkkey' => $form{'linkkey'}};
984:): }
985:): }
986:): if ($env{'request.deeplink.login'}) {
987:): if (ref($extra_env) eq 'HASH') {
988:): %{$extra_env} = ( %{$extra_env}, 'request.deeplink.login' => $form{'firsturl'} );
989:): } else {
990:): $extra_env = {'request.deeplink.login' => $form{'firsturl'}};
991:): }
992:): }
993:): }
994:): &success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,$extra_env,
1.109 raeburn 995: \%form);
1.110 raeburn 996: return OK;
1.81 albertel 997: }
1.1 albertel 998: }
999:
1.121.2.22 raeburn 1000: sub get_form_items {
1001: my ($r) = @_;
1002: my $buffer;
1003: if ($r->header_in('Content-length') > 0) {
1004: $r->read($buffer,$r->header_in('Content-length'),0);
1005: }
1006: my %form;
1007: foreach my $pair (split(/&/,$buffer)) {
1008: my ($name,$value) = split(/=/,$pair);
1009: $value =~ tr/+/ /;
1010: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1011: $form{$name}=$value;
1012: }
1013: return %form;
1014: }
1015:
1.121.2.24.2. (raeburn 1016:): sub set_deeplink_login {
1017:): my (%form) = @_;
1018:): my $disallow;
1019:): if ($form{'firsturl'} =~ m{^/tiny/($match_domain)/\w+$}) {
1020:): my $cdom = $1;
1021:): my ($cnum,$symb) = &Apache::loncommon::symb_from_tinyurl($form{'firsturl'},'',$cdom);
1022:): if ($symb) {
1023:): if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
1024:): my $deeplink;
1025:): if ($symb =~ /\.(page|sequence)$/) {
1026:): my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
1027:): my $navmap = Apache::lonnavmaps::navmap->new();
1028:): if (ref($navmap)) {
1029:): $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
1030:): }
1031:): } else {
1032:): $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
1033:): }
1034:): if ($deeplink ne '') {
1035:): my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink);
1036:): if (($protect ne 'none') && ($protect ne '')) {
1037:): my ($acctype,$item) = split(/:/,$protect);
1038:): if ($acctype =~ /lti(c|d)$/) {
1039:): unless ($form{'linkprot'} eq $item.$1.':'.$env{'request.deeplink.login'}) {
1040:): $disallow = 1;
1041:): }
1042:): } elsif ($acctype eq 'key') {
1043:): unless ($form{'linkkey'} eq $item) {
1044:): $disallow = 1;
1045:): }
1046:): }
1047:): }
1048:): }
1049:): unless ($disallow) {
1050:): $env{'request.deeplink.login'} = $form{'firsturl'};
1051:): }
1052:): } else {
1053:): $env{'request.deeplink.login'} = $form{'firsturl'};
1054:): }
1055:): }
1056:): }
1057:): if ($disallow) {
1058:): return;
1059:): }
1060:): return 'ok';
1061:): }
1062:):
1.121.2.22 raeburn 1063: sub set_retry_token {
1064: my ($form,$lonhost,$querystr) = @_;
1065: if (ref($form) eq 'HASH') {
1066: my ($firsturl,$token,$extras,@names);
1.121.2.24.2. (raeburn 1067:): @names = ('role','symb','linkprotuser','linkprotexit','linkprot','linkkey','iptoken','linkprotpbid','linkprotpburl');
1.121.2.22 raeburn 1068: foreach my $name (@names) {
1069: if ($form->{$name} ne '') {
1070: $extras .= '&'.$name.'='.&escape($form->{$name});
1071: last if ($name eq 'linkprot');
1072: }
1073: }
1074: my $firsturl = $form->{'firsturl'};
1075: if (($firsturl ne '') || ($extras ne '')) {
1076: $extras .= ':retry';
1077: $token = &Apache::lonnet::reply('tmpput:'.&escape($firsturl).
1078: $extras,$lonhost);
1079: if (($token eq 'con_lost') || ($token eq 'no_such_host')) {
1080: return 'fail';
1081: } else {
1082: if (ref($querystr)) {
1083: $$querystr = 'retry='.$token;
1084: }
1085: return 'ok';
1086: }
1087: }
1088: }
1089: return;
1090: }
1091:
1.105 raeburn 1092: sub check_can_host {
1093: my ($r,$form,$authhost,$domdesc) = @_;
1094: return unless (ref($form) eq 'HASH');
1095: my $canhost = 1;
1.106 raeburn 1096: my $lonhost = $r->dir_config('lonHostID');
1.105 raeburn 1097: my $udom = $form->{'udom'};
1.108 raeburn 1098: my @intdoms;
1099: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
1100: if (ref($internet_names) eq 'ARRAY') {
1101: @intdoms = @{$internet_names};
1102: }
1.106 raeburn 1103: my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
1104: my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
1105: unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
1106: my $machine_dom = &Apache::lonnet::host_domain($lonhost);
1107: my $hostname = &Apache::lonnet::hostname($lonhost);
1108: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
1109: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1110: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
1.105 raeburn 1111: my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
1112: my $loncaparev;
1113: if ($authhost eq 'no_account_on_host') {
1.106 raeburn 1114: $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom);
1.105 raeburn 1115: } else {
1.106 raeburn 1116: $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom,$lonhost);
1.105 raeburn 1117: }
1.106 raeburn 1118: $canhost = &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
1119: $udomdefaults{'remotesessions'},
1120: $defdomdefaults{'hostedsessions'});
1.105 raeburn 1121: }
1122: unless ($canhost) {
1123: if ($authhost eq 'no_account_on_host') {
1.115 raeburn 1124: my $checkloginvia = 1;
1125: my ($login_host,$hostname) =
1126: &Apache::lonnet::choose_server($udom,$checkloginvia);
1.105 raeburn 1127: &Apache::loncommon::content_type($r,'text/html');
1128: $r->send_http_header;
1129: if ($login_host ne '') {
1130: my $protocol = $Apache::lonnet::protocol{$login_host};
1131: $protocol = 'http' if ($protocol ne 'https');
1.121.2.22 raeburn 1132: my $alias = &Apache::lonnet::use_proxy_alias($r,$login_host);
1133: $hostname = $alias if ($alias ne '');
1.105 raeburn 1134: my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
1.121.2.24.2. (raeburn 1135:): #FIXME Should preserve where user was going and linkprot by setting ltoken at $login_host
1.105 raeburn 1136: $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
1137: '<h3>'.&mt('Account creation').'</h3>'.
1138: &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
1139: '<p>'.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'</p>'.
1140: '<p>'.&mt('[_1]Log in[_2]','<a href="'.$newurl.'">','</a>').
1141: &Apache::loncommon::end_page());
1142: } else {
1143: $r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable').
1144: '<h3>'.&mt('Account creation unavailable').'</h3>'.
1145: &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
1146: '<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>'.
1147: &Apache::loncommon::end_page());
1148: }
1149: } else {
1150: &success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef,
1151: $form);
1.121.2.24.2. (raeburn 1152:): if ($form->{'firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
1153:): $env{'request.deeplink.login'} = $form->{'firsturl'};
1154:): } elsif ($form->{'firsturl'} eq '/adm/email') {
1155:): if ($form->{'display'} && ($form->{'mailrecip'} eq $form->{'uname'}.':'.$form->{'udom'})) {
1156:): $env{'request.display'} = $form->{'mailrecip'};
1157:): $env{'request.mailrecip'} = $form->{'mailrecip'};
1158:): }
1159:): }
1160:): if ($form->{'linkprot'}) {
1161:): $env{'request.linkprot'} = $form->{'linkprot'};
1162:): } elsif ($form->{'linkkey'} ne '') {
1163:): $env{'request.linkkey'} = $form->{'linkkey'};
1164:): }
1.107 raeburn 1165: my ($otherserver) = &Apache::lonnet::choose_server($udom);
1.105 raeburn 1166: $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
1167: }
1168: }
1.110 raeburn 1169: return $canhost;
1.105 raeburn 1170: }
1171:
1.115 raeburn 1172: sub noswitch {
1173: my $result = &Apache::loncommon::start_page('Access to LON-CAPA unavailable').
1174: '<h3>'.&mt('Session unavailable').'</h3>'.
1175: &mt('This LON-CAPA server is unable to host your session.').'<br />'.
1176: '<p>'.&mt('Currently no other LON-CAPA server is available to host your session either.').'</p>'.
1177: &Apache::loncommon::end_page();
1178: return $result;
1179: }
1180:
1.121.2.2 raeburn 1181: sub loginhelpdisplay {
1182: my ($authdomain) = @_;
1183: my $login_help = 1;
1184: my $lang = &Apache::lonlocal::current_language();
1185: if ($login_help) {
1186: my $dom = $authdomain;
1187: if ($dom eq '') {
1188: $dom = &Apache::lonnet::default_login_domain();
1189: }
1190: my %domconfhash = &Apache::loncommon::get_domainconf($dom);
1191: my $loginhelp_url;
1192: if ($lang) {
1193: $loginhelp_url = $domconfhash{$dom.'.login.helpurl_'.$lang};
1194: if ($loginhelp_url ne '') {
1195: return $loginhelp_url;
1196: }
1197: }
1198: $loginhelp_url = $domconfhash{$dom.'.login.helpurl_nolang'};
1199: if ($loginhelp_url ne '') {
1200: return $loginhelp_url;
1201: } else {
1202: return '/adm/loginproblems.html';
1203: }
1204: }
1205: return;
1206: }
1207:
1.121.2.24.2. (raeburn 1208:): sub alternate_unames_check {
1209:): my ($uname,$udom) = @_;
1210:): my %possunames;
1211:): my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1212:): if (ref($domdefs{'unamemap_rule'}) eq 'ARRAY') {
1213:): if (@{$domdefs{'unamemap_rule'}} > 0) {
1214:): %possunames =
1215:): &Apache::lonnet::inst_rulecheck($udom,$uname,undef,
1216:): 'unamemap',$domdefs{'unamemap_rule'});
1217:): }
1218:): }
1219:): return %possunames;
1220:): }
1221:):
1.1 albertel 1222: 1;
1223: __END__
1.7 www 1224:
1225:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonauth.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / auth