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

[raeburn]

raeburn		Tue Nov 15 16:35:03 2005 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Functionality for course groups. Group information from roles.db not displayed as a selectable role, but privileges are provided in user's environment, contingenet on the time window for the user's access to the group.  If a user selects a role in a course, the group privileges will be available, for lonnet::allowed() checks.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.677 loncom/lonnet/perl/lonnet.pm:1.678
--- loncom/lonnet/perl/lonnet.pm:1.677	Tue Nov 15 13:39:16 2005
+++ loncom/lonnet/perl/lonnet.pm	Tue Nov 15 16:35:02 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.677 2005/11/15 18:39:16 albertel Exp $
+# $Id: lonnet.pm,v 1.678 2005/11/15 21:35:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2575,15 +2575,17 @@
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
     my %allroles=();
+    my %allgroups=();   
     my $now=time;
     my $userroles="user.login.time=$now\n";
+    my $group_privs;
 
     if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {
 	  if ($_!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);
 	    $area=~s/\_\w\w$//;
-            my ($trole,$tend,$tstart);
+            my ($trole,$tend,$tstart,$group_privs);
 	    if ($role=~/^cr/) { 
 		if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
 		    ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
@@ -2591,6 +2593,10 @@
 		} else {
 		    $trole=$role;
 		}
+            } elsif ($role =~ m|^gr/|) {
+                ($trole,$tend,$tstart) = split(/_/,$role);
+                ($trole,$group_privs) = split(/\//,$trole);
+                $group_privs = &unescape($group_privs);
 	    } else {
 		($trole,$tend,$tstart)=split(/_/,$role);
 	    }
@@ -2602,13 +2608,15 @@
 		my ($tdummy,$tdomain,$trest)=split(/\//,$area);
 		if ($trole =~ /^cr\//) {
                     &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+                } elsif ($trole eq 'gr') {
+                    &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
 		} else {
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
 		}
             }
           }
         }
-        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
+        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles,\%allgroups);
         $userroles.='user.adv='.$adv."\n".
 	            'user.author='.$author."\n";
         $env{'user.adv'}=$adv;
@@ -2650,6 +2658,17 @@
     }
 }
 
+sub group_roleprivs {
+    my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
+    my $access = 1;
+    my $now = time;
+    if (($tend!=0) && ($tend<$now)) { $access = 0; }
+    if (($tstart!=0) && ($tstart>$now)) { $access=0; }
+    if ($access) {
+        my ($course,$group) = ($area =~ m|(/\w+/\w+)/([^/]+)$|);
+        $$allgroups{$course}{$group} .=':'.$group_privs;
+    }
+}
 
 sub standard_roleprivs {
     my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
@@ -2670,9 +2689,33 @@
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles) = @_; 
+    my ($userroles,$allroles,$allgroups) = @_; 
     my $author=0;
     my $adv=0;
+    my %grouproles = ();
+    my %groups_checked = ();
+    if (keys(%{$allgroups}) > 0) {
+        foreach my $role (keys %{$allroles}) {
+            my ($trole,$area);
+            if ($role =~ m|^(\w+)\.(/\w+/\w+)|) {
+                $trole = $1;
+                $area = $2;
+                unless ($groups_checked{$area}) {
+                    $groups_checked{$area} = 1;
+                    if (exists($$allgroups{$area})) {
+                        foreach my $group (keys(%{$$allgroups{$area}})) {
+                            my $spec = $trole.'.'.$area;
+                            $grouproles{$spec.'.'.$area.'/'.$group} = 
+                                                    $$allgroups{$area}{$group};
+                        }
+                    }
+                }
+            }
+        }
+    }
+    foreach (keys(%grouproles)) {
+        $$allroles{$_} = $grouproles{$_};
+    }
     foreach (keys %{$allroles}) {
         my %thesepriv=();
         if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
@@ -3024,8 +3067,6 @@
     my $orguri=$uri;
     $uri=&declutter($uri);
     
-    
-    
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
@@ -3072,7 +3113,7 @@
     if (($priv eq 'ccc') && ($env{'request.role'} =~ /^dc\./)) {
         # uri is the requested domain in this case.
         # comparison to 'request.role.domain' shows if the user has selected
-        # a role of dc for the domain in question. 
+        # a role of dc for the domain in question.
         return 'F' if ($uri eq $env{'request.role.domain'});
     }
 
@@ -3103,6 +3144,14 @@
        $thisallowed.=$1;
     }
 
+# Group: uri itself is a group
+    my $groupuri=$uri;
+    $groupuri=~s/^([^\/])/\/$1/;
+    if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri}
+       =~/\Q$priv\E\&([^\:]*)/) {
+       $thisallowed.=$1;
+    }
+
 # URI is an uploaded document for this course, default permissions don't matter
 # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
@@ -3675,6 +3724,16 @@
            return 'refused'; 
         }
         $mrole='cr';
+    } elsif ($role =~ /^gr\//) {
+        my $cwogrp=$url;
+        $cwogrp=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
+        unless (&allowed('mdg',$cwogrp)) {
+            &logthis('Refused group assignrole: '.
+              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+                    $env{'user.name'}.' at '.$env{'user.domain'});
+            return 'refused';
+        }
+        $mrole='gr';
     } else {
         my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;