Annotation of loncom/auth/migrateuser.pm, revision 1.43
1.1 albertel 1: # The LearningOnline Network
2: # Starts a user off based of an existing token.
3: #
1.43 ! raeburn 4: # $Id: migrateuser.pm,v 1.42 2018/12/26 20:10:21 raeburn Exp $
1.1 albertel 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:
1.2 albertel 29: package Apache::migrateuser;
1.1 albertel 30:
31: use strict;
1.19 raeburn 32: use LONCAPA qw(:DEFAULT :match);
1.1 albertel 33: use Apache::Constants qw(:common :http :methods);
34: use Apache::lonauth;
35: use Apache::lonnet;
1.37 raeburn 36: use Apache::loncommon;
1.6 albertel 37: use Apache::lonlocal;
1.18 raeburn 38: use Apache::lonlogin();
1.27 raeburn 39: use Apache::ltiauth;
1.37 raeburn 40: use Apache::switchserver;
1.28 raeburn 41: use CGI::Cookie;
1.1 albertel 42:
43: sub goto_login {
1.27 raeburn 44: my ($r,$domain,$data) = @_;
45: if ((ref($data) eq 'HASH') && ($data->{'lti.login'})) {
46: &Apache::ltiauth::invalid_request($r,'22');
47: } else {
48: &Apache::loncommon::content_type($r,'text/html');
49: $r->send_http_header;
50: my $url = '/adm/login';
51: if ($domain) {
52: $url .= '?domain='.$domain;
53: }
54: $r->print(&Apache::loncommon::start_page('Going to login',undef,
55: {'redirect' => [0,$url],}).
56: '<h1>'.&mt('One moment please...').'</h1>'.
57: '<p>'.&mt('Transferring to login page.').'</p>'.
58: &Apache::loncommon::end_page());
59: }
1.2 albertel 60: return OK;
1.1 albertel 61: }
62:
1.27 raeburn 63: sub sso_check {
1.7 albertel 64: my ($data) = @_;
1.8 albertel 65: my %extra_env;
1.18 raeburn 66: if (ref($data) eq 'HASH') {
67: if ($data->{'sso.login'}) {
68: $extra_env{'request.sso.login'} = $data->{'sso.login'};
69: }
70: if ($data->{'sso.reloginserver'}) {
71: $extra_env{'request.sso.reloginserver'} =
72: $data->{'sso.reloginserver'};
73: }
1.35 raeburn 74: if (($data->{'balancer'}) && ($data->{'server'}) && ($data->{'balcookie'})) {
75: $extra_env{'request.balancercookie'} = $data->{'server'}.':'.$data->{'balcookie'};
76: }
1.27 raeburn 77: }
78: return \%extra_env;
79: }
80:
81: sub lti_check {
82: my ($data) = @_;
83: my %lti_env;
84: if (ref($data) eq 'HASH') {
1.26 raeburn 85: if ($data->{'lti.login'}) {
1.27 raeburn 86: $lti_env{'request.lti.login'} = $data->{'lti.login'};
87: if ($data->{'lti.reqcrs'}) {
88: $lti_env{'request.lti.reqcrs'} = $data->{'lti.reqcrs'};
89: }
90: if ($data->{'lti.reqrole'}) {
91: $lti_env{'request.lti.reqrole'} = $data->{'lti.reqrole'};
92: }
93: if ($data->{'lti.selfenrollrole'}) {
94: $lti_env{'request.lti.selfenrollrole'} = $data->{'lti.selfenrollrole'};
95: }
1.29 raeburn 96: if ($data->{'lti.uri'}) {
97: $lti_env{'request.lti.uri'} = $data->{'lti.uri'};
98: }
99: if ($data->{'lti.target'}) {
100: $lti_env{'request.lti.target'} = $data->{'lti.target'};
101: }
1.32 raeburn 102: if ($data->{'lti.sourcecrs'}) {
103: $lti_env{'request.lti.sourcecrs'} = $data->{'lti.sourcecrs'};
104: }
1.26 raeburn 105: }
106: if ($data->{'lti.passbackid'}) {
1.27 raeburn 107: $lti_env{'request.lti.passbackid'} = $data->{'lti.passbackid'};
1.26 raeburn 108: }
109: if ($data->{'lti.passbackurl'}) {
1.27 raeburn 110: $lti_env{'request.lti.passbackurl'} = $data->{'lti.passbackurl'};
1.26 raeburn 111: }
112: if ($data->{'lti.rosterid'}) {
1.27 raeburn 113: $lti_env{'request.lti.rosterid'} = $data->{'lti.rosterid'};
1.26 raeburn 114: }
115: if ($data->{'lti.rosterurl'}) {
1.27 raeburn 116: $lti_env{'request.lti.rosterurl'} = $data->{'lti.rosterurl'};
1.26 raeburn 117: }
1.7 albertel 118: }
1.27 raeburn 119: return \%lti_env;
1.18 raeburn 120: }
121:
1.39 raeburn 122: sub canhost {
123: my ($uname,$udom,$lonhost,$loncaparev) = @_;
124: my $canhost;
125: if (&Apache::lonnet::is_library($lonhost)) {
126: my @possdoms = &Apache::lonnet::current_machine_domains();
127: my %roleshash = &Apache::lonnet::get_my_roles($uname,$udom,'userroles','',['ca','aa'],\@possdoms);
128: if (keys(%roleshash)) {
129: foreach my $key (keys(%roleshash)) {
1.40 raeburn 130: my $audom = (split(/:/,$key))[1];
1.39 raeburn 131: if ((&Apache::lonnet::will_trust('othcoau',$udom,$audom)) &&
132: (&Apache::lonnet::will_trust('coaurem',$audom,$udom))) {
133: $canhost = 1;
134: last;
135: }
136: }
137: }
138: }
139: unless ($canhost) {
140: my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
141: my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
142: my @intdoms;
143: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
144: if (ref($internet_names) eq 'ARRAY') {
145: @intdoms = @{$internet_names};
146: }
147: if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
148: $canhost = 1;
149: } else {
150: my $hostname = &Apache::lonnet::hostname($lonhost);
151: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
152: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
153: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
154: my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
155: $canhost =
156: &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
157: $udomdefaults{'remotesessions'},
158: $defdomdefaults{'hostedsessions'});
159: }
160: }
161: return $canhost;
162: }
163:
1.18 raeburn 164: sub ip_changed {
1.37 raeburn 165: my ($r,$udom,$camefrom,$idsref,$dataref) = @_;
1.18 raeburn 166: &Apache::loncommon::content_type($r,'text/html');
167: $r->send_http_header;
168: if (ref($dataref) eq 'HASH') {
169: my $title = 'LON-CAPA Session redirected';
170: my $message = &mt('Your internet address has changed since you logged in.');
171: my $rule_in_effect;
1.22 raeburn 172: if ($dataref->{'balancer'}) {
173: my $baldom = &Apache::lonnet::host_domain($camefrom);
174: my $balprimaryid = &Apache::lonnet::domain($baldom,'primary');
175: my $balintdom = &Apache::lonnet::internet_dom($balprimaryid);
176: my $uprimaryid = &Apache::lonnet::domain($udom,'primary');
177: my $uintdom = &Apache::lonnet::internet_dom($uprimaryid);
178: my $dom_in_use;
179: if (($uintdom ne '') && ($uintdom eq $balintdom)) {
180: $dom_in_use = $udom;
181: } else {
182: $dom_in_use = $baldom;
1.21 raeburn 183: }
1.22 raeburn 184: my ($result,$cached)=&Apache::lonnet::is_cached_new('loadbalancing',$dom_in_use);
1.18 raeburn 185: unless (defined($cached)) {
186: my $cachetime = 60*60*24;
187: my %domconfig =
1.22 raeburn 188: &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);
1.18 raeburn 189: if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
1.22 raeburn 190: $result = &Apache::lonnet::do_cache_new('loadbalancing',$dom_in_use,
1.18 raeburn 191: $domconfig{'loadbalancing'},$cachetime);
192: }
193: }
194: if (ref($result) eq 'HASH') {
195: (undef,my $currtargets,my $currrules) =
196: &Apache::lonnet::check_balancer_result($result,$dataref->{'server'});
197: if (ref($currrules) eq 'HASH') {
198: if ($dataref->{'sso.login'}) {
199: if ($currrules->{'_LC_ipchangesso'} ne '') {
200: $rule_in_effect = $currrules->{'_LC_ipchangesso'};
201: }
202: } else {
203: if ($currrules->{'_LC_ipchange'} ne '') {
204: $rule_in_effect = $currrules->{'_LC_ipchange'};
205: }
206: }
207: }
208: }
209: }
210: my $url;
211: my $lonhost= $r->dir_config('lonHostID');
212: my $switchto = $lonhost;
1.23 raeburn 213: if ($rule_in_effect ne 'offloadedto') {
1.37 raeburn 214: my ($hosthere,@ids);
215: if (ref($idsref) eq 'ARRAY') {
216: @ids=@{$idsref};
217: }
1.23 raeburn 218: unless ($rule_in_effect eq 'balancer') {
219: if (grep(/^\Q$rule_in_effect\E$/,@ids)) {
220: $hosthere = 1;
221: }
222: }
223: unless ($hosthere) {
224: if ($dataref->{'role'}) {
225: my ($adom,$aname);
226: if ($dataref->{'role'} =~ m{^au\./($match_domain)/$}) {
227: $adom = $1;
228: $aname = $dataref->{'username'};
229: } elsif ($dataref->{'role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)$}) {
230: $adom = $1;
231: $aname = $2;
232: }
233: if ($adom ne '' && $aname ne '') {
234: my $ahome = &Apache::lonnet::homeserver($aname,$adom);
235: unless ($ahome eq 'no_host') {
236: if ($ahome && grep(/^\Q$ahome\E$/,@ids)) {
237: $hosthere = 1;
238: }
1.18 raeburn 239: }
240: }
241: }
242: }
1.23 raeburn 243: unless ($hosthere) {
244: my $hostname;
245: if ($rule_in_effect eq 'balancer') {
246: $hostname = &Apache::lonnet::hostname($dataref->{'server'});
247: if ($hostname) {
248: $switchto = $dataref->{'server'};
249: }
250: } else {
251: $hostname = &Apache::lonnet::hostname($rule_in_effect);
252: if ($hostname) {
253: $switchto = $rule_in_effect;
254: }
255: }
1.18 raeburn 256: if ($hostname) {
257: my $protocol = $Apache::lonnet::protocol{$switchto};
258: $protocol = 'http' if ($protocol ne 'https');
259: $url = $protocol.'://'.$hostname;
1.23 raeburn 260: if ($rule_in_effect eq 'balancer') {
261: $message .= '<br />'.
262: &mt('As a result, your LON-CAPA session is being redirected to the server where you originally logged in.');
263: } else {
264: $message .= '<br />'.
265: &mt('As a result, your LON-CAPA session is being redirected.');
266: }
1.18 raeburn 267: }
268: }
1.35 raeburn 269: unless ($hosthere) {
270: if (($dataref->{'balancer'}) && ($dataref->{'balcookie'})) {
271: &Apache::lonnet::delbalcookie($dataref->{'balcookie'},$dataref->{'balancer'});
272: }
273: }
1.18 raeburn 274: }
275: if ($dataref->{'sso.login'}) {
1.21 raeburn 276: $url .= '/adm/roles';
1.18 raeburn 277: } else {
1.21 raeburn 278: $url .= '/adm/login';
1.24 raeburn 279: if ($udom) {
280: $url .= '?domain='.$udom;
281: }
1.20 raeburn 282: $message .= '<br />'.&mt('You will need to provide your password one more time.');
1.18 raeburn 283: }
284: my %info= (
1.24 raeburn 285: 'domain' => $udom,
1.18 raeburn 286: 'username' => $dataref->{'username'},
287: 'role' => $dataref->{'role'},
288: 'sessionserver' => $lonhost,
289: );
290: if ($dataref->{'origurl'}) {
291: $info{'origurl'} = $dataref->{'origurl'};
292: }
293: if ($dataref->{'symb'}) {
294: $info{'symb'} = $dataref->{'symb'};
295: }
296: my $iptoken = &Apache::lonnet::tmpput(\%info,$switchto);
297: unless ($iptoken eq 'conlost') {
1.24 raeburn 298: $url .= ($url =~ /\?/) ? '&' : '?';
299: $url .= 'iptoken='.$iptoken;
1.18 raeburn 300: }
301: $r->print(&Apache::loncommon::start_page($title,undef,
302: {'redirect' =>
303: [2,$url],}).
304: '<h1>'.&mt('One moment please...').'</h1>'.
305: '<p class="LC_warning">'.$message.'</p>'.
306: &Apache::loncommon::end_page());
307: } else {
308: return &goto_login($r);
1.10 raeburn 309: }
1.18 raeburn 310: return OK;
1.7 albertel 311: }
312:
1.28 raeburn 313: sub logout {
314: my ($r,$handle,$data,$lti_env) = @_;
1.34 raeburn 315: my $lonidsdir=$r->dir_config('lonIDsDir');
316: if (unlink("$lonidsdir/$handle.id")) {
317: if (($env{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
318: (-l "$lonidsdir/$env{'user.linkedenv'}.id") &&
319: (readlink("$lonidsdir/$env{'user.linkedenv'}.id") eq "$lonidsdir/$handle.id")) {
320: unlink("$lonidsdir/$env{'user.linkedenv'}.id");
1.28 raeburn 321: }
322: }
323: my %temp=('logout' => time);
324: &Apache::lonnet::put('email_status',\%temp);
325: &Apache::lonnet::log($env{'user.domain'},
326: $env{'user.name'},
327: $env{'user.home'},
328: "Logout $ENV{'REMOTE_ADDR'}");
329:
330: &Apache::loncommon::content_type($r,'text/html');
331:
1.34 raeburn 332: #expire the cookies
333: my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
334: foreach my $name (keys(%cookies)) {
335: next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
336: my $c = new CGI::Cookie(-name => $name,
337: -value => '',
338: -expires => '-10y',);
339: $r->headers_out->add('Set-cookie' => $c);
1.28 raeburn 340: }
341: my (%info,%user_info,%lti_info);
342: if (ref($lti_env) eq 'HASH') {
343: %lti_info = %{$lti_env};
344: }
345: my $lonhost = $r->dir_config('lonHostID');
346: if (ref($data) eq 'HASH') {
347: %user_info=('ip' => $ENV{'REMOTE_ADDR'},
348: 'domain' => $data->{'domain'},
349: 'username' => $data->{'username'},
1.36 raeburn 350: 'home' => $data->{'home'},
1.28 raeburn 351: 'role' => $data->{'role'},
352: 'origurl' => $data->{'origurl'},
353: 'symb' => $data->{'symb'},
354: 'server' => $lonhost);
355: }
356: %info = (%user_info,%lti_info);
357: my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
358: my $url = '/adm/migrateuser?token='.$token;
359: $r->send_http_header;
360: $r->print(
361: &Apache::loncommon::start_page('Updating Session ...',undef,
362: {'redirect' => [0.1,$url],
363: 'only_body' => 1,}).
364: &Apache::loncommon::end_page());
365: $r->register_cleanup(\&flush_course_logs);
366: return;
367: }
368:
1.36 raeburn 369: sub conlost_userhome {
370: my ($r,$idsref,$dataref) = @_;
371: return unless ((ref($idsref) eq 'ARRAY') && (ref($dataref) eq 'HASH'));
372: my @ids = @{$idsref};
373: my %data = %{$dataref};
1.37 raeburn 374: my ($lonhost,$lowest_load,$otherserver,$is_balancer,%conlost,%posstargets);
375: $lonhost = $r->dir_config('lonHostID');
376: if (grep(/^\Q$lonhost\E$/,split(/,/,$data{'dom_balancers'}))) {
377: $is_balancer = 1;
378: }
379: $lowest_load = 30000;
1.36 raeburn 380: if ($data{'conlost'} ne '') {
381: map { $conlost{$_} = 1; } split(/,/,$data{'conlost'});
382: }
1.37 raeburn 383: if ($data{'loncfail'}) {
1.38 raeburn 384: if ($lonhost ne $data{'from_balancer'}) {
385: my ($is_balancer,$posshost,$setcookie,$offloadto,$dom_balancers) =
386: &Apache::lonnet::check_loadbalancing($data{'username'},$data{'domain'});
387: if ($is_balancer) {
388: if (ref($offloadto) eq 'HASH') {
389: $data{'offloadto'} = '';
390: foreach my $key (keys(%{$offloadto})) {
391: if (ref($offloadto->{$key}) eq 'ARRAY') {
392: $data{'offloadto'} .= $key.'='.join(',',@{$offloadto->{$key}}).'&';
1.37 raeburn 393: }
394: }
1.38 raeburn 395: $data{'offloadto'} =~ s/\&$//;
396: } elsif (ref($offloadto) eq 'ARRAY') {
397: $data{'offloadto'} = join(',',@{$offloadto});
1.37 raeburn 398: }
399: }
400: }
401: } else {
402: $conlost{$lonhost} = 1;
403: $data{'conlost'} = join(',',sort(keys(%conlost)));
404: }
1.36 raeburn 405: if ($data{'offloadto'} =~ /\&/) {
1.37 raeburn 406: foreach my $item (split(/\&/,$data{'offloadto'})) {
1.36 raeburn 407: my ($type,$targets) = split(/\=/,$item);
408: @{$posstargets{$type}} = split(/,/,$targets);
409: }
410: } elsif ($data{'offloadto'} =~ /=/) {
411: my ($type,$targets) = split(/\=/,$data{'offloadto'});
412: @{$posstargets{$type}} = split(/,/,$targets);
413: } else {
414: @{$posstargets{'default'}} = split(/,/,$data{'offloadto'});
415: }
416: if (ref($posstargets{'primary'}) eq 'ARRAY') {
417: foreach my $try_server (@{$posstargets{'primary'}}) {
418: next if ($conlost{$try_server});
1.37 raeburn 419: next if ((grep(/^\Q$try_server\E$/,@ids)) && !$data{'loncfail'});
1.36 raeburn 420: ($otherserver,$lowest_load) =
421: &Apache::lonnet::compare_server_load($try_server,
422: $otherserver,
423: $lowest_load);
424: }
425: }
426: my $found_server = ($otherserver ne '' && $lowest_load < 100);
427: if (!$found_server) {
428: if (ref($posstargets{'default'}) eq 'ARRAY') {
429: foreach my $try_server (@{$posstargets{'default'}}) {
1.37 raeburn 430: next if ($conlost{$try_server});
431: next if ((grep(/^\Q$try_server\E$/,@ids)) && !$data{'loncfail'});
1.36 raeburn 432: ($otherserver,$lowest_load) =
1.37 raeburn 433: &Apache::lonnet::compare_server_load($try_server,
434: $otherserver,
435: $lowest_load);
1.36 raeburn 436: }
437: }
438: }
439: if ($otherserver ne '') {
440: my $switchto = &Apache::lonnet::hostname($otherserver);
441: if ($switchto ne '') {
442: $data{'server'} = $lonhost;
1.37 raeburn 443: if ($data{'loncfail'}) {
444: delete($data{'loncfail'});
445: }
1.36 raeburn 446: if (grep(/^\Q$otherserver\E$/,split(/,/,$data{'dom_balancers'}))) {
1.37 raeburn 447: $data{'noloadbalance'} = $otherserver;
1.36 raeburn 448: }
1.37 raeburn 449: &do_server_switch($r,$otherserver,$switchto,$is_balancer,\%data);
1.36 raeburn 450: return $otherserver;
1.37 raeburn 451: } else {
452: #FIXME Contents of $data{offloadto} contains invalid hostID.
453: }
454: } else {
455: my (%poss_balancers,%tried_balancers);
456: map { $poss_balancers{$_} = 1; } split(/,/,$data{'dom_balancers'});
457: map { $tried_balancers{$_} = 1; } split(/,/,$data{'tried_balancers'});
458: if (keys(%poss_balancers)) {
459: foreach my $try_server (sort(keys(%poss_balancers))) {
460: next if (grep(/^\Q$try_server\E$/,@ids));
461: next if (($data{'loncfail'}) && ($tried_balancers{$try_server}));
462: my $alreadytried;
463: foreach my $key (keys(%posstargets)) {
464: if ((ref($posstargets{$key}) eq 'ARRAY') &&
465: (grep(/^\Q$try_server\E$/,@{$posstargets{$key}}))) {
466: $alreadytried = 1;
467: last;
468: }
469: }
470: unless ($alreadytried) {
471: if (&Apache::lonnet::reply('ping',$try_server) eq $try_server) {
472: $otherserver = $try_server;
473: last;
474: }
475: }
476: }
477: }
478: if ($otherserver ne '') {
479: my $switchto = &Apache::lonnet::hostname($otherserver);
480: if ($switchto ne '') {
481: $data{'server'} = $lonhost;
482: $data{'loncfail'} = $lonhost;
483: $tried_balancers{$otherserver} = 1;
484: $data{'tried_balancers'} = join(',',sort(keys(%tried_balancers)));
485: &do_server_switch($r,$otherserver,$switchto,$is_balancer,\%data);
486: return $otherserver;
487: } else {
488: #FIXME Contents of $data{'dom_balancers'} contains invalid hostID.
1.39 raeburn 489: }
1.37 raeburn 490: } else {
491: if ($data{'loncfail'}) {
492: #FIXME Nowhere to go.
493: } else {
494: # FIXME Send back to a balancer (no token); different balancer if this is a balancer.
495: # Send command to balancer to exclude this host using http instead on lonc/lond
496: }
1.36 raeburn 497: }
498: }
1.37 raeburn 499: return;
500: }
501:
502: sub do_server_switch {
503: my ($r,$otherserver,$switchto,$is_balancer,$dataref) = @_;
504: if (ref($dataref) eq 'HASH') {
505: my $domain = $dataref->{'domain'};
506: my $username = $dataref->{'username'};
507: # If this is a balancer set a balancer cookie unless browser already sent
508: # LON-CAPA load balancer cookie which points at the target server.
509: if ($is_balancer) {
510: my $newcookieid;
511: my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
512: unless (($found_server eq $otherserver) &&
513: ($balancer_cookie =~ /^\Q$domain\E_\Q$username\E_/)) {
514: $newcookieid =
515: &Apache::switchserver::balancer_cookieid($r,$otherserver,$username,$domain);
516: if ($newcookieid) {
517: $dataref->{'balcookie'} = $newcookieid;
518: }
519: }
520: }
521: my $token = &Apache::lonnet::tmpput($dataref,$otherserver);
522: my $protocol = $Apache::lonnet::protocol{$otherserver};
523: $protocol = 'http' if ($protocol ne 'https');
524: my $url = $protocol.'://'.$switchto.'/adm/login?domain='.$domain.
525: '&username='.$username.'&token='.$token;
526: $r->send_http_header;
527: $r->print(
528: &Apache::loncommon::start_page('Switching Server ...',undef,
529: {'redirect' => [0.1,$url]}).
530: &Apache::loncommon::end_page());
531: }
532: return;
1.36 raeburn 533: }
534:
535: sub log_switch {
536: my ($r,$data,$lti_env) = @_;
537: my $lonhost = $r->dir_config('lonHostID');
538: return unless ((ref($data) eq 'HASH') && (ref($lti_env) eq 'HASH'));
539: my $now = time;
540: my %temp=('switchserver' => $now.':'.$lonhost,$data->{'role'});
541: &Apache::lonnet::put('email_status',\%temp);
542: my $logmsg = "Switch Server to $lonhost";
543: if ($data->{'role'}) {
544: $logmsg .= " with role: ".$data->{'role'};
545: } elsif (($lti_env->{'reqcrs'}) && ($lti_env->{'reqrole'} eq 'cc')) {
546: $logmsg .= " to create new LTI course";
547: } elsif ($lti_env->{'selfenrollrole'}) {
548: $logmsg .= " to selfenroll with role: ".$lti_env->{'selfenrollrole'};
549: } else {
550: $logmsg .= " (no role)";
551: }
552: $logmsg .= ' '.$ENV{'REMOTE_ADDR'};
553: &Apache::lonnet::log($data->{'domain'},$data->{'username'},$data->{'home'},$logmsg);
554: }
555:
1.28 raeburn 556: sub flush_course_logs {
557: &Apache::lonnet::flushcourselogs();
558: return OK;
559: }
560:
1.1 albertel 561: sub handler {
562: my ($r) = @_;
563:
564: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['token']);
1.4 albertel 565: my %data = &Apache::lonnet::tmpget($env{'form.token'});
1.13 raeburn 566: if (keys(%data) == 0) {
567: return &goto_login($r);
568: }
1.4 albertel 569: my $delete = &Apache::lonnet::tmpdel($env{'form.token'});
570:
1.6 albertel 571: &Apache::lonlocal::get_language_handle($r);
572:
1.4 albertel 573: if ($delete ne 'ok') {
1.27 raeburn 574: return &goto_login($r,undef,\%data);
1.4 albertel 575: }
1.2 albertel 576:
1.18 raeburn 577: if (!defined($data{'username'}) || !defined($data{'domain'})) {
1.27 raeburn 578: return &goto_login($r,undef,\%data);
1.18 raeburn 579: }
1.37 raeburn 580: my ($home,@ids);
581: @ids=&Apache::lonnet::current_machine_ids();
1.18 raeburn 582: if ($data{'ip'} ne $ENV{'REMOTE_ADDR'}) {
1.24 raeburn 583: &Apache::lonnet::logthis('IP change when session migration requested -- was: '.
584: $data{'ip'}.'; now: '.$ENV{'REMOTE_ADDR'}.' for '.$data{'username'}.':'.$data{'domain'});
1.37 raeburn 585: return &ip_changed($r,$data{'domain'},$data{'server'},\@ids,\%data);
1.2 albertel 586: }
1.37 raeburn 587: if ($data{'loncfail'}) {
588: &Apache::lonnet::logthis('Returned from '.$data{'server'}.' -- no connection to library node or other access node(s)');
589: my $otherserver = &conlost_userhome($r,\@ids,\%data);
590: if ($otherserver ne '') {
591: &Apache::lonnet::logthis("Switching to $otherserver");
592: }
593: return OK;
594: } else {
595: $home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
596: if ($home eq 'no_host') {
597: if (($data{'home'} ne '') && (&Apache::lonnet::hostname($data{'home'}))) {
598: &Apache::lonnet::reconlonc($data{'home'});
599: $home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
600: if ($home eq 'no_host') {
601: unless (grep(/^\Q$data{'home'}\E$/,@ids)) {
602: if (&Apache::lonnet::reply('ping',$data{'home'}) eq 'con_lost') {
603: my $otherserver = &conlost_userhome($r,\@ids,\%data);
604: if ($otherserver ne '') {
605: &Apache::lonnet::logthis("No connection to home server ($data{'home'}) for $data{'username'}:$data{'domain'}. Switching to $otherserver");
606: }
1.36 raeburn 607: return OK;
608: }
609: }
610: }
611: }
612: }
613: }
614:
1.24 raeburn 615: my $udom;
616: if (&Apache::lonnet::domain($data{'domain'})) {
617: $udom=$data{'domain'};
618: }
1.36 raeburn 619: if ($home eq 'no_host') { return &goto_login($r,$udom,\%data); }
1.38 raeburn 620: if (&Apache::lonnet::hostname($home) eq '') { return &goto_login($r,$udom,\%data); }
1.36 raeburn 621:
1.39 raeburn 622: unless (grep(/^\Q$home\E$/,@ids)) {
623: my $lonhost = $r->dir_config('lonHostID');
624: my $loncaparev = $r->dir_config('lonVersion');
625: unless (&canhost($data{'username'},$data{'domain'},$lonhost,$loncaparev)) {
626: return &goto_login($r,$udom,\%data);
627: }
628: }
1.41 raeburn 629:
1.36 raeburn 630: my $rolemsg;
631: if ($data{'role'}) {
1.38 raeburn 632: $rolemsg = "role: $data{'role'}";
1.36 raeburn 633: } else {
634: $rolemsg = '(no role)';
635: }
636:
637: &Apache::lonnet::logthis("Allowing access for $data{'username'}:$data{'domain'} $rolemsg");
1.27 raeburn 638:
639: my $sso_env = &sso_check(\%data);
640: my $lti_env = <i_check(\%data);
1.2 albertel 641:
1.27 raeburn 642: my $extra_env;
643: if ((ref($sso_env) eq 'HASH') && (keys(%{$sso_env}))) {
644: $extra_env = $sso_env;
645: } elsif ((ref($lti_env) eq 'HASH') && (keys(%{$lti_env}))) {
646: $extra_env = $lti_env;
647: }
1.8 albertel 648:
1.37 raeburn 649: if (($data{'conlost'}) && ($data{'server'})) {
650: my @conlosts = split(/,/,$data{'conlost'});
651: my $switchfrom = $data{'server'};
652: if (@conlosts) {
653: if (grep(/^\Q$switchfrom\E$/,@conlosts)) {
654: &log_switch($r,\%data,$extra_env);
655: }
656: }
657: }
658:
1.16 raeburn 659: my %form;
660: if ($data{'symb'} ne '') {
661: $form{'symb'} = $data{'symb'};
662: }
1.21 raeburn 663: if ($data{'iptoken'} ne '') {
664: $form{'iptoken'} = $data{'iptoken'};
665: }
1.25 raeburn 666: if ($data{'noloadbalance'} ne '') {
667: $form{'noloadbalance'} = $data{'noloadbalance'};
668: }
1.16 raeburn 669:
1.3 albertel 670: if (!$data{'role'}) {
1.12 albertel 671: my $handle = &Apache::lonnet::check_for_valid_session($r);
672: if ($handle) {
1.11 albertel 673: &Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'),
674: $handle);
1.42 raeburn 675: if ($data{'linkprot'} ne '') {
676: my ($linkprotector,$deeplink) = split(/:/,$data{'linkprot'},2);
1.43 ! raeburn 677: if ($deeplink ne '') {
! 678: &Apache::lonnet::appenv({'request.deeplink.login' => $deeplink});
! 679: }
1.42 raeburn 680: if ($env{'user.linkprotector'}) {
681: my @protectors = split(/,/,$env{'user.linkprotector'});
682: unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
683: push(@protectors,$linkprotector);
684: @protectors = sort { $a <=> $b } @protectors;
685: &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
686: }
687: } else {
688: &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
1.43 ! raeburn 689: }
1.42 raeburn 690: if ($env{'user.linkproturi'}) {
691: my @proturis = split(/,/,$env{'user.linkproturi'});
692: unless(grep(/^\Q$deeplink\E$/,@proturis)) {
693: push(@proturis,$deeplink);
694: @proturis = sort @proturis;
695: &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
696: }
697: } else {
698: &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
699: }
1.43 ! raeburn 700: } elsif ($data{'deeplink.login'}) {
! 701: my $deeplink = $data{'deeplink.login'};
! 702: if ($data{'linkkey'}) {
! 703: my $linkkey = $data{'linkkey'};
! 704: if ($env{'user.deeplinkkey'}) {
! 705: my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
! 706: unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
! 707: push(@linkkeys,$linkkey);
! 708: &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
! 709: }
! 710: } else {
! 711: &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
! 712: }
! 713: if ($env{'user.keyedlinkuri'}) {
! 714: my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
! 715: unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
! 716: push(@keyeduris,$deeplink);
! 717: &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
! 718: }
! 719: } else {
! 720: &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
! 721: }
! 722: }
! 723: &Apache::lonnet::appenv({'request.deeplink.login' => $data{'deeplink.login'}});
1.42 raeburn 724: }
1.27 raeburn 725: if ($data{'lti.login'}) {
1.28 raeburn 726: my $needslogout;
727: if ($env{'request.lti.login'}) {
728: if (($env{'user.name'} ne $data{'username'}) ||
729: ($env{'user.domain'} ne $data{'domain'})) {
730: $needslogout = 1;
731: }
732: } else {
733: $needslogout = 1;
734: }
735: # If access is via LTI, and user already has a non-LTI session cookie
736: # (and session) or has an LTI session cookie for a different username,
737: # logout the existing session, and start a new one
738: if ($needslogout) {
739: &logout($r,$handle,\%data,$lti_env);
740: } elsif (($data{'lti.reqcrs'}) && ($data{'lti.reqrole'} eq 'cc')) {
1.27 raeburn 741: $form{'lti.reqcrs'} = $data{'lti.reqcrs'};
742: $form{'lti.reqrole'} = $data{'lti.reqrole'};
743: $form{'lti.sourcecrs'} = $data{'lti.sourcecrs'};
1.29 raeburn 744: $form{'lti.uri'} = $data{'lti.uri'};
1.28 raeburn 745: if ($data{'lti.passbackid'}) {
746: $form{'lti.passbackid'} = $data{'lti.passbackid'};
747: }
748: if ($data{'lti.passbackurl'}) {
749: $form{'lti.passbackurl'} = $data{'lti.passbackurl'};
750: }
751: if ($data{'lti.rosterid'}) {
752: $form{'lti.rosterid'} = $data{'lti.rosterid'};
753: }
754: if ($data{'lti.rosterurl'}) {
755: $form{'lti.rosterurl'} = $data{'lti.rosterurl'};
756: }
1.29 raeburn 757: if ($data{'lti.target'}) {
758: $form{'lti.target'} = $data{'lti.target'};
759: }
1.27 raeburn 760: &Apache::loncommon::content_type($r,'text/html');
761: $r->send_http_header;
762: &Apache::ltiauth::lti_reqcrs($r,$data{'domain'},\%form,$data{'username'},$data{'domain'});
1.28 raeburn 763: } else {
764: if (ref($lti_env) eq 'HASH') {
765: delete($lti_env->{'reqcrs'});
766: delete($lti_env->{'reqrole'});
767: delete($lti_env->{'selfenrollrole'});
768: }
769: if ($data{'lti.selfenrollrole'}) {
1.32 raeburn 770: if (&Apache::ltiauth::lti_enroll($data{'username'},$data{'domain'},
1.28 raeburn 771: $data{'lti.selfenrollrole'}) eq 'ok') {
772: my $url = '/adm/roles?selectrole=1&'.
773: &escape($data{'lti.selfenrollrole'}).'=1';
774: if ($data{'origurl'} =~ m{/default_\d+\.sequence$}) {
775: $url .= '&orgurl='.$data{'origurl'}.'&navmap=1';
776: } elsif ($data{'origurl'} ne '') {
777: $url .= '&orgurl='.$data{'origurl'};
778: }
779: if (ref($lti_env) eq 'HASH') {
780: &Apache::lonnet::appenv($lti_env);
781: }
782: $r->internal_redirect($url);
783: } else {
784: &Apache::ltiauth::invalid_request($r,23);
785: }
786: } elsif ($data{'origurl'} ne '') {
787: my $url = $data{'origurl'};
788: if ($url =~ m{/default_\d+\.sequence$}) {
789: $url .= (($url =~/\?/)?'&':'?').'navmap=1';
790: }
791: if (ref($lti_env) eq 'HASH') {
792: &Apache::lonnet::appenv($lti_env);
1.27 raeburn 793: }
794: $r->internal_redirect($url);
795: } else {
1.28 raeburn 796: if (ref($lti_env) eq 'HASH') {
797: &Apache::lonnet::appenv($lti_env);
798: }
1.27 raeburn 799: }
800: }
801: } elsif ($data{'origurl'} ne '') {
1.14 raeburn 802: $r->internal_redirect($data{'origurl'});
803: } elsif ($env{'request.course.id'}) {
804: $r->internal_redirect('/adm/navmaps');
1.11 albertel 805: } else {
806: $r->internal_redirect('/adm/roles');
807: }
808: } else {
1.14 raeburn 809: my $desturl = '/adm/roles';
810: if ($data{'origurl'} ne '') {
811: $desturl = $data{'origurl'};
1.27 raeburn 812: if ($data{'lti.login'}) {
813: $desturl = $data{'origurl'};
814: if ($desturl =~ m{/default_\d+\.sequence$}) {
815: $desturl .= (($desturl =~/\?/)?'&':'?').'navmap=1';
816: }
817: }
1.42 raeburn 818: if ($data{'linkprot'}) {
819: my ($linkprotector,$linkuri) = split(/:/,$data{'linkprot'},2);
820: if ($linkprotector) {
821: if (ref($extra_env) eq 'HASH') {
822: $extra_env->{'user.linkprotector'} = $linkprotector;
823: $extra_env->{'user.linkproturi'} = $linkuri;
824: } else {
825: $extra_env = {'user.linkprotector' => $linkprotector,
826: 'user.linkproturi' => $linkuri,};
827: }
828: }
1.43 ! raeburn 829: } elsif ($data{'deeplink.login'}) {
! 830: if ($data{'linkkey'}) {
! 831: if (ref($extra_env) eq 'HASH') {
! 832: $extra_env->{'user.deeplinkkey'} = $data{'linkkey'};
! 833: $extra_env->{'user.keyedlinkuri'} = $data{'deeplink.login'},
! 834: } else {
! 835: $extra_env = {'user.deeplinkkey' => $data{'linkkey'},
! 836: 'user.keyedlinkuri' => $data{'deeplink.login'}};
! 837: }
! 838: }
! 839: if (ref($extra_env) eq 'HASH') {
! 840: $extra_env->{'request.deeplink.login' => $data{'deeplink.login'}};
! 841: } else {
! 842: $extra_env = {'request.deeplink.login' => $data{'deeplink.login'}};
! 843: }
1.42 raeburn 844: }
1.27 raeburn 845: }
846: my $skipcritical;
847: if (($data{'lti.login'}) && ($data{'lti.reqcrs'}) &&
848: ($data{'lti.reqrole'} eq 'cc')) {
849: $skipcritical = 1;
1.14 raeburn 850: }
1.11 albertel 851: &Apache::lonauth::success($r,$data{'username'},$data{'domain'},
1.27 raeburn 852: $home,$desturl,$extra_env,\%form,$skipcritical);
1.11 albertel 853: }
1.1 albertel 854: return OK;
855: }
1.6 albertel 856:
1.33 raeburn 857: my $next_url='/adm/roles?selectrole=1&'.&escape($data{'role'}).'=1';
1.15 raeburn 858: if ($data{'origurl'} ne '') {
1.33 raeburn 859: $next_url .= '&orgurl='.&escape($data{'origurl'});
1.30 raeburn 860: if ($data{'lti.login'}) {
1.31 raeburn 861: if (($data{'origurl'} =~ m{/default_\d+\.sequence$}) ||
862: ($data{'origurl'} =~ m{^/res/.+\.sequence$})) {
1.33 raeburn 863: $next_url .= '&navmap=1';
1.30 raeburn 864: }
865: }
1.15 raeburn 866: }
1.6 albertel 867: &Apache::lonauth::success($r,$data{'username'},$data{'domain'},$home,
1.16 raeburn 868: $next_url,$extra_env,\%form);
1.6 albertel 869: return OK;
1.1 albertel 870: }
871:
872: 1;
873: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to migrateuser.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / auth