--- loncom/lonnet/perl/lonnet.pm 2009/10/23 00:20:40 1.1034
+++ loncom/lonnet/perl/lonnet.pm 2009/11/30 06:23:37 1.1047
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1034 2009/10/23 00:20:40 raeburn Exp $
+# $Id: lonnet.pm,v 1.1047 2009/11/30 06:23:37 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1353,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'};
@@ -1388,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;
@@ -2729,7 +2735,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}
@@ -2738,7 +2744,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;
@@ -2759,7 +2766,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;
@@ -3907,6 +3915,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;
}
@@ -4841,6 +4852,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 {
@@ -4995,17 +5055,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
@@ -5015,7 +5126,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
@@ -6035,30 +6148,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',
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
@@ -6117,16 +6237,44 @@ 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 = '';
} elsif ($context eq 'requestcourses') {
- my @possroles = ('st','ta','ep','in','cc');
+ my @possroles = ('st','ta','ep','in','cc','co');
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 = '';
+ 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 = '';
+ }
}
}
}
@@ -6498,10 +6646,10 @@ sub createcourse {
if (($chome eq '') || ($chome eq 'no_host')) {
$uname = $cnum;
} else {
- $uname = &generate_coursenum($udom);
+ $uname = &generate_coursenum($udom,$crstype);
}
} else {
- $uname = &generate_coursenum($udom);
+ $uname = &generate_coursenum($udom,$crstype);
}
return $uname if ($uname =~ /^error/);
# -------------------------------------------------- Check supplied server name
@@ -6561,17 +6709,28 @@ ENDINITMAP
# ------------------------------------------------------------------- Create ID
sub generate_coursenum {
- my ($udom) = @_;
+ my ($udom,$crstype) = @_;
my $domdesc = &domain($udom);
return 'error: invalid domain' if ($domdesc eq '');
- my $uname=int(1+rand(9)).
+ 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')) {
- $uname=int(1+rand(9)).
+ 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'};
@@ -10155,7 +10314,7 @@ createcourse($udom,$description,$url,$co
=item *
-generate_coursenum($udom) : get a unique (unused) course number in domain $udom
+generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community).
=back