FileControl

SYNOPSIS

page_path perl_routine

DESCRIPTION

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 Subs, or as GlobalSubs.

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).

See the section called “EXAMPLES”.

DIRECTIVE TYPE AND DEFAULT VALUE

Global directive,
Catalog directive

EXAMPLES

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

NOTES

AVAILABILITY

FileControl is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: lib/Vend/Config.pm
Line 468

['FileControl',     'action',       ''],

Source: lib/Vend/Config.pm
Line 541

['FileControl',     'action',       ''],

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;

}

AUTHORS

Interchange Development Group


FeatureDir		FileDatabase

Name