--- loncom/lonnet/perl/lonnet.pm	2000/10/26 15:29:17	1.51
+++ loncom/lonnet/perl/lonnet.pm	2000/10/28 17:26:35	1.52
@@ -66,7 +66,8 @@
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
 # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli
-# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26 Gerd Kortemeyer
+# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28 
+# Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -714,8 +715,7 @@ sub eget {
 
 sub allowed {
     my ($priv,$uri)=@_;
-    $uri=~s/^\/res//;
-    $uri=~s/^\///;
+    $uri=&declutter($uri);
 
 # Free bre access to adm resources
 
@@ -723,97 +723,168 @@ sub allowed {
 	return 'F';
     }
 
-# Gather priviledges over system and domain
-
     my $thisallowed='';
-    if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) {
+    my $statecond=0;
+    my $courseprivid='';
+
+# Course
+
+    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
+       $thisallowed.=$1;
+    }
+
+# Domain
+
+    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
+       =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;
     }
-    if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {
+
+# Course: uri itself is a course
+
+    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
+       =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;
     }
 
-# Full access at system or domain level? Exit.
+# Full access at system, domain or course-wide level? Exit.
 
     if ($thisallowed=~/F/) {
 	return 'F';
     }
 
-# The user does not have full access at system or domain level
-# Course level access control
+# If this is generating or modifying users, exit with special codes
 
-# uri itself refering to a course?
-    
-    if ($uri=~/\.course$/) {
-       if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) {
-          $thisallowed.=$1;
+    if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) {
+	return $thisallowed;
+    }
+#
+# Gathered so far: system, domain and course wide priviledges
+#
+# Course: See if uri or referer is an individual resource that is part of 
+# the course
+
+    if ($ENV{'request.course.id'}) {
+       $courseprivid=$ENV{'request.course.id'};
+       if ($ENV{'request.course.sec'}) {
+          $courseprivid.='/'.$ENV{'request.course.sec'};
        }
-# Full access on course level? Exit.
-       if ($thisallowed=~/F/) {
-	  return 'F';
+       $courseprivid=~s/\_/\//;
+       my $checkreferer=1;
+       my @uriparts=split(/\//,$uri);
+       my $filename=$uriparts[$#uriparts];
+       my $pathname=$uri;
+       $pathname=~s/\/$filename$//;
+       if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+           /\&$filename\:(\d+)\&/) {
+           $statecond=$1;
+           if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
+               =~/$priv\&([^\:]*)/) {
+               $thisallowed.=$1;
+               $checkreferer=0;
+           }
        }
-
-# uri is refering to an individual resource; user needs to be in a course
-
-   } else {
-
-       unless(defined($ENV{'request.course.id'})) {
-	   return '1';
+       if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
+          my @uriparts=split(/\//,&declutter($ENV{'HTTP_REFERER'}));
+          my $filename=$uriparts[$#uriparts];
+          my $pathname=$uri;
+          $pathname=~s/\/$filename$//;
+          if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+              /\&$filename\:(\d+)\&/) {
+              $statecond=$1;
+              if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
+                  =~/$priv\&([^\:]*)/) {
+                  $thisallowed.=$1;
+              }
+          }
        }
+   }
 
-# Get access priviledges for course
+#
+# Gathered now: all priviledges that could apply, and condition number
+# 
+#
+# Full or no access?
+#
 
-       if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {
-          $thisallowed.=$1;
-       }
-
-# See if resource or referer is part of this course
-          
-       my @uriparts=split(/\//,$uri);
-       my $urifile=$uriparts[$#uriparts];
-       $urifile=~/\.(\w+)$/;
-       my $uritype=$1;
-       $#uriparts--;
-       my $uripath=join('/',@uriparts);
-       my $uricond=-1;
-       if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~
-	   /\&$urifile\:(\d+)\&/) {
-	   $uricond=$1;
-       } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {
-	  my $refuri=$ENV{'HTTP_REFERER'};
-          $refuri=~s/^\/res//;
-          $refuri=~s/^\///;
-          @uriparts=split(/\//,$refuri);
-          $urifile=$uriparts[$#uriparts];
-          $#uriparts--;
-          $uripath=join('/',@uriparts);
-          if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~
-	     /\&$urifile\:(\d+)\&/) {
-	     $uricond=$1;
-	  }
-       }
+    if ($thisallowed=~/F/) {
+	return 'F';
+    }
 
-       if ($uricond>=0) {
+    unless ($thisallowed) {
+        return '';
+    }
 
-# The resource is part of the course
-# If user had full access on course level, go ahead
+# Restrictions exist, deal with them
+#
+#   C:according to course preferences
+#   R:according to resource settings
+#   L:unless locked
+#   X:according to user session state
+#
+
+# Possibly locked functionality, check all courses
+
+    my $envkey;
+    if ($thisallowed=~/L/) {
+        foreach $envkey (keys %ENV) {
+           if ($envkey=~/^user\.role\.st\.([^\.]*)/) {
+	       my ($cdom,$cnum,$csec)=split(/\//,$1);
+               my %locks=();
+               map {
+                   my ($name,$value)=split(/\=/,$_);
+                   $locks{&unescape($name)}=&unescape($value);
+               } split(/\&/,&reply('get:'.$cdom.':'.$cnum.
+                 ':environment:'.&escape('priv.'.$priv.'.lock.sections').
+                             ':'.&escape('priv.'.$priv.'.lock.expire').
+                             ':'.&escape('res.'.$uri.'.lock.sections').
+			     ':'.&escape('res.'.$uri.'.lock.expire'),
+                  &homeserver($cnum,$cdom)));
+               if (($locks{'res.'.$uri.'.lock.sections'}=~/\,$csec\,/) ||
+                   ($locks{'res.'.$uri.'.lock.sections'} eq 'all')) {
+		   if ($locks{'res.'.$uri.'.lock.expire'}>time) {
+                       &log('Locked by res: '.$priv.' for '.$uri.' due to '.
+                            $cdom.'/'.$cnum.'/'.$csec.' expire '.
+                            $locks{'priv.'.$priv.'.lock.expire'});
+		       return '';
+                   }
+               }
+               if (($locks{'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/) ||
+                   ($locks{'priv.'.$priv.'.lock.sections'} eq 'all')) {
+		   if ($locks{'priv.'.$priv.'.lock.expire'}>time) {
+                       &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
+                            $cdom.'/'.$cnum.'/'.$csec.' expire '.
+                            $locks{'priv.'.$priv.'.lock.expire'});
+		       return '';
+                   }
+               }
+	   }
+       }
+    }
+   
+#
+# Rest of the restrictions depend on selected course
+#
+
+    unless ($ENV{'request.course.id'}) {
+       return '1';
+    }
 
-           if ($thisallowed=~/F/) {
-	       return 'F';
-           }
+#
+# Now user is definitely in a course
+#
 
 # Restricted by state?
 
-           if ($thisallowed=~/X/) {
-	      if (&condval($uricond)) {
-	         return '2';
-              } else {
-                 return '';
-              }
-	   }
-       }
-    }
-    return $thisallowed;
+   if ($thisallowed=~/X/) {
+      if (&condval($statecond)) {
+	 return '2';
+      } else {
+         return '';
+      }
+   }
+
+   return 'F';
 }
 
 # ---------------------------------------------------------- Refresh State Info