--- loncom/lonnet/perl/lonnet.pm 2021/11/08 03:02:14 1.1470
+++ loncom/lonnet/perl/lonnet.pm 2022/09/18 22:33:45 1.1492
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1470 2021/11/08 03:02:14 raeburn Exp $
+# $Id: lonnet.pm,v 1.1492 2022/09/18 22:33:45 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1323,7 +1323,7 @@ sub changepass {
sub queryauthenticate {
my ($uname,$udom)=@_;
my $uhome=&homeserver($uname,$udom);
- if (!$uhome) {
+ if ((!$uhome) || ($uhome eq 'no_host')) {
&logthis("User $uname at $udom is unknown when looking for authentication mechanism");
return 'no_host';
}
@@ -1372,12 +1372,35 @@ sub authenticate {
}
if ($answer eq 'non_authorized') {
&logthis("User $uname at $udom rejected by $uhome");
- return 'no_host';
+ return 'no_host';
}
&logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
return 'no_host';
}
+sub can_switchserver {
+ my ($udom,$home) = @_;
+ my ($canswitch,@intdoms);
+ my $internet_names = &get_internet_names($home);
+ if (ref($internet_names) eq 'ARRAY') {
+ @intdoms = @{$internet_names};
+ }
+ my $uint_dom = &internet_dom(&domain($udom,'primary'));
+ if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
+ $canswitch = 1;
+ } else {
+ my $serverhomeID = &get_server_homeID(&hostname($home));
+ my $serverhomedom = &host_domain($serverhomeID);
+ my %defdomdefaults = &get_domain_defaults($serverhomedom);
+ my %udomdefaults = &get_domain_defaults($udom);
+ my $remoterev = &get_server_loncaparev('',$home);
+ $canswitch = &can_host_session($udom,$home,$remoterev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
+ }
+ return $canswitch;
+}
+
sub can_host_session {
my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
my $canhost = 1;
@@ -2262,6 +2285,57 @@ sub del_dom {
}
}
+sub store_dom {
+ my ($storehash,$id,$namespace,$dom,$home,$encrypt) = @_;
+ $$storehash{'ip'}=&get_requestor_ip();
+ $$storehash{'host'}=$perlvar{'lonHostID'};
+ my $namevalue='';
+ foreach my $key (keys(%{$storehash})) {
+ $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+ }
+ $namevalue=~s/\&$//;
+ if (grep { $_ eq $home } current_machine_ids()) {
+ return LONCAPA::Lond::store_dom("storedom:$dom:$namespace:$id:$namevalue");
+ } else {
+ if ($namespace eq 'private') {
+ return 'refused';
+ } elsif ($encrypt) {
+ return reply("encrypt:storedom:$dom:$namespace:$id:$namevalue",$home);
+ } else {
+ return reply("storedom:$dom:$namespace:$id:$namevalue",$home);
+ }
+ }
+}
+
+sub restore_dom {
+ my ($id,$namespace,$dom,$home,$encrypt) = @_;
+ my $answer;
+ if (grep { $_ eq $home } current_machine_ids()) {
+ $answer = LONCAPA::Lond::restore_dom("restoredom:$dom:$namespace:$id");
+ } elsif ($namespace ne 'private') {
+ if ($encrypt) {
+ $answer=&reply("encrypt:restoredom:$dom:$namespace:$id",$home);
+ } else {
+ $answer=&reply("restoredom:$dom:$namespace:$id",$home);
+ }
+ }
+ my %returnhash=();
+ unless (($answer eq '') || ($answer eq 'con_lost') || ($answer eq 'refused') ||
+ ($answer eq 'unknown_cmd') || ($answer eq 'rejected')) {
+ foreach my $line (split(/\&/,$answer)) {
+ my ($name,$value)=split(/\=/,$line);
+ $returnhash{&unescape($name)}=&thaw_unescape($value);
+ }
+ my $version;
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
+ $returnhash{$item}=$returnhash{$version.':'.$item};
+ }
+ }
+ }
+ return %returnhash;
+}
+
# ----------------------------------construct domainconfig user for a domain
sub get_domainconfiguser {
my ($udom) = @_;
@@ -2542,6 +2616,10 @@ sub inst_rulecheck {
$response=&unescape(&reply('instselfcreatecheck:'.
&escape($udom).':'.&escape($uname).
':'.$rulestr,$homeserver));
+ } elsif ($item eq 'unamemap') {
+ $response=&unescape(&reply('instunamemapcheck:'.
+ &escape($udom).':'.&escape($uname).
+ ':'.$rulestr,$homeserver));
}
if ($response ne 'refused') {
my @pairs=split(/\&/,$response);
@@ -2571,6 +2649,9 @@ sub inst_userrules {
} elsif ($check eq 'email') {
$response=&reply('instemailrules:'.&escape($udom),
$homeserver);
+ } elsif ($check eq 'unamemap') {
+ $response=&reply('unamemaprules:'.&escape($udom),
+ $homeserver);
} else {
$response=&reply('instuserrules:'.&escape($udom),
$homeserver);
@@ -2617,7 +2698,7 @@ sub get_domain_defaults {
'coursedefaults','usersessions',
'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',
- 'trust','helpsettings','wafproxy'],$domain);
+ 'trust','helpsettings','wafproxy','ltisec'],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2626,9 +2707,12 @@ sub get_domain_defaults {
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
+ $domdefaults{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'};
+ $domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'};
$domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};
$domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
+ $domdefaults{'unamemap_rule'} = $domconfig{'defaults'}{'unamemap_rule'};
} else {
$domdefaults{'lang_def'} = &domain($domain,'lang_def');
$domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -2666,6 +2750,7 @@ sub get_domain_defaults {
if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
$domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
$domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};
+ $domdefaults{'inline_chem'} = $domconfig{'coursedefaults'}{'inline_chem'};
$domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};
if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
$domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
@@ -2698,7 +2783,10 @@ sub get_domain_defaults {
}
if ($domconfig{'coursedefaults'}{'texengine'}) {
$domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};
- }
+ }
+ if (exists($domconfig{'coursedefaults'}{'ltiauth'})) {
+ $domdefaults{'crsltiauth'} = $domconfig{'coursedefaults'}{'ltiauth'};
+ }
}
if (ref($domconfig{'usersessions'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -2773,6 +2861,7 @@ sub get_domain_defaults {
}
if (ref($domconfig{'autoenroll'}) eq 'HASH') {
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
+ $domdefaults{'failsafe'} = $domconfig{'autoenroll'}{'failsafe'};
}
if (ref($domconfig{'helpsettings'}) eq 'HASH') {
$domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};
@@ -2786,7 +2875,19 @@ sub get_domain_defaults {
$domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
}
}
- }
+ }
+ if (ref($domconfig{'ltisec'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') {
+ $domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'};
+ $domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'};
+ $domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'};
+ }
+ if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
+ $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ }
+ }
+ }
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;
}
@@ -2868,6 +2969,26 @@ sub course_portal_url {
return $firsturl;
}
+sub url_prefix {
+ my ($r,$dom,$home,$context) = @_;
+ my $prefix;
+ my %domdefs = &get_domain_defaults($dom);
+ if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) {
+ if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) {
+ $prefix = $1;
+ }
+ }
+ if ($prefix eq '') {
+ my $hostname = &hostname($home);
+ my $protocol = $protocol{$home};
+ $protocol = 'http' if ($protocol{$home} ne 'https');
+ my $alias = &use_proxy_alias($r,$home);
+ $hostname = $alias if ($alias ne '');
+ $prefix = $protocol.'://'.$hostname;
+ }
+ return $prefix;
+}
+
# --------------------------------------------- Get domain config for passwords
sub get_passwdconf {
@@ -4659,7 +4780,7 @@ sub bubblesheet_converter {
next if (($num == 1) && ($csvoptions{'hdr'} == 1));
$line =~ s{[\r\n]+$}{};
my %found;
- my @values = split(/,/,$line);
+ my @values = split(/,/,$line,-1);
my ($qstart,$record);
for (my $i=0; $i<@values; $i++) {
if ((($qstart ne '') && ($i > $qstart)) ||
@@ -4842,6 +4963,7 @@ sub get_scantronformat_file {
close($fh);
}
}
+ chomp(@lines);
}
return @lines;
}
@@ -4963,6 +5085,29 @@ sub flushcourselogs {
if (! defined($dom) || $dom eq '' ||
! defined($name) || $name eq '') {
my $cid = $env{'request.course.id'};
+#
+# FIXME 11/29/2021
+# Typo in rev. 1.458 (2003/12/09)??
+# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
+#
+# While these ramain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
+# $dom and $name will always be null, so the &inc() call will default to storing this data
+# in a nohist_accesscount.db file for the user rather than the course.
+#
+# That said there is a lot of noise in the data being stored.
+# So counts for prtspool/ and adm/ etc. are recorded.
+#
+# A review of which items ending '___count' are written to %accesshash should likely be
+# made before deciding whether to set these to 'course.' instead of 'request.'
+#
+# Under the current scheme each user receives a nohist_accesscount.db file listing
+# accesses for things which are not published resources, regardless of course, and
+# there is not a nohist_accesscount.db file in a course, which might log accesses from
+# anyone in the course for things which are not published resources.
+#
+# For an author, nohist_accesscount.db ends up having records for other items
+# mixed up with the legitimate access counts for the author's published resources.
+#
$dom = $env{'request.'.$cid.'.domain'};
$name = $env{'request.'.$cid.'.num'};
}
@@ -6749,31 +6894,31 @@ sub course_adhocrole_privs {
$full{$priv} = $restrict;
}
foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
- next if ($item eq '');
- my ($rule,$rest) = split(/=/,$item);
- next unless (($rule eq 'off') || ($rule eq 'on'));
- foreach my $priv (split(/:/,$rest)) {
- if ($priv ne '') {
- if ($rule eq 'off') {
- $possremove{$priv} = 1;
- } else {
- $possadd{$priv} = 1;
- }
- }
- }
- }
- foreach my $priv (sort(keys(%full))) {
- if (exists($currprivs{$priv})) {
- unless (exists($possremove{$priv})) {
- $storeprivs{$priv} = $currprivs{$priv};
- }
- } elsif (exists($possadd{$priv})) {
- $storeprivs{$priv} = $full{$priv};
- }
- }
- $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
- }
- return $coursepriv;
+ next if ($item eq '');
+ my ($rule,$rest) = split(/=/,$item);
+ next unless (($rule eq 'off') || ($rule eq 'on'));
+ foreach my $priv (split(/:/,$rest)) {
+ if ($priv ne '') {
+ if ($rule eq 'off') {
+ $possremove{$priv} = 1;
+ } else {
+ $possadd{$priv} = 1;
+ }
+ }
+ }
+ }
+ foreach my $priv (sort(keys(%full))) {
+ if (exists($currprivs{$priv})) {
+ unless (exists($possremove{$priv})) {
+ $storeprivs{$priv} = $currprivs{$priv};
+ }
+ } elsif (exists($possadd{$priv})) {
+ $storeprivs{$priv} = $full{$priv};
+ }
+ }
+ $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
+ }
+ return $coursepriv;
}
sub group_roleprivs {
@@ -7560,15 +7705,15 @@ sub portfolio_access {
if ($result) {
my %setters;
if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
- my ($startblock,$endblock) =
- &Apache::loncommon::blockcheck(\%setters,'port',$unum,$udom);
- if ($startblock && $endblock) {
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &Apache::loncommon::blockcheck(\%setters,'port',$clientip,$unum,$udom);
+ if (($startblock && $endblock) || ($by_ip)) {
return 'B';
}
} else {
- my ($startblock,$endblock) =
- &Apache::loncommon::blockcheck(\%setters,'port');
- if ($startblock && $endblock) {
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
+ if (($startblock && $endblock) || ($by_ip)) {
return 'B';
}
}
@@ -7834,6 +7979,7 @@ sub usertools_access {
blog => 1,
webdav => 1,
portfolio => 1,
+ timezone => 1,
);
}
return if (!defined($tools{$tool}));
@@ -8029,6 +8175,7 @@ sub check_can_request {
my @options = ('approval','validate','autolimit');
my $optregex = join('|',@options);
if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
+ my %willtrust;
foreach my $type (@{$types}) {
if (&usertools_access($uname,$udom,$type,undef,
'requestcourses')) {
@@ -8048,12 +8195,17 @@ sub check_can_request {
if (ref($request_domains) eq 'HASH') {
my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/);
if ($otherdom ne '') {
- if (ref($request_domains->{$type}) eq 'ARRAY') {
- unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+ unless (exists($willtrust{$otherdom})) {
+ $willtrust{$otherdom} = &will_trust('reqcrs',$env{'user.domain'},$otherdom);
+ }
+ if ($willtrust{$otherdom}) {
+ if (ref($request_domains->{$type}) eq 'ARRAY') {
+ unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+ push(@{$request_domains->{$type}},$otherdom);
+ }
+ } else {
push(@{$request_domains->{$type}},$otherdom);
}
- } else {
- push(@{$request_domains->{$type}},$otherdom);
}
}
}
@@ -8130,7 +8282,7 @@ sub allowed {
$uri=&declutter($uri);
if ($priv eq 'evb') {
-# Evade communication block restrictions for specified role in a course
+# Evade communication block restrictions for specified role in a course or domain
if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {
return $1;
} else {
@@ -8151,9 +8303,9 @@ sub allowed {
if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) &&
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) {
my %setters;
- my ($startblock,$endblock) =
- &Apache::loncommon::blockcheck(\%setters,'port');
- if ($startblock && $endblock) {
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
+ if (($startblock && $endblock) || ($by_ip)) {
return 'B';
} else {
return 'F';
@@ -8891,10 +9043,9 @@ sub get_commblock_resources {
}
} elsif ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;
- my @to_test;
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
- my @interval;
+ my (@interval,$mapname);
my $type = 'map';
if ($item eq 'course') {
$type = 'course';
@@ -8903,36 +9054,11 @@ sub get_commblock_resources {
if ($item =~ /___\d+___/) {
$type = 'resource';
@interval=&EXT("resource.0.interval",$item);
- if (ref($navmap)) {
- my $res = $navmap->getBySymb($item);
- push(@to_test,$res);
- }
} else {
- my $mapsymb = &symbread($item,1);
- if ($mapsymb) {
- if (ref($navmap)) {
- my $mapres = $navmap->getBySymb($mapsymb);
- if (ref($mapres)) {
- my $first = $mapres->map_start();
- my $finish = $mapres->map_finish();
- my $it = $navmap->getIterator($first,$finish,undef,0,0);
- if (ref($it)) {
- my $res;
- while ($res = $it->next(undef,1)) {
- next unless (ref($res));
- my $symb = $res->symb();
- next if (($symb eq $mapsymb) || ($symb eq ''));
- @interval=&EXT("resource.0.interval",$symb);
- if ($interval[1] eq 'map') {
- if ($res->answerable()) {
- push(@to_test,$res);
- last;
- }
- }
- }
- }
- }
- }
+ $mapname = &deversion($item);
+ if (ref($navmap)) {
+ my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval');
+ @interval = ($timelimit,'map');
}
}
}
@@ -8950,10 +9076,37 @@ sub get_commblock_resources {
my $timesup = $first_access+$timelimit;
if ($timesup > $now) {
my $activeblock;
- foreach my $res (@to_test) {
- if ($res->answerable()) {
- $activeblock = 1;
- last;
+ if ($type eq 'resource') {
+ if (ref($navmap)) {
+ my $res = $navmap->getBySymb($item);
+ if ($res->answerable()) {
+ $activeblock = 1;
+ }
+ }
+ } elsif ($type eq 'map') {
+ my $mapsymb = &symbread($mapname,1);
+ if (($mapsymb) && (ref($navmap))) {
+ my $mapres = $navmap->getBySymb($mapsymb);
+ if (ref($mapres)) {
+ my $first = $mapres->map_start();
+ my $finish = $mapres->map_finish();
+ my $it = $navmap->getIterator($first,$finish,undef,0,0);
+ if (ref($it)) {
+ my $res;
+ while ($res = $it->next(undef,1)) {
+ next unless (ref($res));
+ my $symb = $res->symb();
+ next if (($symb eq $mapsymb) || ($symb eq ''));
+ @interval=&EXT("resource.0.interval",$symb);
+ if ($interval[1] eq 'map') {
+ if ($res->answerable()) {
+ $activeblock = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
}
}
if ($activeblock) {
@@ -9387,7 +9540,7 @@ sub fetch_enrollment_query {
}
sub get_query_reply {
- my ($queryid,$sleep,$loopmax) = @_;;
+ my ($queryid,$sleep,$loopmax) = @_;
if (($sleep eq '') || ($sleep !~ /^\d+\.?\d*$/)) {
$sleep = 0.2;
}
@@ -12189,15 +12342,24 @@ sub resdata {
sub get_domain_lti {
my ($cdom,$context) = @_;
- my ($name,%lti);
+ my ($name,$cachename,%lti);
if ($context eq 'consumer') {
$name = 'ltitools';
} elsif ($context eq 'provider') {
$name = 'lti';
+ } elsif ($context eq 'linkprot') {
+ $name = 'ltisec';
} else {
return %lti;
}
- my ($result,$cached)=&is_cached_new($name,$cdom);
+
+ if ($context eq 'linkprot') {
+ $cachename = $context;
+ } else {
+ $cachename = $name;
+ }
+
+ my ($result,$cached)=&is_cached_new($cachename,$cdom);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
%lti = %{$result};
@@ -12205,20 +12367,28 @@ sub get_domain_lti {
} else {
my %domconfig = &get_dom('configuration',[$name],$cdom);
if (ref($domconfig{$name}) eq 'HASH') {
- %lti = %{$domconfig{$name}};
- my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
- if (ref($encdomconfig{$name}) eq 'HASH') {
- foreach my $id (keys(%lti)) {
- if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
- foreach my $item ('key','secret') {
- $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
+ if ($context eq 'linkprot') {
+ if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') {
+ %lti = %{$domconfig{$name}{'linkprot'}};
+ }
+ } else {
+ %lti = %{$domconfig{$name}};
+ }
+ if (($context eq 'consumer') && (keys(%lti))) {
+ my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
+ if (ref($encdomconfig{$name}) eq 'HASH') {
+ foreach my $id (keys(%lti)) {
+ if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
+ foreach my $item ('key','secret') {
+ $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
+ }
}
}
}
}
}
my $cachetime = 24*60*60;
- &do_cache_new($name,$cdom,\%lti,$cachetime);
+ &do_cache_new($cachename,$cdom,\%lti,$cachetime);
}
return %lti;
}
@@ -12240,6 +12410,55 @@ sub get_course_lti {
return %courselti;
}
+sub courselti_itemid {
+ my ($cnum,$cdom,$url,$method,$params,$context) = @_;
+ my ($chome,$itemid);
+ $chome = &homeserver($cnum,$cdom);
+ return if ($chome eq 'no_host');
+ if (ref($params) eq 'HASH') {
+ my $items = &freeze_escape($params);
+ my $rep;
+ if (grep { $_ eq $chome } current_machine_ids()) {
+ $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
+ } else {
+ my $escurl = &escape($url);
+ my $escmethod = &escape($method);
+ my $items = &freeze_escape($params);
+ $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$chome);
+ }
+ unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+ ($rep eq 'unknown_cmd')) {
+ $itemid = $rep;
+ }
+ }
+ return $itemid;
+}
+
+sub domainlti_itemid {
+ my ($cdom,$url,$method,$params,$context) = @_;
+ my ($primary_id,$itemid);
+ $primary_id = &domain($cdom,'primary');
+ return if ($primary_id eq '');
+ if (ref($params) eq 'HASH') {
+ my $items = &freeze_escape($params);
+ my $rep;
+ if (grep { $_ eq $primary_id } current_machine_ids()) {
+ $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
+ } else {
+ my $cnum = '';
+ my $escurl = &escape($url);
+ my $escmethod = &escape($method);
+ my $items = &freeze_escape($params);
+ $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$primary_id);
+ }
+ unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+ ($rep eq 'unknown_cmd')) {
+ $itemid = $rep;
+ }
+ }
+ return $itemid;
+}
+
sub get_numsuppfiles {
my ($cnum,$cdom,$ignorecache)=@_;
my $hashid=$cnum.':'.$cdom;
@@ -13577,17 +13796,10 @@ sub symbread {
my %bighash;
my $syval='';
if (($env{'request.course.fn'}) && ($thisfn)) {
- my $targetfn = $thisfn;
- if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
- $targetfn = 'adm/wrapper/'.$thisfn;
- }
- if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
- $targetfn=$1;
- }
unless ($ignoresymbdb) {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_READER(),0640)) {
- $syval=$hash{$targetfn};
+ $syval=$hash{$thisfn};
untie(%hash);
}
if ($syval && $checkforblock) {
@@ -14632,7 +14844,7 @@ sub use_proxy_alias {
return;
}
-sub alias_shibboleth {
+sub alias_sso {
my ($lonid) = @_;
if ($lonid eq '') {
$lonid = $perlvar{'lonHostID'};