--- loncom/lonnet/perl/lonnet.pm 2000/10/26 15:29:17 1.51
+++ loncom/lonnet/perl/lonnet.pm 2000/10/28 19:26:07 1.53
@@ -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;
@@ -498,7 +499,7 @@ sub coursedescription {
if ($chome ne 'no_host') {
my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
if ($rep ne 'con_lost') {
- my %cachehash=();
+ my %envhash=();
my %returnhash=('home' => $chome,
'domain' => $cdomain,
'num' => $cnum);
@@ -507,14 +508,14 @@ sub coursedescription {
$name=&unescape($name);
$value=&unescape($value);
$returnhash{$name}=$value;
- if ($name eq 'description') {
- $cachehash{$courseid}=$value;
- }
+ my $normalid=$courseid;
+ $normalid=~s/\//\_/g;
+ $envhash{'course.'.$normalid.'.'.$name}=$value;
} split(/\&/,$rep);
$returnhash{'url'}='/res/'.declutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
- put ('nohist_coursedescriptions',%cachehash);
+ &appenv(%envhash);
return %returnhash;
}
}
@@ -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,191 @@ 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'};
+ }
+ $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;
+ }
}
-# Full access on course level? Exit.
- if ($thisallowed=~/F/) {
- return 'F';
+ if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
+ my $refuri=&declutter($ENV{'HTTP_REFERER'});
+ my @uriparts=split(/\//,$refuri);
+ my $filename=$uriparts[$#uriparts];
+ my $pathname=$refuri;
+ $pathname=~s/\/$filename$//;
+ my @filenameparts=split(/\./,$filename);
+ if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {
+ if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+ /\&$filename\:(\d+)\&/) {
+ my $refstatecond=$1;
+ if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
+ =~/$priv\&([^\:]*)/) {
+ $thisallowed.=$1;
+ $uri=$refuri;
+ $statecond=$refstatecond;
+ }
+ }
+ }
}
+ }
-# uri is refering to an individual resource; user needs to be in a course
+#
+# Gathered now: all priviledges that could apply, and condition number
+#
+#
+# Full or no access?
+#
- } else {
+ if ($thisallowed=~/F/) {
+ return 'F';
+ }
- unless(defined($ENV{'request.course.id'})) {
- return '1';
+ unless ($thisallowed) {
+ return '';
+ }
+
+# 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
+#
-# Get access priviledges for course
+ unless ($ENV{'request.course.id'}) {
+ return '1';
+ }
- if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {
- $thisallowed.=$1;
- }
+#
+# Now user is definitely in a course
+#
-# 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 ($uricond>=0) {
+# Course preferences
-# The resource is part of the course
-# If user had full access on course level, go ahead
+ if ($thisallowed=~/C/) {
+#
+# Registered course preferences from environment
+#
+ }
- if ($thisallowed=~/F/) {
- return 'F';
- }
+# Resource preferences
+
+ if ($thisallowed=~/R/) {
+#
+# Resource Metadata
+#
+ }
# 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