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 (? \s* ( )? \s* ( ]*> )? \s* ( )? \s* ( ]*> )? \s* ( )? \s* ( ]*> .*? \s* | ( ]*> \s* | ]*> \s* | ]*> .*? \s* | ]*> .*? \s* | ]*> .*? \s* | ]*> \s* | \s* )+ )? ( )? \s* ( ]*> )? \s* )? (? .*? ) (? \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; } # First pass if (not $f->ctx) { my ($buf, $content); $content .= $buf while $f->read($buf); if (not $content =~ /$doc/) { $f->r->warn('Inject: Cannot find ( too long?)'); return DECLINED; } $f->print($+{head}) if $+{head}; inject($f, "InjectHead"); $f->print($+{body}) if $+{body}; inject($f, "InjectFoot"); $f->print($+{rest}) if $+{rest}; $f->ctx(1); } # Any subsequent pass else { my $buf; $f->print($buf) while $f->read($buf); } 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;