File:
[LON-CAPA] /
loncom /
auth /
migrateuser.pm
Revision
1.43:
download - view:
text,
annotated -
select for diffs
Sun Jan 27 16:02:43 2019 UTC (5 years, 3 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
- Bug 6400
- Enforce access restrictions for content which is deeplink-only (users
with "advanced priv for current role are exempt).
- Support "key" link type in deeplink parameter (requested link must either
be sent with linkkey as element in POSTed data, or with linkkey in query
string). Corresponding value must match key set in deeplink parameter.
# The LearningOnline Network
# Starts a user off based of an existing token.
#
# $Id: migrateuser.pm,v 1.43 2019/01/27 16:02:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::migrateuser;
use strict;
use LONCAPA qw(:DEFAULT :match);
use Apache::Constants qw(:common :http :methods);
use Apache::lonauth;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
use Apache::lonlogin();
use Apache::ltiauth;
use Apache::switchserver;
use CGI::Cookie;
sub goto_login {
my ($r,$domain,$data) = @_;
if ((ref($data) eq 'HASH') && ($data->{'lti.login'})) {
&Apache::ltiauth::invalid_request($r,'22');
} else {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $url = '/adm/login';
if ($domain) {
$url .= '?domain='.$domain;
}
$r->print(&Apache::loncommon::start_page('Going to login',undef,
{'redirect' => [0,$url],}).
'<h1>'.&mt('One moment please...').'</h1>'.
'<p>'.&mt('Transferring to login page.').'</p>'.
&Apache::loncommon::end_page());
}
return OK;
}
sub sso_check {
my ($data) = @_;
my %extra_env;
if (ref($data) eq 'HASH') {
if ($data->{'sso.login'}) {
$extra_env{'request.sso.login'} = $data->{'sso.login'};
}
if ($data->{'sso.reloginserver'}) {
$extra_env{'request.sso.reloginserver'} =
$data->{'sso.reloginserver'};
}
if (($data->{'balancer'}) && ($data->{'server'}) && ($data->{'balcookie'})) {
$extra_env{'request.balancercookie'} = $data->{'server'}.':'.$data->{'balcookie'};
}
}
return \%extra_env;
}
sub lti_check {
my ($data) = @_;
my %lti_env;
if (ref($data) eq 'HASH') {
if ($data->{'lti.login'}) {
$lti_env{'request.lti.login'} = $data->{'lti.login'};
if ($data->{'lti.reqcrs'}) {
$lti_env{'request.lti.reqcrs'} = $data->{'lti.reqcrs'};
}
if ($data->{'lti.reqrole'}) {
$lti_env{'request.lti.reqrole'} = $data->{'lti.reqrole'};
}
if ($data->{'lti.selfenrollrole'}) {
$lti_env{'request.lti.selfenrollrole'} = $data->{'lti.selfenrollrole'};
}
if ($data->{'lti.uri'}) {
$lti_env{'request.lti.uri'} = $data->{'lti.uri'};
}
if ($data->{'lti.target'}) {
$lti_env{'request.lti.target'} = $data->{'lti.target'};
}
if ($data->{'lti.sourcecrs'}) {
$lti_env{'request.lti.sourcecrs'} = $data->{'lti.sourcecrs'};
}
}
if ($data->{'lti.passbackid'}) {
$lti_env{'request.lti.passbackid'} = $data->{'lti.passbackid'};
}
if ($data->{'lti.passbackurl'}) {
$lti_env{'request.lti.passbackurl'} = $data->{'lti.passbackurl'};
}
if ($data->{'lti.rosterid'}) {
$lti_env{'request.lti.rosterid'} = $data->{'lti.rosterid'};
}
if ($data->{'lti.rosterurl'}) {
$lti_env{'request.lti.rosterurl'} = $data->{'lti.rosterurl'};
}
}
return \%lti_env;
}
sub canhost {
my ($uname,$udom,$lonhost,$loncaparev) = @_;
my $canhost;
if (&Apache::lonnet::is_library($lonhost)) {
my @possdoms = &Apache::lonnet::current_machine_domains();
my %roleshash = &Apache::lonnet::get_my_roles($uname,$udom,'userroles','',['ca','aa'],\@possdoms);
if (keys(%roleshash)) {
foreach my $key (keys(%roleshash)) {
my $audom = (split(/:/,$key))[1];
if ((&Apache::lonnet::will_trust('othcoau',$udom,$audom)) &&
(&Apache::lonnet::will_trust('coaurem',$audom,$udom))) {
$canhost = 1;
last;
}
}
}
}
unless ($canhost) {
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
my @intdoms;
my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
if (ref($internet_names) eq 'ARRAY') {
@intdoms = @{$internet_names};
}
if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
$canhost = 1;
} else {
my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
$canhost =
&Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
$udomdefaults{'remotesessions'},
$defdomdefaults{'hostedsessions'});
}
}
return $canhost;
}
sub ip_changed {
my ($r,$udom,$camefrom,$idsref,$dataref) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if (ref($dataref) eq 'HASH') {
my $title = 'LON-CAPA Session redirected';
my $message = &mt('Your internet address has changed since you logged in.');
my $rule_in_effect;
if ($dataref->{'balancer'}) {
my $baldom = &Apache::lonnet::host_domain($camefrom);
my $balprimaryid = &Apache::lonnet::domain($baldom,'primary');
my $balintdom = &Apache::lonnet::internet_dom($balprimaryid);
my $uprimaryid = &Apache::lonnet::domain($udom,'primary');
my $uintdom = &Apache::lonnet::internet_dom($uprimaryid);
my $dom_in_use;
if (($uintdom ne '') && ($uintdom eq $balintdom)) {
$dom_in_use = $udom;
} else {
$dom_in_use = $baldom;
}
my ($result,$cached)=&Apache::lonnet::is_cached_new('loadbalancing',$dom_in_use);
unless (defined($cached)) {
my $cachetime = 60*60*24;
my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$result = &Apache::lonnet::do_cache_new('loadbalancing',$dom_in_use,
$domconfig{'loadbalancing'},$cachetime);
}
}
if (ref($result) eq 'HASH') {
(undef,my $currtargets,my $currrules) =
&Apache::lonnet::check_balancer_result($result,$dataref->{'server'});
if (ref($currrules) eq 'HASH') {
if ($dataref->{'sso.login'}) {
if ($currrules->{'_LC_ipchangesso'} ne '') {
$rule_in_effect = $currrules->{'_LC_ipchangesso'};
}
} else {
if ($currrules->{'_LC_ipchange'} ne '') {
$rule_in_effect = $currrules->{'_LC_ipchange'};
}
}
}
}
}
my $url;
my $lonhost= $r->dir_config('lonHostID');
my $switchto = $lonhost;
if ($rule_in_effect ne 'offloadedto') {
my ($hosthere,@ids);
if (ref($idsref) eq 'ARRAY') {
@ids=@{$idsref};
}
unless ($rule_in_effect eq 'balancer') {
if (grep(/^\Q$rule_in_effect\E$/,@ids)) {
$hosthere = 1;
}
}
unless ($hosthere) {
if ($dataref->{'role'}) {
my ($adom,$aname);
if ($dataref->{'role'} =~ m{^au\./($match_domain)/$}) {
$adom = $1;
$aname = $dataref->{'username'};
} elsif ($dataref->{'role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)$}) {
$adom = $1;
$aname = $2;
}
if ($adom ne '' && $aname ne '') {
my $ahome = &Apache::lonnet::homeserver($aname,$adom);
unless ($ahome eq 'no_host') {
if ($ahome && grep(/^\Q$ahome\E$/,@ids)) {
$hosthere = 1;
}
}
}
}
}
unless ($hosthere) {
my $hostname;
if ($rule_in_effect eq 'balancer') {
$hostname = &Apache::lonnet::hostname($dataref->{'server'});
if ($hostname) {
$switchto = $dataref->{'server'};
}
} else {
$hostname = &Apache::lonnet::hostname($rule_in_effect);
if ($hostname) {
$switchto = $rule_in_effect;
}
}
if ($hostname) {
my $protocol = $Apache::lonnet::protocol{$switchto};
$protocol = 'http' if ($protocol ne 'https');
$url = $protocol.'://'.$hostname;
if ($rule_in_effect eq 'balancer') {
$message .= '<br />'.
&mt('As a result, your LON-CAPA session is being redirected to the server where you originally logged in.');
} else {
$message .= '<br />'.
&mt('As a result, your LON-CAPA session is being redirected.');
}
}
}
unless ($hosthere) {
if (($dataref->{'balancer'}) && ($dataref->{'balcookie'})) {
&Apache::lonnet::delbalcookie($dataref->{'balcookie'},$dataref->{'balancer'});
}
}
}
if ($dataref->{'sso.login'}) {
$url .= '/adm/roles';
} else {
$url .= '/adm/login';
if ($udom) {
$url .= '?domain='.$udom;
}
$message .= '<br />'.&mt('You will need to provide your password one more time.');
}
my %info= (
'domain' => $udom,
'username' => $dataref->{'username'},
'role' => $dataref->{'role'},
'sessionserver' => $lonhost,
);
if ($dataref->{'origurl'}) {
$info{'origurl'} = $dataref->{'origurl'};
}
if ($dataref->{'symb'}) {
$info{'symb'} = $dataref->{'symb'};
}
my $iptoken = &Apache::lonnet::tmpput(\%info,$switchto);
unless ($iptoken eq 'conlost') {
$url .= ($url =~ /\?/) ? '&' : '?';
$url .= 'iptoken='.$iptoken;
}
$r->print(&Apache::loncommon::start_page($title,undef,
{'redirect' =>
[2,$url],}).
'<h1>'.&mt('One moment please...').'</h1>'.
'<p class="LC_warning">'.$message.'</p>'.
&Apache::loncommon::end_page());
} else {
return &goto_login($r);
}
return OK;
}
sub logout {
my ($r,$handle,$data,$lti_env) = @_;
my $lonidsdir=$r->dir_config('lonIDsDir');
if (unlink("$lonidsdir/$handle.id")) {
if (($env{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
(-l "$lonidsdir/$env{'user.linkedenv'}.id") &&
(readlink("$lonidsdir/$env{'user.linkedenv'}.id") eq "$lonidsdir/$handle.id")) {
unlink("$lonidsdir/$env{'user.linkedenv'}.id");
}
}
my %temp=('logout' => time);
&Apache::lonnet::put('email_status',\%temp);
&Apache::lonnet::log($env{'user.domain'},
$env{'user.name'},
$env{'user.home'},
"Logout $ENV{'REMOTE_ADDR'}");
&Apache::loncommon::content_type($r,'text/html');
#expire the cookies
my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
foreach my $name (keys(%cookies)) {
next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
my $c = new CGI::Cookie(-name => $name,
-value => '',
-expires => '-10y',);
$r->headers_out->add('Set-cookie' => $c);
}
my (%info,%user_info,%lti_info);
if (ref($lti_env) eq 'HASH') {
%lti_info = %{$lti_env};
}
my $lonhost = $r->dir_config('lonHostID');
if (ref($data) eq 'HASH') {
%user_info=('ip' => $ENV{'REMOTE_ADDR'},
'domain' => $data->{'domain'},
'username' => $data->{'username'},
'home' => $data->{'home'},
'role' => $data->{'role'},
'origurl' => $data->{'origurl'},
'symb' => $data->{'symb'},
'server' => $lonhost);
}
%info = (%user_info,%lti_info);
my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
my $url = '/adm/migrateuser?token='.$token;
$r->send_http_header;
$r->print(
&Apache::loncommon::start_page('Updating Session ...',undef,
{'redirect' => [0.1,$url],
'only_body' => 1,}).
&Apache::loncommon::end_page());
$r->register_cleanup(\&flush_course_logs);
return;
}
sub conlost_userhome {
my ($r,$idsref,$dataref) = @_;
return unless ((ref($idsref) eq 'ARRAY') && (ref($dataref) eq 'HASH'));
my @ids = @{$idsref};
my %data = %{$dataref};
my ($lonhost,$lowest_load,$otherserver,$is_balancer,%conlost,%posstargets);
$lonhost = $r->dir_config('lonHostID');
if (grep(/^\Q$lonhost\E$/,split(/,/,$data{'dom_balancers'}))) {
$is_balancer = 1;
}
$lowest_load = 30000;
if ($data{'conlost'} ne '') {
map { $conlost{$_} = 1; } split(/,/,$data{'conlost'});
}
if ($data{'loncfail'}) {
if ($lonhost ne $data{'from_balancer'}) {
my ($is_balancer,$posshost,$setcookie,$offloadto,$dom_balancers) =
&Apache::lonnet::check_loadbalancing($data{'username'},$data{'domain'});
if ($is_balancer) {
if (ref($offloadto) eq 'HASH') {
$data{'offloadto'} = '';
foreach my $key (keys(%{$offloadto})) {
if (ref($offloadto->{$key}) eq 'ARRAY') {
$data{'offloadto'} .= $key.'='.join(',',@{$offloadto->{$key}}).'&';
}
}
$data{'offloadto'} =~ s/\&$//;
} elsif (ref($offloadto) eq 'ARRAY') {
$data{'offloadto'} = join(',',@{$offloadto});
}
}
}
} else {
$conlost{$lonhost} = 1;
$data{'conlost'} = join(',',sort(keys(%conlost)));
}
if ($data{'offloadto'} =~ /\&/) {
foreach my $item (split(/\&/,$data{'offloadto'})) {
my ($type,$targets) = split(/\=/,$item);
@{$posstargets{$type}} = split(/,/,$targets);
}
} elsif ($data{'offloadto'} =~ /=/) {
my ($type,$targets) = split(/\=/,$data{'offloadto'});
@{$posstargets{$type}} = split(/,/,$targets);
} else {
@{$posstargets{'default'}} = split(/,/,$data{'offloadto'});
}
if (ref($posstargets{'primary'}) eq 'ARRAY') {
foreach my $try_server (@{$posstargets{'primary'}}) {
next if ($conlost{$try_server});
next if ((grep(/^\Q$try_server\E$/,@ids)) && !$data{'loncfail'});
($otherserver,$lowest_load) =
&Apache::lonnet::compare_server_load($try_server,
$otherserver,
$lowest_load);
}
}
my $found_server = ($otherserver ne '' && $lowest_load < 100);
if (!$found_server) {
if (ref($posstargets{'default'}) eq 'ARRAY') {
foreach my $try_server (@{$posstargets{'default'}}) {
next if ($conlost{$try_server});
next if ((grep(/^\Q$try_server\E$/,@ids)) && !$data{'loncfail'});
($otherserver,$lowest_load) =
&Apache::lonnet::compare_server_load($try_server,
$otherserver,
$lowest_load);
}
}
}
if ($otherserver ne '') {
my $switchto = &Apache::lonnet::hostname($otherserver);
if ($switchto ne '') {
$data{'server'} = $lonhost;
if ($data{'loncfail'}) {
delete($data{'loncfail'});
}
if (grep(/^\Q$otherserver\E$/,split(/,/,$data{'dom_balancers'}))) {
$data{'noloadbalance'} = $otherserver;
}
&do_server_switch($r,$otherserver,$switchto,$is_balancer,\%data);
return $otherserver;
} else {
#FIXME Contents of $data{offloadto} contains invalid hostID.
}
} else {
my (%poss_balancers,%tried_balancers);
map { $poss_balancers{$_} = 1; } split(/,/,$data{'dom_balancers'});
map { $tried_balancers{$_} = 1; } split(/,/,$data{'tried_balancers'});
if (keys(%poss_balancers)) {
foreach my $try_server (sort(keys(%poss_balancers))) {
next if (grep(/^\Q$try_server\E$/,@ids));
next if (($data{'loncfail'}) && ($tried_balancers{$try_server}));
my $alreadytried;
foreach my $key (keys(%posstargets)) {
if ((ref($posstargets{$key}) eq 'ARRAY') &&
(grep(/^\Q$try_server\E$/,@{$posstargets{$key}}))) {
$alreadytried = 1;
last;
}
}
unless ($alreadytried) {
if (&Apache::lonnet::reply('ping',$try_server) eq $try_server) {
$otherserver = $try_server;
last;
}
}
}
}
if ($otherserver ne '') {
my $switchto = &Apache::lonnet::hostname($otherserver);
if ($switchto ne '') {
$data{'server'} = $lonhost;
$data{'loncfail'} = $lonhost;
$tried_balancers{$otherserver} = 1;
$data{'tried_balancers'} = join(',',sort(keys(%tried_balancers)));
&do_server_switch($r,$otherserver,$switchto,$is_balancer,\%data);
return $otherserver;
} else {
#FIXME Contents of $data{'dom_balancers'} contains invalid hostID.
}
} else {
if ($data{'loncfail'}) {
#FIXME Nowhere to go.
} else {
# FIXME Send back to a balancer (no token); different balancer if this is a balancer.
# Send command to balancer to exclude this host using http instead on lonc/lond
}
}
}
return;
}
sub do_server_switch {
my ($r,$otherserver,$switchto,$is_balancer,$dataref) = @_;
if (ref($dataref) eq 'HASH') {
my $domain = $dataref->{'domain'};
my $username = $dataref->{'username'};
# If this is a balancer set a balancer cookie unless browser already sent
# LON-CAPA load balancer cookie which points at the target server.
if ($is_balancer) {
my $newcookieid;
my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
unless (($found_server eq $otherserver) &&
($balancer_cookie =~ /^\Q$domain\E_\Q$username\E_/)) {
$newcookieid =
&Apache::switchserver::balancer_cookieid($r,$otherserver,$username,$domain);
if ($newcookieid) {
$dataref->{'balcookie'} = $newcookieid;
}
}
}
my $token = &Apache::lonnet::tmpput($dataref,$otherserver);
my $protocol = $Apache::lonnet::protocol{$otherserver};
$protocol = 'http' if ($protocol ne 'https');
my $url = $protocol.'://'.$switchto.'/adm/login?domain='.$domain.
'&username='.$username.'&token='.$token;
$r->send_http_header;
$r->print(
&Apache::loncommon::start_page('Switching Server ...',undef,
{'redirect' => [0.1,$url]}).
&Apache::loncommon::end_page());
}
return;
}
sub log_switch {
my ($r,$data,$lti_env) = @_;
my $lonhost = $r->dir_config('lonHostID');
return unless ((ref($data) eq 'HASH') && (ref($lti_env) eq 'HASH'));
my $now = time;
my %temp=('switchserver' => $now.':'.$lonhost,$data->{'role'});
&Apache::lonnet::put('email_status',\%temp);
my $logmsg = "Switch Server to $lonhost";
if ($data->{'role'}) {
$logmsg .= " with role: ".$data->{'role'};
} elsif (($lti_env->{'reqcrs'}) && ($lti_env->{'reqrole'} eq 'cc')) {
$logmsg .= " to create new LTI course";
} elsif ($lti_env->{'selfenrollrole'}) {
$logmsg .= " to selfenroll with role: ".$lti_env->{'selfenrollrole'};
} else {
$logmsg .= " (no role)";
}
$logmsg .= ' '.$ENV{'REMOTE_ADDR'};
&Apache::lonnet::log($data->{'domain'},$data->{'username'},$data->{'home'},$logmsg);
}
sub flush_course_logs {
&Apache::lonnet::flushcourselogs();
return OK;
}
sub handler {
my ($r) = @_;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['token']);
my %data = &Apache::lonnet::tmpget($env{'form.token'});
if (keys(%data) == 0) {
return &goto_login($r);
}
my $delete = &Apache::lonnet::tmpdel($env{'form.token'});
&Apache::lonlocal::get_language_handle($r);
if ($delete ne 'ok') {
return &goto_login($r,undef,\%data);
}
if (!defined($data{'username'}) || !defined($data{'domain'})) {
return &goto_login($r,undef,\%data);
}
my ($home,@ids);
@ids=&Apache::lonnet::current_machine_ids();
if ($data{'ip'} ne $ENV{'REMOTE_ADDR'}) {
&Apache::lonnet::logthis('IP change when session migration requested -- was: '.
$data{'ip'}.'; now: '.$ENV{'REMOTE_ADDR'}.' for '.$data{'username'}.':'.$data{'domain'});
return &ip_changed($r,$data{'domain'},$data{'server'},\@ids,\%data);
}
if ($data{'loncfail'}) {
&Apache::lonnet::logthis('Returned from '.$data{'server'}.' -- no connection to library node or other access node(s)');
my $otherserver = &conlost_userhome($r,\@ids,\%data);
if ($otherserver ne '') {
&Apache::lonnet::logthis("Switching to $otherserver");
}
return OK;
} else {
$home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
if ($home eq 'no_host') {
if (($data{'home'} ne '') && (&Apache::lonnet::hostname($data{'home'}))) {
&Apache::lonnet::reconlonc($data{'home'});
$home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
if ($home eq 'no_host') {
unless (grep(/^\Q$data{'home'}\E$/,@ids)) {
if (&Apache::lonnet::reply('ping',$data{'home'}) eq 'con_lost') {
my $otherserver = &conlost_userhome($r,\@ids,\%data);
if ($otherserver ne '') {
&Apache::lonnet::logthis("No connection to home server ($data{'home'}) for $data{'username'}:$data{'domain'}. Switching to $otherserver");
}
return OK;
}
}
}
}
}
}
my $udom;
if (&Apache::lonnet::domain($data{'domain'})) {
$udom=$data{'domain'};
}
if ($home eq 'no_host') { return &goto_login($r,$udom,\%data); }
if (&Apache::lonnet::hostname($home) eq '') { return &goto_login($r,$udom,\%data); }
unless (grep(/^\Q$home\E$/,@ids)) {
my $lonhost = $r->dir_config('lonHostID');
my $loncaparev = $r->dir_config('lonVersion');
unless (&canhost($data{'username'},$data{'domain'},$lonhost,$loncaparev)) {
return &goto_login($r,$udom,\%data);
}
}
my $rolemsg;
if ($data{'role'}) {
$rolemsg = "role: $data{'role'}";
} else {
$rolemsg = '(no role)';
}
&Apache::lonnet::logthis("Allowing access for $data{'username'}:$data{'domain'} $rolemsg");
my $sso_env = &sso_check(\%data);
my $lti_env = <i_check(\%data);
my $extra_env;
if ((ref($sso_env) eq 'HASH') && (keys(%{$sso_env}))) {
$extra_env = $sso_env;
} elsif ((ref($lti_env) eq 'HASH') && (keys(%{$lti_env}))) {
$extra_env = $lti_env;
}
if (($data{'conlost'}) && ($data{'server'})) {
my @conlosts = split(/,/,$data{'conlost'});
my $switchfrom = $data{'server'};
if (@conlosts) {
if (grep(/^\Q$switchfrom\E$/,@conlosts)) {
&log_switch($r,\%data,$extra_env);
}
}
}
my %form;
if ($data{'symb'} ne '') {
$form{'symb'} = $data{'symb'};
}
if ($data{'iptoken'} ne '') {
$form{'iptoken'} = $data{'iptoken'};
}
if ($data{'noloadbalance'} ne '') {
$form{'noloadbalance'} = $data{'noloadbalance'};
}
if (!$data{'role'}) {
my $handle = &Apache::lonnet::check_for_valid_session($r);
if ($handle) {
&Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'),
$handle);
if ($data{'linkprot'} ne '') {
my ($linkprotector,$deeplink) = split(/:/,$data{'linkprot'},2);
if ($deeplink ne '') {
&Apache::lonnet::appenv({'request.deeplink.login' => $deeplink});
}
if ($env{'user.linkprotector'}) {
my @protectors = split(/,/,$env{'user.linkprotector'});
unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
push(@protectors,$linkprotector);
@protectors = sort { $a <=> $b } @protectors;
&Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
}
} else {
&Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
}
if ($env{'user.linkproturi'}) {
my @proturis = split(/,/,$env{'user.linkproturi'});
unless(grep(/^\Q$deeplink\E$/,@proturis)) {
push(@proturis,$deeplink);
@proturis = sort @proturis;
&Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
}
} else {
&Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
}
} elsif ($data{'deeplink.login'}) {
my $deeplink = $data{'deeplink.login'};
if ($data{'linkkey'}) {
my $linkkey = $data{'linkkey'};
if ($env{'user.deeplinkkey'}) {
my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
push(@linkkeys,$linkkey);
&Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
}
} else {
&Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
}
if ($env{'user.keyedlinkuri'}) {
my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
push(@keyeduris,$deeplink);
&Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
}
} else {
&Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
}
}
&Apache::lonnet::appenv({'request.deeplink.login' => $data{'deeplink.login'}});
}
if ($data{'lti.login'}) {
my $needslogout;
if ($env{'request.lti.login'}) {
if (($env{'user.name'} ne $data{'username'}) ||
($env{'user.domain'} ne $data{'domain'})) {
$needslogout = 1;
}
} else {
$needslogout = 1;
}
# If access is via LTI, and user already has a non-LTI session cookie
# (and session) or has an LTI session cookie for a different username,
# logout the existing session, and start a new one
if ($needslogout) {
&logout($r,$handle,\%data,$lti_env);
} elsif (($data{'lti.reqcrs'}) && ($data{'lti.reqrole'} eq 'cc')) {
$form{'lti.reqcrs'} = $data{'lti.reqcrs'};
$form{'lti.reqrole'} = $data{'lti.reqrole'};
$form{'lti.sourcecrs'} = $data{'lti.sourcecrs'};
$form{'lti.uri'} = $data{'lti.uri'};
if ($data{'lti.passbackid'}) {
$form{'lti.passbackid'} = $data{'lti.passbackid'};
}
if ($data{'lti.passbackurl'}) {
$form{'lti.passbackurl'} = $data{'lti.passbackurl'};
}
if ($data{'lti.rosterid'}) {
$form{'lti.rosterid'} = $data{'lti.rosterid'};
}
if ($data{'lti.rosterurl'}) {
$form{'lti.rosterurl'} = $data{'lti.rosterurl'};
}
if ($data{'lti.target'}) {
$form{'lti.target'} = $data{'lti.target'};
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::ltiauth::lti_reqcrs($r,$data{'domain'},\%form,$data{'username'},$data{'domain'});
} else {
if (ref($lti_env) eq 'HASH') {
delete($lti_env->{'reqcrs'});
delete($lti_env->{'reqrole'});
delete($lti_env->{'selfenrollrole'});
}
if ($data{'lti.selfenrollrole'}) {
if (&Apache::ltiauth::lti_enroll($data{'username'},$data{'domain'},
$data{'lti.selfenrollrole'}) eq 'ok') {
my $url = '/adm/roles?selectrole=1&'.
&escape($data{'lti.selfenrollrole'}).'=1';
if ($data{'origurl'} =~ m{/default_\d+\.sequence$}) {
$url .= '&orgurl='.$data{'origurl'}.'&navmap=1';
} elsif ($data{'origurl'} ne '') {
$url .= '&orgurl='.$data{'origurl'};
}
if (ref($lti_env) eq 'HASH') {
&Apache::lonnet::appenv($lti_env);
}
$r->internal_redirect($url);
} else {
&Apache::ltiauth::invalid_request($r,23);
}
} elsif ($data{'origurl'} ne '') {
my $url = $data{'origurl'};
if ($url =~ m{/default_\d+\.sequence$}) {
$url .= (($url =~/\?/)?'&':'?').'navmap=1';
}
if (ref($lti_env) eq 'HASH') {
&Apache::lonnet::appenv($lti_env);
}
$r->internal_redirect($url);
} else {
if (ref($lti_env) eq 'HASH') {
&Apache::lonnet::appenv($lti_env);
}
}
}
} elsif ($data{'origurl'} ne '') {
$r->internal_redirect($data{'origurl'});
} elsif ($env{'request.course.id'}) {
$r->internal_redirect('/adm/navmaps');
} else {
$r->internal_redirect('/adm/roles');
}
} else {
my $desturl = '/adm/roles';
if ($data{'origurl'} ne '') {
$desturl = $data{'origurl'};
if ($data{'lti.login'}) {
$desturl = $data{'origurl'};
if ($desturl =~ m{/default_\d+\.sequence$}) {
$desturl .= (($desturl =~/\?/)?'&':'?').'navmap=1';
}
}
if ($data{'linkprot'}) {
my ($linkprotector,$linkuri) = split(/:/,$data{'linkprot'},2);
if ($linkprotector) {
if (ref($extra_env) eq 'HASH') {
$extra_env->{'user.linkprotector'} = $linkprotector;
$extra_env->{'user.linkproturi'} = $linkuri;
} else {
$extra_env = {'user.linkprotector' => $linkprotector,
'user.linkproturi' => $linkuri,};
}
}
} elsif ($data{'deeplink.login'}) {
if ($data{'linkkey'}) {
if (ref($extra_env) eq 'HASH') {
$extra_env->{'user.deeplinkkey'} = $data{'linkkey'};
$extra_env->{'user.keyedlinkuri'} = $data{'deeplink.login'},
} else {
$extra_env = {'user.deeplinkkey' => $data{'linkkey'},
'user.keyedlinkuri' => $data{'deeplink.login'}};
}
}
if (ref($extra_env) eq 'HASH') {
$extra_env->{'request.deeplink.login' => $data{'deeplink.login'}};
} else {
$extra_env = {'request.deeplink.login' => $data{'deeplink.login'}};
}
}
}
my $skipcritical;
if (($data{'lti.login'}) && ($data{'lti.reqcrs'}) &&
($data{'lti.reqrole'} eq 'cc')) {
$skipcritical = 1;
}
&Apache::lonauth::success($r,$data{'username'},$data{'domain'},
$home,$desturl,$extra_env,\%form,$skipcritical);
}
return OK;
}
my $next_url='/adm/roles?selectrole=1&'.&escape($data{'role'}).'=1';
if ($data{'origurl'} ne '') {
$next_url .= '&orgurl='.&escape($data{'origurl'});
if ($data{'lti.login'}) {
if (($data{'origurl'} =~ m{/default_\d+\.sequence$}) ||
($data{'origurl'} =~ m{^/res/.+\.sequence$})) {
$next_url .= '&navmap=1';
}
}
}
&Apache::lonauth::success($r,$data{'username'},$data{'domain'},$home,
$next_url,$extra_env,\%form);
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>