FileControl — specify page names and Perl subroutines that implement access control
The FileControl
directive allows you to control access
to Interchange pages by using an arbitrary decision method, implemented
as a Perl function. Perl functions may be provided in-place,
as Sub
s, or as GlobalSub
s.
The function is called with three parameters: the filename, write flag, and Perl caller information. The return value should be a boolean, specifying whether access is allowed (a true value) or not (a false value).
Example: Specifying FileControl routine in-place
FileControl test_page <<EOR sub { my ($fn, $write, @caller) = @_; # Allow write to files containing "foo" in filename if( $write ) { return $fn =~ /foo/; } # Allow read for files NOT containing "bar" in filename return $fn !~ /bar/; } EOR
Example: Specifying FileControl routine as a Sub or GlobalSub
Sub <<EOF sub filecontrol_access { my ($fn, $write, @caller) = @_; # Allow write to files containing "foo" in filename if( $write ) { return $fn =~ /foo/; } # Allow read for files NOT containing "bar" in filename return $fn !~ /bar/; } EOF FileControl test_directory/test_page filecontrol_access
Example: Specifying FileControl as a mapped routine name
In interchange.cfg
, you can use mapped routine names:
FileControl test_page Vend::YourModule::file_control
Interchange 5.9.0:
Source: lib/Vend/Config.pm
Line 2161 (context shows lines 2161-2258)
sub parse_action { my ($var, $value, $mapped) = @_; if (! $value) { return $InitializeEmpty{$var} ? '' : {}; } return if $Vend::ExternalProgram; my $c; if($mapped) { $c = $mapped; } elsif(defined $C) { $c = $C->{$var} ||= {}; } else { no strict 'refs'; $c = ${"Global::$var"} ||= {}; } if (defined $C and ! $c->{_mvsafe}) { my $calc = Vend::Interpolate::reset_calc(); $c->{_mvsafe} = $calc; } my ($name, $sub) = split /\s+/, $value, 2; $name =~ s/-/_/g; ## Determine if we are in a catalog config, and if ## perl should be global and/or strict my $nostrict; my $perlglobal = 1; if($C) { $nostrict = $Global::PerlNoStrict->{$C->{CatalogName}}; $perlglobal = $Global::AllowGlobal->{$C->{CatalogName}}; } # Untaint and strip this pup $sub =~ s/^\s*((?s:.)*\S)\s*//; $sub = $1; if($sub !~ /\s/) { no strict 'refs'; if($sub =~ /::/ and ! $C) { $c->{$name} = \&{"$sub"}; } else { if($C and $C->{Sub}) { $c->{$name} = $C->{Sub}{$sub}; } if(! $c->{$name} and $Global::GlobalSub) { $c->{$name} = $Global::GlobalSub->{$sub}; } } if(! $c->{$name} and $AllowScalarAction{$var}) { $c->{$name} = $sub; } elsif(! $c->{$name}) { $@ = errmsg("Mapped %s action routine '%s' is non-existent.", $var, $sub); } } elsif ( ! $mapped and $sub !~ /^sub\b/) { if($AllowScalarAction{$var}) { $c->{$name} = $sub; } else { my $code = <<EOF; sub { return Vend::Interpolate::interpolate_html(<<EndOfThisHaiRYTHING); $sub EndOfThisHaiRYTHING } EOF $c->{$name} = eval $code; } } elsif ($perlglobal) { package Vend::Interpolate; if($nostrict) { no strict; $c->{$name} = eval $sub; } else { $c->{$name} = eval $sub; } } else { package Vend::Interpolate; $c->{$name} = $c->{_mvsafe}->reval($sub); } if($@) { config_warn("Action '%s' did not compile correctly (%s).", $name, $@); } return $c; }