--- loncom/lonnet/perl/lonnet.pm 2009/10/23 00:20:40 1.1034 +++ loncom/lonnet/perl/lonnet.pm 2010/01/15 00:14:01 1.1048.2.1 @@ -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.1048.2.1 2010/01/15 00:14:01 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; @@ -1722,6 +1728,9 @@ sub userenvironment { 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]); @@ -2729,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} @@ -2738,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; @@ -2759,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; @@ -3907,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; } @@ -4841,6 +4855,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 +5058,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 +5129,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 +6151,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 +6240,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 = ''; + } elsif (($selfenroll == 1) && ($role eq 'st') && ($cdom eq 'gci') && ($cnum eq '1H96711d710194bfegcil1')) { + if ($env{'request.role'} eq 'cc./gci/9615072b469884921gcil1') { + $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 +6653,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 +6716,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 +10321,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