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

[www]

www		Wed Mar 19 16:23:03 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Evaluation of custom access rights.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.342 loncom/lonnet/perl/lonnet.pm:1.343
--- loncom/lonnet/perl/lonnet.pm:1.342	Wed Mar 19 11:50:14 2003
+++ loncom/lonnet/perl/lonnet.pm	Wed Mar 19 16:23:03 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.342 2003/03/19 16:50:14 www Exp $
+# $Id: lonnet.pm,v 1.343 2003/03/19 21:23:03 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1875,12 +1875,27 @@
 sub customaccess {
     my ($priv,$uri)=@_;
     my ($urole,$urealm)=split(/\./,$ENV{'request.role'});
-    my ($udm,$ucid,$usec)=split(/\//,$urealm);
+    $urealm=~s/^\W//;
+    my ($udom,$ucrs,$usec)=split(/\//,$urealm);
     my $access=0;
     foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
 	my ($effect,$realm,$role)=split(/\:/,$_);
-        foreach my $thisrealm (split(/\s*\,\s*/,$realm)) {
-            &logthis('testing '.$effect.' '.$thisrealm.' '.$role);
+        if ($role) {
+	   if ($role ne $urole) { next; }
+        }
+        foreach (split(/\s*\,\s*/,$realm)) {
+            my ($tdom,$tcrs,$tsec)=split(/\_/,$_);
+            if ($tdom) {
+		if ($tdom ne $udom) { next; }
+            }
+            if ($tcrs) {
+		if ($tcrs ne $ucrs) { next; }
+            }
+            if ($tsec) {
+		if ($tsec ne $usec) { next; }
+            }
+            $access=($effect eq 'allow');
+            last;
         }
     }
     return $access;