Apache2-SSI
view release on metacpan or search on metacpan
lib/Apache2/SSI.pm view on Meta::CPAN
eval
{
$r->headers_out->set( 'Content-Length' => $len );
my $sent = $f->print( "$res" );
$r->log->debug( "${class} [PerlOutputFilterHandler]: ${sent} bytes sent out." ) if( $debug > 0 );
};
if( $@ )
{
$r->log->error( "${class} encountered an error while sending resulting data via Apache2::Filter->print: $@" );
}
# This will cause a segfault
# $r->rflush;
return( &Apache2::Const::OK );
}
}
sub init
{
my $self = shift( @_ );
my $class = ref( $self );
my $args = {};
if( scalar( @_ ) )
{
no warnings 'uninitialized';
$args = Scalar::Util::reftype( $_[0] ) eq 'HASH'
? shift( @_ )
: !( scalar( @_ ) % 2 )
? { @_ }
: {};
}
my $uri = delete( $args->{document_uri} ) // '';
$self->{html} = '';
$self->{apache_filter} = '';
$self->{apache_request} = '';
$self->{document_root} = '';
# e.g.: [Value Undefined]
$self->{echomsg} = '';
$self->{errmsg} = '[an error occurred while processing this directive]';
$self->{filename} = '';
$self->{legacy} = 0;
$self->{trunk} = 0;
$self->{remote_ip} = '';
$self->{sizefmt} = 'abbrev';
$self->{timefmt} = undef;
$self->{_init_strict_use_sub} = 1;
$self->{_init_params_order} = [qw( apache_filter apache_request document_root document_uri )];
$self->SUPER::init( %$args ) || return;
$self->{_env} = '';
$self->{_path_info_processed} = 0;
# Used to hold regular expression matches during eval in _eval_vars()
# and make them available for the next evaluation
$self->{_regexp_capture}= [];
$self->{_uri_reset} = 0;
# A stack reflecting the current state of if/else parser.
# Each entry is 1 when we've seen a true condition in this if-chain,
# 0 when we haven't. Initially it's as if we're in a big true
# if-block with no else.
$self->{if_state} = [1];
$self->{notes} = '';
$self->{suspend} = [0];
# undef means the current locale's default
$self->mod_perl( defined( $MOD_PERL ) ? length( $MOD_PERL ) > 0 : 0 );
my $r = $self->apache_request;
if( $MOD_PERL && !$r )
{
# NOTE: Must check if GlobalRequest is set
if( !( $r = $self->apache_request ) )
{
$r = Apache2::RequestUtil->request;
if( $r )
{
$self->apache_request( $r );
$self->apache_filter( $r->input_filters );
}
else
{
print( STDERR "${class} seems to be running under modperl version '$MOD_PERL', but could not get the Apache2::RequestRec object via Apache2::RequestUtil->request(). You need to enable GlobalRequest in your VirtualHost with: PerlOption...
}
}
}
my $p = {};
if( length( "$uri" ) )
{
$p->{document_uri} = "$uri";
}
elsif( $r )
{
$p->{document_uri} = $r->unparsed_uri;
}
elsif( length( $self->env( 'DOCUMENT_URI' ) ) )
{
$p->{document_uri} = $self->env( 'DOCUMENT_URI' );
}
else
{
$p->{document_uri} = $self->env( 'REQUEST_URI' );
}
if( length( $self->{document_root} ) )
{
$p->{document_root} = $self->{document_root};
}
elsif( $r )
{
$p->{document_root} = $r->document_root;
}
else
{
$self->env( 'DOCUMENT_ROOT' );
}
$p->{debug} = $self->{debug};
$p->{apache_request} = $r if( $r );
if( length( "$p->{document_uri}" ) && length( "$p->{document_root}" ) )
{
my $u = Apache2::SSI::URI->new( $p ) ||
return( $self->error( "Unable to instantiate an Apache2::SSI::URI object with document uri \"$p->{document_uri}\" and document root \"$p->{document_root}\": ", Apache2::SSI::URI->error ) );
$self->{uri} = $u;
}
elsif( !length( "$p->{document_root}" ) )
{
lib/Apache2/SSI.pm view on Meta::CPAN
my $desc = Apache2::ServerUtil::get_server_description();
if( $desc =~ /\bApache\/([\d\.]+)/ )
{
$vers = $1;
}
};
if( $@ )
{
}
}
require File::Which;
# NOTE: to test our alternative approach
if( !$vers && ( my $apxs = File::Which::which( 'apxs' ) ) )
{
$vers = qx( $apxs -q -v HTTPD_VERSION );
chomp( $vers );
$vers = '' unless( $vers =~ /^[\d\.]+$/ );
}
# Try apache2
if( !$vers )
{
foreach my $bin ( qw( apache2 httpd ) )
{
if( ( my $apache2 = File::Which::which( $bin ) ) )
{
my $v_str = qx( $apache2 -v );
if( ( split( /\r?\n/, $v_str ) )[0] =~ /\bApache\/([\d\.]+)/ )
{
$vers = $1;
chomp( $vers );
last;
}
}
}
}
if( $vers )
{
$self->{server_version} = $SERVER_VERSION = version->parse( $vers );
return( $self->{server_version} );
}
return( '' );
}
sub sizefmt { return( shift->_set_get_scalar( 'sizefmt', @_ ) ); }
sub timefmt { return( shift->_set_get_scalar( 'timefmt', @_ ) ); }
sub trunk { return( shift->_set_get_boolean( 'trunk', @_ ) ); }
sub uri { return( shift->_set_get_object( 'uri', 'Apache2::SSI::URI', @_ ) ); }
sub _format_time
{
my( $self, $time, $format, $tzone ) = @_;
my $env = $self->env;
$format ||= $self->{timefmt};
# Quotes are important as they are used to stringify overloaded $time
my $params = { epoch => "$time" };
$params->{time_zone} = ( $tzone || 'local' );
$params->{locale} = $env->{lang} if( length( $env->{lang} ) );
require DateTime;
require DateTime::Format::Strptime;
my $tz;
# DateTime::TimeZone::Local will die ungracefully if the local timezeon is not set with the error:
# "Cannot determine local time zone"
local $@;
# try-catch
eval
{
require DateTime::TimeZone;
$tz = DateTime::TimeZone->new( name => 'local' );
};
if( $@ )
{
$tz = DateTime::TimeZone->new( name => 'UTC' );
warn( "Your system is missing key timezone components. Reverting to UTC instead of local time zone.\n" );
}
# try-catch
my $rv = eval
{
my $dt = DateTime->from_epoch( %$params );
if( length( $format ) )
{
my $fmt = DateTime::Format::Strptime->new(
pattern => $format,
time_zone => ( $params->{time_zone} || $tz ),
locale => $dt->locale->code,
);
$dt->set_formatter( $fmt );
return( $dt );
}
else
{
return( $dt->format_cldr( $dt->locale->date_format_full ) );
}
};
if( $@ )
{
$self->error( "An error occurred getting a DateTime object for time \"$time\" with format \"$format\": $@" );
return( $self->errmsg );
}
return( $rv );
}
sub _handle_ifs
{
my $self = shift( @_ );
my $cond = shift( @_ );
if( $self->{if_state}->[0] )
{
$self->{suspend}->[0] = 1;
}
else
{
$self->{suspend}->[0] = !( $self->{if_state}->[0] = !!$cond );
}
return( '' );
}
sub _has_utf8
{
my $self = shift( @_ );
return( $_[0] =~ /$IS_UTF8/ );
}
sub _interp_vars
{
# Find all $var and ${var} expressions in the string and fill them in.
my $self = shift( @_ );
# Because ssi_echo may change $1, $2, ...
my( $a, $b, $c );
$_[0] =~ s{ (^|[^\\]) (\\\\)* \$(\{)?(\w+)(\})? }
{ ($a,$b,$c) = ($1,$2,$4);
$a . ( length( $b ) ? substr( $b, length( $b ) / 2 ) : '' ) . $self->parse_echo({ var => $c }) }exg;
}
sub _ipmatch
{
my $self = shift( @_ );
my $subnet = shift( @_ ) || return( $self->error( "No subnet provided" ) );
my $ip = shift( @_ ) || $self->remote_ip;
local $@;
# try-catch
my $rv = eval
{
local $SIG{__WARN__} = sub{};
require Net::Subnet;
my $net = Net::Subnet::subnet_matcher( $subnet );
my $res = $net->( $ip );
return( $res ? 1 : 0 );
};
if( $@ )
{
lib/Apache2/SSI.pm view on Meta::CPAN
use Apache2::RequestUtil (); # extends Apache2::RequestRec objects
my $r = $r->is_initial_req ? $r : $r->main;
=item C<debug>
Sets the debug level. Starting from 3, this will output on the STDERR or in Apache error log a lot of debugging output.
=item C<document_root>
This is only necessary to be provided if this is not running under Apache mod_perl. Without this value, L<Apache2::SSI> has no way to guess the document root and will not be able to function properly and will return an L</error>.
=item C<document_uri>
This is only necessary to be provided if this is not running under Apache mod_perl. This must be the uri of the document being served, such as C</my/path/index.html>. So, if you are using this outside of the rim of Apache mod_perl and your file resid...
=item C<errmsg>
The error message to be returned when a ssi directive fails. By default, it is C<[an error occurred while processing this directive]>
=item C<html>
The html data to be parsed. You do not have to provide that value now. You can provide it to L</parse> as its first argument when you call it.
=item C<legacy>
Takes a boolean value such as C<1> or C<0> to indicate whether the Apache2 expression supported accepts legacy style.
Legacy Apache expression typically allows for perl style variable C<${REQUEST_URI}> versus the modern style of C<%{REQUEST_URI}> and just an equal sign to imply a regular expression such as:
$HTTP_COOKIES = /lang\%22\%3A\%22([a-zA-Z]+\-[a-zA-Z]+)\%22\%7D;?/
Modern expression equivalent would be:
%{HTTP_COOKIES} =~ /lang\%22\%3A\%22([a-zA-Z]+\-[a-zA-Z]+)\%22\%7D;?/
See L<Regexp::Common::Apache2> for more information.
See also the property C<trunk> to enable experimental expressions.
=item C<remote_ip>
This is used when you want to artificially set the remote ip address, i.e. the address of the visitor accessing the page. This is used essentially by the SSI directive:
my $ssi = Apache2::SSI->new( remote_ip => '192.168.2.10' ) ||
die( Apache2::SSI->error );
<!--#if expr="-R '192.168.2.0/24' || -R '127.0.0.1/24'" -->
Remote ip is part of my private network
<!--#else -->
Go away!
<!--#endif -->
=item C<sizefmt>
The default way to format a file size. By default, this is C<abbrev>, which means a human readable format such as C<2.5M> for 2.5 megabytes. Other possible value is C<bytes> which would have the C<fsize> ssi directive return the size in bytes.
See L<Apache2 documentation|https://httpd.apache.org/docs/current/en/howto/ssi.html> for more information on this.
=item C<timefmt>
The default way to format a date time. By default, this uses the display according to your locale, such as C<ja_JP> (for Japan) or C<en_GB> for the United Kingdom. The time zone can be specified in the format, or it will be set to the local time zone...
See L<Apache2 documentation|https://httpd.apache.org/docs/current/en/howto/ssi.html> for more information on this.
=item C<trunk>
This takes a boolean value such as C<0> or C<1> and when enabled this allows the support for Apache2 experimental expressions.
See L<Regexp::Common::Apache2> for more information.
Also, see the property C<legacy> to enable legacy Apache2 expressions.
=back
=head2 handler
This is a key method expected by mod_perl. Depending on how this module is used, it will redirect either to L</apache_filter_handler> or to L</apache_response_handler>
=head2 ap2perl_expr
This method is used to convert Apache2 expressions into perl equivalents to be then eval'ed.
It takes an hash reference provided by L<Apache2::Expression/parse>, an array reference to store the output recursively and an optional hash reference of parameters.
It parse recursively the structure provided in the hash reference to provide the perl equivalent for each Apache2 expression component.
It returns the array reference provided as the content buffer. This array is used by L</parse_expr> and then joined using a single space to form a string of perl expression to be eval'ed.
=head2 apache_filter
Set or get the L<Apache2::Filter> object.
When running under Apache mod_perl this is set automatically from the special L</handler> method.
=head2 apache_filter_handler
This method is called from L</handler> to handle the Apache response when this module L<Apache2::SSI> is used as a filter handler.
See also L</apache_response_handler>
=head2 apache_request
Sets or gets the L<Apache2::RequestRec> object. As explained in the L</new> method, you can get this Apache object by requiring the package L<Apache2::RequestUtil> and calling L<Apache2::RequestUtil/request> such as C<Apache2::RequestUtil->request> a...
When running under Apache mod_perl this is set automatically from the special L</handler> method, such as:
my $r = $f->r; # $f is the Apache2::Filter object provided by Apache
=head2 apache_response_handler
This method is called from L</handler> to handle the Apache response when this module L<Apache2::SSI> is used as a response handler.
See also L</apache_filter_handler>
=head2 clone
Create a clone of the object and return it.
=head2 decode_base64
Decode base64 data provided. When running under Apache mod_perl, this uses L<APR::Base64/decode> module, otherwise it uses L<MIME::Base64/decode>
lib/Apache2/SSI.pm view on Meta::CPAN
Sets or gets arbitrary notes using Apache mod_perl C<pnotes>. This allows the sharing of information among requests. A value provided can be any kind of data, array reference, hash reference, or just string.
See L<Apache2::ConnectionUtil|/pnotes>
=head2 parse
Provided with html data and if none is provided will use the data specified with the method L</html>, this method will parse the html and process the ssi directives.
It returns the html string with the ssi result.
=head2 parse_comment
Provided with an Apache SSI comment, such as C<< <!--#comment Something --> >>, and it returns an empty string, because comments are simply removed from the result.
=head2 parse_config
Provided with an hash reference of parameters and this sets three of the object parameters that can also be set during object instantiation:
=over 4
=item C<echomsg>
The value is a message that is sent back to the client if the echo element attempts to echo an undefined variable.
This overrides any default value set for the parameter C<echomsg> upon object instantiation.
=item C<errmsg>
This is the default error message to be used as the result for a faulty ssi directive.
See the L</echomsg> method.
=item C<sizefmt>
This is the format to be used to format the files size. Value can be either C<bytes> or C<abbrev>
See also the L</sizefmt> method.
=item C<timefmt>
This is the format to be used to format the dates and times. The value is a date formatting based on L<POSIX/strftime>
See also the L</timefmt> method.
=back
=head2 parse_echo
Provided with an hash reference of parameter and this process the C<echo> ssi directive and returns its output as a string.
For example:
Query string passed: <!--#echo var="QUERY_STRING" -->
There are a number of standard environment variable accessible under SSI on top of other environment variables set. See L<SSI Directives> section below.
=for Pod::Coverage parse_echo_query_string
=head2 parse_echo_date_gmt
Returns the current date with time zone set to gmt and based on the provided format or the format available for the current locale such as C<ja_JP> or C<en_GB>.
=head2 parse_echo_date_local
Returns the current date with time zone set to the local time zone whatever that may be and on the provided format or the format available for the current locale such as C<ja_JP> or C<en_GB>.
Example:
<!--#echo var="DATE_LOCAL" -->
=head2 parse_echo_document_name
Returns the document name. Under Apache, this returns the environment variable C<DOCUMENT_NAME>, if set, or the base name of the value returned by L<Apache2::RequestRec/filename>
Outside of Apache, this returns the environment variable C<DOCUMENT_NAME>, if set, or the base name of the value for L</document_uri>
Example:
<!--#echo var="DOCUMENT_NAME" -->
If the uri were C</some/where/file.html>, this would return only C<file.html>
=head2 parse_echo_document_uri
Returns the value of L</document_uri>
Example:
<!--#echo var="DOCUMENT_URI" -->
The document uri would include, if any, any path info and query string.
=head2 parse_echo_last_modified
This returns document last modified date. Under Apache, there is a standard environment variable called C<LAST_MODIFIED> (see the section on L</SSI Directives>), and if somehow absent, it will return instead the formatted last modification datetime f...
Outside of Apache, the similar result is achieved by returning the value of the environment variable C<LAST_MODIFIED> if available, or the formatted datetime of the document uri as set with L</document_uri>
Example:
<!--#echo var="LAST_MODIFIED" -->
=for Pod::Coverage parse_expr_args
=head2 parse_eval_expr
Provided with a string representing an Apache2 expression and this will parse it, transform it into a perl equivalent and return its value.
It does the parsing using L<Apache2::Expression/parse> called from L</parse_expr>
If the expression contains regular expression with capture groups, the value of capture groups will be stored and will be usable in later expressions, such as:
<!--#config errmsg="[Include error]" -->
<!--#if expr="%{HTTP_COOKIE} =~ /lang\%22\%3A\%22([a-zA-Z]+\-[a-zA-Z]+)\%22\%7D;?/"-->
<!--#set var="CONTENT_LANGUAGE" value="%{tolower:$1}"-->
<!--#elif expr="-z %{CONTENT_LANGUAGE}"-->
<!--#set var="CONTENT_LANGUAGE" value="en"-->
<!--#endif-->
<!DOCTYPE html>
<html lang="<!--#echo encoding="none" var="CONTENT_LANGUAGE" -->">
=head2 parse_exec
Provided with an hash reference of parameters and this process the C<exec> ssi directives.
Example:
<!--#exec cgi="/uri/path/to/progr.cgi" -->
or
<!--#exec cmd="/some/system/file/path.sh" -->
=head2 parse_expr
It takes a string representing an Apache2 expression and calls L<Apache2::Expression/parse> to break it down, and then calls L</ap2perl_expr> to transform it into a perl expression that is then eval'ed by L</parse_eval_expr>.
It returns the perl representation of the Apache2 expression.
To make this work, certain Apache2 standard functions used such as C<base64> or C<md5> are converted to use this package function equivalents. See the C<parse_func_*> methods for more information.
=head2 parse_elif
Parse the C<elif> condition.
Example:
<!--#if expr=1 -->
Hi, should print
<!--#elif expr=1 -->
Shouldn't print
<!--#else -->
Shouldn't print
<!--#endif -->
( run in 2.071 seconds using v1.01-cache-2.11-cpan-5a3173703d6 )