--- loncom/lonnet/perl/lonnet.pm 2003/03/18 07:26:49 1.341 +++ loncom/lonnet/perl/lonnet.pm 2003/03/19 21:23:03 1.343 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.341 2003/03/18 07:26:49 www Exp $ +# $Id: lonnet.pm,v 1.343 2003/03/19 21:23:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1874,10 +1874,29 @@ sub eget { sub customaccess { my ($priv,$uri)=@_; + my ($urole,$urealm)=split(/\./,$ENV{'request.role'}); + $urealm=~s/^\W//; + my ($udom,$ucrs,$usec)=split(/\//,$urealm); my $access=0; foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) { - my ($effect,$realm,$content)=split(/\:/,$_); - &logthis('testing '.$effect.' '.$realm.' '.$content); + my ($effect,$realm,$role)=split(/\:/,$_); + 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; }