package Apache::Inject::Handler;
use strict;
use warnings FATAL => 'all';
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::Const qw/OK DECLINED/;
my $doc = qr{
\A
(?
\s*
(]*>)? \s*
(]*>)? \s*
( ]*>.*? \s*
| ( ]*>.*? \s*
| ]*> \s*
| ]*> \s*
| ]*> \s*
| \s* # n.b.
| \s* # n.b.
)+
)?
(]*>)?
)?
(? .*? )
(? \s* )?
\z
}xmsi;
sub inject {
my ($r, $var) = @_;
# Retrieve value implicitly set by Inject directive
return if not (my $val = $r->dir_config($var));
# Validate path
if ($val =~ m{^/}) {
warn "$var should not begin with slash, "
. "as it is already always relative to document root";
}
if ($val =~ m{^../|/../|/..$}) {
warn "$var cannot extend past document root";
return;
}
# note: document root has been confirmed not to be empty
my $root = $r->document_root;
# Read contents of specified file
open my $fh, '<', "$root/$val" or do {
warn "$var $root/$val does not exist";
return;
};
print for <$fh>;
close $fh;
}
sub handler {
my $r = shift;
return DECLINED if not $r->content_type eq 'text/html';
my $content = ${$r->slurp_filename};
return DECLINED if not $content =~ /$doc/;
# Or is DocumentRoot guaranteed not to be empty?
if (not $r->document_root) {
warn 'Declining request due to empty document root';
return DECLINED;
}
print $+{head} if $+{head};
inject($r, "InjectHead");
print $+{body} if $+{body};
inject($r, "InjectFoot");
print $+{rest} if $+{rest};
return OK;
}
1;