package Apache::Inject::Handler; use 5.010000; use strict; use mod_perl2; 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 { my $r = shift; return DECLINED if not $r->content_type eq 'text/html'; my $content = ${$r->slurp_filename}; return DECLINED if not $content =~ /$doc/; if (not $r->document_root) { $r->warn('Inject: 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; } sub inject { my ($r, $var) = @_; # Retrieve value implicitly set by Inject directive return if not (my $val = $r->dir_config($var)); return if $val eq '-'; # special value signifying absence of argument # Validate path if ($val =~ m{^/}) { $r->log_error("Inject: $var should not begin with slash, as it is already always relative to document root"); } if ($val =~ m{^../|/../|/..$}) { $r->log_error("Inject: $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 { $r->log_error("Inject: $var $root/$val does not exist"); return; }; print for <$fh>; close $fh; } 1;