--- loncom/lonnet/perl/lonnet.pm 2000/09/01 21:34:27 1.26 +++ loncom/lonnet/perl/lonnet.pm 2000/09/06 14:25:17 1.30 @@ -6,7 +6,12 @@ # plaintext(short) : plain text explanation of short term # fileembstyle(ext) : embed style in page for file extension # filedescription(ext) : descriptor text for file extension -# allowed(short,url) : returns codes for allowed actions F,R,S,X,C +# allowed(short,url) : returns codes for allowed actions +# F: full access +# U,I,K: authentication modes (cxx only) +# '': forbidden +# 1: user needs to choose course +# 2: browse allowed # definerole(rolename,sys,dom,cou) : define a custom role rolename # set priviledges in format of lonTabs/roles.tab for # system, domain and course level, @@ -23,13 +28,16 @@ # restore : returns hash for this url # eget(namesp,array) : returns hash with keys from array filled in from namesp # get(namesp,array) : returns hash with keys from array filled in from namesp +# del(namesp,array) : deletes keys out of arry from namesp # put(namesp,hash) : stores hash in namesp # dump(namesp) : dumps the complete namespace into a hash # ssi(url,hash) : does a complete request cycle on url to localhost, posts # hash # repcopy(filename) : replicate file # dirlist(url) : gets a directory listing -# condval(index) : value of condition index based on state +# condval(index) : value of condition index based on state +# varval(name) : value of a variable +# refreshstate() : refresh the state information string # # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, @@ -41,7 +49,7 @@ # 06/26 Ben Tyszka # 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer # 08/14 Ben Tyszka -# 08/22,08/28,08/31,09/01 Gerd Kortemeyer +# 08/22,08/28,08/31,09/01,09/02,09/04,09/05 Gerd Kortemeyer package Apache::lonnet; @@ -523,11 +531,24 @@ sub get { my %returnhash=(); map { my ($key,$value)=split(/=/,$_); - $returnhash{unespace($key)}=unescape($value); + $returnhash{unescape($key)}=unescape($value); } @pairs; return %returnhash; } +# --------------------------------------------------------------- del interface + +sub del { + my ($namespace,@storearr)=@_; + my $items=''; + map { + $items.=escape($_).'&'; + } @storearr; + $items=~s/\&$//; + return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", + $ENV{'user.home'}); +} + # -------------------------------------------------------------- dump interface sub dump { @@ -538,7 +559,7 @@ sub dump { my %returnhash=(); map { my ($key,$value)=split(/=/,$_); - $returnhash{unespace($key)}=unescape($value); + $returnhash{unescape($key)}=unescape($value); } @pairs; return %returnhash; } @@ -571,7 +592,7 @@ sub eget { my %returnhash=(); map { my ($key,$value)=split(/=/,$_); - $returnhash{unespace($key)}=unescape($value); + $returnhash{unescape($key)}=unescape($value); } @pairs; return %returnhash; } @@ -582,9 +603,15 @@ sub allowed { my ($priv,$uri)=@_; $uri=~s/^\/res//; $uri=~s/^\///; - if ($uri=~/^adm\//) { + +# Free bre access to adm resources + + if (($uri=~/^adm\//) && ($priv eq 'bre')) { return 'F'; } + +# Gather priviledges over system and domain + my $thisallowed=''; if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) { $thisallowed.=$1; @@ -592,12 +619,95 @@ sub allowed { if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) { $thisallowed.=$1; } - if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) { - $thisallowed.=$1; + +# Full access at system or domain level? Exit. + + if ($thisallowed=~/F/) { + return 'F'; + } + +# The user does not have full access at system or domain level +# Course level access control + +# uri itself refering to a course? + + if ($uri=~/\.course$/) { + 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 + + } else { + + unless(defined($ENV{'request.course.uri'})) { + return '1'; + } + +# Get access priviledges for course + + if ($ENV{'user.priv./'.$ENV{'request.course.uri'}}=~/$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'}.'.'.$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'}.'.'.$uripath}=~ + /\&$urifile\:(\d+)\&/) { + $uricond=$1; + } + } + + if ($uricond>=0) { + +# The resource is part of the course +# If user had full access on course level, go ahead + + if ($thisallowed=~/F/) { + return 'F'; + } + +# Restricted by state? + + if ($thisallowed=~/X/) { + if (&condval($uricond)>1) { + return '2'; + } else { + return ''; + } + } + } } return $thisallowed; } +# ---------------------------------------------------------- Refresh State Info + +sub refreshstate { +} + # ----------------------------------------------------------------- Define Role sub definerole { @@ -666,6 +776,8 @@ sub filedecription { sub assignrole { my ($udom,$uname,$url,$role,$end,$start)=@_; my $mrole; + $url=~s/^\///; + $url=~s/^res\///; if ($role =~ /^cr\//) { unless ($url=~/\.course$/) { return 'invalid'; } unless (allowed('ccr',$url)) { return 'refused'; } @@ -768,7 +880,7 @@ sub condval { my $condidx=shift; my $result=0; if ($ENV{'request.course'}) { - if ($ENV{'acc.cond.'.$ENV{'request.course'}.'.'.$condidx}) { + if (defined($ENV{'acc.cond.'.$ENV{'request.course'}.'.'.$condidx})) { my $operand='|'; my @stack; map { @@ -799,6 +911,25 @@ sub condval { return $result; } +# --------------------------------------------------------- Value of a Variable + +sub varval { + my ($realm,$space,@components)=split(/\./,shift); + my $value=''; + if ($realm eq 'user') { + if ($space=~/^resource/) { + $space=~s/^resource\[//; + $space=~s/\]$//; + + } else { + } + } elsif ($realm eq 'course') { + } elsif ($realm eq 'session') { + } elsif ($realm eq 'system') { + } + return $value; +} + # -------------------------------------------------------- Escape Special Chars sub escape {