Apache2-AUS

 view release on metacpan or  search on metacpan

examples/CGI/htdocs/login.cgi  view on Meta::CPAN

 <HEAD>
  <TITLE>Login Test</TITLE>
 </HEAD>
 <BODY>
  <A HREF="login?logout=1&go=/test/apache2-aus-cgi/login.cgi">Log Out</A>
  <HR/>
  <FORM METHOD="POST" ACTION="login">
   <INPUT TYPE="HIDDEN" NAME="go" VALUE="/test/apache2-aus-cgi/env.cgi">
   <INPUT TYPE="HIDDEN" NAME="go_error" VALUE="/test/apache2-aus-cgi/login.cgi">
   User: <INPUT TYPE="TEXT" NAME="user" /><BR/>
   Pass: <INPUT TYPE="TEXT" NAME="password" /><BR/>
   <INPUT TYPE="SUBMIT" VALUE="Go" />
  </FORM>
  <HR/>
  <B>$message</B>
 </BODY>
</HTML>
EOT

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

    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;

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

ensure that your session is saved at the end of each request. See
L</_Fixup> below.

This handler always returns OK.

=item Response

In Apache2::AUS, the C<Response> handler is responsible for logging the user
in. This handler will read any GET / POST arguments (via
L<Apache2::Request|Apache2::Request> so other handlers can use them later).
If "user" and "password" are supplied, a login will be attempted under that
user id. If "logout" is supplied, any logged-in user will be logged out.

If the login was unsuccessful, the AUS_AUTH_FAILURE environment
variable will be set to a string containing the reason why.

This handler always returns OK, and will do an internal redirect to a page
based on the "go" and "go_error" GET / POST arguments;

=over

t/cgi.t  view on Meta::CPAN

    $self->{_received}, qr{REMOTE_USER},
    "We don't have a REMOTE_USER yet"
);
delete $self->{_received};

$received = GET_BODY "$path/login.cgi";
like($received, qr{<B></B>}, "Got login page, no message.");

$received = POST_BODY(
    "$path/login",
    [ user => "kristina", password => "tampon", @go ]
);
like(
    $received,
    qr{\Q<B>User not found.\E}, "Get correct error for bad user"
);

my $user = Schema::RDBMS::AUS::User->create(
    _dbh        => $self->{dbh},
    name        => "kristina",
    _password   => "rum"
);
ok($user->save, "Created a user");
$self->{_user} = $user;

$received = POST_BODY(
    "$path/login", [ user => "kristina", password => "tampon", @go ]
);
like(
    $received,
    qr{\Q<B>Bad password for user\E},
    "Got bad password error"
);

$received = GET_BODY("$path/protected.cgi");
unlike($received, qr{You made it}, "Can't hit protected page without login");

$received = POST_BODY(
    "$path/login", [ user => "kristina", password => "rum", @go ]
);
$test = "REMOTE_USER set on successful login";
if($received =~ m{REMOTE_USER'?\s+=>\s+'?(\d+)'?}) {
    $self->{_user_id} = $1;
    pass($test);
} else {
    diag($received);
    fail($test);
}



( run in 0.573 second using v1.01-cache-2.11-cpan-49f99fa48dc )