version 1.683.2.3, 2005/12/22 20:57:49
|
version 1.683.2.7, 2006/01/11 07:33:45
|
Line 271 sub transfer_profile_to_env {
|
Line 271 sub transfer_profile_to_env {
|
my %Remove; |
my %Remove; |
for ($envi=0;$envi<=$#profile;$envi++) { |
for ($envi=0;$envi<=$#profile;$envi++) { |
chomp($profile[$envi]); |
chomp($profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi],2); |
$env{$envname} = $envvalue; |
$env{$envname} = $envvalue; |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if ($time < time-300) { |
if ($time < time-300) { |
Line 323 sub appenv {
|
Line 323 sub appenv {
|
for (my $i=0; $i<=$#oldenv; $i++) { |
for (my $i=0; $i<=$#oldenv; $i++) { |
chomp($oldenv[$i]); |
chomp($oldenv[$i]); |
if ($oldenv[$i] ne '') { |
if ($oldenv[$i] ne '') { |
my ($name,$value)=split(/=/,$oldenv[$i]); |
my ($name,$value)=split(/=/,$oldenv[$i],2); |
unless (defined($newenv{$name})) { |
unless (defined($newenv{$name})) { |
$newenv{$name}=$value; |
$newenv{$name}=$value; |
} |
} |
Line 382 sub delenv {
|
Line 382 sub delenv {
|
} |
} |
foreach (@oldenv) { |
foreach (@oldenv) { |
if ($_=~/^$delthis/) { |
if ($_=~/^$delthis/) { |
my ($key,undef) = split('=',$_); |
my ($key,undef) = split('=',$_,2); |
delete($env{$key}); |
delete($env{$key}); |
} else { |
} else { |
print $fh $_; |
print $fh $_; |
Line 3010 sub tmpput {
|
Line 3010 sub tmpput {
|
|
|
# ------------------------------------------------------------ tmpget interface |
# ------------------------------------------------------------ tmpget interface |
sub tmpget { |
sub tmpget { |
my ($token)=@_; |
my ($token,$server)=@_; |
my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'}); |
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
|
my $rep=&reply("tmpget:$token",$server); |
my %returnhash; |
my %returnhash; |
foreach my $item (split(/\&/,$rep)) { |
foreach my $item (split(/\&/,$rep)) { |
my ($key,$value)=split(/=/,$item); |
my ($key,$value)=split(/=/,$item); |
Line 3020 sub tmpget {
|
Line 3021 sub tmpget {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
# ------------------------------------------------------------ tmpget interface |
|
sub tmpdel { |
|
my ($token,$server)=@_; |
|
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
|
return &reply("tmpdel:$token",$server); |
|
} |
|
|
# ---------------------------------------------- Custom access rule evaluation |
# ---------------------------------------------- Custom access rule evaluation |
|
|
sub customaccess { |
sub customaccess { |
Line 3338 sub allowed {
|
Line 3346 sub allowed {
|
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
=~/\Q$rolecode\E/) { |
=~/\Q$rolecode\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
if ($priv ne 'pch') { |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
$env{'request.course.id'}); |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
|
$env{'request.course.id'}); |
|
} |
return ''; |
return ''; |
} |
} |
|
|
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
=~/\Q$unamedom\E/) { |
=~/\Q$unamedom\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
if ($priv ne 'pch') { |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
$env{'request.course.id'}); |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
|
$env{'request.course.id'}); |
|
} |
return ''; |
return ''; |
} |
} |
} |
} |
Line 3358 sub allowed {
|
Line 3370 sub allowed {
|
if ($thisallowed=~/R/) { |
if ($thisallowed=~/R/) { |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { |
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
if ($priv ne 'pch') { |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
return ''; |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
|
} |
|
return ''; |
} |
} |
} |
} |
|
|
Line 3391 sub is_on_map {
|
Line 3405 sub is_on_map {
|
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s/^adm\/wrapper\///; |
$pathname=~s/^adm\/wrapper\///; |
|
$pathname=~s/^adm\/coursedocs\/showdoc\///; |
#Trying to find the conditional for the file |
#Trying to find the conditional for the file |
my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ |
my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ |
/\&\Q$filename\E\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
Line 4961 sub metadata {
|
Line 4976 sub metadata {
|
# if it is a non metadata possible uri return quickly |
# if it is a non metadata possible uri return quickly |
if (($uri eq '') || |
if (($uri eq '') || |
(($uri =~ m|^/*adm/|) && |
(($uri =~ m|^/*adm/|) && |
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || |
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|) |
|
&& ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) || |
($uri =~ m|home/[^/]+/public_html/|)) { |
($uri =~ m|home/[^/]+/public_html/|)) { |
return undef; |
return undef; |
Line 5279 sub symbverify {
|
Line 5295 sub symbverify {
|
my $thisfn=$thisurl; |
my $thisfn=$thisurl; |
# wrapper not part of symbs |
# wrapper not part of symbs |
$thisfn=~s/^\/adm\/wrapper//; |
$thisfn=~s/^\/adm\/wrapper//; |
|
$thisfn=~s/^\/adm\/coursedocs\/showdoc\///; |
$thisfn=&declutter($thisfn); |
$thisfn=&declutter($thisfn); |
# direct jump to resource in page or to a sequence - will construct own symbs |
# direct jump to resource in page or to a sequence - will construct own symbs |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
Line 5333 sub symbclean {
|
Line 5350 sub symbclean {
|
# remove wrapper |
# remove wrapper |
|
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/; |
return $symb; |
return $symb; |
} |
} |
|
|
Line 6067 sub declutter {
|
Line 6085 sub declutter {
|
$thisfn=~s/^\///; |
$thisfn=~s/^\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/\?.+$//; |
$thisfn=~s/\?.+$//; |
|
$thisfn=~s|^adm/wrapper/||; |
|
$thisfn=~s|^adm/coursedocs/showdoc/||; |
return $thisfn; |
return $thisfn; |
} |
} |
|
|
Line 6077 sub clutter {
|
Line 6097 sub clutter {
|
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
|
if ($thisfn !~m|/adm|) { |
|
if ($thisfn =~ m|/ext/|) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} else { |
|
my ($ext) = ($thisfn =~ /\.(\w+)$/); |
|
my $embstyle=&Apache::loncommon::fileembstyle($ext); |
|
if (($embstyle eq 'img') |
|
|| ($embstyle eq 'emb') |
|
|| ($embstyle eq 'wrp')) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} elsif ($embstyle eq 'ssi') { |
|
#do nothing with these |
|
} elsif ($thisfn!~/\.(sequence|page)$/) { |
|
$thisfn='/adm/coursedocs/showdoc'.$thisfn; |
|
} |
|
} |
|
} |
return $thisfn; |
return $thisfn; |
} |
} |
|
|