From 68373909df410fb1be8c664875e7fa4df2f7e2bc Mon Sep 17 00:00:00 2001 From: root Date: Fri, 23 Apr 2021 18:29:21 +0000 Subject: Change directory structure --- Inject.pm | 58 ------------------------------- Inject/Handler.pm | 82 -------------------------------------------- lib/Apache/Inject.pm | 58 +++++++++++++++++++++++++++++++ lib/Apache/Inject/Handler.pm | 82 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 140 insertions(+), 140 deletions(-) delete mode 100644 Inject.pm delete mode 100644 Inject/Handler.pm create mode 100644 lib/Apache/Inject.pm create mode 100644 lib/Apache/Inject/Handler.pm diff --git a/Inject.pm b/Inject.pm deleted file mode 100644 index a9f1a61..0000000 --- a/Inject.pm +++ /dev/null @@ -1,58 +0,0 @@ -package Apache::Inject; - -use strict; -use warnings; - -use Apache2::CmdParms (); -use Apache2::Module (); -use Apache2::Const qw/OR_LIMIT OR_AUTHCFG TAKE12/; - -my @directives = ( - { name => 'Inject', - func => __PACKAGE__.'::Inject', - req_override => OR_LIMIT|OR_AUTHCFG, - args_how => TAKE12, - errmsg => 'Inject HeadFile[!] FootFile[!]' } -); -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', - '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 - - Inject head.html foot.html - - -=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 deleted file mode 100644 index 5a40fd8..0000000 --- a/Inject/Handler.pm +++ /dev/null @@ -1,82 +0,0 @@ -package Apache::Inject::Handler; - -use strict; -use warnings FATAL => 'all'; - -use Apache2::RequestRec (); -use Apache2::RequestUtil (); -use Apache2::Const qw/OK DECLINED/; - -my $doc = qr{ - \A - (? \s* - (]*>)? \s* - (]*>)? \s* - ( ]*>.*? \s* - | ( ]*>.*? \s* - | ]*> \s* - | ]*> \s* - | ]*> \s* - | ]*>.*? \s* # n.b. - | ]*>.*? \s* # n.b. - )+ - )? - (]*>)? - )? - (? .*? ) - (? \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; - - return DECLINED if not $r->content_type eq 'text/html'; - - 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}; - inject($r, "InjectHead"); - print $+{body} if $+{body}; - inject($r, "InjectFoot"); - print $+{rest} if $+{rest}; - - return OK; -} - -1; diff --git a/lib/Apache/Inject.pm b/lib/Apache/Inject.pm new file mode 100644 index 0000000..a9f1a61 --- /dev/null +++ b/lib/Apache/Inject.pm @@ -0,0 +1,58 @@ +package Apache::Inject; + +use strict; +use warnings; + +use Apache2::CmdParms (); +use Apache2::Module (); +use Apache2::Const qw/OR_LIMIT OR_AUTHCFG TAKE12/; + +my @directives = ( + { name => 'Inject', + func => __PACKAGE__.'::Inject', + req_override => OR_LIMIT|OR_AUTHCFG, + args_how => TAKE12, + errmsg => 'Inject HeadFile[!] FootFile[!]' } +); +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', + '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 + + Inject head.html foot.html + + +=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/lib/Apache/Inject/Handler.pm b/lib/Apache/Inject/Handler.pm new file mode 100644 index 0000000..5a40fd8 --- /dev/null +++ b/lib/Apache/Inject/Handler.pm @@ -0,0 +1,82 @@ +package Apache::Inject::Handler; + +use strict; +use warnings FATAL => 'all'; + +use Apache2::RequestRec (); +use Apache2::RequestUtil (); +use Apache2::Const qw/OK DECLINED/; + +my $doc = qr{ + \A + (? \s* + (]*>)? \s* + (]*>)? \s* + ( ]*>.*? \s* + | ( ]*>.*? \s* + | ]*> \s* + | ]*> \s* + | ]*> \s* + | ]*>.*? \s* # n.b. + | ]*>.*? \s* # n.b. + )+ + )? + (]*>)? + )? + (? .*? ) + (? \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; + + return DECLINED if not $r->content_type eq 'text/html'; + + 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}; + inject($r, "InjectHead"); + print $+{body} if $+{body}; + inject($r, "InjectFoot"); + print $+{rest} if $+{rest}; + + return OK; +} + +1; -- cgit v1.2.3