aboutsummaryrefslogtreecommitdiff
path: root/lib/Apache/Inject/Filter.pm
blob: f87cdc17f6973d396061f470e05d31fa7da0a147 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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;