--- loncom/lonnet/perl/lonnet.pm 2009/08/11 01:39:44 1.1013
+++ loncom/lonnet/perl/lonnet.pm 2009/10/28 19:09:21 1.1037
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1013 2009/08/11 01:39:44 raeburn Exp $
+# $Id: lonnet.pm,v 1.1037 2009/10/28 19:09:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -92,6 +92,7 @@ use Time::HiRes qw( gettimeofday tv_inte
use Cache::Memcached;
use Digest::MD5;
use Math::Random;
+use File::MMagic;
use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Configuration;
@@ -784,7 +785,8 @@ sub changepass {
my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
$currentpass = &escape($currentpass);
$newpass = &escape($newpass);
- my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
+ my $lonhost = $perlvar{'lonHostID'};
+ my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context:$lonhost",
$server);
if (! $answer) {
&logthis("No reply on password change request to $server ".
@@ -809,6 +811,9 @@ sub changepass {
} elsif ($answer =~ "^refused") {
&logthis("$server refused to change $uname in $udom password because ".
"it was sent an unencrypted request to change the password.");
+ } elsif ($answer =~ "invalid_client") {
+ &logthis("$server refused to change $uname in $udom password because ".
+ "it was a reset by e-mail originating from an invalid server.");
}
return $answer;
}
@@ -958,44 +963,21 @@ sub idput {
}
}
-# ------------------------------------------------ dump from domain db files
-
+# ------------------------------dump from db file owned by domainconfig user
sub dump_dom {
- my ($namespace,$udom,$uhome,$regexp,$range)=@_;
+ my ($namespace,$udom,$regexp,$range)=@_;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
my %returnhash;
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- if ($regexp) {
- $regexp=&escape($regexp);
- } else {
- $regexp='.';
- }
- my $rep=&reply("dumpdom:$udom:$namespace:$regexp:$range",$uhome);
- my @pairs=split(/\&/,$rep);
- foreach my $item (@pairs) {
- my ($key,$value)=split(/=/,$item,2);
- $key = &unescape($key);
- next if ($key =~ /^error: 2 /);
- $returnhash{$key}=&thaw_unescape($value);
- }
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ %returnhash = &dump($namespace,$udom,$uname,$regexp,$range);
}
return %returnhash;
}
-# ------------------------------------------- get items from domain db files
+# ------------------------------------------ get items from domain db files
sub get_dom {
my ($namespace,$storearr,$udom,$uhome)=@_;
@@ -1069,70 +1051,40 @@ sub put_dom {
}
}
-# -------------------------------------- newput for items in domain db files
-
+# --------------------- newput for items in db file owned by domainconfig user
sub newput_dom {
- my ($namespace,$storehash,$udom,$uhome) = @_;
+ my ($namespace,$storehash,$udom) = @_;
my $result;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- my $items='';
- if (ref($storehash) eq 'HASH') {
- foreach my $key (keys(%$storehash)) {
- $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
- }
- $items=~s/\&$//;
- $result = &reply("newputdom:$udom:$namespace:$items",$uhome);
- }
- } else {
- &logthis("put_dom failed - no homeserver and/or domain");
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ $result = &newput($namespace,$storehash,$udom,$uname);
}
return $result;
}
+# --------------------- delete for items in db file owned by domainconfig user
sub del_dom {
- my ($namespace,$storearr,$udom,$uhome)=@_;
+ my ($namespace,$storearr,$udom)=@_;
if (ref($storearr) eq 'ARRAY') {
- my $items='';
- foreach my $item (@$storearr) {
- $items.=&escape($item).'&';
- }
- $items=~s/\&$//;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- return &reply("deldom:$udom:$namespace:$items",$uhome);
- } else {
- &logthis("del_dom failed - no homeserver and/or domain");
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ return &del($namespace,$storearr,$udom,$uname);
}
}
}
+# ----------------------------------construct domainconfig user for a domain
+sub get_domainconfiguser {
+ my ($udom) = @_;
+ return $udom.'-domainconfig';
+}
+
sub retrieve_inst_usertypes {
my ($udom) = @_;
my (%returnhash,@order);
@@ -2112,9 +2064,13 @@ sub process_coursefile {
print $fh $env{'form.'.$source};
close($fh);
if ($parser eq 'parse') {
- my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
- unless ($parse_result eq 'ok') {
- &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+ my $mm = new File::MMagic;
+ my $mime_type = $mm->checktype_filename($filepath.'/'.$fname);
+ if ($mime_type eq 'text/html') {
+ my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
+ unless ($parse_result eq 'ok') {
+ &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+ }
}
}
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
@@ -2356,11 +2312,15 @@ sub finishuserfileupload {
}
}
if ($parser eq 'parse') {
- my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles,
- $codebase);
- unless ($parse_result eq 'ok') {
- &logthis('Failed to parse '.$filepath.$file.
- ' for embedded media: '.$parse_result);
+ my $mm = new File::MMagic;
+ my $mime_type = $mm->checktype_filename($filepath.'/'.$file);
+ if ($mime_type eq 'text/html') {
+ my $parse_result = &extract_embedded_items($filepath.'/'.$file,
+ $allfiles,$codebase);
+ unless ($parse_result eq 'ok') {
+ &logthis('Failed to parse '.$filepath.$file.
+ ' for embedded media: '.$parse_result);
+ }
}
}
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
@@ -3071,7 +3031,8 @@ sub courseidput {
sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
- $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,$cloneonly)=@_;
+ $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
+ $cloneonly,$createdbefore,$createdafter,$creationcontext)=@_;
my $as_hash = 1;
my %returnhash;
if (!$domfilter) { $domfilter=''; }
@@ -3091,7 +3052,9 @@ sub courseiddump {
':'.&escape($regexp_ok).':'.$as_hash.':'.
&escape($selfenrollonly).':'.&escape($catfilter).':'.
$showhidden.':'.$caller.':'.&escape($cloner).':'.
- &escape($cc_clone).':'.$cloneonly,$tryserver);
+ &escape($cc_clone).':'.$cloneonly.':'.
+ &escape($createdbefore).':'.&escape($createdafter).':'.
+ &escape($creationcontext),$tryserver);
my @pairs=split(/\&/,$rep);
foreach my $item (@pairs) {
my ($key,$value)=split(/\=/,$item,2);
@@ -3146,10 +3109,10 @@ sub dcmaildump {
sub get_domain_roles {
my ($dom,$roles,$startdate,$enddate)=@_;
- if (undef($startdate) || $startdate eq '') {
+ if ((!defined($startdate)) || ($startdate eq '')) {
$startdate = '.';
}
- if (undef($enddate) || $enddate eq '') {
+ if ((!defined($enddate)) || ($enddate eq '')) {
$enddate = '.';
}
my $rolelist;
@@ -3839,7 +3802,10 @@ sub privileged {
my ($username,$domain)=@_;
my $rolesdump=&reply("dump:$domain:$username:roles",
&homeserver($username,$domain));
- if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
+ if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||
+ ($rolesdump =~ /^error:/)) {
+ return 0;
+ }
my $now=time;
if ($rolesdump ne '') {
foreach my $entry (split(/&/,$rolesdump)) {
@@ -3867,13 +3833,15 @@ sub privileged {
sub rolesinit {
my ($domain,$username,$authhost)=@_;
- my %userroles;
+ my $now=time;
+ my %userroles = ('user.login.time' => $now);
my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
- if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return \%userroles; }
+ if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||
+ ($rolesdump =~ /^error:/)) {
+ return \%userroles;
+ }
my %allroles=();
my %allgroups=();
- my $now=time;
- %userroles = ('user.login.time' => $now);
my $group_privs;
if ($rolesdump ne '') {
@@ -4047,8 +4015,8 @@ sub role_status {
$$tstatus='is';
if ($$tstart && $$tstart>$then) {
$$tstatus='future';
- if ($$tstart && $$tstart>$refresh) {
- if ($$tstart<$now) {
+ if ($$tstart<$now) {
+ if ($$tstart && $$tstart>$refresh) {
if (($$where ne '') && ($$role ne '')) {
my (%allroles,%allgroups,$group_privs);
my %userroles = (
@@ -4078,9 +4046,9 @@ sub role_status {
my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
&appenv(\%userroles,[$$role,'cm']);
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
- $$tstatus = 'is';
}
}
+ $$tstatus = 'is';
}
}
if ($$tend) {
@@ -4772,7 +4740,7 @@ sub usertools_access {
$toolstatus = $env{'environment.'.$context.'.'.$tool};
$inststatus = $env{'environment.inststatus'};
} else {
- my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool);
+ my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus');
$toolstatus = $userenv{$context.'.'.$tool};
$inststatus = $userenv{'inststatus'};
}
@@ -4873,6 +4841,55 @@ sub is_advanced_user {
return $is_adv;
}
+sub check_can_request {
+ my ($dom,$can_request,$request_domains) = @_;
+ my $canreq = 0;
+ my ($types,$typename) = &Apache::loncommon::course_types();
+ my @options = ('approval','validate','autolimit');
+ my $optregex = join('|',@options);
+ if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
+ foreach my $type (@{$types}) {
+ if (&usertools_access($env{'user.name'},
+ $env{'user.domain'},
+ $type,undef,'requestcourses')) {
+ $canreq ++;
+ if (ref($request_domains) eq 'HASH') {
+ push(@{$request_domains->{$type}},$env{'user.domain'});
+ }
+ if ($dom eq $env{'user.domain'}) {
+ $can_request->{$type} = 1;
+ }
+ }
+ if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
+ my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
+ if (@curr > 0) {
+ foreach my $item (@curr) {
+ 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}})) {
+ push(@{$request_domains->{$type}},$otherdom);
+ }
+ } else {
+ push(@{$request_domains->{$type}},$otherdom);
+ }
+ }
+ }
+ }
+ unless($dom eq $env{'user.domain'}) {
+ $canreq ++;
+ if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
+ $can_request->{$type} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ return $canreq;
+}
+
# ---------------------------------------------- Custom access rule evaluation
sub customaccess {
@@ -5657,7 +5674,8 @@ sub auto_validate_instcode {
}
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
&escape($instcode).':'.&escape($owner),$homeserver));
- return $response;
+ my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
+ return ($outcome,$description);
}
sub auto_create_password {
@@ -5774,6 +5792,13 @@ sub auto_instcode_format {
push(@homeservers,$tryserver);
}
}
+ } elsif ($caller eq 'requests') {
+ if ($codedom =~ /^$match_domain$/) {
+ my $chome = &domain($codedom,'primary');
+ unless ($chome eq 'no_host') {
+ push(@homeservers,$chome);
+ }
+ }
} else {
push(@homeservers,&homeserver($caller,$codedom));
}
@@ -5874,13 +5899,37 @@ sub auto_possible_instcodes {
sub auto_courserequest_checks {
my ($dom) = @_;
- my %validations;
+ my ($homeserver,%validations);
+ if ($dom =~ /^$match_domain$/) {
+ $homeserver = &domain($dom,'primary');
+ }
+ unless ($homeserver eq 'no_host') {
+ my $response=&reply('autocrsreqchecks:'.$dom,$homeserver);
+ unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
+ my @items = split(/&/,$response);
+ foreach my $item (@items) {
+ my ($key,$value) = split('=',$item);
+ $validations{&unescape($key)} = &thaw_unescape($value);
+ }
+ }
+ }
return %validations;
}
sub auto_courserequest_validation {
- my ($dom,$details,$inststatuses,$message) = @_;
- return 'pending';
+ my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
+ my ($homeserver,$response);
+ if ($dom =~ /^$match_domain$/) {
+ $homeserver = &domain($dom,'primary');
+ }
+ unless ($homeserver eq 'no_host') {
+
+ $response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner).
+ ':'.&escape($crstype).':'.&escape($inststatuslist).
+ ':'.&escape($instcode).':'.&escape($instseclist),
+ $homeserver));
+ }
+ return $response;
}
sub auto_validate_class_sec {
@@ -6041,24 +6090,31 @@ sub plaintext {
if (!defined($cid)) {
$cid = $env{'request.course.id'};
}
- if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {
- unless ($forcedefault) {
- my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'};
- &Apache::lonlocal::mt_escape(\$roletext);
- return &Apache::lonlocal::mt($roletext);
- }
- }
my %rolenames = (
Course => 'std',
Community => 'alt1',
);
- if (defined($type) &&
- defined($rolenames{$type}) &&
- defined($prp{$short}{$rolenames{$type}})) {
+ if ($cid ne '') {
+ if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
+ unless ($forcedefault) {
+ my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'};
+ &Apache::lonlocal::mt_escape(\$roletext);
+ return &Apache::lonlocal::mt($roletext);
+ }
+ }
+ }
+ if ((defined($type)) && (defined($rolenames{$type})) &&
+ (defined($rolenames{$type})) &&
+ (defined($prp{$short}{$rolenames{$type}}))) {
return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}});
- } else {
- return &Apache::lonlocal::mt($prp{$short}{'std'});
+ } elsif ($cid ne '') {
+ my $crstype = $env{'course.'.$cid.'.type'};
+ if (($crstype ne '') && (defined($rolenames{$crstype})) &&
+ (defined($prp{$short}{$rolenames{$crstype}}))) {
+ return &Apache::lonlocal::mt($prp{$short}{$rolenames{$crstype}});
+ }
}
+ return &Apache::lonlocal::mt($prp{$short}{'std'});
}
# ----------------------------------------------------------------- Assign Role
@@ -6071,10 +6127,27 @@ sub assignrole {
my $cwosec=$url;
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
unless (&allowed('ccr',$cwosec)) {
- &logthis('Refused custom assignrole: '.
- $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
- $env{'user.name'}.' at '.$env{'user.domain'});
- return 'refused';
+ my $refused = 1;
+ if ($context eq 'requestcourses') {
+ if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
+ if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
+ if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {
+ my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
+ my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+ if ($crsenv{'internal.courseowner'} eq
+ $env{'user.name'}.':'.$env{'user.domain'}) {
+ $refused = '';
+ }
+ }
+ }
+ }
+ }
+ if ($refused) {
+ &logthis('Refused custom assignrole: '.
+ $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.
+ ' by '.$env{'user.name'}.' at '.$env{'user.domain'});
+ return 'refused';
+ }
}
$mrole='cr';
} elsif ($role =~ /^gr\//) {
@@ -6102,7 +6175,18 @@ sub assignrole {
if ($refused) {
if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
$refused = '';
- } else {
+ } elsif ($context eq 'requestcourses') {
+ my @possroles = ('st','ta','ep','in','cc');
+ if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
+ my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
+ my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+ if ($crsenv{'internal.courseowner'} eq
+ $env{'user.name'}.':'.$env{'user.domain'}) {
+ $refused = '';
+ }
+ }
+ }
+ if ($refused) {
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
' '.$role.' '.$end.' '.$start.' by '.
$env{'user.name'}.' at '.$env{'user.domain'});
@@ -6426,10 +6510,41 @@ sub writecoursepref {
sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
- $course_owner,$crstype,$cnum)=@_;
+ $course_owner,$crstype,$cnum,$context,$category)=@_;
$url=&declutter($url);
my $cid='';
- unless (&allowed('ccc',$udom)) {
+ if ($context eq 'requestcourses') {
+ my $can_create = 0;
+ my ($ownername,$ownerdom) = split(':',$course_owner);
+ if ($udom eq $ownerdom) {
+ if (&usertools_access($ownername,$ownerdom,$category,undef,
+ $context)) {
+ $can_create = 1;
+ }
+ } else {
+ my %userenv = &userenvironment($ownerdom,$ownername,'reqcrsotherdom.'.
+ $category);
+ if ($userenv{'reqcrsotherdom.'.$category} ne '') {
+ my @curr = split(',',$userenv{'reqcrsotherdom.'.$category});
+ if (@curr > 0) {
+ my @options = qw(approval validate autolimit);
+ my $optregex = join('|',@options);
+ if (grep(/^\Q$udom\E:($optregex)(=?\d*)$/,@curr)) {
+ $can_create = 1;
+ }
+ }
+ }
+ }
+ if ($can_create) {
+ unless ($ownername eq $env{'user.name'} && $ownerdom eq $env{'user.domain'}) {
+ unless (&allowed('ccc',$udom)) {
+ return 'refused';
+ }
+ }
+ } else {
+ return 'refused';
+ }
+ } elsif (!&allowed('ccc',$udom)) {
return 'refused';
}
# --------------------------------------------------------------- Get Unique ID
@@ -6460,12 +6575,17 @@ sub createcourse {
}
# ----------------------------------------------------------------- Course made
# log existence
+ my $now = time;
my $newcourse = {
$udom.'_'.$uname => {
description => $description,
inst_code => $inst_code,
owner => $course_owner,
type => $crstype,
+ creator => $env{'user.name'}.':'.
+ $env{'user.domain'},
+ created => $now,
+ context => $context,
},
};
&courseidput($udom,$newcourse,$uhome,'notime');
@@ -6529,13 +6649,16 @@ sub is_course {
return 0;
}
-sub store_coursereq {
- my ($requestkey,$storehash) = @_;
+sub store_userdata {
+ my ($storehash,$datakey,$namespace,$udom,$uname) = @_;
my $result;
- if ($requestkey =~ /^($match_domain)_($match_courseid)$/) {
+ if ($datakey ne '') {
if (ref($storehash) eq 'HASH') {
- my $namespace = 'courserequests';
- my $uhome=&homeserver();
+ if ($udom eq '' || $uname eq '') {
+ $udom = $env{'user.domain'};
+ $uname = $env{'user.name'};
+ }
+ my $uhome=&homeserver($uname,$udom);
if (($uhome eq '') || ($uhome eq 'no_host')) {
$result = 'error: no_host';
} else {
@@ -6548,7 +6671,7 @@ sub store_coursereq {
}
$namevalue=~s/\&$//;
$result = &reply("store:$env{'user.domain'}:$env{'user.name'}:".
- "$namespace:$requestkey:$namevalue",$uhome);
+ "$namespace:$datakey:$namevalue",$uhome);
}
} else {
$result = 'error: data to store was not a hash reference';
@@ -8048,6 +8171,11 @@ sub devalidate_title_cache {
&devalidate_cache_new('title',$key);
}
+# ------------------------------------------------- Get the title of a course
+
+sub current_course_title {
+ return $env{ 'course.' . $env{'request.course.id'} . '.description' };
+}
# ------------------------------------------------- Get the title of a resource
sub gettitle {
@@ -8151,6 +8279,9 @@ sub symbverify {
if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
&GDBM_READER(),0640)) {
+ if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
+ $thisurl =~ s/\?.+$//;
+ }
my $ids=$bighash{'ids_'.&clutter($thisurl)};
unless ($ids) {
$ids=$bighash{'ids_/'.$thisurl};
@@ -8159,6 +8290,9 @@ sub symbverify {
# ------------------------------------------------------------------- Has ID(s)
foreach my $id (split(/\,/,$ids)) {
my ($mapid,$resid)=split(/\./,$id);
+ if ($thisfn =~ m{^/adm/wrapper/ext/}) {
+ $symb =~ s/\?.+$//;
+ }
if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {
@@ -9035,7 +9169,9 @@ sub declutter {
$thisfn=~s|^adm/wrapper/||;
$thisfn=~s|^adm/coursedocs/showdoc/||;
$thisfn=~s/^res\///;
- $thisfn=~s/\?.+$//;
+ unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) {
+ $thisfn=~s/\?.+$//;
+ }
return $thisfn;
}
@@ -9047,8 +9183,8 @@ sub clutter {
|| $thisfn =~ m{^/adm/(includes|pages)} ) {
$thisfn='/res'.$thisfn;
}
- if ($thisfn !~m|/adm|) {
- if ($thisfn =~ m|/ext/|) {
+ if ($thisfn !~m|^/adm|) {
+ if ($thisfn =~ m|^/ext/|) {
$thisfn='/adm/wrapper'.$thisfn;
} else {
my ($ext) = ($thisfn =~ /\.(\w+)$/);