view release on metacpan or  search on metacpan

lib/Apache2/AuthCookie/Base.pm  view on Meta::CPAN

}


sub key {
    my ($self, $r) = @_;

    my $cookie_name = $self->cookie_name($r);

    my $allcook = ($r->headers_in->get("Cookie") || "");

    return ($allcook =~ /(?:^|\s)$cookie_name=([^;]*)/)[0];
}


sub login {
    my ($self, $r) = @_;

    my $debug = $r->dir_config("AuthCookieDebug") || 0;

    my $auth_type = $r->auth_type;
    my $auth_name = $r->auth_name;

    my $params = $self->params($r);

    if ($r->method eq 'POST') {
        $self->_convert_to_get($r);
    }

    my $default_destination = $r->dir_config("${auth_name}DefaultDestination");
    my $destination         = $params->param('destination');

    if (is_blank($destination)) {
        if (!is_blank($default_destination)) {
            $destination = $default_destination;
            $r->server->log_error("destination set to $destination");
        }
        else {
            $r->server->log_error("No key 'destination' found in form data");
            $r->subprocess_env('AuthCookieReason', 'no_cookie');
            return $auth_type->login_form($r);
        }
    }

    if ($r->dir_config("${auth_name}EnforceLocalDestination")) {
        my $current_url = $r->construct_url;
        unless (is_local_destination($destination, $current_url)) {
            $r->server->log_error("non-local destination $destination detected for uri ",$r->uri);

            if (is_local_destination($default_destination, $current_url)) {
                $destination = $default_destination;
                $r->server->log_error("destination changed to $destination");
            }
            else {
                $r->server->log_error("Returning login form: non local destination: $destination");
                $r->subprocess_env('AuthCookieReason', 'no_cookie');
                return $auth_type->login_form($r);
            }
        }
    }

    # Get the credentials from the data posted by the client
    my @credentials;
    for (my $i = 0; defined $params->param("credential_$i"); $i++) {
        my $key = "credential_$i";
        my $val = $params->param($key);
        $r->server->log_error("$key $val") if $debug >= 2;
        push @credentials, $val;
    }

    # save creds in pnotes so login form script can use them if it wants to
    $r->pnotes("${auth_name}Creds", \@credentials);

    # Exchange the credentials for a session key.
    my $ses_key = $self->authen_cred($r, @credentials);
    unless ($ses_key) {
        $r->server->log_error("Bad credentials") if $debug >= 2;
        $r->subprocess_env('AuthCookieReason', 'bad_credentials');
        $r->uri($self->untaint_destination($destination));
        return $auth_type->login_form($r);
    }

    if ($debug >= 2) {
        defined $ses_key ? $r->server->log_error("ses_key $ses_key")
                         : $r->server->log_error("ses_key undefined");
    }

    $self->send_cookie($r, $ses_key);

    $self->handle_cache($r);

    if ($debug >= 2) {
        $r->server->log_error("redirect to $destination");
    }

    $r->headers_out->set(
        "Location" => $self->untaint_destination($destination));

    return HTTP_MOVED_TEMPORARILY;
}


sub login_form {
    my ($self, $r) = @_;

    my $auth_name = $r->auth_name;

    if ($r->method eq 'POST') {
        $self->_convert_to_get($r);
    }

    # There should be a PerlSetVar directive that gives us the URI of
    # the script to execute for the login form.

    my $authen_script;
    unless ($authen_script = $r->dir_config($auth_name . "LoginScript")) {
        $r->server->log_error("PerlSetVar '${auth_name}LoginScript' not set", $r->uri);
        return SERVER_ERROR;
    }

    my $status = $self->login_form_status($r);
    $status = HTTP_FORBIDDEN unless defined $status;

    $r->custom_response($status, $authen_script);

    return $status;
}


sub login_form_status {
    my ($self, $r) = @_;

    my $ua = $r->headers_in->get('User-Agent')
        or return HTTP_FORBIDDEN;

    if (Apache::AuthCookie::Util::understands_forbidden_response($ua)) {
        return HTTP_FORBIDDEN;
    }

lib/Apache2/AuthCookie/Base.pm  view on Meta::CPAN

The Cookie name

=item *

value

the Cookie value

=item *

expires (optional)

When the cookie expires. See L<Apache::AuthCookie::Util/expires()>.  Uses C<${auth_name}Expires> if not giv

=back

All other cookie settings come from C<PerlSetVar> settings.

=head2 decoded_requires($r): arrayref

This method returns the C<< $r->requires >> array, with the C<requirement>
values decoded if C<${auth_name}RequiresEncoding> is in effect for this
request.

=head2 decoded_user($r): string

If you have set ${auth_name}Encoding, then this will return the decoded value of
C<< $r-E<gt>user >>.

=head2 encoding($r): string

Return the ${auth_name}Encoding setting that is in effect for this request.

=head2 escape_uri($r, $value): string

Escape the given string so it is suitable to be used in a URL.

=head2 get_cookie_path($r): string

Returns the value of C<PerlSetVar ${auth_name}Path>.

=head2 handle_cache($r): void

If C<${auth_name}Cache> is defined, this sets up the response so that the
client will not cache the result.  This sents C<no_cache> in the apache request
object and sends the appropriate headers so that the client will not cache the
response.

=head2 key($r): string

This method will return the current session key, if any.  This can be handy
inside a method that implements a C<require> directive check (like the
C<species> method discussed above) if you put any extra information like
clearances or whatever into the session key.

=head2 login($r): int

This method handles the submission of the login form.  It will call the
C<authen_cred()> method, passing it C<$r> and all the submitted data with names
like C<credential_#>, where # is a number.  These will be passed in a simple
array, so the prototype is C<$self-E<gt>authen_cred($r, @credentials)>.  After
calling C<authen_cred()>, we set the user's cookie and redirect to the URL
contained in the C<destination> submitted form field.

=head2 login_form($r): int

This method is responsible for displaying the login form. The default
implementation will make an internal redirect and display the URL you specified
with the C<PerlSetVar WhatEverLoginScript> configuration directive. You can
overwrite this method to provide your own mechanism.

=head2 login_form_status($r): int

This method returns the HTTP status code that will be returned with the login
form response.  The default behaviour is to return HTTP_FORBIDDEN, except for
some known browsers which ignore HTML content for HTTP_FORBIDDEN responses
(e.g.: SymbianOS).  You can override this method to return custom codes.

Note that HTTP_FORBIDDEN is the most correct code to return as the given
request was not authorized to view the requested page.  You should only change
this if HTTP_FORBIDDEN does not work.

=head2 logout($r): void

This is simply a convenience method that unsets the session key for you.  You
can call it in your logout scripts.  Usually this looks like
C<$r-E<gt>auth_type-E<gt>logout($r)>.

=head2 params($r): Apache2::AuthCookie::Params

Get the GET/POST params object for this request.

=head2 recognize_user($r): int

If the user has provided a valid session key but the document isn't protected,
this method will set C<$r-E<gt>user> anyway.  Use it as a PerlFixupHandler,
unless you have a better idea.

=head2 remove_cookie($r): void

Adds a C<Set-Cookie> header that instructs the client to delete the cookie
immediately.

=head2 requires_encoding($r): string

Return the ${auth_name}RequiresEncoding setting that is in effect for this request.

=head2 send_cookie($r, $ses_key, $args): void

By default this method simply sends out the session key you give it.  If you
need to change the default behavior (perhaps to update a timestamp in the key)
you can override this method.

=head2 send_p3p($r): void

Set a P3P response header if C<${auth_name}P3P> is configured.  The value of
the header is whatever is in the C<${auth_name}P3P> setting.

=head2 untaint_destination($destination): string

This method returns a modified version of the destination parameter before