aboutsummaryrefslogtreecommitdiff
path: root/lib/Apache/Inject/Filter.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Apache/Inject/Filter.pm')
-rw-r--r--lib/Apache/Inject/Filter.pm93
1 files changed, 93 insertions, 0 deletions
diff --git a/lib/Apache/Inject/Filter.pm b/lib/Apache/Inject/Filter.pm
new file mode 100644
index 0000000..f87cdc1
--- /dev/null
+++ b/lib/Apache/Inject/Filter.pm
@@ -0,0 +1,93 @@
+package Apache::Inject::Filter;
+
+use 5.010000;
+use strict;
+
+use mod_perl2;
+use base qw/Apache2::Filter/;
+use Apache2::Const qw/OK DECLINED/;
+use Apache2::Log ();
+use Apache2::RequestRec ();
+use Apache2::RequestUtil ();
+
+my $doc = qr{
+ \A
+ (?<head> \s*
+ ( <!-- .*? --> )? \s*
+ ( <!doctype[^>]*> )? \s*
+ ( <!-- .*? --> )? \s*
+ ( <html[^>]*> )? \s*
+ ( <!-- .*? --> )? \s*
+ ( <head[^>]*> .*? </head> \s*
+ | ( <meta[^>]*> \s*
+ | <link[^>]*> \s*
+ | <title[^>]*> .*? </title> \s*
+ | <style[^>]*> .*? </style> \s*
+ | <script[^>]*> .*? </script> \s*
+ | <base[^>]*> \s*
+ | <!-- .*? --> \s*
+ )+
+ )?
+ ( <!-- .*? --> )? \s*
+ ( <body[^>]*> )? \s*
+ )?
+ (?<body> .*? )
+ (?<rest> </html> \s*
+ ( <!-- .*? --> )? \s*
+ )?
+ \z
+}xmsi;
+
+sub handler : FilterRequestHandler {
+ my $f = shift;
+
+ return DECLINED if not $f->r->content_type;
+ return DECLINED if not $f->r->content_type =~ m{^text/html($|;.*)};
+
+ if (not $f->r->document_root) {
+ $f->r->warn('Inject: Declining due to empty document root');
+ return DECLINED;
+ }
+
+ my ($buf, $content);
+ $content .= $buf while $f->read($buf);
+ return DECLINED if not $content =~ /$doc/;
+
+ $f->print($+{head}) if $+{head};
+ inject($f, "InjectHead");
+ $f->print($+{body}) if $+{body};
+ inject($f, "InjectFoot");
+ $f->print($+{rest}) if $+{rest};
+
+ return OK;
+}
+
+sub inject {
+ my ($f, $var) = @_;
+
+ # Retrieve value implicitly set by Inject directive
+ return if not (my $val = $f->r->dir_config($var));
+ return if $val eq '-'; # special value signifying absence of argument
+
+ # Validate path
+ if ($val =~ m{^/}) {
+ $f->r->log_error("Inject: $var should not begin with slash, as it is already always relative to document root");
+ }
+ if ($val =~ m{^../|/../|/..$}) {
+ $f->r->log_error("Inject: $var cannot extend past document root");
+ return;
+ }
+
+ # note: document root has been confirmed not to be empty
+ my $root = $f->r->document_root;
+
+ # Read contents of specified file
+ open my $fh, '<', "$root/$val" or do {
+ $f->r->log_error("Inject: $var $root/$val does not exist");
+ return;
+ };
+ $f->print($_) for <$fh>;
+ close $fh;
+}
+
+1;