Apache2-API

 view release on metacpan or  search on metacpan

lib/Apache2/API/Request.pm  view on Meta::CPAN

# The allowed methods, GET, POST, PUT, OPTIONS, HEAD, etc
sub allowed { return( shift->_try( 'request', 'allowed', @_ ) ); }

sub allow_methods { return( shift->_try( 'request', 'allow_methods', @_ ) ); }

sub allow_methods_list
{
    my $self = shift( @_ );
    my $r = $self->request;
    my $mask = $r->allowed;
    my $names =
    [
        map  { $methods_bit_to_name->{ $_ } }
        grep { $mask & (1 << $_) }
        keys( %$methods_bit_to_name )
    ];
    # Mirror Apache behavior: if GET is allowed, HEAD is implied.
    push( @$names, 'HEAD' ) if( $mask & ( 1 << Apache2::Const::M_GET ) );
    return( $names );
}

sub allow_options { return( shift->_try( 'request', 'allow_options', @_ ) ); }

sub allow_overrides { return( shift->_try( 'request', 'allow_overrides', @_ ) ); }

{
    # A nice alias
    # NOTE: sub apache
    no warnings 'once';
    *apache = \&request;
}

# APR::Request::Apache2->handle( $r );
sub apr { return( shift->_set_get_object( { field => 'apr', no_init => 1 }, 'APR::Request', @_ ) ); }

# sub args { return( shift->_try( 'request', 'args', @_ ) ); }
# Better yet, use APR::Body->args
sub args { return( shift->_try( 'apr', 'args', @_ ) ); }

sub args_status { return( shift->_try( 'args_status', 'args', @_ ) ); }

sub as_string { return( shift->_try( 'request', 'as_string' ) ); }

sub auth { return( shift->_set_get_scalar( 'auth', @_ ) ); }

sub auth_headers { return( shift->_try( 'request', 'note_auth_failure', @_ ) ); }

sub auth_headers_basic { return( shift->_try( 'request', 'note_basic_auth_failure', @_ ) ); }

sub auth_headers_digest { return( shift->_try( 'request', 'note_digest_auth_failure', @_ ) ); }

sub auth_name { return( shift->_try( 'request', 'auth_name', @_ ) ); }

# with mod_perl2, we need to call ap_auth_type() rather than auth_type()
sub auth_type { return( shift->_try( 'request', 'ap_auth_type', @_ ) ); }

sub authorization { return( shift->headers( 'Authorization', @_ ) ); }

# Must manually update the counter
# $r->connection->keepalives($r->connection->keepalives + 1);
# See Apache2::RequestRec
sub auto_header 
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $v = shift( @_ );
        return( $self->request->assbackwards( $v ? 0 : 1 ) );
    }
    return( $self->request->assbackwards );
}

# my( $rc, $passwd ) = $req->basic_auth_passwd;
sub basic_auth_passwd { return( shift->_try( 'request', 'get_basic_auth_pw' ) ); }

{
    no warnings 'once';
    *basic_auth_pwd = \&basic_auth_passwd;
    *basic_auth_pw = \&basic_auth_passwd;
}

# See APR::Request
# sub body { return( shift->_try( 'request', 'body', @_ ) ); }
sub body { return( shift->_try( 'apr', 'body', @_ ) ); }

sub body_status { return( shift->_try( 'apr', 'body_status', @_ ) ); }

sub brigade_limit { return( shift->_try( 'apr', 'brigade_limit', @_ ) ); }

sub call { return( shift->_try( 'request', @_ ) ); }

sub charset { return( shift->_set_get_scalar( 'charset', @_ ) ); }

sub checkonly { return( shift->_set_get_scalar( 'checkonly', @_ ) ); }

sub child_terminate { return( shift->_try( 'request', 'child_terminate' ) ); }

sub client_api_version
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $v = shift( @_ );
        unless( ref( $v ) eq 'version' )
        {
            $v = version->parse( $v );
        }
        $self->{client_api_version} = $v;
    }
    return( $self->{client_api_version} );
}

# Close the client connection
# APR::Socket->close is not implemented; left undone
# So this is a successful work around
sub close
{
    my $self = shift( @_ );
    # Using APR::Socket to get the fileno
    my $fd = $self->socket->fileno;

lib/Apache2/API/Request.pm  view on Meta::CPAN

}

sub if_none_match { return( shift->headers( 'If-None-Match', @_ ) ); }

sub input_filters { return( shift->_try( 'request', 'input_filters' ) ); }

# <https://perl.apache.org/docs/1.0/guide/debug.html#toc_Detecting_Aborted_Connections>
sub is_aborted
{
    my $self = shift( @_ );
    my $r = $self->request ||
        return( $self->error( "No Apache2::RequestRec object set anymore!" ) );
    # try-catch
    local $@;
    eval
    {        
        $r->print( "\0" );
        $r->rflush;
    };
    return(1) if( $@ && $@ =~ /Broken pipe/i );
    return( $r->connection->aborted );
}

sub is_auth_required { return( shift->_try( 'request', 'some_auth_required' ) ); }

# A HEAD request maybe ?
sub is_header_only { return( shift->request->header_only ); }

# To find out if a PerlOptions is activated like +GlobalRequest or -GlobalRequest
sub is_perl_option_enabled { return( shift->_try( 'request', 'is_perl_option_enabled', @_ ) ); }

sub is_initial_req { return( shift->_try( 'request', 'is_initial_req', @_ ) ); }

sub is_secure { return( ( shift->env( 'HTTPS' ) // '' ) eq 'on' ? 1 : 0 ); }

sub json
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    my $j    = JSON->new->relaxed;
    my $equi =
    {
        ordered => 'canonical',
        sorted => 'canonical',
        sort => 'canonical',
    };

    foreach my $opt ( keys( %$opts ) )
    {
        my $ref;
        $ref = $j->can( exists( $equi->{ $opt } ) ? $equi->{ $opt } : $opt ) || do
        {
            warn( "Unknown JSON option '${opt}'\n" ) if( $self->_warnings_is_enabled );
            next;
        };
        $ref->( $j, $opts->{ $opt } );
    }
    return( $j );
}

sub keepalive { return( shift->_try( 'connection', 'keepalive', @_ ) ); }

sub keepalives { return( shift->_try( 'connection', 'keepalives', @_ ) ); }

sub languages
{
    my $self = shift( @_ );
    my $lang = $self->accept_language || return( [] );
    my $al = HTTP::AcceptLanguage->new( $lang );
    my( @langs ) = $al->languages;
    return( $self->new_array( \@langs ) );
}

sub length { return( shift->headers->{'Content-Length'} ); }

sub local_addr { return( shift->_try( 'connection', 'local_addr' ) ); }

sub local_host { return( shift->_try( 'connection', 'local_host' ) ); }

sub local_ip { return( shift->_try( 'connection', 'local_ip' ) ); }

sub location { return( shift->_try( 'request', 'location' ) ); }

# Would return a Apache2::Log::Request
sub log { return( shift->_try( 'request', 'log', @_ ) ); }

sub log_error { return( shift->_try( 'request', 'log_error', @_ ) ); }

sub max_size { return( shift->_set_get_number( 'max_size', @_ ) ); }

sub method { return( shift->_try( 'request', 'method', @_ ) ); }

# This takes a method name, notwithstanding its case, and returns the corresponding Apache2::Const value.
sub method_bit
{
    my $self = shift( @_ );
    my $meth = shift( @_ ) ||
        return( $self->error( "No HTTP method name was provided." ) );
    $meth = uc( $meth );
    my @keys = keys( %$methods_bit_to_name );
    my $name2bit = {};
    @$name2bit{ @$methods_bit_to_name{ @keys } } = @keys;
    unless( exists( $name2bit->{ $meth } ) )
    {
        return( $self->error( "The HTTP method provided (${meth}) is not supported." ) );
    }
    return( $name2bit->{ $meth } );
}

# Provided with an Apache constant representing a method bitwise value, and this returns its name
sub method_name
{
    my $self = shift( @_ );
    my $bit  = shift( @_ );
    unless( $self->_is_integer( $bit ) )
    {
        return( $self->error( "Value provided (", ( $bit // 'undef' ), ") is not a bitwise value." ) );
    }
    $bit = 0 + $bit;
    if( exists( $methods_bit_to_name->{ $bit } ) )
    {
        return( $methods_bit_to_name->{ $bit } );
    }

lib/Apache2/API/Request.pm  view on Meta::CPAN

    my $do_not_track = $req->dnt;

    my $encoded = $req->encode( $string );

    $req->discard_request_body(1);

    my $document_root = $req->document_root;
    my $url = $req->document_uri;
    # APR::Table object
    my $hash_ref = $req->env;
    my $headers = $req->err_headers_out;
    # request filename
    my $filename = $req->filename;
    # APR::Finfo object
    my $finfo = $req->finfo;
    # e.g.: CGI/1.1
    my $gateway = $req->gateway_interface;
    my $code_ref = $req->get_handlers( $name );

    # 404 Not Found
    my $str = $req->get_status_line(404);
    my $r = $req->global_request;
    my $is_head = $req->header_only;
    # same
    my $is_head = $req->is_header_only;

    my $content_type = $req->headers( 'Content-Type' );
    # or (since it is case insensitive)
    my $content_type = $req->headers( 'content-type' );
    # or
    my $content_type = $req->headers->{'Content-Type'};
    $req->headers( 'Content-Type' => 'text/plain' );
    # or
    $req->headers->{'Content-Type'} = 'text/plain';
    # APR::Table object
    my $headers = $req->headers;

    my $hash_ref = $req->headers_as_hashref;
    my $json = $req->headers_as_json;
    my $headers = $req->headers_in;
    my $out = $req->headers_out;

    my $hostname = $req->hostname;
    my $uri_host = $req->http_host;

    my $conn_id = $req->id;

    my $if_mod = $req->if_modified_since;
    my $if_no_match = $req->if_none_match;

    my $filters = $req->input_filters;

    my $bool = $req->is_aborted;

    my $enabled = $req->is_perl_option_enabled;
    # running under https?
    my $secure = $req->is_secure;

    # JSON object
    my $json = $req->json;
    my $keepalive = $req->keepalive;
    my $keepalives = $req->keepalives;

    my $ok_languages = $req->languages;
    my $nbytes = $req->length;
    # APR::SockAddr object
    my $addr = $req->local_addr;
    my $host = $req->local_host;
    my $str = $req->local_ip;
    my $loc = $req->location;
    $req->log_error( "Oh no!" );

    # 200kb
    $req->max_size(204800);

    my $http_method = $req->method;
    my $meth_num = $req->method_number;
    # mod_perl/2.0.11
    my $mod_perl = $req->mod_perl;
    my $vers = $req->mod_perl_version;
    my $seconds = $req->mtime;
    my $req2 = $req->next;
    $req->no_cache(1);

    # APR::Table object
    my $notes = $req->notes;
    my $notes = $req->pnotes;

    my $filters = $req->output_filters;
    my $val = $req->param( $name );
    my $hash_ref = $req->params;

    my $dt = $req->parse_date( $http_date_string );

    my $path = $req->path;
    my $path_info = $req->path_info;
    # for JSON payloads
    my $hash_ref = $req->payload;
    my $val = $req->per_dir_config( $my_config_name );
    # APR::Pool object
    my $pool = $req->pool;

    my $best_lang = $req->preferred_language( $lang_array_ref );

    my $req0 = $req->prev;
    my $proto = $req->protocol;
    $req->proxyreq( Apache2::Const::PROXYREQ_PROXY );
    $req->push_handlers( $name => $code_ref );

    # get hash reference from the query string using Apache2::API::Query instead of APR::Body->args
    # To use APR::Body->args, call args() instead
    my $hash_ref = $req->query;
    my $string = $req->query_string;

    my $nbytes = $req->read( $buff, 1024 );
    my $notes = $req->redirect_error_notes;
    my $qs = $req->redirect_query_string;
    my $status = $req->redirect_status;
    my $url = $req->redirect_url;
    my $referrer = $req->referer;

    # APR::SockAddr object

lib/Apache2/API/Request.pm  view on Meta::CPAN

Setup the output headers so that the client knows how to authenticate itself the next time, if an authentication request failed. This function works only for basic and digest authentication, by calling L<Apache2::Access/note_auth_failure>

This method requires C<AuthType> to be set to C<Basic> or C<Digest>. Depending on the setting it will call either L</auth_headers_basic> or L</auth_headers_digest>.

It does not return anything.

=head2 auth_headers_basic

    $req->auth_headers_basic;

Setup the output headers so that the client knows how to authenticate itself the next time, if an authentication request failed. This function works only for basic authentication.

It does not return anything.

=head2 auth_headers_digest

    $req->auth_headers_digest;

Setup the output headers so that the client knows how to authenticate itself the next time, if an authentication request failed. This function works only for digest authentication.

It does not return anything.

=head2 auth_name

    my $auth_name = $req->auth_name();
    my $auth_name = $req->auth_name( $new_auth_name );

Sets or gets the current Authorization realm, i.e. the per directory configuration directive C<AuthName>

The C<AuthName> directive creates protection realm within the server document space. To quote RFC 1945 "These realms allow the protected resources on a server to be partitioned into a set of protection spaces, each with its own authentication scheme ...

The client uses the root URL of the server to determine which authentication credentials to send with each HTTP request. These credentials are tagged with the name of the authentication realm that created them. Then during the authentication stage th...

=head2 auth_type

    my $auth_type = $req->auth_type();
    my $auth_type = $req->auth_type( $new_auth_type );

Sets or gets the type of authorization required for this request, i.e. the per directory configuration directive C<AuthType>

Normally C<AuthType> would be set to C<Basic> to use the basic authentication scheme defined in RFC 1945, Hypertext Transfer Protocol (HTTP/1.0). However, you could set to something else and implement your own authentication scheme.

=head2 authorization

Returns the HTTP C<authorization> header value. This is similar to L</auth>.

See also L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Authorization>

=head2 auth_type

Returns the authentication type by calling L<Apache2::RequestRec/auth_type>

    my $auth_type = $req->auth_type; # Basic

=head2 auto_header

Given a boolean value, this enables the auto header or not by calling the method L<Apache2::RequestRec/assbackwards>

If this is disabled, you need to make sure to manually update the counter, such as:

    $req->connection->keepalives( $req->connection->keepalives + 1 );

See L<Apache2::RequestRec> for more information on this.

=head2 basic_auth_passwd

    my( $rc, $passwd ) = $req->basic_auth_passwd;

Get the details from the basic authentication, by calling L<Apache2::Access/get_basic_auth_pw>

It returns:

=over 4

=item 1. the value of an Apache constant

This would be C<Apache2::Const::OK> if the password value is set (and assured a correct value in L</user>); otherwise it returns an error code, either C<Apache2::Const::HTTP_INTERNAL_SERVER_ERROR> if things are really confused, C<Apache2::Const::HTTP...

=item 2. the password as set in the headers (decoded)

=back

Note that if C<AuthType> is not set, L<Apache2::Access/get_basic_auth_pw> first sets it to C<Basic>.

=head2 basic_auth_pw

This is an alias for L</basic_auth_passwd>

=head2 basic_auth_pwd

This is an alias for L</basic_auth_passwd>

=head2 body

Returns an L<APR::Request::Param::Table|APR::Request::Param> object containing the C<POST> data parameters of the L<Apache2::Request> object.

    my $body = $req->body;
    my @body_names = $req->body;

If there is no request body, then this would return C<undef>. So, for example, if you do a C<POST> query without any content, this would return C<undef>

An optional name parameter can be passed to return the POST (or other similar query types) data parameter associated with the given name:

    my $foo_body = $req->body("foo");

In scalar context this method fetches the first matching body param.  In list context it returns all matching body params.

This is similar to the C<param> method. The main difference is that modifications to the scalar C<< $req->body() >> table affect the underlying C<apr_table_t> attribute in C<apreq_request_t>, so their impact will be noticed by all C<libapreq2> applic...

Contrary to perl hash, this uses L<APR::Table> and the order in the hash is preserved, so you could do:

    my @body_names = $req->body;
    my @body_names = %$body;

would yield the same thing.

This will throw an L<APR::Request::Error> object whenever L</body_status> returns a non-zero value.

Check L<Apache2::Request> and L<APR::Table> for more information.

=head2 body_status

lib/Apache2/API/Request.pm  view on Meta::CPAN

It returns true if the connection was aborted, and false otherwise.

=head2 is_auth_required

    my $need_auth = $r->is_auth_required;

Check if any authentication is required for the current request, by calling L<Apache2::Access/some_auth_required>

It returns a boolean value.

See also L</has_auth>, which is an alias of this method.

=head2 is_header_only

Returns a boolean value on whether the request is a C<HEAD> request or not, by calling L<Apache2::RequestRec/header_only>

So, it returns true if the client is asking for headers only, false otherwise.

=head2 is_perl_option_enabled

Sets or gets whether a directory level C<PerlOptions> flag is enabled or not. This returns a boolean value, by calling L<Apache2::RequestUtil/is_perl_option_enabled>

For example to check whether the C<SetupEnv> option is enabled for the current request (which can be disabled with C<PerlOptions -SetupEnv>) and populate the environment variables table if disabled:

     $req->subprocess_env unless $req->is_perl_option_enabled('SetupEnv');

See also: PerlOptions and the equivalent function for server level PerlOptions flags.

See the L<Apache2::RequestUtil> module documentation for more information.

=head2 is_initial_req

    # Are we in the main request?
    $is_initial = $req->is_initial_req;

Determines whether the current request is the main request or a sub-request.

This returns a boolean value.

See also L<main|/main>, which returns the main request object.

=head2 is_secure

Returns true (1) if the connection is made under ssl, i.e. of the environment variable C<HTTPS> is set to C<on>, other it returns false (0).

This is done by checking if the environment variable C<HTTPS> is set to C<on> or not.

=head2 json

Returns a L<JSON> object with the C<relaxed> attribute enabled so that it allows more relaxed C<JSON> data.

You can provide an optional hash or hash reference of properties to enable or disable:

    my $J = $api->json( pretty => 1, relaxed => 1 );

Each property corresponds to one that is supported by L<JSON>

It also supports C<ordered>, C<order> and C<sort> as an alias to C<canonical>

=head2 keepalive

    $status = $c->keepalive();
    $status = $c->keepalive($new_status);

This method answers the question: Should the the connection be kept alive for another HTTP request after the current request is completed?

This sets or gets the status by calling L<Apache2::Connection/keepalive>

     use Apache2::Const -compile => qw(:conn_keepalive);
     # ...
     my $c = $req->connection;
     if ($c->keepalive == Apache2::Const::CONN_KEEPALIVE) {
         # do something
     }
     elsif ($c->keepalive == Apache2::Const::CONN_CLOSE) {
         # do something else
     }
     elsif ($c->keepalive == Apache2::Const::CONN_UNKNOWN) {
         # do yet something else
     }
     else {
         # die "unknown state";
     }

Notice that new states could be added later by Apache, so your code should make no assumptions and do things only if the desired state matches.

The method does not return true or false, but one of the states which can be compared against Apache constants (C<:conn_keepalive constants>).

See L<Apache2::Connection> for more information.

=head2 keepalives

    my $served = $req->connection->keepalives();
    my $served = $req->connection->keepalives( $new_served );

This returns an integer representing how many requests were already served over the current connection.

This method calls L<Apache2::Connection/keepalives>

This method is only relevant for keepalive connections. The core connection output filter C<ap_http_header_filter> increments this value when the response headers are sent and it decides that the connection should not be closed (see "ap_set_keepalive...

If you send your own set of HTTP headers with C<< $req->assbackwards >>, which includes the C<Keep-Alive> HTTP response header, you must make sure to increment the C<keepalives> counter.

See L<Apache2::Connection> for more information.

=head2 languages

This will check the C<Accept-Languages> HTTP headers and derive a list of priority ordered user preferred languages and return an L<array object|Module::Generic::Array>.

See also the L</preferred_language> method.

=head2 length

Returns an integer representing the length in bytes of the request body, by calling L<Apache2::RequestRec/bytes_sent>

=head2 local_addr

Returns our server local address as a L<APR::SockAddr> object, by calling L<Apache2::Connection/local_addr>

    my $local_sock_addr  = $req->connection->local_addr;
    my $port = $local_sock_addr->port;
    my $ip   = $local_sock_addr->ip_get; # e.g.: 192.168.1.2

=head2 local_host

Used for C<ap_get_server_name> when C<UseCanonicalName> is set to C<DNS> (ignores setting of HostnameLookups)

This calls L<Apache2::Connection/local_host>

Better to use the L</server_name> instead.

=head2 local_ip

Return our server IP address as string, by calling L<Apache2::Connection/local_ip>

=head2 location

Get the path of the <Location> section from which the current C<Perl*Handler> is being called.

This calls L<Apache2::RequestUtil/location>

Returns a string.

=head2 log

    $req->log->emerg( "Urgent message." );
    $req->log->alert( "Alert!" );
    $req->log->crit( "Critical message." );
    $req->log->error( "Error message." );
    $req->log->warn( "Warning..." );
    $req->log->notice( "You should know." );
    $req->log->info( "This is for your information." );
    $req->log->debug( "This is debugging message." );

Returns a L<Apache2::Log::Request> object.

=head2 log_error

Returns the value from L<Apache2::Request/log_error> by passing it whatever arguments were received.

=head2 main