view release on metacpan or  search on metacpan

lib/Apache2/SSI.pm  view on Meta::CPAN

sub _is_perl_script
{
    my $self = shift( @_ );
    my $file = shift( @_ );
    return( $self->error( "No file was provided to check if it looks like a perl script." ) ) if( !length( "$file" ) );
    if( -T( "$file" ) )
    {
        my $io = IO::File->new( "<$file" ) || return( $self->error( "Unable to open file \"$file\" in read mode: $!" ) );
        my $shebang = $io->getline;
        chomp( $shebang );
        $io->close;
        # We explicitly return 1 or 0, because otherwise upon failure perl would return undef which we reserve for errors
        return( $shebang =~ /^\#\!(.*?)\bperl\b/i ? 1 : 0 );
    }
    return( 0 );
}

sub _lastmod                                                                                                                                                                                                                                              ...
{
    my( $self, $file, $format ) = @_;
    return( $self->_format_time( ( stat( "$file" ) )[9], $format ) );
}

# This is different from the env() method. This one is obviously private
# whereas the env() one has triggers that could otherwise create an infinite loop.
sub _set_env
{
    my $self = shift( @_ );
    my $name = shift( @_ );
    return( $self->error( "No environment variable name provided." ) ) if( !length( $name ) );
    $self->{_env} = {} if( !ref( $self->{_env} ) );
    my $env = $self->{_env};
    $env->{ $name } = shift( @_ );
    return( $self );
}

sub _set_var
{
    my $self = shift( @_ );
    my $r    = shift( @_ );
    if( $r )
    {
        $r->subprocess_env( $_[0], $_[1] );
    }
    else
    {
        my $env = $self->env;
        $env->{ $_[0] } = $_[1];
    }
    return( $_[1] );
}

sub _time_args
{
    # This routine must respect the caller's wantarray() context.
    my( $self, $time, $zone ) = @_;
    return( ( $zone && $zone =~ /GMT/ ) ? gmtime( $time ) : localtime( $time ) );
}

# Credits: Torsten Förtsch
{
    # NOTE: Apache2::SSI::Filter class
    package
        Apache2::SSI::Filter;

    if( exists( $ENV{MOD_PERL} ) &&
        $ENV{MOD_PERL} =~ /^mod_perl\/(\d+\.[\d\.]+)/ )
    {
        require Apache2::Filter;
        require Apache2::RequestUtil;
        require APR::Brigade;
        require APR::Bucket;
        require parent;
        parent->import( qw( Apache2::Filter ) );
        require Apache2::Const;
        Apache2::Const->import( -compile => qw( OK DECLINED HTTP_OK ) );
        eval( "sub fetch_content_filter : FilterRequestHandler { return( &apache_filter_handler ); }" );
    }

    sub read_bb
    {
        my( $bb, $buffer ) = @_;
        my $r = Apache2::RequestUtil->request;
        my $debug = int( $r->dir_config( 'Apache2_SSI_DEBUG' ) );

        my $eos = 0;
        # Cycling through APR::Bucket
#         while( my $b = $bb->first )
#         {
#             $eos++ if( $b->is_eos );
#             $r->log->debug( __PACKAGE__ . ": ", $b->length, " bytes of data received." );
#             ## $b->read( my $bdata );
#             my $len = $b->read( my $bdata );
#             $r->log->debug( __PACKAGE__ . ": data read is '$bdata' ($len byts read)" );
#             push( @$buffer, $bdata ) if( $buffer and length( $bdata ) );
#             $b->delete;
#         }
        $r->log->debug( __PACKAGE__, ": cycling through all the Brigade buckets." ) if( $debug > 0 );
        for( my $b = $bb->first; $b; $b = $bb->next( $b ) )
        {
            $r->log->debug( __PACKAGE__ . ": ", $b->length, " bytes of data received." ) if( $debug > 0 );
            my $len = $b->read( my $bdata );
            $r->log->debug( __PACKAGE__ . ": data read is '$bdata' ($len byts read)" ) if( $debug > 0 );
            push( @$buffer, $bdata ) if( $buffer and length( $bdata ) );
            $b->delete;
            $eos++, last if( $b->is_eos );
        }
        return( $eos );
    }
    
    # We cannot declare it now. Instead we eval it so that it works under Apache and gets discarded outside
    # sub fetch_content_filter : FilterRequestHandler
    sub apache_filter_handler
    {
        my( $f, $bb ) = @_;
        my $r = $f->r;
        unless( $f->ctx )
        {
            unless( $r->status == &Apache2::Const::HTTP_OK or
                    $r->pnotes->{force_fetch_content} )

lib/Apache2/SSI.pm  view on Meta::CPAN

=item DOCUMENT_ARGS

=item DOCUMENT_NAME

=item DOCUMENT_PATH_INFO

=item DOCUMENT_URI

=item LAST_MODIFIED

=item QUERY_STRING_UNESCAPED

=item USER_NAME

=back

See L<Apache documentation|https://httpd.apache.org/docs/current/en/mod/mod_include.html#page-header> and L<this page too|https://httpd.apache.org/docs/current/en/expr.html#page-header> for more information.

=head2 expressions

There is reasonable, but limited support for Apache expressions. For example, the followings are supported

In the examples below, we use the variable C<QUERY_STRING>, but you can use any other variable of course.

The regular expression are the ones L<PCRE|http://www.pcre.org/> compliant, so your perl regular expressions should work.

    <!--#if expr="$QUERY_STRING = 'something'" -->
    <!--#if expr="v('QUERY_STRING') = 'something'" -->
    <!--#if expr="%{QUERY_STRING} = 'something'" -->
    <!--#if expr="$QUERY_STRING = /^something/" -->
    <!--#if expr="$QUERY_STRING == /^something/" -->
    # works also with eq, ne, lt, le, gt and ge
    <!--#if expr="9 gt 3" -->
    <!--#if expr="9 -gt 3" -->
    # Other operators work too, namely == != < <= > >= =~ !~
    <!--#if expr="9 > 3" -->
    <!--#if expr="9 !> 3" -->
    <!--#if expr="9 !gt 3" -->
    # Checks the remote ip is part of this subnet
    <!--#if expr="-R 192.168.2.0/24" -->
    <!--#if expr="192.168.2.10 -R 192.168.2.0/24" -->
    <!--#if expr="192.168.2.10 -ipmatch 192.168.2.0/24" -->
    # Checks if variable is non-empty
    <!--#if expr="-n $some_variable" -->
    # Checks if variable is empty
    <!--#if expr="-z $some_variable" -->
    # Checks if the visitor can access the uri /restricted/uri
    <!--#if expr="-A /restricted/uri" -->

For subnet checks, this uses L<Net::Subnet>

Expressions that would not work outside of Apache, i.e. it will return an empty string:

    <!--#expr="%{HTTP:X-example-header} in { 'foo', 'bar', 'baz' }" -->

See L<Apache documentation|http://httpd.apache.org/docs/2.4/en/expr.html> for more information.

=head1 CREDITS

Credits to Ken Williams for his implementation of L<Apache::SSI> from which I borrowed some code.

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

CPAN ID: jdeguest

L<https://gitlab.com/jackdeguest/Apache2-SSI>

=head1 SEE ALSO

L<Apache2::SSI::File>, L<Apache2::SSI::Finfo>, L<Apache2::SSI::Notes>, L<Apache2::SSI::URI>, L<Apache2::SSI::SharedMem> and L<Apache2::SSI::SemStat>

mod_include, mod_perl(3), L<Apache::SSI>, 
L<https://httpd.apache.org/docs/current/en/mod/mod_include.html>,
L<https://httpd.apache.org/docs/current/en/howto/ssi.html>,
L<https://httpd.apache.org/docs/current/en/expr.html>
L<https://perl.apache.org/docs/2.0/user/handlers/filters.html#C_PerlOutputFilterHandler_>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2020-2021 DEGUEST Pte. Ltd.

You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.

=cut