version 1.1457, 2021/06/06 23:18:59
|
version 1.1466, 2021/09/22 13:52:02
|
Line 468 sub reply {
|
Line 468 sub reply {
|
my $subcmd = $1; |
my $subcmd = $1; |
if (($subcmd eq 'auth') || ($subcmd eq 'passwd') || |
if (($subcmd eq 'auth') || ($subcmd eq 'passwd') || |
($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) { |
($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades') || |
|
($subcmd eq 'put')) { |
(undef,undef,my @rest) = split(/:/,$cmd); |
(undef,undef,my @rest) = split(/:/,$cmd); |
if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) { |
if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) { |
splice(@rest,2,1,'Hidden'); |
splice(@rest,2,1,'Hidden'); |
} elsif ($subcmd eq 'passwd') { |
} elsif ($subcmd eq 'passwd') { |
splice(@rest,2,2,('Hidden','Hidden')); |
splice(@rest,2,2,('Hidden','Hidden')); |
} elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
} elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || |
($subcmd eq 'autoexportgrades')) { |
($subcmd eq 'autoexportgrades') || ($subcmd eq 'put')) { |
splice(@rest,3,1,'Hidden'); |
splice(@rest,3,1,'Hidden'); |
} |
} |
$logged = join(':',('encrypt:'.$subcmd,@rest)); |
$logged = join(':',('encrypt:'.$subcmd,@rest)); |
Line 2146 sub dump_dom {
|
Line 2147 sub dump_dom {
|
# ------------------------------------------ get items from domain db files |
# ------------------------------------------ get items from domain db files |
|
|
sub get_dom { |
sub get_dom { |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my ($namespace,$storearr,$udom,$uhome,$encrypt)=@_; |
return if ($udom eq 'public'); |
return if ($udom eq 'public'); |
my $items=''; |
my $items=''; |
foreach my $item (@$storearr) { |
foreach my $item (@$storearr) { |
Line 2172 sub get_dom {
|
Line 2173 sub get_dom {
|
my $rep; |
my $rep; |
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
# domain information is hosted on this machine |
# domain information is hosted on this machine |
my $cmd = 'getdom'; |
$rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items"); |
if ($namespace =~ /^enc/) { |
|
$cmd = 'egetdom'; |
|
} |
|
$rep = &LONCAPA::Lond::get_dom("$cmd:$udom:$namespace:$items"); |
|
} else { |
} else { |
if ($namespace =~ /^enc/) { |
if ($encrypt) { |
$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); |
$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome); |
} else { |
} else { |
$rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
$rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
Line 2206 sub get_dom {
|
Line 2203 sub get_dom {
|
# -------------------------------------------- put items in domain db files |
# -------------------------------------------- put items in domain db files |
|
|
sub put_dom { |
sub put_dom { |
my ($namespace,$storehash,$udom,$uhome)=@_; |
my ($namespace,$storehash,$udom,$uhome,$encrypt)=@_; |
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
Line 2227 sub put_dom {
|
Line 2224 sub put_dom {
|
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
if ($namespace =~ /^enc/) { |
if ($encrypt) { |
return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); |
return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome); |
} else { |
} else { |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
Line 7117 sub unserialize {
|
Line 7114 sub unserialize {
|
# see Lond::dump_with_regexp |
# see Lond::dump_with_regexp |
# if $escapedkeys hash keys won't get unescaped. |
# if $escapedkeys hash keys won't get unescaped. |
sub dump { |
sub dump { |
my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_; |
my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys,$encrypt)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
Line 7133 sub dump {
|
Line 7130 sub dump {
|
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
return %{unserialize($reply, $escapedkeys)}; |
return %{unserialize($reply, $escapedkeys)}; |
} |
} |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my $rep; |
|
if ($encrypt) { |
|
$rep=&reply("encrypt:edump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
|
} else { |
|
$rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
|
} |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
if (!($rep =~ /^error/ )) { |
if (!($rep =~ /^error/ )) { |
Line 7280 sub inc {
|
Line 7282 sub inc {
|
# --------------------------------------------------------------- put interface |
# --------------------------------------------------------------- put interface |
|
|
sub put { |
sub put { |
my ($namespace,$storehash,$udomain,$uname)=@_; |
my ($namespace,$storehash,$udomain,$uname,$encrypt)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
Line 7289 sub put {
|
Line 7291 sub put {
|
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
if ($encrypt) { |
|
return &reply("encrypt:put:$udomain:$uname:$namespace:$items",$uhome); |
|
} else { |
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
|
} |
} |
} |
|
|
# ------------------------------------------------------------ newput interface |
# ------------------------------------------------------------ newput interface |
Line 8117 sub customaccess {
|
Line 8123 sub customaccess {
|
# ------------------------------------------------- Check for a user privilege |
# ------------------------------------------------- Check for a user privilege |
|
|
sub allowed { |
sub allowed { |
my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_; |
my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_; |
my $ver_orguri=$uri; |
my $ver_orguri=$uri; |
$uri=&deversion($uri); |
$uri=&deversion($uri); |
my $orguri=$uri; |
my $orguri=$uri; |
Line 8342 sub allowed {
|
Line 8348 sub allowed {
|
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
my $deeplinkblock = &deeplink_check($priv,$symb,$uri); |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$uri); |
|
} |
if ($deeplinkblock) { |
if ($deeplinkblock) { |
$thisallowed='D'; |
$thisallowed='D'; |
} elsif ($noblockcheck) { |
} elsif ($noblockcheck) { |
Line 8365 sub allowed {
|
Line 8374 sub allowed {
|
$refuri=&declutter($refuri); |
$refuri=&declutter($refuri); |
my ($match) = &is_on_map($refuri); |
my ($match) = &is_on_map($refuri); |
if ($match) { |
if ($match) { |
my $deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
|
} |
if ($deeplinkblock) { |
if ($deeplinkblock) { |
$thisallowed='D'; |
$thisallowed='D'; |
} elsif ($noblockcheck) { |
} elsif ($noblockcheck) { |
Line 8441 sub allowed {
|
Line 8453 sub allowed {
|
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
if ($noblockcheck) { |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$uri); |
|
} |
|
if ($deeplinkblock) { |
|
$thisallowed = 'D'; |
|
} elsif ($noblockcheck) { |
$thisallowed.=$value; |
$thisallowed.=$value; |
} else { |
} else { |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache); |
Line 8483 sub allowed {
|
Line 8501 sub allowed {
|
=~/\Q$priv\E\&([^\:]*)/) { |
=~/\Q$priv\E\&([^\:]*)/) { |
my $value = $1; |
my $value = $1; |
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
my $deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
my $deeplinkblock; |
|
unless ($nodeeplinkcheck) { |
|
$deeplinkblock = &deeplink_check($priv,$symb,$refuri); |
|
} |
if ($deeplinkblock) { |
if ($deeplinkblock) { |
$thisallowed = 'D'; |
$thisallowed = 'D'; |
} elsif ($noblockcheck) { |
} elsif ($noblockcheck) { |
Line 8666 sub allowed {
|
Line 8687 sub allowed {
|
} |
} |
} |
} |
|
|
|
# Restricted for deeplinked session? |
|
|
|
if ($env{'request.deeplink.login'}) { |
|
if ($env{'acc.deeplinkout'} && !$nodeeplinkout) { |
|
if (!$symb) { $symb=&symbread($uri,1); } |
|
if (($symb) && ($env{'acc.deeplinkout'}=~/\&\Q$symb\E\&/)) { |
|
return ''; |
|
} |
|
} |
|
} |
|
|
# Restricted by state or randomout? |
# Restricted by state or randomout? |
|
|
if ($thisallowed=~/X/) { |
if ($thisallowed=~/X/) { |
Line 9023 sub deeplink_check {
|
Line 9055 sub deeplink_check {
|
@symbs = keys(%possibles); |
@symbs = keys(%possibles); |
} |
} |
|
|
my ($login,$switchrole,$allow); |
my ($deeplink_symb,$allow); |
if ($env{'request.deeplink.login'} =~ m{^\Q/tiny/$cdom/\E(\w+)$}) { |
if ($env{'request.deeplink.login'}) { |
my $key = $1; |
$deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom); |
my $tinyurl; |
|
my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); |
|
if (defined($cached)) { |
|
$tinyurl = $result; |
|
} else { |
|
my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); |
|
my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); |
|
if ($currtiny{$key} ne '') { |
|
$tinyurl = $currtiny{$key}; |
|
&Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); |
|
} |
|
} |
|
if ($tinyurl ne '') { |
|
my ($cnumreq,$posslogin) = split(/\&/,$tinyurl); |
|
if ($cnumreq eq $cnum) { |
|
$login = $posslogin; |
|
} else { |
|
$switchrole = 1; |
|
} |
|
} |
|
} |
} |
foreach my $symb (@symbs) { |
foreach my $symb (@symbs) { |
last if ($allow); |
last if ($allow); |
Line 9053 sub deeplink_check {
|
Line 9065 sub deeplink_check {
|
if ($deeplink eq '') { |
if ($deeplink eq '') { |
$allow = 1; |
$allow = 1; |
} else { |
} else { |
my ($listed,$scope,$access) = split(/,/,$deeplink); |
my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink); |
if ($access eq 'any') { |
if ($state ne 'only') { |
$allow = 1; |
$allow = 1; |
} elsif ($login) { |
} else { |
if ($access eq 'only') { |
my $check_deeplink_entry; |
|
if ($protect ne 'none') { |
|
my ($acctype,$item) = split(/:/,$protect); |
|
if (($acctype eq 'ltic') && ($env{'user.linkprotector'})) { |
|
if (grep(/^\Q$item\Ec$/,split(/,/,$env{'user.linkprotector'}))) { |
|
$check_deeplink_entry = 1 |
|
} |
|
} elsif (($acctype eq 'ltid') && ($env{'user.linkprotector'})) { |
|
if (grep(/^\Q$item\Ed$/,split(/,/,$env{'user.linkprotector'}))) { |
|
$check_deeplink_entry = 1; |
|
} |
|
} elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) { |
|
if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) { |
|
$check_deeplink_entry = 1; |
|
} |
|
} |
|
} |
|
if (($protect eq 'none') || ($check_deeplink_entry)) { |
if ($scope eq 'res') { |
if ($scope eq 'res') { |
if ($symb eq $login) { |
if ($symb eq $deeplink_symb) { |
$allow = 1; |
$allow = 1; |
} |
} |
} elsif ($scope eq 'map') { |
} elsif (($scope eq 'map') || ($scope eq 'rec')) { |
#FIXME Compare map for $env{'request.deeplink.login'} with map for $symb |
my ($map_from_symb,$map_from_login); |
} elsif ($scope eq 'rec') { |
$map_from_symb = &deversion((&decode_symb($symb))[0]); |
#FIXME Recurse up for $env{'request.deeplink.login'} with map for $symb |
if ($deeplink_symb =~ /\.(page|sequence)$/) { |
} |
$map_from_login = &deversion((&decode_symb($deeplink_symb))[2]); |
} else { |
} else { |
my ($acctype,$item) = split(/:/,$access); |
$map_from_login = &deversion((&decode_symb($deeplink_symb))[0]); |
if (($acctype eq 'lti') && ($env{'user.linkprotector'})) { |
|
if (grep(/^\Q$item\E$/,split(/,/,$env{'user.linkprotector'}))) { |
|
my %tinyurls = &get('tiny',[$symb],$cdom,$cnum); |
|
if (grep(/\Q$tinyurls{$symb}\E$/,split(/,/,$env{'user.linkproturis'}))) { |
|
$allow = 1; |
|
} |
|
} |
} |
} elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) { |
if (($map_from_symb) && ($map_from_login)) { |
if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) { |
if ($map_from_symb eq $map_from_login) { |
my %tinyurls = &get('tiny',[$symb],$cdom,$cnum); |
|
if (grep(/\Q$tinyurls{$symb}\E$/,split(/,/,$env{'user.keyedlinkuri'}))) { |
|
$allow = 1; |
$allow = 1; |
|
} elsif ($scope eq 'rec') { |
|
my @recurseup = &get_map_hierarchy($map_from_symb,$env{'request.course.id'}); |
|
if (grep(/^\Q$map_from_login\E$/,@recurseup)) { |
|
$allow = 1; |
|
} |
} |
} |
} |
} |
} |
} |
Line 9776 sub auto_validate_class_sec {
|
Line 9802 sub auto_validate_class_sec {
|
return $response; |
return $response; |
} |
} |
|
|
|
sub auto_instsec_reformat { |
|
my ($cdom,$action,$instsecref) = @_; |
|
return unless(($action eq 'clutter') || ($action eq 'declutter')); |
|
my @homeservers; |
|
if (defined(&domain($cdom,'primary'))) { |
|
push(@homeservers,&domain($cdom,'primary')); |
|
} else { |
|
my %servers = &get_servers($cdom,'library'); |
|
foreach my $tryserver (keys(%servers)) { |
|
if (!grep(/^\Q$tryserver\E$/,@homeservers)) { |
|
push(@homeservers,$tryserver); |
|
} |
|
} |
|
} |
|
my $response; |
|
my %reformatted = %{$instsecref}; |
|
foreach my $server (@homeservers) { |
|
if (ref($instsecref) eq 'HASH') { |
|
my $info = &freeze_escape($instsecref); |
|
my $response=&reply('autoinstsecreformat:'.$cdom.':'. |
|
$action.':'.$info,$server); |
|
next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/); |
|
my @items = split(/&/,$response); |
|
foreach my $item (@items) { |
|
my ($key,$value) = split(/=/,$item); |
|
$reformatted{&unescape($key)} = &thaw_unescape($value); |
|
} |
|
} |
|
} |
|
return %reformatted; |
|
} |
|
|
sub auto_validate_instclasses { |
sub auto_validate_instclasses { |
my ($cdom,$cnum,$owners,$classesref) = @_; |
my ($cdom,$cnum,$owners,$classesref) = @_; |
my ($homeserver,%validations); |
my ($homeserver,%validations); |
Line 12140 sub get_domain_lti {
|
Line 12198 sub get_domain_lti {
|
my %domconfig = &get_dom('configuration',[$name],$cdom); |
my %domconfig = &get_dom('configuration',[$name],$cdom); |
if (ref($domconfig{$name}) eq 'HASH') { |
if (ref($domconfig{$name}) eq 'HASH') { |
%lti = %{$domconfig{$name}}; |
%lti = %{$domconfig{$name}}; |
my %encdomconfig = &get_dom('encconfig',[$name],$cdom); |
my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1); |
if (ref($encdomconfig{$name}) eq 'HASH') { |
if (ref($encdomconfig{$name}) eq 'HASH') { |
foreach my $id (keys(%lti)) { |
foreach my $id (keys(%lti)) { |
if (ref($encdomconfig{$name}{$id}) eq 'HASH') { |
if (ref($encdomconfig{$name}{$id}) eq 'HASH') { |
Line 12157 sub get_domain_lti {
|
Line 12215 sub get_domain_lti {
|
return %lti; |
return %lti; |
} |
} |
|
|
|
sub get_course_lti { |
|
my ($cnum,$cdom) = @_; |
|
my $hashid=$cdom.'_'.$cnum; |
|
my %courselti; |
|
my ($result,$cached)=&is_cached_new('courselti',$hashid); |
|
if (defined($cached)) { |
|
if (ref($result) eq 'HASH') { |
|
%courselti = %{$result}; |
|
} |
|
} else { |
|
%courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1); |
|
my $cachetime = 24*60*60; |
|
&do_cache_new('courselti',$hashid,\%courselti,$cachetime); |
|
} |
|
return %courselti; |
|
} |
|
|
sub get_numsuppfiles { |
sub get_numsuppfiles { |
my ($cnum,$cdom,$ignorecache)=@_; |
my ($cnum,$cdom,$ignorecache)=@_; |
my $hashid=$cnum.':'.$cdom; |
my $hashid=$cnum.':'.$cdom; |
Line 12216 sub EXT_cache_set {
|
Line 12291 sub EXT_cache_set {
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
sub EXT { |
sub EXT { |
|
|
my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_; |
my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid,$recurseupref)=@_; |
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
#get real user name/domain, courseid and symb |
#get real user name/domain, courseid and symb |
my $courseid; |
my $courseid; |
Line 12370 sub EXT {
|
Line 12445 sub EXT {
|
} |
} |
|
|
my ($section, $group, @groups, @recurseup, $recursed); |
my ($section, $group, @groups, @recurseup, $recursed); |
|
if (ref($recurseupref) eq 'ARRAY') { |
|
@recurseup = @{$recurseupref}; |
|
$recursed = 1; |
|
} |
my ($courselevelm,$courseleveli,$courselevel,$mapp); |
my ($courselevelm,$courseleveli,$courselevel,$mapp); |
if (($courseid eq '') && ($cid)) { |
if (($courseid eq '') && ($cid)) { |
$courseid = $cid; |
$courseid = $cid; |
Line 14308 sub machine_ids {
|
Line 14387 sub machine_ids {
|
|
|
sub additional_machine_domains { |
sub additional_machine_domains { |
my @domains; |
my @domains; |
open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab"); |
if (-e "$perlvar{'lonTabDir'}/expected_domains.tab") { |
while( my $line = <$fh>) { |
if (open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab")) { |
$line =~ s/\s//g; |
while (my $line = <$fh>) { |
push(@domains,$line); |
chomp($line); |
|
$line =~ s/\s//g; |
|
push(@domains,$line); |
|
} |
|
close($fh); |
|
} |
} |
} |
return @domains; |
return @domains; |
} |
} |
Line 14507 sub get_proxy_alias {
|
Line 14591 sub get_proxy_alias {
|
my $cachetime = 60*60*24; |
my $cachetime = 60*60*24; |
my %domconfig = |
my %domconfig = |
&Apache::lonnet::get_dom('configuration',['wafproxy'],$dom); |
&Apache::lonnet::get_dom('configuration',['wafproxy'],$dom); |
my $alias; |
|
if (ref($domconfig{'wafproxy'}) eq 'HASH') { |
if (ref($domconfig{'wafproxy'}) eq 'HASH') { |
if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') { |
if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') { |
$alias = $domconfig{'wafproxy'}{'alias'}{$lonid}; |
$alias = $domconfig{'wafproxy'}{'alias'}{$lonid}; |
Line 14540 sub use_proxy_alias {
|
Line 14623 sub use_proxy_alias {
|
} |
} |
return; |
return; |
} |
} |
|
|
|
sub get_saml_landing { |
|
my ($lonid) = @_; |
|
if ($lonid eq '') { |
|
my $defdom = &default_login_domain(); |
|
my @hosts = ¤t_machine_ids(); |
|
if (@hosts > 1) { |
|
foreach my $hostid (@hosts) { |
|
if (&host_domain($hostid) eq $defdom) { |
|
$lonid = $hostid; |
|
last; |
|
} |
|
} |
|
} else { |
|
$lonid = $perlvar{'lonHostID'}; |
|
} |
|
if ($lonid) { |
|
unless (&Apache::lonnet::host_domain($lonid) eq $defdom) { |
|
return; |
|
} |
|
} else { |
|
return; |
|
} |
|
} elsif (!defined(&hostname($lonid))) { |
|
return; |
|
} |
|
my ($landing,$cached) = &is_cached_new('samllanding',$lonid); |
|
if ($cached) { |
|
return $landing; |
|
} |
|
my $dom = &Apache::lonnet::host_domain($lonid); |
|
if ($dom ne '') { |
|
my $cachetime = 60*60*24; |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['login'],$dom); |
|
if (ref($domconfig{'login'}) eq 'HASH') { |
|
if (ref($domconfig{'login'}{'saml'}) eq 'HASH') { |
|
if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') { |
|
$landing = 1; |
|
} |
|
} |
|
} |
|
return &do_cache_new('samllanding',$lonid,$landing,$cachetime); |
|
} |
|
return; |
|
} |
|
|
# ------------------------------------------------------------- Declutters URLs |
# ------------------------------------------------------------- Declutters URLs |
|
|