--- loncom/lonnet/perl/lonnet.pm 2009/10/24 03:24:25 1.1035 +++ loncom/lonnet/perl/lonnet.pm 2009/10/31 21:38:00 1.1039 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1035 2009/10/24 03:24:25 raeburn Exp $ +# $Id: lonnet.pm,v 1.1039 2009/10/31 21:38:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4842,7 +4842,7 @@ sub is_advanced_user { } sub check_can_request { - my ($dom,$can_request) = @_; + my ($dom,$can_request,$request_domains) = @_; my $canreq = 0; my ($types,$typename) = &Apache::loncommon::course_types(); my @options = ('approval','validate','autolimit'); @@ -4853,6 +4853,9 @@ sub check_can_request { $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; } @@ -4860,8 +4863,22 @@ sub check_can_request { if ($env{'environment.reqcrsotherdom.'.$type} ne '') { my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type}); if (@curr > 0) { - $canreq ++; - unless ($dom eq $env{'user.domain'}) { + 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; } @@ -5027,17 +5044,65 @@ sub allowed { my $statecond=0; my $courseprivid=''; + my $ownaccess; + # Community Coordinator 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/$uname/}) { + 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/\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; + if ($env{"user.role.ca./$adom/$aname"}) { + my ($start,$end) = + split('.',$env{"user.role.ca./$adom/$aname"}); + if (($now >= $start) && (!$end || $end < $now)) { + $ownaccess = 1; + } + } + } + } + } + } + } + # 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 @@ -5047,7 +5112,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 @@ -6073,24 +6140,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 @@ -6530,10 +6604,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 @@ -6593,17 +6667,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'}; @@ -10187,7 +10272,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