--- loncom/lonnet/perl/lonnet.pm 2009/04/11 21:43:02 1.994
+++ loncom/lonnet/perl/lonnet.pm 2010/01/16 13:46:05 1.1049
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.994 2009/04/11 21:43:02 raeburn Exp $
+# $Id: lonnet.pm,v 1.1049 2010/01/16 13:46:05 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;
@@ -718,7 +719,12 @@ sub spareserver {
if ($protocol{$spare_server} eq 'https') {
$protocol = $protocol{$spare_server};
}
- $spare_server = $protocol.'://'.&hostname($spare_server);
+ if (defined($spare_server)) {
+ my $hostname = &hostname($spare_server);
+ if (defined($hostname)) {
+ $spare_server = $protocol.'://'.$hostname;
+ }
+ }
}
return $spare_server;
}
@@ -779,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 ".
@@ -804,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;
}
@@ -953,7 +963,21 @@ sub idput {
}
}
-# ------------------------------------------- get items from domain db files
+# ------------------------------dump from db file owned by domainconfig user
+sub dump_dom {
+ my ($namespace,$udom,$regexp,$range)=@_;
+ if (!$udom) {
+ $udom=$env{'user.domain'};
+ }
+ my %returnhash;
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ %returnhash = &dump($namespace,$udom,$uname,$regexp,$range);
+ }
+ return %returnhash;
+}
+
+# ------------------------------------------ get items from domain db files
sub get_dom {
my ($namespace,$storearr,$udom,$uhome)=@_;
@@ -1027,6 +1051,40 @@ sub put_dom {
}
}
+# --------------------- newput for items in db file owned by domainconfig user
+sub newput_dom {
+ my ($namespace,$storehash,$udom) = @_;
+ my $result;
+ if (!$udom) {
+ $udom=$env{'user.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)=@_;
+ if (ref($storearr) eq 'ARRAY') {
+ if (!$udom) {
+ $udom=$env{'user.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);
@@ -1295,7 +1353,8 @@ sub get_domain_defaults {
my %domdefaults;
my %domconfig =
&Apache::lonnet::get_dom('configuration',['defaults','quotas',
- 'requestcourses','inststatus'],$domain);
+ 'requestcourses','inststatus',
+ 'coursedefaults'],$domain);
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1321,7 +1380,7 @@ sub get_domain_defaults {
}
}
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
- foreach my $item ('official','unofficial') {
+ foreach my $item ('official','unofficial','community') {
$domdefaults{$item} = $domconfig{'requestcourses'}{$item};
}
}
@@ -1330,6 +1389,11 @@ sub get_domain_defaults {
$domdefaults{$item} = $domconfig{'inststatus'}{$item};
}
}
+ if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
+ foreach my $item ('canuse_pdfforms') {
+ $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
+ }
+ }
&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
$cachetime);
return %domdefaults;
@@ -1660,12 +1724,17 @@ sub userenvironment {
}
$items=~s/\&$//;
my %returnhash=();
- my @answer=split(/\&/,
- &reply('get:'.$udom.':'.$unam.':environment:'.$items,
- &homeserver($unam,$udom)));
- my $i;
- for ($i=0;$i<=$#what;$i++) {
- $returnhash{$what[$i]}=&unescape($answer[$i]);
+ my $uhome = &homeserver($unam,$udom);
+ unless ($uhome eq 'no_host') {
+ my @answer=split(/\&/,
+ &reply('get:'.$udom.':'.$unam.':environment:'.$items,$uhome));
+ if ($#answer==0 && $answer[0] =~ /^(con_lost|error:|no_such_host)/i) {
+ return %returnhash;
+ }
+ my $i;
+ for ($i=0;$i<=$#what;$i++) {
+ $returnhash{$what[$i]}=&unescape($answer[$i]);
+ }
}
return %returnhash;
}
@@ -1861,6 +1930,8 @@ sub ssi_body {
if ($filelink=~/^https?\:/) {
($output,$response)=&externalssi($filelink);
} else {
+ $filelink .= $filelink=~/\?/ ? '&' : '?';
+ $filelink .= 'inhibitmenu=yes';
($output,$response)=&ssi($filelink,%form);
}
$output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
@@ -1904,7 +1975,7 @@ sub ssi {
&Apache::lonenc::check_encrypt(\$fn);
if (%form) {
$request=new HTTP::Request('POST',&absolute_url().$fn);
- $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
+ $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));
} else {
$request=new HTTP::Request('GET',&absolute_url().$fn);
}
@@ -2002,9 +2073,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,
@@ -2166,9 +2241,12 @@ sub userfileupload {
close($fh);
return $fullpath.'/'.$fname;
}
-
+ if ($subdir eq 'scantron') {
+ $fname = 'scantron_orig_'.$fname;
+ } else {
# Create the directory if not present
- $fname="$subdir/$fname";
+ $fname="$subdir/$fname";
+ }
if ($coursedoc) {
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
@@ -2243,11 +2321,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+$/)) {
@@ -2551,7 +2633,7 @@ sub flushcourselogs {
# Reverse lookup of domain roles (dc, ad, li, sc, au)
#
my %domrolebuffer = ();
- foreach my $entry (keys %domainrolehash) {
+ foreach my $entry (keys(%domainrolehash)) {
my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
if ($domrolebuffer{$rudom}) {
$domrolebuffer{$rudom}.='&'.&escape($entry).
@@ -2656,7 +2738,7 @@ sub userrolelog {
if (($trole=~/^ca/) || ($trole=~/^aa/) ||
($trole=~/^in/) || ($trole=~/^cc/) ||
($trole=~/^ep/) || ($trole=~/^cr/) ||
- ($trole=~/^ta/)) {
+ ($trole=~/^ta/) || ($trole=~/^co/)) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$userrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -2665,7 +2747,8 @@ sub userrolelog {
if (($env{'request.role'} =~ /dc\./) &&
(($trole=~/^au/) || ($trole=~/^in/) ||
($trole=~/^cc/) || ($trole=~/^ep/) ||
- ($trole=~/^cr/) || ($trole=~/^ta/))) {
+ ($trole=~/^cr/) || ($trole=~/^ta/) ||
+ ($trole=~/^co/))) {
$userrolehash
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
=$tend.':'.$tstart;
@@ -2686,7 +2769,8 @@ sub courserolelog {
if (($trole eq 'cc') || ($trole eq 'in') ||
($trole eq 'ep') || ($trole eq 'ad') ||
($trole eq 'ta') || ($trole eq 'st') ||
- ($trole=~/^cr/) || ($trole eq 'gr')) {
+ ($trole=~/^cr/) || ($trole eq 'gr') ||
+ ($trole eq 'co')) {
if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
my $cdom = $1;
my $cnum = $2;
@@ -2706,6 +2790,9 @@ sub courserolelog {
$storehash{'section'} = $sec;
}
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+ if (($trole ne 'st') || ($sec ne '')) {
+ &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+ }
}
}
return;
@@ -2728,15 +2815,29 @@ sub get_course_adv_roles {
my %dumphash=
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
my $now=time;
- foreach my $entry (keys %dumphash) {
+ my %privileged;
+ foreach my $entry (keys(%dumphash)) {
my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
if (($tstart) && ($tstart<0)) { next; }
if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$entry);
if ($username eq '' || $domain eq '') { next; }
- if ((&privileged($username,$domain)) &&
- (!$nothide{$username.':'.$domain})) { next; }
+ unless (ref($privileged{$domain}) eq 'HASH') {
+ my %dompersonnel =
+ &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+ $privileged{$domain} = {};
+ foreach my $server (keys(%dompersonnel)) {
+ if (ref($dompersonnel{$server}) eq 'HASH') {
+ foreach my $user (keys(%{$dompersonnel{$server}})) {
+ my ($trole,$uname,$udom) = split(/:/,$user);
+ $privileged{$udom}{$uname} = 1;
+ }
+ }
+ }
+ }
+ if ((exists($privileged{$domain}{$username})) &&
+ (!$nothide{$username.':'.$domain})) { next; }
if ($role eq 'cr') { next; }
if ($codes) {
if ($section) { $role .= ':'.$section; }
@@ -2781,6 +2882,7 @@ sub get_my_roles {
}
my %returnhash=();
my $now=time;
+ my %privileged;
foreach my $entry (keys(%dumphash)) {
my ($role,$tend,$tstart);
if ($context eq 'userroles') {
@@ -2829,9 +2931,32 @@ sub get_my_roles {
}
}
if ($hidepriv) {
- if ((&privileged($username,$domain)) &&
- (!$nothide{$username.':'.$domain})) {
- next;
+ if ($context eq 'userroles') {
+ if ((&privileged($username,$domain)) &&
+ (!$nothide{$username.':'.$domain})) {
+ next;
+ }
+ } else {
+ unless (ref($privileged{$domain}) eq 'HASH') {
+ my %dompersonnel =
+ &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+ $privileged{$domain} = {};
+ if (keys(%dompersonnel)) {
+ foreach my $server (keys(%dompersonnel)) {
+ if (ref($dompersonnel{$server}) eq 'HASH') {
+ foreach my $user (keys(%{$dompersonnel{$server}})) {
+ my ($trole,$uname,$udom) = split(/:/,$user);
+ $privileged{$udom}{$uname} = $trole;
+ }
+ }
+ }
+ }
+ }
+ if (exists($privileged{$domain}{$username})) {
+ if (!$nothide{$username.':'.$domain}) {
+ next;
+ }
+ }
}
}
if ($withsec) {
@@ -2917,7 +3042,8 @@ sub courseidput {
sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
- $selfenrollonly,$catfilter,$showhidden,$caller)=@_;
+ $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
+ $cloneonly,$createdbefore,$createdafter,$creationcontext)=@_;
my $as_hash = 1;
my %returnhash;
if (!$domfilter) { $domfilter=''; }
@@ -2936,7 +3062,10 @@ sub courseiddump {
':'.&escape($coursefilter).':'.&escape($typefilter).
':'.&escape($regexp_ok).':'.$as_hash.':'.
&escape($selfenrollonly).':'.&escape($catfilter).':'.
- $showhidden.':'.$caller,$tryserver);
+ $showhidden.':'.$caller.':'.&escape($cloner).':'.
+ &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);
@@ -2951,7 +3080,7 @@ sub courseiddump {
for (my $i=0; $i<@responses; $i++) {
$returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
}
- }
+ }
}
}
}
@@ -2991,10 +3120,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;
@@ -3401,7 +3530,7 @@ sub tmpreset {
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
&GDBM_WRCREAT(),0640)) {
- foreach my $key (keys %hash) {
+ foreach my $key (keys(%hash)) {
if ($key=~ /:$symb/) {
delete($hash{$key});
}
@@ -3684,7 +3813,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)) {
@@ -3712,13 +3844,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 '') {
@@ -3784,6 +3918,9 @@ sub custom_roleprivs {
if (($rdummy ne 'con_lost') && ($roledef ne '')) {
my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
if (defined($syspriv)) {
+ if ($trest =~ /^$match_community$/) {
+ $syspriv =~ s/bre\&S//;
+ }
$$allroles{'cm./'}.=':'.$syspriv;
$$allroles{$spec.'./'}.=':'.$syspriv;
}
@@ -3837,7 +3974,7 @@ sub set_userprivs {
my $adv=0;
my %grouproles = ();
if (keys(%{$allgroups}) > 0) {
- foreach my $role (keys %{$allroles}) {
+ foreach my $role (keys(%{$allroles})) {
my ($trole,$area,$sec,$extendedarea);
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
$trole = $1;
@@ -3881,7 +4018,7 @@ sub set_userprivs {
}
sub role_status {
- my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+ my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
my @pwhere = ();
if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
@@ -3892,7 +4029,34 @@ sub role_status {
$$tstatus='is';
if ($$tstart && $$tstart>$then) {
$$tstatus='future';
- if ($$tstart<$now) { $$tstatus='will'; }
+ if ($$tstart<$now) {
+ if ($$tstart && $$tstart>$refresh) {
+ if (($$where ne '') && ($$role ne '')) {
+ my (%allroles,%allgroups,$group_privs);
+ my %userroles = (
+ 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
+ );
+ my $spec=$$role.'.'.$$where;
+ my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
+ if ($$role =~ /^cr\//) {
+ &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+ } elsif ($$role eq 'gr') {
+ my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+ $env{'user.name'});
+ my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
+ } else {
+ &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
+ }
+ 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';
+ }
}
if ($$tend) {
if ($$tend<$then) {
@@ -3906,11 +4070,11 @@ sub role_status {
}
sub check_adhoc_privs {
- my ($cdom,$cnum,$then,$now,$checkrole) = @_;
+ my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
if ($env{$cckey}) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
&set_adhoc_privileges($cdom,$cnum,$checkrole);
}
@@ -4550,6 +4714,7 @@ sub usertools_access {
%tools = (
official => 1,
unofficial => 1,
+ community => 1,
);
} else {
%tools = (
@@ -4582,7 +4747,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'};
}
@@ -4683,6 +4848,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 {
@@ -4837,17 +5051,68 @@ sub allowed {
my $statecond=0;
my $courseprivid='';
+ my $ownaccess;
+ # Community Coordinator or Assistant Co-author browsing resource space.
+ if (($priv eq 'bro') && ($env{'user.author'})) {
+ if ($uri eq '') {
+ $ownaccess = 1;
+ } else {
+ if (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+ my $udom = $env{'user.domain'};
+ my $uname = $env{'user.name'};
+ if ($uri =~ m{^\Q$udom\E/?$}) {
+ $ownaccess = 1;
+ } elsif ($uri =~ m{^\Q$udom\E/\Q$uname\E/?}) {
+ unless ($uri =~ m{\.\./}) {
+ $ownaccess = 1;
+ }
+ } elsif (($udom ne 'public') && ($uname ne 'public')) {
+ my $now = time;
+ if ($uri =~ m{^([^/]+)/?$}) {
+ my $adom = $1;
+ foreach my $key (keys(%env)) {
+ if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
+ my ($start,$end) = split('.',$env{$key});
+ if (($now >= $start) && (!$end || $end < $now)) {
+ $ownaccess = 1;
+ last;
+ }
+ }
+ }
+ } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {
+ my $adom = $1;
+ my $aname = $2;
+ foreach my $role ('ca','aa') {
+ if ($env{"user.role.$role./$adom/$aname"}) {
+ my ($start,$end) =
+ split('.',$env{"user.role.$role./$adom/$aname"});
+ if (($now >= $start) && (!$end || $end < $now)) {
+ $ownaccess = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
# Course
if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ unless (($priv eq 'bro') && (!$ownaccess)) {
+ $thisallowed.=$1;
+ }
}
# Domain
if ($env{'user.priv.'.$env{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ unless (($priv eq 'bro') && (!$ownaccess)) {
+ $thisallowed.=$1;
+ }
}
# Course: uri itself is a course
@@ -4857,7 +5122,9 @@ sub allowed {
if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
=~/\Q$priv\E\&([^\:]*)/) {
- $thisallowed.=$1;
+ unless (($priv eq 'bro') && (!$ownaccess)) {
+ $thisallowed.=$1;
+ }
}
# URI is an uploaded document for this course, default permissions don't matter
@@ -4997,7 +5264,7 @@ sub allowed {
my $envkey;
if ($thisallowed=~/L/) {
- foreach $envkey (keys %env) {
+ foreach $envkey (keys(%env)) {
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
my $courseid=$2;
my $roleid=$1.'.'.$2;
@@ -5288,7 +5555,7 @@ sub fetch_enrollment_query {
}
my $host=&hostname($homeserver);
my $cmd = '';
- foreach my $affiliate (keys %{$affiliatesref}) {
+ foreach my $affiliate (keys(%{$affiliatesref})) {
$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
}
$cmd =~ s/%%$//;
@@ -5421,11 +5688,21 @@ sub auto_run {
sub auto_get_sections {
my ($cnum,$cdom,$inst_coursecode) = @_;
- my $homeserver = &homeserver($cnum,$cdom);
- my @secs = ();
- my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
- unless ($response eq 'refused') {
- @secs = split(/:/,$response);
+ my $homeserver;
+ if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+ $homeserver = &homeserver($cnum,$cdom);
+ }
+ if (!defined($homeserver)) {
+ if ($cdom =~ /^$match_domain$/) {
+ $homeserver = &domain($cdom,'primary');
+ }
+ }
+ my @secs;
+ if (defined($homeserver)) {
+ my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
+ unless ($response eq 'refused') {
+ @secs = split(/:/,$response);
+ }
}
return @secs;
}
@@ -5444,6 +5721,23 @@ sub auto_validate_courseID {
return $response;
}
+sub auto_validate_instcode {
+ my ($cnum,$cdom,$instcode,$owner) = @_;
+ my ($homeserver,$response);
+ if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+ $homeserver = &homeserver($cnum,$cdom);
+ }
+ if (!defined($homeserver)) {
+ if ($cdom =~ /^$match_domain$/) {
+ $homeserver = &domain($cdom,'primary');
+ }
+ }
+ my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
+ &escape($instcode).':'.&escape($owner),$homeserver));
+ my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
+ return ($outcome,$description);
+}
+
sub auto_create_password {
my ($cnum,$cdom,$authparam,$udom) = @_;
my ($homeserver,$response);
@@ -5558,6 +5852,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));
}
@@ -5615,7 +5916,81 @@ sub auto_instcode_defaults {
}
return $response;
-}
+}
+
+sub auto_possible_instcodes {
+ my ($domain,$codetitles,$cat_titles,$cat_orders,$code_order) = @_;
+ unless ((ref($codetitles) eq 'ARRAY') && (ref($cat_titles) eq 'HASH') &&
+ (ref($cat_orders) eq 'HASH') && (ref($code_order) eq 'ARRAY')) {
+ return;
+ }
+ my (@homeservers,$uhome);
+ if (defined(&domain($domain,'primary'))) {
+ $uhome=&domain($domain,'primary');
+ push(@homeservers,&domain($domain,'primary'));
+ } else {
+ my %servers = &get_servers($domain,'library');
+ foreach my $tryserver (keys(%servers)) {
+ if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+ push(@homeservers,$tryserver);
+ }
+ }
+ }
+ my $response;
+ foreach my $server (@homeservers) {
+ $response=&reply('autopossibleinstcodes:'.$domain,$server);
+ next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+ my ($codetitlestr,$codeorderstr,$cat_title,$cat_order) =
+ split(':',$response);
+ @{$codetitles} = map { &unescape($_); } (split('&',$codetitlestr));
+ @{$code_order} = map { &unescape($_); } (split('&',$codeorderstr));
+ foreach my $item (split('&',$cat_title)) {
+ my ($name,$value)=split('=',$item);
+ $cat_titles->{&unescape($name)}=&thaw_unescape($value);
+ }
+ foreach my $item (split('&',$cat_order)) {
+ my ($name,$value)=split('=',$item);
+ $cat_orders->{&unescape($name)}=&thaw_unescape($value);
+ }
+ return 'ok';
+ }
+ return $response;
+}
+
+sub auto_courserequest_checks {
+ my ($dom) = @_;
+ 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,$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 {
my ($cdom,$cnum,$owners,$inst_class) = @_;
@@ -5769,30 +6144,37 @@ sub devalidate_getgroups_cache {
sub plaintext {
my ($short,$type,$cid,$forcedefault) = @_;
- if ($short =~ /^cr/) {
+ if ($short =~ m{^cr/}) {
return (split('/',$short))[-1];
}
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',
- Group => 'alt1',
+ 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
@@ -5805,10 +6187,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\//) {
@@ -5834,9 +6233,48 @@ sub assignrole {
$refused = 1;
}
if ($refused) {
- if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+ my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
+ if (!$selfenroll && $context eq 'course') {
+ my %crsenv;
+ if ($role eq 'cc' || $role eq 'co') {
+ %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+ if (($role eq 'cc') && ($cnum !~ /^$match_community$/)) {
+ if ($env{'request.role'} eq 'cc./'.$cdom.'/'.$cnum) {
+ if ($crsenv{'internal.courseowner'} eq
+ $env{'user.name'}.':'.$env{'user.domain'}) {
+ $refused = '';
+ }
+ }
+ } elsif (($role eq 'co') && ($cnum =~ /^$match_community$/)) {
+ if ($env{'request.role'} eq 'co./'.$cdom.'/'.$cnum) {
+ if ($crsenv{'internal.courseowner'} eq
+ $env{'user.name'}.':'.$env{'user.domain'}) {
+ $refused = '';
+ }
+ }
+ }
+ }
+ } elsif (($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','co');
+ if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
+ my $wrongcc;
+ if ($cnum =~ /^$match_community$/) {
+ $wrongcc = 1 if ($role eq 'cc');
+ } else {
+ $wrongcc = 1 if ($role eq 'co');
+ }
+ unless ($wrongcc) {
+ 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'});
@@ -6160,28 +6598,57 @@ sub writecoursepref {
sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
- $course_owner,$crstype)=@_;
+ $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';
}
-# ------------------------------------------------------------------- Create ID
- my $uname=int(1+rand(9)).
- ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
- substr($$.time,0,5).unpack("H8",pack("I32",time)).
- unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
-# ----------------------------------------------- Make sure that does not exist
- my $uhome=&homeserver($uname,$udom,'true');
- unless (($uhome eq '') || ($uhome eq 'no_host')) {
- $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
- unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
- $uhome=&homeserver($uname,$udom,'true');
- unless (($uhome eq '') || ($uhome eq 'no_host')) {
- return 'error: unable to generate unique course-ID';
- }
- }
-# ------------------------------------------------ Check supplied server name
+# --------------------------------------------------------------- Get Unique ID
+ my $uname;
+ if ($cnum =~ /^$match_courseid$/) {
+ my $chome=&homeserver($cnum,$udom,'true');
+ if (($chome eq '') || ($chome eq 'no_host')) {
+ $uname = $cnum;
+ } else {
+ $uname = &generate_coursenum($udom,$crstype);
+ }
+ } else {
+ $uname = &generate_coursenum($udom,$crstype);
+ }
+ return $uname if ($uname =~ /^error/);
+# -------------------------------------------------- Check supplied server name
$course_server = $env{'user.homeserver'} if (! defined($course_server));
if (! &is_library($course_server)) {
return 'error:bad server name '.$course_server;
@@ -6190,18 +6657,23 @@ sub createcourse {
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
$course_server);
unless ($reply eq 'ok') { return 'error: '.$reply; }
- $uhome=&homeserver($uname,$udom,'true');
+ my $uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: no such course';
}
# ----------------------------------------------------------------- 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');
@@ -6231,6 +6703,41 @@ ENDINITMAP
return '/'.$udom.'/'.$uname;
}
+# ------------------------------------------------------------------- Create ID
+sub generate_coursenum {
+ my ($udom,$crstype) = @_;
+ my $domdesc = &domain($udom);
+ return 'error: invalid domain' if ($domdesc eq '');
+ my $first;
+ if ($crstype eq 'Community') {
+ $first = '0';
+ } else {
+ $first = int(1+rand(9));
+ }
+ my $uname=$first.
+ ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+ substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+# ----------------------------------------------- Make sure that does not exist
+ my $uhome=&homeserver($uname,$udom,'true');
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ if ($crstype eq 'Community') {
+ $first = '0';
+ } else {
+ $first = int(1+rand(9));
+ }
+ $uname=$first.
+ ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+ substr($$.time,0,5).unpack("H8",pack("I32",time)).
+ unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+ $uhome=&homeserver($uname,$udom,'true');
+ unless (($uhome eq '') || ($uhome eq 'no_host')) {
+ return 'error: unable to generate unique course-ID';
+ }
+ }
+ return $uname;
+}
+
sub is_course {
my ($cdom,$cnum) = @_;
my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
@@ -6241,6 +6748,39 @@ sub is_course {
return 0;
}
+sub store_userdata {
+ my ($storehash,$datakey,$namespace,$udom,$uname) = @_;
+ my $result;
+ if ($datakey ne '') {
+ if (ref($storehash) eq 'HASH') {
+ 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 {
+ $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};
+ $storehash->{'host'} = $perlvar{'lonHostID'};
+
+ my $namevalue='';
+ foreach my $key (keys(%{$storehash})) {
+ $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+ }
+ $namevalue=~s/\&$//;
+ $result = &reply("store:$env{'user.domain'}:$env{'user.name'}:".
+ "$namespace:$datakey:$namevalue",$uhome);
+ }
+ } else {
+ $result = 'error: data to store was not a hash reference';
+ }
+ } else {
+ $result= 'error: invalid requestkey';
+ }
+ return $result;
+}
+
# ---------------------------------------------------------- Assign Custom Role
sub assigncustomrole {
@@ -7730,6 +8270,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 {
@@ -7796,7 +8341,7 @@ sub symblist {
if (($env{'request.course.fn'}) && (%newhash)) {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_WRCREAT(),0640)) {
- foreach my $url (keys %newhash) {
+ foreach my $url (keys(%newhash)) {
next if ($url eq 'last_known'
&& $env{'form.no_update_last_known'});
$hash{declutter($url)}=&encode_symb($mapname,
@@ -7833,6 +8378,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};
@@ -7841,6 +8389,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) {
@@ -8717,7 +9268,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;
}
@@ -8729,8 +9282,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+)$/);
@@ -9543,7 +10096,7 @@ and course level
plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash
(rolesplain.tab); plain text explanation of a user role term.
-$type is Course (default) or Group.
+$type is Course (default) or Community.
If $forcedefault evaluates to true, text returned will be default
text for $type. Otherwise, if this is a course, the text returned
will be a custom name for the role (if defined in the course's
@@ -9753,7 +10306,11 @@ database) for a course
=item *
-createcourse($udom,$description,$url) : make/modify course
+createcourse($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner,$crstype,$cnum) : make course
+
+=item *
+
+generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community).
=back