view release on metacpan or  search on metacpan

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

package Apache2::AUS;

use 5.006;
use strict;
use warnings;
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::Request ();
use Apache2::AUS::RequestRec ();
use Apache2::AUS::Util qw(
    create_session bake_session_cookie set_remote_user
    check_requirement auth_failure go
);
use Apache2::Const qw(OK FORBIDDEN DECLINED AUTH_REQUIRED);
use Apache2::Access;
use Apache2::Log;
use Carp qw(verbose);

our $VERSION = "0.02";

return 1;

sub Init {
    my($class, $r) = @_;
    
    my $session = $r->aus_session || create_session($r);
    my $use_count = $session->param('_use_count');
    $use_count ++;
    $session->param('_use_count', $use_count);
    $r->headers_out->add('Set-Cookie', bake_session_cookie($r, $session));
    $r->aus_session($session);
    $r->push_handlers(PerlFixupHandler => \&_Fixup);

    if(my $u = $session->user) {
        $r->user($u->{id});
    }
    
    return OK;
}

# Save our session before handling the Response phase.
# This ensures that other things touching the session (eg; CGI)
# will have a current copy they can load and save, as well as
# making sure we don't save over their changes when $r
# goes out of scope.

sub _Fixup {
    my $r = shift;
    my $session = $r->aus_session;
    $session->flush;
    return OK;
}

sub Response {
    my($class, $r) = @_;
    my $session = $r->aus_session;
    my $req = Apache2::Request->new($r, DISABLE_UPLOADS => 1);
    my $table = $req->param;
    my $go = $table->{go} || '/';
    my $go_error = $table->{go_error} || $go;
    
    if($table->{logout}) {
        $session->logout;
        return go($r, $go);
    } elsif($table->{user} && $table->{password}) {
        my $user = eval { $session->login(@$table{'user','password'}); };
        my $err = $@;
        $session->_set_status($session->STATUS_MODIFIED);
        $session->flush;
        if($err) {
            auth_failure($r, $err);
            return go($r, $go_error);
        } else {
            $r->user($user->{id});
            return go($r, $go);
        }
    } else {
        $r->subprocess_env('Username or password not specified.');
        return go($r, $go_error);
    }
}

sub Authen {
    my($class, $r) = @_;
    my $requires = $r->requires;
    if($requires && scalar(@$requires)) {
        my $session = $r->aus_session;
        my $user = $session->user;
        foreach (
            map { [ split(" ", $_->{requirement}) ] } (@$requires)