credentials results from the CPAN

credentials

Apache2-API

view release on metacpan or search on metacpan

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

##----------------------------------------------------------------------------
## Apache2 API Framework - ~/lib/Apache2/API/Response.pm
## Version v0.2.0
## Copyright(c) 2025 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2023/05/30
## Modified 2025/11/02
## All rights reserved
## 
## 
## This program is free software; you can redistribute  it  and/or  modify  it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Apache2::API::Response;
BEGIN
{
    use strict;
    use warnings;
    warnings::register_categories( 'Apache2::API' );
    use parent qw( Module::Generic );
    use vars qw( $VERSION );
    use Apache2::Request;
    use Apache2::Const -compile => qw( :common :http );
    use Apache2::Log ();
    use Apache2::Response ();
    use Apache2::RequestIO ();
    use Apache2::RequestRec ();
    use Apache2::SubRequest ();
    use APR::Request ();
    # use APR::Request::Cookie;
    use Apache2::API::Status;
    use Cookie::Jar;
    use Scalar::Util;
    use URI::Escape ();
    our $VERSION = 'v0.2.0';
};

use strict;
use warnings;

sub init
{
    my $self = shift( @_ );
    my $r;
    $r = shift( @_ ) if( @_ % 2 );
    # Which is an Apache2::Request, but inherits everything from Apache2::RequestRec and APR::Request::Apache2
    $self->{request} = '';
    $self->{checkonly} = 0;
    $self->SUPER::init( @_ );
    $r ||= $self->{request};
    unless( $self->{checkonly} )
    {
        return( $self->error( "No Apache2::API::Request was provided." ) ) if( !$r );
        return( $self->error( "Apache2::API::Request provided ($r) is not an object!" ) ) if( !Scalar::Util::blessed( $r ) );
        return( $self->error( "I was expecting an Apache2::API::Request, but instead I got \"$r\"." ) ) if( !$r->isa( 'Apache2::API::Request' ) );
    }
    return( $self );
}

# Response header: <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Credentials>
sub allow_credentials { return( shift->_set_get_one( 'Access-Control-Allow-Credentials', @_ ) ); }

# Response header <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Headers>
sub allow_headers { return( shift->_set_get_one( 'Access-Control-Allow-Headers', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Methods>
sub allow_methods { return( shift->_set_get_one( 'Access-Control-Allow-Methods', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Origin>
sub allow_origin { return( shift->_set_get_one( 'Access-Control-Allow-Origin', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Alt-Svc>
sub alt_svc { return( shift->_set_get_multi( 'Alt-Svc', @_ ) ); }

sub bytes_sent { return( shift->_try( '_request', 'bytes_sent' ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Cache-Control>
sub cache_control { return( shift->_set_get_one( 'Cache-Control', @_ ) ); }

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

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Clear-Site-Data>
sub clear_site_data { return( shift->_set_get_multi( 'Clear-Site-Data', @_ ) ); }

# Apache2::Connection
sub connection { return( shift->_try( '_request', 'connection' ) ); }

# Set the http code to be returned, e.g,:
# return( $resp->code( Apache2::Const:HTTP_OK ) );
sub code { return( shift->_try( '_request', 'status', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Disposition>
# TODO: More work to be done here like create a disposition method to parse its content
sub content_disposition { return( shift->_set_get_one( 'Content-Disposition', @_ ) ); }

# sub content_encoding { return( shift->_request->content_encoding( @_ ) ); }
sub content_encoding
{
    my $self = shift( @_ );
    my( $pack, $file, $line ) = caller;
    my $sub = ( caller( 1 ) )[3];
    # try-catch
    local $@;
    my $rv = eval
    {
        return( $self->_request->content_encoding( @_ ) );
    };
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to access Apache Request method \"content_encoding\": $@" ) );
    }
    return( $rv );
}

# https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Language
sub content_language { return( shift->headers( 'Content-Language', @_ ) ); }

sub content_languages { return( shift->_try( '_request', 'content_languages', @_ ) ); }

# sub content_length { return( shift->headers( 'Content-Length', @_ ) ); }
# https://perl.apache.org/docs/2.0/api/Apache2/Response.html#toc_C_set_content_length_

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

sub _try
{
    my $self = shift( @_ );
    my $pack = shift( @_ ) || return( $self->error( "No Apache package name was provided to call method" ) );
    my $meth = shift( @_ ) || return( $self->error( "No method name was provided to try!" ) );
    my $r = Apache2::RequestUtil->request;
    # $r->log_error( "Apache2::API::Response::_try to call method \"$meth\" in package \"$pack\"." );
    # try-catch
    local $@;
    my( @rv, $rv );
    if( wantarray() )
    {
        @rv = eval
        {
            return( $self->$pack->$meth() ) if( !scalar( @_ ) );
            return( $self->$pack->$meth( @_ ) );
        };
    }
    else
    {
        $rv = eval
        {
            return( $self->$pack->$meth() ) if( !scalar( @_ ) );
            return( $self->$pack->$meth( @_ ) );
        };
    }
    if( $@ )
    {
        return( $self->error( "An error occurred while trying to call Apache ", ucfirst( $pack ), " method \"$meth\": $@" ) );
    }
    return( wantarray() ? @rv : $rv );
}

# NOTE: sub FREEZE is inherited

sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }

sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }

# NOTE: sub THAW is inherited

1;
# NOTE: POD
__END__

=encoding utf8

=head1 NAME

Apache2::API::Response - Apache2 Outgoing Response Access and Manipulation

=head1 SYNOPSIS

    use Apache2::API::Response;
    # $r is the Apache2::RequestRec object
    my $resp = Apache2::API::Response->new( request => $r, debug => 1 );
    # or, to test it outside of a modperl environment:
    my $resp = Apache2::API::Response->new( request => $r, debug => 1, checkonly => 1 );

    # Access-Control-Allow-Credentials
    my $cred = $resp->allow_credentials;
    # Access-Control-Allow-Headers
    $resp->allow_headers( $custom_header );
    # Access-Control-Allow-Methods
    $resp->allow_methods( $method );
    $reso->allow_origin( $origin );
    # Alt-Svc
    my $alt = $resp->alt_svc;
    my $nbytes = $resp->bytes_sent;
    # Cache-Control
    my $cache = $resp->cache_control;
    # Clear-Site-Data
    my $clear = $resp->clear_site_data;
    
    # Apache2::Connection object
    my $conn = $resp->connection;
    my $code = $resp->code;
    # Content-Disposition
    my $disp = $resp->content_disposition;
    my $encoding = $resp->content_encoding;
    # Content-Language
    my $lang = $resp->content_language;
    my $langs_array_ref = $resp->content_languages;
    # Content-Length
    my $len = $resp->content_length;
    # Content-Location
    my $location = $resp->content_location;
    # Content-Range
    my $range = $resp->content_range;
    # Content-Security-Policy
    my $policy = $resp->content_security_policy;
    my $policy = $resp->content_security_policy_report_only;
    my $ct = $resp->content_type;
    my $cookie = $resp->cookie_new(
        name => $name,
        value => $some_value,
        value => 'sid1234567',
        path => '/',
        expires => '+10D',
        # or alternatively
        maxage => 864000
        # to make it exclusively accessible by regular http request and not javascript
        http_only => 1,
        same_site => 'Lax',
        # should it be used under ssl only?
        secure => 1
    );
    $resp->cookie_replace( $cookie );
    $resp->cookie_set( $cookie );
    # Cross-Origin-Embedder-Policy
    my $policy = $resp->cross_origin_embedder_policy;
    # Cross-Origin-Opener-Policy
    my $policy = $resp->cross_origin_opener_policy;
    # Cross-Origin-Resource-Policy
    my $policy = $resp->cross_origin_resource_policy;
    my $cspro = $resp->cspro;
    $resp->custom_response( Apache2::Const::AUTH_REQUIRED, "Authenticate please" );
    my $decoded = $resp->decode( $string );
    # Digest
    my $digest = $resp->digest;
    my $encoded = $resp->encode( $string );

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

    # Vary
    my $vary = $resp->vary;
    # Via
    my $via = $resp->via;
    # Want-Digest
    my $want = $resp->want_digest;
    # Warning
    my $warn = $resp->warning;
    $resp->write( $buffer, $len, $offset );
    # WWW-Authenticate
    my $auth = $resp->www_authenticate;
    # X-Content-Type-Options
    my $opt = $resp->x_content_type_options;
    # X-DNS-Prefetch-Control
    my $proto = $resp->x_dns_prefetch_control;
    # X-Frame-Options
    my $opt = $resp->x_frame_options;
    # X-XSS-Protection
    my $xss = $resp->x_xss_protection; 

=head1 VERSION

    v0.2.0

=head1 DESCRIPTION

The purpose of this module is to provide an easy access to various method to process and manipulate incoming request.

This is designed to work under modperl.

Normally, one would need to know which method to access across various Apache2 mod perl modules, which makes development more time consuming and even difficult, because of the scattered documentation and even sometime outdated.

This module alleviate this problem by providing all the necessary methods in one place. Also, at the contrary of C<Apache2> modules suit, all the methods here are die safe. When an error occurs, it will always return undef() and the error will be abl...

Fo its alter ego to manipulate outgoing HTTP response, use the L<Apache2::API::Response> module.

=head1 CONSTRUCTORS

=head2 new

This initiates the package and take the following parameters:

=over 4

=item * C<checkonly>

If true, it will not perform the initialisation it would usually do under modperl.

=item * C<debug>

Optional. If set with a positive integer, this will activate verbose debugging message

=item * C<request>

This is a required parameter to be sent with a value set to a L<Apache2::RequestRec> object

=back

=head1 METHODS

=head2 allow_credentials

Sets or gets the HTTP header field C<Access-Control-Allow-Credentials>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Credentials>

=head2 allow_headers

Sets or gets the HTTP header field C<Access-Control-Allow-Credentials>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Headers>

=head2 allow_methods

Sets or gets the HTTP header field C<Access-Control-Allow-Methods>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Methods>

=head2 allow_origin

Sets or gets the HTTP header field C<Access-Control-Allow-Origin>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Allow-Origin>

=head2 alt_svc

Sets or gets the HTTP header field C<Alt-Svc>

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

=head2 bytes_sent

The number of bytes sent to the client, handy for logging, etc.

This calls L<Apache2::RequestRec/bytes_sent>

=head2 cache_control

Sets or gets the HTTP header field C<Cache-Control>

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

=head2 call

Provided with an Apache2 API method name, and optionally with some additional arguments, and this will call that Apache2 method and return its result.

This is designed to allow you to call arbitrary Apache2 method that, possibly, are not covered here.

For example:

    $resp->call( 'send_error_response' );

It returns whatever value this call returns.

=head2 clear_site_data

Sets or gets the HTTP header field C<Clear-Site-Data>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Clear-Site-Data>

=head2 code

( run in 0.741 second using v1.01-cache-2.11-cpan-140bd7fdf52 )