--- loncom/lonnet/perl/lonnet.pm 2022/09/19 21:11:55 1.1172.2.146.2.7 +++ loncom/lonnet/perl/lonnet.pm 2022/02/27 02:19:13 1.1172.2.147 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.146.2.7 2022/09/19 21:11:55 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.147 2022/02/27 02:19:13 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 { @@ -3613,14 +3498,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 +3522,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 +3531,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 +5536,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 +5547,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 +5559,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 +6539,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 +6827,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 +6902,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 +6918,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 +7064,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 +7073,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 +7610,6 @@ sub usertools_access { blog => 1, webdav => 1, portfolio => 1, - timezone => 1, ); } return if (!defined($tools{$tool})); @@ -8043,14 +7895,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 +7912,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 +7960,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 +8117,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 +8137,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 +8210,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 +8252,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 +8432,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 +8452,6 @@ sub allowed { return 'A'; } elsif ($thisallowed eq 'B') { return 'B'; - } elsif ($thisallowed eq 'D') { - return 'D'; } return 'F'; } @@ -8821,8 +8633,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 +8643,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 +8768,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 +10472,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 +11514,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 +11538,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 +11851,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 +11884,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 +11969,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; } @@ -13128,10 +12696,17 @@ 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{$thisfn}; + $syval=$hash{$targetfn}; untie(%hash); } if ($syval && $checkforblock) { @@ -14303,8 +13878,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; } @@ -15376,7 +14949,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 *