[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Wed Sep 16 05:59:50 2009 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Modify allow check in createcourse() to accommodate requestcourses case.
    - Need to check course owner's environment.db for reqcrsotherdom.$category 
      if course domain is different from course owner's domain.
  - If current user is different to course owner, this is a previously queued request - now approved or validated, and user must have ccc priv in course's domain.  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1027 loncom/lonnet/perl/lonnet.pm:1.1028
--- loncom/lonnet/perl/lonnet.pm:1.1027	Sun Sep 13 03:13:38 2009
+++ loncom/lonnet/perl/lonnet.pm	Wed Sep 16 05:59:49 2009
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1027 2009/09/13 03:13:38 raeburn Exp $
+# $Id: lonnet.pm,v 1.1028 2009/09/16 05:59:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6445,14 +6445,39 @@
         $course_owner,$crstype,$cnum,$context,$category)=@_;
     $url=&declutter($url);
     my $cid='';
-    unless (&allowed('ccc',$udom)) {
-        if ($context eq 'requestcourses') {
-            unless (&usertools_access($course_owner,$udom,$category,undef,$context)) {
-                return 'refused';
+    if ($context eq 'requestcourses') {
+        my $can_create = 0;
+        my ($ownername,$ownerdom) = split(':',$course_owner);
+        if ($udom eq $ownerdom) {
+            if (&usertools_access($ownername,$ownerdom,$category,undef,
+                                  $context)) {
+                $can_create = 1;
+            }
+        } else {
+            my %userenv = &userenvironment($ownerdom,$ownername,'reqcrsotherdom.'.
+                                           $category);
+            if ($userenv{'reqcrsotherdom.'.$category} ne '') {
+                my @curr = split(',',$userenv{'reqcrsotherdom.'.$category});
+                if (@curr > 0) {
+                    my @options = qw(approval validate autolimit);
+                    my $optregex = join('|',@options);
+                    if (grep(/^\Q$udom\E:($optregex)(=?\d*)$/,@curr)) {
+                        $can_create = 1;
+                    }
+                }
+            }
+        }
+        if ($can_create) {
+            unless ($ownername eq $env{'user.name'} && $ownerdom eq $env{'user.domain'}) {
+                unless (&allowed('ccc',$udom)) {
+                    return 'refused'; 
+                }
             }
         } else {
             return 'refused';
         }
+    } elsif (!&allowed('ccc',$udom)) {
+        return 'refused';
     }
 # --------------------------------------------------------------- Get Unique ID
     my $uname;