diff options
| author | root <root@rbsd.ankarstrom.se> | 2021-04-23 16:24:05 +0000 |
|---|---|---|
| committer | root <root@rbsd.ankarstrom.se> | 2021-04-23 18:28:43 +0000 |
| commit | 2c8e4634e5a3f739fd1e048039893338de63e828 (patch) | |
| tree | 5698cb68fb3a9b9246f4af1f297a0b9d13bcd756 | |
| parent | 3d91ba4623e3d8538d61d610cae3935178f623bf (diff) | |
| download | Apache-Inject-2c8e4634e5a3f739fd1e048039893338de63e828.tar.gz | |
Propagate directive arguments to handler and read file contents
| -rw-r--r-- | Inject.pm | 35 | ||||
| -rw-r--r-- | Inject/Handler.pm | 63 |
2 files changed, 85 insertions, 13 deletions
@@ -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; } |