--- loncom/lonnet/perl/lonnet.pm 2022/09/19 20:51:17 1.1172.2.146.2.6
+++ loncom/lonnet/perl/lonnet.pm 2024/07/01 23:30:15 1.1172.2.148
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.146.2.6 2022/09/19 20:51:17 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.148 2024/07/01 23:30:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -127,7 +127,7 @@ our @EXPORT = qw(%env);
$logid ++;
my $now = time();
my $id=$now.'00000'.$$.'00000'.$logid;
- my $ip = &get_requestor_ip();
+ my $ip = &get_requestor_ip();
my $logentry = {
$id => {
'exe_uname' => $env{'user.name'},
@@ -1309,29 +1309,6 @@ sub authenticate {
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;
@@ -1905,7 +1882,7 @@ sub dump_dom {
# ------------------------------------------ get items from domain db files
sub get_dom {
- my ($namespace,$storearr,$udom,$uhome,$encrypt)=@_;
+ my ($namespace,$storearr,$udom,$uhome)=@_;
return if ($udom eq 'public');
my $items='';
foreach my $item (@$storearr) {
@@ -1932,12 +1909,8 @@ sub get_dom {
if (grep { $_ eq $uhome } ¤t_machine_ids()) {
# domain information is hosted on this machine
$rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");
- } else {
- if ($encrypt) {
- $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
- } else {
- $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
- }
+ } else {
+ $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
}
my %returnhash;
if ($rep eq '' || $rep =~ /^error: 2 /) {
@@ -1961,7 +1934,7 @@ sub get_dom {
# -------------------------------------------- put items in domain db files
sub put_dom {
- my ($namespace,$storehash,$udom,$uhome,$encrypt)=@_;
+ my ($namespace,$storehash,$udom,$uhome)=@_;
if (!$udom) {
$udom=$env{'user.domain'};
if (defined(&domain($udom,'primary'))) {
@@ -1982,11 +1955,7 @@ sub put_dom {
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
}
$items=~s/\&$//;
- if ($encrypt) {
- return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);
- } else {
- return &reply("putdom:$udom:$namespace:$items",$uhome);
- }
+ return &reply("putdom:$udom:$namespace:$items",$uhome);
} else {
&logthis("put_dom failed - no homeserver and/or domain");
}
@@ -2020,57 +1989,6 @@ 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) = @_;
@@ -2349,14 +2267,14 @@ sub inst_rulecheck {
$response=&unescape(&reply('instidrulecheck:'.&escape($udom).
':'.&escape($id).':'.$rulestr,
$homeserver));
- } elsif ($item eq 'unamemap') {
- $response=&unescape(&reply('instunamemapcheck:'.
- &escape($udom).':'.&escape($uname).
- ':'.$rulestr,$homeserver));
} elsif ($item eq 'selfcreate') {
$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);
@@ -2435,7 +2353,7 @@ sub get_domain_defaults {
'coursedefaults','usersessions',
'requestauthor','selfenrollment',
'coursecategories','autoenroll',
- 'helpsettings','wafproxy','ltisec'],$domain);
+ 'helpsettings','wafproxy'],$domain);
my @coursetypes = ('official','unofficial','community','textbook');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2518,9 +2436,6 @@ 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') {
@@ -2591,18 +2506,6 @@ sub get_domain_defaults {
}
}
}
- 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;
}
@@ -2689,24 +2592,6 @@ sub get_passwdconf {
return %passwdconf;
}
-sub course_portal_url {
- my ($cnum,$cdom,$r) = @_;
- my $chome = &homeserver($cnum,$cdom);
- my $hostname = &hostname($chome);
- my $protocol = $protocol{$chome};
- $protocol = 'http' if ($protocol ne 'https');
- my %domdefaults = &get_domain_defaults($cdom);
- my $firsturl;
- if ($domdefaults{'portal_def'}) {
- $firsturl = $domdefaults{'portal_def'};
- } else {
- my $alias = &Apache::lonnet::use_proxy_alias($r,$chome);
- $hostname = $alias if ($alias ne '');
- $firsturl = $protocol.'://'.$hostname;
- }
- return $firsturl;
-}
-
# --------------------------------------------------- Assign a key to a student
sub assign_access_key {
@@ -3552,10 +3437,15 @@ sub can_edit_resource {
return;
}
} elsif (!$crsedit) {
+ if ($env{'request.role'} =~ m{^st\./$cdom/$cnum}) {
#
# No edit allowed where CC has switched to student role.
#
- return;
+ return;
+ } elsif (($resurl !~ m{^/res/$match_domain/$match_username/}) ||
+ ($resurl =~ m{^/res/lib/templates/})) {
+ return;
+ }
}
}
}
@@ -3613,14 +3503,6 @@ sub can_edit_resource {
$cfile = '/adm/wrapper'.$resurl;
}
}
- } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
- $incourse = 1;
- if ($env{'form.forceedit'}) {
- $forceview = 1;
- } else {
- $forceedit = 1;
- }
- $cfile = $resurl;
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
$incourse = 1;
if ($env{'form.forceedit'}) {
@@ -3645,14 +3527,6 @@ sub can_edit_resource {
$forceedit = 1;
}
$cfile = $resurl;
- } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
- $incourse = 1;
- if ($env{'form.forceedit'}) {
- $forceview = 1;
- } else {
- $forceedit = 1;
- }
- $cfile = $resurl;
} elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
$incourse = 1;
$forceview = 1;
@@ -3662,13 +3536,8 @@ sub can_edit_resource {
$cfile = &clutter($res);
} else {
$cfile = $env{'form.suppurl'};
- my $escfile = &unescape($cfile);
- if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
- $cfile = '/adm/wrapper'.$escfile;
- } else {
- $escfile =~ s{^http://}{};
- $cfile = &escape("/adm/wrapper/ext/$escfile");
- }
+ $cfile =~ s{^http://}{};
+ $cfile = '/adm/wrapper/ext/'.$cfile;
}
} elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
if ($env{'form.forceedit'}) {
@@ -5672,10 +5541,9 @@ my %cachedtimes=();
my $cachedtime='';
sub load_all_first_access {
- my ($uname,$udom,$ignorecache)=@_;
+ my ($uname,$udom)=@_;
if (($cachedkey eq $uname.':'.$udom) &&
- (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
- (!$ignorecache)) {
+ (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
return;
}
$cachedtime=time;
@@ -5684,7 +5552,7 @@ sub load_all_first_access {
}
sub get_first_access {
- my ($type,$argsymb,$argmap,$ignorecache)=@_;
+ my ($type,$argsymb,$argmap)=@_;
my ($symb,$courseid,$udom,$uname)=&whichuser();
if ($argsymb) { $symb=$argsymb; }
my ($map,$id,$res)=&decode_symb($symb);
@@ -5696,7 +5564,7 @@ sub get_first_access {
} else {
$res=$symb;
}
- &load_all_first_access($uname,$udom,$ignorecache);
+ &load_all_first_access($uname,$udom);
return $cachedtimes{"$courseid\0$res"};
}
@@ -6676,31 +6544,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 {
@@ -6964,8 +6832,7 @@ sub set_adhoc_privileges {
my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);
&appenv(\%userroles,[$role,'cm']);
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
- unless (($caller eq 'constructaccess' && $env{'request.course.id'}) ||
- ($caller eq 'tiny')) {
+ unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
&appenv( {'request.role' => $spec,
'request.role.domain' => $dcdom,
'request.course.sec' => $sec,
@@ -7040,7 +6907,7 @@ sub unserialize {
# see Lond::dump_with_regexp
# if $escapedkeys hash keys won't get unescaped.
sub dump {
- my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys,$encrypt)=@_;
+ my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
@@ -7056,12 +6923,7 @@ sub dump {
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
return %{&unserialize($reply, $escapedkeys)};
}
- 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 $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
if (!($rep =~ /^error/ )) {
@@ -7207,7 +7069,7 @@ sub inc {
# --------------------------------------------------------------- put interface
sub put {
- my ($namespace,$storehash,$udomain,$uname,$encrypt)=@_;
+ my ($namespace,$storehash,$udomain,$uname)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
@@ -7216,11 +7078,7 @@ sub put {
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
}
$items=~s/\&$//;
- if ($encrypt) {
- return &reply("encrypt:put:$udomain:$uname:$namespace:$items",$uhome);
- } else {
- return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
- }
+ return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
}
# ------------------------------------------------------------ newput interface
@@ -7757,7 +7615,6 @@ sub usertools_access {
blog => 1,
webdav => 1,
portfolio => 1,
- timezone => 1,
);
}
return if (!defined($tools{$tool}));
@@ -8043,14 +7900,14 @@ sub customaccess {
# ------------------------------------------------- Check for a user privilege
sub allowed {
- my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_;
+ my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;
my $ver_orguri=$uri;
$uri=&deversion($uri);
my $orguri=$uri;
$uri=&declutter($uri);
if ($priv eq 'evb') {
-# Evade communication block restrictions for specified role in a course or domain
+# Evade communication block restrictions for specified role in a course
if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {
return $1;
} else {
@@ -8060,7 +7917,7 @@ sub allowed {
if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
# Free bre access to adm and meta resources
- if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme|ext\.tool)$}))
+ if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$}))
|| (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))
&& ($priv eq 'bre')) {
return 'F';
@@ -8108,10 +7965,7 @@ sub allowed {
# Free bre to public access
if ($priv eq 'bre') {
- my $copyright;
- unless ($uri =~ /ext\.tool/) {
- $copyright=&metadata($uri,'copyright');
- }
+ my $copyright=&metadata($uri,'copyright');
if (($copyright eq 'public') && (!$env{'request.course.id'})) {
return 'F';
}
@@ -8268,13 +8122,7 @@ sub allowed {
if ($env{'user.priv.'.$env{'request.role'}.'./'}
=~/\Q$priv\E\&([^\:]*)/) {
my $value = $1;
- my $deeplinkblock;
- unless ($nodeeplinkcheck) {
- $deeplinkblock = &deeplink_check($priv,$symb,$uri);
- }
- if ($deeplinkblock) {
- $thisallowed='D';
- } elsif ($noblockcheck) {
+ if ($noblockcheck) {
$thisallowed.=$value;
} else {
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
@@ -8294,13 +8142,7 @@ sub allowed {
$refuri=&declutter($refuri);
my ($match) = &is_on_map($refuri);
if ($match) {
- my $deeplinkblock;
- unless ($nodeeplinkcheck) {
- $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
- }
- if ($deeplinkblock) {
- $thisallowed='D';
- } elsif ($noblockcheck) {
+ if ($noblockcheck) {
$thisallowed='F';
} else {
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
@@ -8373,13 +8215,7 @@ sub allowed {
=~/\Q$priv\E\&([^\:]*)/) {
my $value = $1;
if ($priv eq 'bre') {
- my $deeplinkblock;
- unless ($nodeeplinkcheck) {
- $deeplinkblock = &deeplink_check($priv,$symb,$uri);
- }
- if ($deeplinkblock) {
- $thisallowed = 'D';
- } elsif ($noblockcheck) {
+ if ($noblockcheck) {
$thisallowed.=$value;
} else {
my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
@@ -8421,13 +8257,7 @@ sub allowed {
=~/\Q$priv\E\&([^\:]*)/) {
my $value = $1;
if ($priv eq 'bre') {
- my $deeplinkblock;
- unless ($nodeeplinkcheck) {
- $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
- }
- if ($deeplinkblock) {
- $thisallowed = 'D';
- } elsif ($noblockcheck) {
+ if ($noblockcheck) {
$thisallowed.=$value;
} else {
my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
@@ -8607,17 +8437,6 @@ 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?
if ($thisallowed=~/X/) {
@@ -8638,8 +8457,6 @@ sub allowed {
return 'A';
} elsif ($thisallowed eq 'B') {
return 'B';
- } elsif ($thisallowed eq 'D') {
- return 'D';
}
return 'F';
}
@@ -8821,8 +8638,7 @@ sub get_commblock_resources {
}
}
}
- if ($interval[0] =~ /^(\d+)/) {
- my $timelimit = $1;
+ if ($interval[0] =~ /^\d+$/) {
my $first_access;
if ($type eq 'resource') {
$first_access=&get_first_access($interval[1],$item);
@@ -8832,7 +8648,7 @@ sub get_commblock_resources {
$first_access=&get_first_access($interval[1]);
}
if ($first_access) {
- my $timesup = $first_access+$timelimit;
+ my $timesup = $first_access+$interval[0];
if ($timesup > $now) {
my $activeblock;
if ($type eq 'resource') {
@@ -8957,87 +8773,6 @@ sub has_comm_blocking {
}
}
-sub deeplink_check {
- my ($priv,$symb,$uri) = @_;
- return unless ($env{'request.course.id'});
- return unless ($priv eq 'bre');
- return if ($env{'request.state'} eq 'construct');
- return if ($env{'request.role.adv'});
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my (%possibles,@symbs);
- if (!$symb) {
- $symb = &symbread($uri,1,1,1,\%possibles);
- }
- if ($symb) {
- @symbs = ($symb);
- } elsif (keys(%possibles)) {
- @symbs = keys(%possibles);
- }
-
- my ($deeplink_symb,$allow);
- if ($env{'request.deeplink.login'}) {
- $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
- }
- foreach my $symb (@symbs) {
- last if ($allow);
- my $deeplink = &EXT("resource.0.deeplink",$symb);
- if ($deeplink eq '') {
- $allow = 1;
- } else {
- my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink);
- if ($state ne 'only') {
- $allow = 1;
- } else {
- 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 ($symb eq $deeplink_symb) {
- $allow = 1;
- }
- } elsif (($scope eq 'map') || ($scope eq 'rec')) {
- my ($map_from_symb,$map_from_login);
- $map_from_symb = &deversion((&decode_symb($symb))[0]);
- if ($deeplink_symb =~ /\.(page|sequence)$/) {
- $map_from_login = &deversion((&decode_symb($deeplink_symb))[2]);
- } else {
- $map_from_login = &deversion((&decode_symb($deeplink_symb))[0]);
- }
- if (($map_from_symb) && ($map_from_login)) {
- if ($map_from_symb eq $map_from_login) {
- $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;
- }
- }
- }
- }
- }
- }
- }
- }
- return if ($allow);
- return 1;
-}
-
# -------------------------------- Deversion and split uri into path an filename
#
@@ -10742,19 +10477,14 @@ sub writecoursepref {
sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
- $course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;
+ $course_owner,$crstype,$cnum,$context,$category)=@_;
$url=&declutter($url);
my $cid='';
if ($context eq 'requestcourses') {
my $can_create = 0;
my ($ownername,$ownerdom) = split(':',$course_owner);
if ($udom eq $ownerdom) {
- my $reload;
- if (($callercontext eq 'auto') &&
- ($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {
- $reload = 'reload';
- }
- if (&usertools_access($ownername,$ownerdom,$category,$reload,
+ if (&usertools_access($ownername,$ownerdom,$category,undef,
$context)) {
$can_create = 1;
}
@@ -11789,125 +11519,6 @@ sub resdata {
return undef;
}
-sub get_domain_lti {
- my ($cdom,$context) = @_;
- 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;
- }
-
- 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};
- }
- } else {
- my %domconfig = &get_dom('configuration',[$name],$cdom);
- if (ref($domconfig{$name}) eq 'HASH') {
- 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($cachename,$cdom,\%lti,$cachetime);
- }
- 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 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;
@@ -11932,16 +11543,6 @@ sub get_numsuppfiles {
# EXT resource caching routines
#
-{
-# Cache (5 seconds) of map hierarchy for speedup of navmaps display
-#
-# The course for which we cache
-my $cachedmapkey='';
-# The cached recursive maps for this course
-my %cachedmaps=();
-# When this was last done
-my $cachedmaptime='';
-
sub clear_EXT_cache_status {
&delenv('cache.EXT.');
}
@@ -12255,10 +11856,6 @@ sub EXT {
if ($space eq 'name') {
return $ENV{'SERVER_NAME'};
}
- } elsif ($realm eq 'client') {
- if ($space eq 'remote_addr') {
- return &get_requestor_ip();
- }
}
return '';
}
@@ -12292,30 +11889,6 @@ sub check_group_parms {
return $coursereply;
}
-sub get_map_hierarchy {
- my ($mapname,$courseid) = @_;
- my @recurseup = ();
- if ($mapname) {
- if (($cachedmapkey eq $courseid) &&
- (abs($cachedmaptime-time)<5)) {
- if (ref($cachedmaps{$mapname}) eq 'ARRAY') {
- return @{$cachedmaps{$mapname}};
- }
- }
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (ref($navmap)) {
- @recurseup = $navmap->recurseup_maps($mapname);
- undef($navmap);
- $cachedmaps{$mapname} = \@recurseup;
- $cachedmaptime=time;
- $cachedmapkey=$courseid;
- }
- }
- return @recurseup;
-}
-
-}
-
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
my ($courseid,@groups) = @_;
@groups = sort(@groups);
@@ -12401,7 +11974,7 @@ sub metadata {
# if it is a non metadata possible uri return quickly
if (($uri eq '') ||
(($uri =~ m|^/*adm/|) &&
- ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
+ ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
return undef;
}
@@ -14310,8 +13883,6 @@ sub clutter {
# &logthis("Got a blank emb style");
}
}
- } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
- $thisfn='/adm/wrapper'.$thisfn;
}
return $thisfn;
}
@@ -15383,7 +14954,6 @@ prevents recursive calls to &allowed.
2: browse allowed
A: passphrase authentication needed
B: access temporarily blocked because of a blocking event in a course.
- D: access blocked because access is required via session initiated via deep-link
=item *