view release on metacpan or  search on metacpan

t/auth.t  view on Meta::CPAN

#!perl
#
# test AuthTicket authentication

use strict;
use warnings FATAL => 'all';
use lib qw(t/lib);
use Apache::Test '-withtestmore';
use Apache::TestRequest qw(GET POST);

if (not have_module('DBD::SQLite')) {
    plan skip_all => 'DBD::SQLite is not installed';
}
elsif (not have_module('LWP::UserAgent')) {
    plan skip_all => 'LWP::UserAgent is not installed';
}
else {
    plan tests => 34;
}

# must match value in SQLite DB
my $Secret = 'mvkj39vek@#$R*njdea9@#';

my $CookieFormat = qr/[0-9a-f]{32}\-\-[A-Za-z0-9+\/]+/;

use_ok('Apache::AuthTicket::Base');

Apache::TestRequest::user_agent(
    cookie_jar            => {},
    reset                 => 1,
    requests_redirectable => 0);

# get login form
my $r = GET '/protected/index.html';
isa_ok $r, 'HTTP::Response';
is $r->code, 403, 'got 403 response';
like $r->content, qr/credential_0/, 'content contains credential_0';
like $r->content, qr/credential_0/, 'content contains credential_1';

# login
$r = POST '/login', [
    destination => '/protected/index.html',
    credential_0 => 'programmer',
    credential_1 => 'secret' ];
isa_ok $r, 'HTTP::Response';
is $r->code, 302, 'got 302 response';
is $r->header('Location'), '/protected/index.html', 'Location header';
like $r->header('Set-Cookie'), qr/$CookieFormat/, 'response sets cookie';

# get the protected page.
$r = GET '/protected/index.html';
isa_ok $r, 'HTTP::Response';
is $r->code, 200, 'got 200 response';
like $r->content, qr/congratulations, you got the protected page/;

# logout
$r = GET '/protected/logout';
isa_ok $r, 'HTTP::Response';
is $r->code, 302, 'got 302 response from logout';
like $r->header('Set-Cookie'), qr/::AuthTicket_Protected=;\s+/, 'Cookie was cleared';
is $r->header('Location'), '/protected/index.html', 'Logout sets location header';

# make sure we really logged out.
$r = GET '/protected/index.html';
isa_ok $r, 'HTTP::Response';
is $r->code, 403, 'got 403 response';

### /secure auth area tests.
$r = GET '/secure/protected/index.html';
isa_ok $r, 'HTTP::Response';
is $r->code, 403, 'got 403 response';
like $r->content, qr/credential_0/, 'content contains credential_0';
like $r->content, qr/credential_0/, 'content contains credential_1';

# login
$r = POST '/secure/login', [
    destination => '/secure/protected/index.html',
    credential_0 => 'programmer',
    credential_1 => 'secret' ];
isa_ok $r, 'HTTP::Response';
is $r->code, 302, 'got 302 response';
is $r->header('Location'), '/secure/protected/index.html', 'Location header';
my $cookie = $r->header('Set-Cookie');
like $cookie, qr/AuthTicket_Sec=$CookieFormat/, 'response sets cookie';
ok cookie_has_field($cookie, 'secure'), 'cookie has secure flag set';
ok cookie_has_field($cookie, 'path=/secure'), 'cookie path = /secure';
ok cookie_has_field($cookie, 'domain=.local'), 'cookie domain is .local';
ok check_hash($cookie, ip => 0, browser => 1), 'hash users browser, not ip';

# we have to manually send the cookie here because of secure/domain fields.
$r = GET '/secure/protected/index.html', Cookie => $cookie;
isa_ok $r, 'HTTP::Response';
is $r->code, 200, 'got 200 response';

# lets tamper with the cookie. should get 403
{
    my ($data) = $cookie =~ /--(.*?);/;
    my $ticket = Apache::AuthTicket::Base->unserialize_ticket($data);
    $$ticket{expires} += 1;

    my $new_data = Apache::AuthTicket::Base->serialize_ticket($ticket);
    $cookie =~ s/$data/$new_data/;
    $r = GET '/secure/protected/index.html', Cookie => $cookie;
    isa_ok $r, 'HTTP::Response';
    is $r->code, 403, 'tampered cookie got 403 response';
}

sub cookie_has_field {
    my ($cookie, $expected) = @_;

    my @parts = split /;\s+/, $cookie;

    for my $part (@parts) {
        return 1 if lc $part eq lc $expected;
    }

    return 0;
}

# given a cookie string, recompute the hash and check that it is what we expect.
# options:
#   ip => 0|1      ticket includes ipaddress
#   browser => 0|1 ticket includes user agent string
sub check_hash {
    my ($cookie, %opt) = @_;

    my ($string) = $cookie =~ /AuthTicket_[^=]+=(.*?);/;

    my ($hash, $data) = split '--', $string, 2;

    my @fields = ($Secret, $data);

    if ($opt{ip}) {
        push @fields, '127.0.0.1';
    }

    if ($opt{browser}) {
        push @fields, Apache::TestRequest::user_agent()->agent;
    }

    my $check = Apache::AuthTicket::Base->hash_for(@fields);

    unless ($check eq $hash) {
        diag "Hash mismatch: $hash != $check";
        return 0;
    }

    return 1;
}

# vim: ft=perl