--- loncom/lonnet/perl/lonnet.pm	2009/10/23 00:20:40	1.1034
+++ loncom/lonnet/perl/lonnet.pm	2010/12/08 04:51:26	1.1048.2.5
@@ -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.5 2010/12/08 04:51:26 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;
             }
@@ -4024,13 +4038,6 @@ sub role_status {
                             );
                             my $spec=$$role.'.'.$$where;
                             my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
-                            if ($$role eq 'gr') {
-                                my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
-                                                    $env{'user.name'})=@_;
-                                my ($trole) = split('_',$role,1);
-                                (undef,my $group_privs) = split(/\//,$trole);
-                                $group_privs = &unescape($group_privs);
-                            }
                             if ($$role =~ /^cr\//) {
                                 &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
                             } elsif ($$role eq 'gr') {
@@ -4062,6 +4069,41 @@ sub role_status {
     }
 }
 
+sub curr_role_status {
+    my ($start,$end,$refresh,$then) = @_;
+    if (($start) && ($start<0)) { return 'deleted' };
+    my $status = 'active';
+    if (($end) && ($end<=$then)) {
+        $status = 'previous';
+    }
+    if (($start) && ($refresh<$start)) {
+        $status = 'future';
+    }
+    return $status;
+}
+
+sub gather_roleprivs {
+    my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend) = @_;
+    return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));
+    if (($area ne '') && ($role ne '')) {
+        my $spec = $role.'.'.$area;
+        my ($tdummy,$tdomain,$trest)=split(/\//,$area);
+        if ($role =~ /^cr\//) {
+            &custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);
+        } elsif ($role eq 'gr') {
+            my %rolehash = &get('roles',[$area.'_'.$role],$env{'user.domain'},
+                                $env{'user.name'});
+            my $trole = split('_',$rolehash{$area.'_'.$role},1);
+            (undef,my $group_privs) = split(/\//,$trole);
+            $group_privs = &unescape($group_privs);
+            &group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);
+        } else {
+            &standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);
+        }
+    }
+    return;
+}
+
 sub check_adhoc_privs {
     my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
@@ -4806,6 +4848,27 @@ sub usertools_access {
     }
 }
 
+sub is_course_owner {
+    my ($cdom,$cnum,$udom,$uname) = @_;
+    if (($udom eq '') || ($uname eq '')) {
+        $udom = $env{'user.domain'};
+        $uname = $env{'user.name'};
+    }
+    unless (($udom eq '') || ($uname eq '')) {
+        if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'})) {
+            if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {
+                return 1;
+            } else {
+                my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);
+                if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {
+                    return 1;
+                }
+            }
+        }
+    }
+    return;
+}
+
 sub is_advanced_user {
     my ($udom,$uname) = @_;
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
@@ -4841,6 +4904,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 +5107,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 +5178,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 +6200,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 +6289,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') || ($cnum eq '5422913620b814c90gcil1'))) {
+                    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 +6702,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 +6765,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'};
@@ -9319,6 +9534,7 @@ sub get_dns {
     my %libserv;
     my $loaded;
     my %name_to_host;
+    my %internetdom;
 
     sub parse_hosts_tab {
 	my ($file) = @_;
@@ -9326,7 +9542,7 @@ sub get_dns {
 	    next if ($configline =~ /^(\#|\s*$ )/x);
 	    next if ($configline =~ /^\^/);
 	    chomp($configline);
-	    my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline);
+	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
 		$hostname{$id}=$name;
@@ -9342,6 +9558,9 @@ sub get_dns {
                 } else {
                     $protocol{$id} = 'http';
                 }
+                if (defined($intdom)) {
+                    $internetdom{$id} = $intdom;
+                }
 	    }
 	}
     }
@@ -9440,6 +9659,13 @@ sub get_dns {
 	my @uniq = grep(!$seen{$_}++, values(%hostdom));
 	return @uniq;
     }
+
+    sub internet_dom {
+        &load_hosts_tab() if (!$loaded);
+
+        my ($lonid) = @_;
+        return $internetdom{$lonid};
+    }
 }
 
 { 
@@ -10155,7 +10381,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