--- loncom/lonnet/perl/lonnet.pm 2002/05/27 19:03:59 1.234 +++ loncom/lonnet/perl/lonnet.pm 2002/06/15 20:06:21 1.239 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.234 2002/05/27 19:03:59 www Exp $ +# $Id: lonnet.pm,v 1.239 2002/06/15 20:06:21 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1501,7 +1501,21 @@ sub allowed { # Free bre to public access if ($priv eq 'bre') { - if (&metadata($uri,'copyright') eq 'public') { return 'F'; } + my $copyright=&metadata($uri,'copyright'); + if ($copyright eq 'public') { return 'F'; } + if ($copyright eq 'priv') { + $uri=~/([^\/]+)\/([^\/]+)\//; + unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) { + return ''; + } + } + if ($copyright eq 'domain') { + $uri=~/([^\/]+)\/([^\/]+)\//; + unless (($ENV{'user.domain'} eq $1) || + ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $1)) { + return ''; + } + } } my $thisallowed=''; @@ -1645,7 +1659,7 @@ sub allowed { || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) { if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) { &log($ENV{'user.domain'},$ENV{'user.name'}, - $ENV{'user.host'}, + $ENV{'user.home'}, 'Locked by res: '.$priv.' for '.$uri.' due to '. $cdom.'/'.$cnum.'/'.$csec.' expire '. $ENV{$prefix.'priv.'.$priv.'.lock.expire'}); @@ -1656,7 +1670,7 @@ sub allowed { || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) { if ($ENV{'priv.'.$priv.'.lock.expire'}>time) { &log($ENV{'user.domain'},$ENV{'user.name'}, - $ENV{'user.host'}, + $ENV{'user.home'}, 'Locked by priv: '.$priv.' for '.$uri.' due to '. $cdom.'/'.$cnum.'/'.$csec.' expire '. $ENV{$prefix.'priv.'.$priv.'.lock.expire'}); @@ -1684,6 +1698,7 @@ sub allowed { if ($thisallowed=~/C/) { my $rolecode=(split(/\./,$ENV{'request.role'}))[0]; + my $unamedom=$ENV{'user.name'}.':'.$ENV{'user.domain'}; if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'} =~/$rolecode/) { &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'}, @@ -1691,6 +1706,14 @@ sub allowed { $ENV{'request.course.id'}); return ''; } + + if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.users.denied'} + =~/$unamedom/) { + &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'}, + 'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. + $ENV{'request.course.id'}); + return ''; + } } # Resource preferences @@ -1737,7 +1760,6 @@ sub is_on_map { $pathname=~s/\/$filename$//; my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ /\&$filename\:([\d\|]+)\&/); - &logthis('is: '.$uri.' '.$match.' '.$1); if ($match) { return (1,$1); } else { @@ -2279,7 +2301,11 @@ sub EXT { my %reply=&get($space,[$item]); return $reply{$item}; } - } elsif ($realm eq 'request') { + } elsif ($realm eq 'query') { +# ---------------------------------------------- pull stuff out of query string + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]); + return $ENV{'form.'.$space}; + } elsif ($realm eq 'request') { # ------------------------------------------------------------- request.browser if ($space eq 'browser') { return $ENV{'browser.'.$qualifier}; @@ -2788,6 +2814,7 @@ sub declutter { $thisfn=~s/^$perlvar{'lonDocRoot'}//; $thisfn=~s/^\///; $thisfn=~s/^res\///; + $thisfn=~s/\?.+$//; return $thisfn; }