aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Inject.pm35
-rw-r--r--Inject/Handler.pm63
2 files changed, 85 insertions, 13 deletions
diff --git a/Inject.pm b/Inject.pm
index 10c5934..a9f1a61 100644
--- a/Inject.pm
+++ b/Inject.pm
@@ -18,8 +18,41 @@ Apache2::Module::add(__PACKAGE__, \@directives);
sub Inject {
my ($self, $parms, @args) = @_;
+
+ # Validate arguments and construct corresponding directives
+ my @vars;
+ my @names = qw/InjectHead InjectFoot/;
+ for (@args) {
+ die 'Arguments to Inject directive cannot contain quotes' if /"/;
+ push @vars, 'PerlSetVar ' . (shift @names) . ' ' . $_;
+ }
+
+ # Add relevant directives to current configuration
$parms->add_config(['SetHandler perl-script',
- 'PerlHandler Apache::Inject::Handler']);
+ 'PerlResponseHandler Apache::Inject::Handler',
+ @vars]);
}
1;
+__END__
+
+=head1 NAME
+
+Apache::Inject - Apache directive for injecting HTML headers and footers
+
+=head1 SYNOPSIS
+
+DocumentRoot /uar/local/www/apache24/data
+PerlModule Apache::Inject
+<Directory /usr/local/www/apache24/data>
+ Inject head.html foot.html
+</Directory>
+
+=head1 DESCRIPTION
+
+Apache::Inject is a mod_perl module that adds the Inject directive.
+It injects a header before the body and (optionally) a footer after the body
+of any requested HTML file.
+
+=cut
+
diff --git a/Inject/Handler.pm b/Inject/Handler.pm
index 98d4713..5a40fd8 100644
--- a/Inject/Handler.pm
+++ b/Inject/Handler.pm
@@ -1,29 +1,60 @@
package Apache::Inject::Handler;
use strict;
-use warnings;
+use warnings FATAL => 'all';
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::Const qw/OK DECLINED/;
my $doc = qr{
- (?<head> \s* # common way to trigger quirks mode
- (<!doctype[^>]*>)? \s*
- ( <head[^>]*>.*?</head> \s*
+ \A
+ (?<head> \s*
+ (<!doctype[^>]*>)? \s*
+ (<html[^>]*>)? \s*
+ ( <head[^>]*>.*?</head> \s*
| ( <title[^>]*>.*?</title> \s*
| <base[^>]*> \s*
| <meta[^>]*> \s*
| <link[^>]*> \s*
- | <object[^>]*>.*?</object> \s*
| <style[^>]*>.*?</style> \s* # n.b.
| <script[^>]*>.*?</script> \s* # n.b.
- | <noscript[^>]*>.*?</noscript> \s* # n.b.!
)+
- )
+ )?
+ (<body[^>]*>)?
)?
- (?<body> .* )
-}xms;
+ (?<body> .*? )
+ (?<rest> </html> \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;
@@ -32,10 +63,18 @@ sub handler {
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};
- print "Injection 1\n";
- print $+{body};
- print "Injection 2\n";
+ inject($r, "InjectHead");
+ print $+{body} if $+{body};
+ inject($r, "InjectFoot");
+ print $+{rest} if $+{rest};
return OK;
}