Apache2-SSI

 view release on metacpan or  search on metacpan

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

        $r->headers_out->unset( 'Content-Length' );
    }
    
    # Then, we might get called multiple time, since there may be multiple brigade buckets
    # Here, we retrieve the last buffer we put in $f->ctx->{data} if any
    my $html = exists( $ctx->{data} ) ? $ctx->{data} : '';
    $r->log->debug( "${class} [PerlOutputFilterHandler]: HTML data buffer set to '$html'." ) if( $debug > 0 );
    $ctx->{invoked}++;
    my $seen_eos = 0;
    my $max_length = int( $r->dir_config( 'Apache2_SSI_Max_Length' ) ) || 0;
    $r->log->debug( "${class} [PerlOutputFilterHandler]: Maximum length set to '$max_length'." ) if( $debug > 0 );
    # Get all the brigade buckets data
    for( my $b = $bb->first; $b; $b = $bb->next( $b ) )
    {
        $seen_eos++, last if( $b->is_eos );
        $b->read( my $bdata );
        $html .= $bdata;
        return( &Apache2::Const::DECLINED ) if( $max_length && length( $html ) >= $max_length );
    }
    
    # If we have not reached the special End-of-String bucket, we store our buffer in $f->ctx->{data} and return OK
    if( !$seen_eos )
    {
        # store context for all but the last invocation
        $r->log->debug( "${class} [PerlOutputFilterHandler]: Not reached the EOS bucket. Storing html to data buffer." ) if( $debug > 0 );
        $ctx->{data} = $html;
        $f->ctx( $ctx );
        return( &Apache2::Const::OK );
    }
    
    # Let's behave well as per the doc
    if( $f->c->keepalive == &Apache2::Const::CONN_KEEPALIVE )
    {
        $r->log->debug( "${class} [PerlOutputFilterHandler]: KeepAlive count (", $f->c->keepalive, ") reached the threshold of '", &Apache2::Const::CONN_KEEPALIVE, "'." ) if( $debug > 0 );
        $ctx->{data} = '';
        $f->ctx( $ctx );
    }
    
    my $size = length( $html );
    $ctx->{data} = '';
    $ctx->{invoked} = 0;
    $f->ctx( $ctx );
    if( $size == 0 )
    {
        $r->log->debug( "${class} [PerlOutputFilterHandler]: Data received is empty. Nothing to do." );
        return( &Apache2::Const::OK );
    }

    local $@;
    # try-catch
    $html = eval
    {
        Encode::decode( 'utf8', $html, Encode::FB_CROAK );
    };
    if( $@ )
    {
        $r->log->error( "${class} [PerlOutputFilterHandler]: Failed to decode data from utf8: $@" );
        return( &Apache2::Const::DECLINED );
    }
    
    #W We just add that the charset is utf-8
    $main->content_type( 'text/html; charset=utf-8' ) unless( $main->content_type =~ /\bcharset\n/i );
    
    my $params =
    {
    apache_filter => $f,
    apache_request => $r,
    debug => 3,
    };
    my $val;
    my $map = 
    {
    DEBUG   => 'debug',
    Echomsg => 'echomsg',
    Errmsg  => 'errmsg',
    Sizefmt => 'sizefmt',
    Timefmt => 'timefmt',
    };
    foreach my $key ( keys( %$map ) )
    {
        if( length( $val = $r->dir_config( "Apache2_SSI_${key}" ) ) )
        {
            $params->{ $map->{ $key } } = $val;
        }
    }
    if( $r->dir_config( 'Apache2_SSI_Expression' ) eq 'legacy' )
    {
        $params->{legacy} = 1;
    }
    elsif( $r->dir_config( 'Apache2_SSI_Expression' ) eq 'trunk' )
    {
        $params->{trunk} = 1;
    }
    $r->log->debug( "${class} [PerlOutputFilterHandler]: Creating a ${class} object." ) if( $debug > 0 );
    my $self = $class->new( $params ) || do
    {
        $r->log->error( "Error instantiating ${class}: ", $class->error );
        return( &Apache2::Const::DECLINED );
    };
    # my $addr = $r->useragent_addr;
    my $res = $self->parse( $html );
    if( !defined( $res ) )
    {
        $r->log->error( "${class} [PerlOutputFilterHandler]: is unable to process data: ", $self->error );
        return( &Apache2::Const::DECLINED );
    }
    else
    {
        # try-catch
        $res = eval
        {
            Encode::encode( 'utf8', $res, Encode::FB_CROAK );
        };
        if( $@ )
        {
            $r->log->error( "${class} [PerlOutputFilterHandler]: encountered an error while trying to encode data into utf8: $@" );
            return( &Apache2::Const::DECLINED );
        }
        
        # $r->headers_out->unset( 'Content-Length' );
        my $len = length( $res );
        # try-catch

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

    # No http header outside of Apache
    else
    {
        return( '' );
    }
}

sub parse_func_sha1
{
    my $self = shift( @_ );
    my $val  = join( '', @_ );
    require Digest::SHA;
    return( Digest::SHA::sha1_hex( $val ) );
}

sub parse_func_tolower
{
    my $self = shift( @_ );
    return( lc( join( '', @_ ) ) );
}

sub parse_func_toupper
{
    my $self = shift( @_ );
    return( uc( join( '', @_ ) ) );
}

sub parse_func_unbase64 { return( shift->decode_base64( join( '', @_ ) ) ); }

sub parse_func_unescape { return( shift->decode_uri( join( '', @_ ) ) ); }

sub parse_if
{
    my( $self, $args ) = @_;
    unshift( @{$self->{if_state}}, 0 );
    unshift( @{$self->{suspend}}, $self->{suspend}->[0] );
    return( '' ) if( $self->{suspend}->[0] );
    return( $self->_handle_ifs( $self->parse_eval_expr( $args->{expr} ) ) );
}

sub parse_include
{
    my( $self, $args ) = @_;
    unless( exists( $args->{file} ) or exists( $args->{virtual} ) )
    {
        return( $self->error( "No 'file' or 'virtual' attribute found in SSI 'include' tag" ) );
    }
    my $f = $self->find_file( $args );
    unless( $f->code == 200 )
    {
        return( $self->errmsg );
    }
    my $filename = $f->filename;
    if( !-e( "$filename" ) )
    {
        return( $self->errmsg );
    }
    
    # TODO This needs to be improved, as we should not assume the file encoding is utf8
    # It could be binary or some other text encoding like iso-2022-jp
    # So we should slurp it, parse the meta tags if this is an html and decode if the charset attribute is set or default to utf8
    # But this complicates things quite a bit, so for now, it is just utf8 simply
    my $html = $f->slurp_utf8;
    if( !defined( $html ) )
    {
        $self->error( "Unable to get html data of included file \"", $f->filename, "\": ", $f->error );
        return( $self->errmsg );
    }
    my $clone = $self->clone || do
    {
        warn( $self->error );
        return( $self->errmsg );
    };
    # share our environment variables with our clone so we pass it to included files.
    # If we are running under mod_perl, we'll use subprocess_env
    my $env = $self->env;
    $clone->{_env} = $env;
    return( $clone->parse( $html ) );
}

# NOTE: Legacy
# http://perl.apache.org/docs/1.0/guide/snippets.html#Passing_Arguments_to_a_SSI_script
sub parse_perl
{
    my( $self, $args, $margs ) = @_;
    my $r = $self->apache_request;

    my( $pass_r, @arg1, @arg2, $sub ) = (1);
    {
        my @a;
        while( @a = splice( @$margs, 0, 2 ) )
        {
            $a[1] =~ s/\\(.)/$1/gs;
            if( lc( $a[0] ) eq 'sub' )
            {
                $sub = $a[1];
            }
            elsif( lc( $a[0] ) eq 'arg' )
            {
                push( @arg1, $a[1] );
            }
            elsif( lc( $a[0] ) eq 'args' )
            {
                push( @arg1, split( /,/, $a[1] ) );
            }
            elsif( lc( $a[0] ) eq 'pass_request' )
            {
                $pass_r = 0 if( lc( $a[1] ) eq 'no' );
            }
            elsif( $a[0] =~ s/^-// )
            {
                push( @arg2, @a );
            }
            # Any unknown get passed as key-value pairs
            else
            {
                push( @arg2, @a );
            }
        }
    }

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

The query string value is set automatically when you provide an L<document_uri> upon instantiation or after:

    $ssi->document_uri( '/some/path/to/file.html?q=something&l=ja_JP' );

This will also set automatically the C<QUERY_STRING> environment variable.

=head2 remote_ip

Sets or gets the remote ip address of the visitor.

Under Apache mod_perl, this will call L<Apache2::Connection/remote_ip> for version 2.2 or lower and will call L<Apache2::Connection/useragent_ip> for version above 2.2, and otherwise this will get the value from the environment variable C<REMOTE_ADDR...

This value can also be overriden by being provided during object instantiation.

    # Pretend the ssi directives are accessed from this ip
    $ssi->remote_ip( '192.168.2.20' );

This is useful when one wants to check how the rendering will be when accessed from certain ip addresses.

This is used primarily when there is an expression such as

    <!--#if expr="-R '192.168.1.0/24' -->
    Visitor is part of my private network
    <!--#endif -->

or

    <!--#if expr="v('REMOTE_ADDR') -R '192.168.1.0/24' -->
    <!--#include file="/home/john/special_hidden_login_feature.html" -->
    <!--#endif -->

L<Apache2::Connection> also has a L<Apache2::Connection/remote_addr> method, but this returns a L<APR::SockAddr> object that is used to get the binary version of the ip. However you can also get the string version like this:

    use APR::SockAddr ();
    my $ip = $r->connection->remote_addr->ip_get();

Versions above 2.2 make a distinction between ip from direct connection, or the real ip behind a proxy, i.e. L<Apache2::Connection/useragent_ip>

=head2 request_uri

This is an alias for L</document_uri>

=head2 server_version

Returns the server version as a L<version> object can caches that value.

Under mod_perl2, it uses L<Apache2::ServerUtil/get_server_description> and outside of mod_perl, it tries to find C<apxs> using L<File::Which> and in last resort, tries to find the C<apache2> or C<httpd> binary to get its version information.

=head2 sizefmt

Sets or gets the formatting for file sizes. Value can be either C<bytes> or C<abbrev>

=head2 timefmt

Sets or gets the formatting for date and time values. The format takes the same values as L<POSIX/strftime>

=head1 Encoding

At present time, the html data are treated as utf8 data and decoded and encoded back as such.

If there is a need to broaden support for other charsets, let me know.

=head1 SSI Directives

This is taken from Apache documentation and summarised here for convenience and clarity to the perl community.

=head2 config

    <!--#config errmsg="Error occurred" sizefmt="abbrev" timefmt="%B %Y" -->
    <!--#config errmsg="Oopsie" -->
    <!--#config sizefmt="bytes" -->
    # Thursday 24 December 2020
    <!--#config timefmt="%A $d %B %Y" -->

=head2 echo

     <!--#set var="HTMl_TITLE" value="Un sujet intéressant" -->
     <!--#echo var="HTMl_TITLE" encoding="entity" -->

Encoding can be either C<entity>, C<url> or C<none>

=head2 exec

    # pwd is "print working directory" in shell
    <!--#exec cmd="pwd" -->
    <!--#exec cgi="/uri/path/to/prog.cgi" -->

=head2 include

    # Filesystem file path
    <!--#include file="/home/john/var/quote_of_the_day.txt" -->
    # Relative to the document root
    <!--#include virtual="/footer.html" -->

=head2 flastmod

     <!--#flastmod file="/home/john/var/quote_of_the_day.txt" -->
     <!--#flastmod virtual="/copyright.html" -->

=head2 fsize

    <!--#fsize file="/download/software-v1.2.tgz" -->
    <!--#fsize virtual="/images/logo.jpg" -->

=head2 printenv

    <!--#printenv -->

=head2 set

    <!--#set var="debug" value="2" -->

=head2 if, elif, endif and else

    <!--#if expr="$debug > 1" -->
    I will print a lot of debugging
    <!--#else -->
    Debugging output will be reasonable
    <!--#endif -->

or with new version of Apache SSI: