--- loncom/lonnet/perl/lonnet.pm 2003/03/19 16:50:14 1.342 +++ 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.342 2003/03/19 16:50:14 www Exp $ +# $Id: lonnet.pm,v 1.343 2003/03/19 21:23:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1875,12 +1875,27 @@ sub eget { sub customaccess { my ($priv,$uri)=@_; my ($urole,$urealm)=split(/\./,$ENV{'request.role'}); - my ($udm,$ucid,$usec)=split(/\//,$urealm); + $urealm=~s/^\W//; + my ($udom,$ucrs,$usec)=split(/\//,$urealm); my $access=0; foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) { my ($effect,$realm,$role)=split(/\:/,$_); - foreach my $thisrealm (split(/\s*\,\s*/,$realm)) { - &logthis('testing '.$effect.' '.$thisrealm.' '.$role); + 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;