Commit | Line | Data |
007935b8 |
1 | #!/usr/bin/perl |
007935b8 |
2 | use strict; |
3 | use warnings; |
de3a252c |
4 | use FindBin qw/$Bin/; |
5 | use lib "$Bin/lib"; |
007935b8 |
6 | use Test::More; |
007935b8 |
7 | BEGIN { |
3aff571e |
8 | do { |
9 | eval { require Test::WWW::Mechanize::Catalyst } |
10 | and |
11 | Test::WWW::Mechanize::Catalyst->VERSION('0.51') |
12 | } |
007935b8 |
13 | or plan skip_all => |
14 | "Test::WWW::Mechanize::Catalyst is needed for this test"; |
5b51e987 |
15 | eval { require Catalyst::Plugin::Cache } |
007935b8 |
16 | or plan skip_all => |
5b51e987 |
17 | "Catalyst::Plugin::Cache is needed for this test"; |
513d8ab6 |
18 | eval { require Cache::FileCache } |
5b51e987 |
19 | or plan skip_all => |
20 | "Cache::FileCache is needed for this test"; |
2dad9ca6 |
21 | plan tests => 12; |
007935b8 |
22 | } |
c5a1fa88 |
23 | use Digest::MD5; |
007935b8 |
24 | use HTTP::Request; |
861c2f44 |
25 | use Test::More; |
26 | use Test::WWW::Mechanize::Catalyst qw/AuthDigestTestApp/; |
a14203f8 |
27 | |
c5a1fa88 |
28 | sub do_test { |
29 | my $username = shift; |
2dad9ca6 |
30 | my $uri = shift; |
c5a1fa88 |
31 | my $mech = Test::WWW::Mechanize::Catalyst->new; |
32 | $mech->get("http://localhost/moose"); |
33 | is( $mech->status, 401, "status is 401" ); |
34 | my $www_auth = $mech->res->headers->header('WWW-Authenticate'); |
35 | my %www_auth_params = map { |
36 | my @key_val = split /=/, $_, 2; |
37 | $key_val[0] = lc $key_val[0]; |
38 | $key_val[1] =~ s{"}{}g; # remove the quotes |
39 | @key_val; |
40 | } split /, /, substr( $www_auth, 7 ); #7 == length "Digest " |
41 | $mech->content_lacks( "foo", "no output" ); |
42 | my $response = ''; |
43 | { |
44 | my $password = 'Circle Of Life'; |
45 | my $realm = $www_auth_params{realm}; |
46 | my $nonce = $www_auth_params{nonce}; |
47 | my $cnonce = '0a4f113b'; |
48 | my $opaque = $www_auth_params{opaque}; |
49 | my $nc = '00000001'; |
50 | my $method = 'GET'; |
51 | my $qop = 'auth'; |
2dad9ca6 |
52 | $uri ||= '/moose'; |
c5a1fa88 |
53 | my $ctx = Digest::MD5->new; |
54 | $ctx->add( join( ':', $username, $realm, $password ) ); |
55 | my $A1_digest = $ctx->hexdigest; |
56 | $ctx = Digest::MD5->new; |
57 | $ctx->add( join( ':', $method, $uri ) ); |
58 | my $A2_digest = $ctx->hexdigest; |
59 | my $digest = Digest::MD5::md5_hex( |
60 | join( ':', |
61 | $A1_digest, $nonce, $qop ? ( $nc, $cnonce, $qop ) : (), $A2_digest ) |
62 | ); |
63 | |
64 | $response = qq{Digest username="$username", realm="$realm", nonce="$nonce", uri="$uri", qop=$qop, nc=$nc, cnonce="$cnonce", response="$digest", opaque="$opaque"}; |
65 | } |
2dad9ca6 |
66 | my $r = HTTP::Request->new( GET => "http://localhost" . $uri ); |
c5a1fa88 |
67 | $mech->request($r); |
68 | $r->headers->push_header( Authorization => $response ); |
69 | $mech->request($r); |
70 | is( $mech->status, 200, "status is 200" ); |
71 | $mech->content_contains( $username, "Mufasa output" ); |
007935b8 |
72 | } |
513d8ab6 |
73 | |
c5a1fa88 |
74 | do_test('Mufasa'); |
2dad9ca6 |
75 | do_test('Mufasa2'); |
76 | do_test('Mufasa', '/moose?moose_id=1'); # Digest auth includes the full URL path, so need to test query strings |