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
$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 )