version 1.48, 2000/10/25 10:55:46
|
version 1.52, 2000/10/28 17:26:35
|
Line 66
|
Line 66
|
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer |
# 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 Gerd Kortemeyer |
# 10/04 Guy Albertelli |
# 10/04 Guy Albertelli |
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25 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; |
package Apache::lonnet; |
|
|
Line 492 sub restore {
|
Line 493 sub restore {
|
sub coursedescription { |
sub coursedescription { |
my $courseid=shift; |
my $courseid=shift; |
$courseid=~s/^\///; |
$courseid=~s/^\///; |
|
$courseid=~s/\_/\//g; |
my ($cdomain,$cnum)=split(/\//,$courseid); |
my ($cdomain,$cnum)=split(/\//,$courseid); |
my $chome=homeserver($cnum,$cdomain); |
my $chome=homeserver($cnum,$cdomain); |
if ($chome ne 'no_host') { |
if ($chome ne 'no_host') { |
Line 513 sub coursedescription {
|
Line 515 sub coursedescription {
|
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
put ('coursedescriptions',%cachehash); |
put ('nohist_coursedescriptions',%cachehash); |
return %returnhash; |
return %returnhash; |
} |
} |
} |
} |
Line 551 sub rolesinit {
|
Line 553 sub rolesinit {
|
} |
} |
} |
} |
if (($area ne '') && ($trole ne '')) { |
if (($area ne '') && ($trole ne '')) { |
|
my $spec=$trole.'.'.$area; |
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
if ($trole =~ /^cr\//) { |
if ($trole =~ /^cr\//) { |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
Line 562 sub rolesinit {
|
Line 565 sub rolesinit {
|
if (($roledef ne 'con_lost') && ($roledef ne '')) { |
if (($roledef ne 'con_lost') && ($roledef ne '')) { |
my ($syspriv,$dompriv,$coursepriv)= |
my ($syspriv,$dompriv,$coursepriv)= |
split(/\_/,unescape($roledef)); |
split(/\_/,unescape($roledef)); |
$allroles{'/'}.=':'.$syspriv; |
$allroles{'cm./'}.=':'.$syspriv; |
|
$allroles{$spec.'./'}.=':'.$syspriv; |
if ($tdomain ne '') { |
if ($tdomain ne '') { |
$allroles{'/'.$tdomain.'/'}.=':'.$dompriv; |
$allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv; |
|
$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv; |
if ($trest ne '') { |
if ($trest ne '') { |
$allroles{$area}.=':'.$coursepriv; |
$allroles{'cm.'.$area}.=':'.$coursepriv; |
|
$allroles{$spec.'.'.$area}.=':'.$coursepriv; |
} |
} |
} |
} |
} |
} |
} |
} |
} else { |
} else { |
$allroles{'/'}.=':'.$pr{$trole.':s'}; |
$allroles{'cm./'}.=':'.$pr{$trole.':s'}; |
|
$allroles{$spec.'./'}.=':'.$pr{$trole.':s'}; |
if ($tdomain ne '') { |
if ($tdomain ne '') { |
$allroles{'/'.$tdomain.'/'}.=':'.$pr{$trole.':d'}; |
$allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'}; |
|
$allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'}; |
if ($trest ne '') { |
if ($trest ne '') { |
$allroles{$area}.=':'.$pr{$trole.':c'}; |
$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'}; |
|
$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'}; |
} |
} |
} |
} |
} |
} |
Line 706 sub eget {
|
Line 715 sub eget {
|
|
|
sub allowed { |
sub allowed { |
my ($priv,$uri)=@_; |
my ($priv,$uri)=@_; |
$uri=~s/^\/res//; |
$uri=&declutter($uri); |
$uri=~s/^\///; |
|
|
|
# Free bre access to adm resources |
# Free bre access to adm resources |
|
|
Line 715 sub allowed {
|
Line 723 sub allowed {
|
return 'F'; |
return 'F'; |
} |
} |
|
|
# Gather priviledges over system and domain |
|
|
|
my $thisallowed=''; |
my $thisallowed=''; |
if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) { |
my $statecond=0; |
$thisallowed.=$1; |
my $courseprivid=''; |
} |
|
if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) { |
# Course |
|
|
|
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) { |
$thisallowed.=$1; |
$thisallowed.=$1; |
} |
} |
|
|
# Full access at system or domain level? Exit. |
# Domain |
|
|
if ($thisallowed=~/F/) { |
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'} |
return 'F'; |
=~/$priv\&([^\:]*)/) { |
|
$thisallowed.=$1; |
} |
} |
|
|
# The user does not have full access at system or domain level |
# Course: uri itself is a course |
# Course level access control |
|
|
|
# uri itself refering to a course? |
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri} |
|
=~/$priv\&([^\:]*)/) { |
if ($uri=~/\.course$/) { |
$thisallowed.=$1; |
if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) { |
} |
$thisallowed.=$1; |
|
} |
|
# Full access on course level? Exit. |
|
if ($thisallowed=~/F/) { |
|
return 'F'; |
|
} |
|
|
|
# uri is refering to an individual resource; user needs to be in a course |
# Full access at system, domain or course-wide level? Exit. |
|
|
} else { |
if ($thisallowed=~/F/) { |
|
return 'F'; |
|
} |
|
|
unless(defined($ENV{'request.course.id'})) { |
# If this is generating or modifying users, exit with special codes |
return '1'; |
|
} |
|
|
|
# Get access priviledges for course |
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{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) { |
if ($ENV{'request.course.id'}) { |
$thisallowed.=$1; |
$courseprivid=$ENV{'request.course.id'}; |
|
if ($ENV{'request.course.sec'}) { |
|
$courseprivid.='/'.$ENV{'request.course.sec'}; |
} |
} |
|
$courseprivid=~s/\_/\//; |
# See if resource or referer is part of this course |
my $checkreferer=1; |
|
|
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
my $urifile=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
$urifile=~/\.(\w+)$/; |
my $pathname=$uri; |
my $uritype=$1; |
$pathname=~s/\/$filename$//; |
$#uriparts--; |
if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
my $uripath=join('/',@uriparts); |
/\&$filename\:(\d+)\&/) { |
my $uricond=-1; |
$statecond=$1; |
if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~ |
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid} |
/\&$urifile\:(\d+)\&/) { |
=~/$priv\&([^\:]*)/) { |
$uricond=$1; |
$thisallowed.=$1; |
} elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) { |
$checkreferer=0; |
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 (($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; |
|
} |
|
} |
|
} |
|
} |
|
|
if ($uricond>=0) { |
# |
|
# Gathered now: all priviledges that could apply, and condition number |
# The resource is part of the course |
# |
# If user had full access on course level, go ahead |
# |
|
# Full or no access? |
|
# |
|
|
if ($thisallowed=~/F/) { |
if ($thisallowed=~/F/) { |
return 'F'; |
return 'F'; |
} |
} |
|
|
# Restricted by state? |
unless ($thisallowed) { |
|
return ''; |
|
} |
|
|
if ($thisallowed=~/X/) { |
# Restrictions exist, deal with them |
if (&condval($uricond)) { |
# |
return '2'; |
# C:according to course preferences |
} else { |
# R:according to resource settings |
return ''; |
# 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 ''; |
|
} |
|
} |
} |
} |
} |
} |
} |
} |
return $thisallowed; |
|
|
# |
|
# Rest of the restrictions depend on selected course |
|
# |
|
|
|
unless ($ENV{'request.course.id'}) { |
|
return '1'; |
|
} |
|
|
|
# |
|
# Now user is definitely in a course |
|
# |
|
|
|
# Restricted by state? |
|
|
|
if ($thisallowed=~/X/) { |
|
if (&condval($statecond)) { |
|
return '2'; |
|
} else { |
|
return ''; |
|
} |
|
} |
|
|
|
return 'F'; |
} |
} |
|
|
# ---------------------------------------------------------- Refresh State Info |
# ---------------------------------------------------------- Refresh State Info |
Line 1076 sub varval {
|
Line 1155 sub varval {
|
} elsif ($realm eq 'course') { |
} elsif ($realm eq 'course') { |
# ---------------------------------------------------------- course.description |
# ---------------------------------------------------------- course.description |
if ($space eq 'description') { |
if ($space eq 'description') { |
return &coursedescription($ENV{'request.course.id'}); |
my %reply=&coursedescription($ENV{'request.course.id'}); |
|
return $reply{'description'}; |
# ------------------------------------------------------------------- course.id |
# ------------------------------------------------------------------- course.id |
} elsif ($space eq 'id') { |
} elsif ($space eq 'id') { |
return $ENV{'request.course.id'}; |
return $ENV{'request.course.id'}; |