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

[raeburn]

raeburn		Sat Oct 31 21:38:00 2009 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - 'bro' priv allows a user to browse author directories in /res space 
     for which the user is author or co-author. 
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1038 loncom/lonnet/perl/lonnet.pm:1.1039
--- loncom/lonnet/perl/lonnet.pm:1.1038	Thu Oct 29 03:23:58 2009
+++ loncom/lonnet/perl/lonnet.pm	Sat Oct 31 21:38:00 2009
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1038 2009/10/29 03:23:58 raeburn Exp $
+# $Id: lonnet.pm,v 1.1039 2009/10/31 21:38:00 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5044,17 +5044,65 @@
     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
@@ -5064,7 +5112,9 @@
 
     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