--- loncom/lonnet/perl/lonnet.pm 2009/10/28 19:09:21 1.1037 +++ loncom/lonnet/perl/lonnet.pm 2009/10/31 23:37:00 1.1040 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1037 2009/10/28 19:09:21 raeburn Exp $ +# $Id: lonnet.pm,v 1.1040 2009/10/31 23:37:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -5044,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/\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/\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 @@ -5064,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 @@ -6554,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 @@ -6617,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'}; @@ -10211,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