2 files changed, 140 insertions, 0 deletions
diff --git a/lib/Apache/Inject.pm b/lib/Apache/Inject.pm
new file mode 100644
index 0000000..a9f1a61
--- /dev/null
+++ b/lib/Apache/Inject.pm
@@ -0,0 +1,58 @@
+package Apache::Inject;
+
+use strict;
+use warnings;
+
+use Apache2::CmdParms ();
+use Apache2::Module ();
+use Apache2::Const qw/OR_LIMIT OR_AUTHCFG TAKE12/;
+
+my @directives = (
+	{ name => 'Inject',
+	  func => __PACKAGE__.'::Inject',
+	  req_override => OR_LIMIT|OR_AUTHCFG,
+	  args_how => TAKE12,
+	  errmsg => 'Inject HeadFile[!] FootFile[!]' }
+);
+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',
+	                    '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/lib/Apache/Inject/Handler.pm b/lib/Apache/Inject/Handler.pm
new file mode 100644
index 0000000..5a40fd8
--- /dev/null
+++ b/lib/Apache/Inject/Handler.pm
@@ -0,0 +1,82 @@
+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
+	(?<head> \s*
+	         (<!doctype[^>]*>)? \s*
+	         (<html[^>]*>)? \s*
+	         ( <head[^>]*>.*?</head> \s*
+	         | ( <title[^>]*>.*?</title> \s*
+	           | <base[^>]*> \s*
+	           | <meta[^>]*> \s*
+	           | <link[^>]*> \s*
+	           | <style[^>]*>.*?</style> \s* # n.b.
+	           | <script[^>]*>.*?</script> \s* # n.b.
+	           )+
+	         )?
+	         (<body[^>]*>)?
+	)?
+	(?<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;
+
+	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;