Commit | Line | Data |
2022b950 |
1 | #!/usr/bin/perl |
2 | |
3 | package Catalyst::Plugin::Authentication::Credential::HTTP; |
4 | use base qw/Catalyst::Plugin::Authentication::Credential::Password/; |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use String::Escape (); |
10 | use URI::Escape (); |
11 | |
12 | our $VERSION = "0.01"; |
13 | |
14 | sub authenticate_http { |
15 | my $c = shift; |
16 | |
17 | my $headers = $c->req->headers; |
18 | |
19 | if ( my ( $user, $password ) = $headers->authorization_basic ) { |
20 | |
21 | if ( my $store = $c->config->{authentication}{http}{store} ) { |
22 | $user = $store->get_user($user); |
23 | } |
24 | |
25 | return $c->login( $user, $password ); |
26 | } |
27 | } |
28 | |
29 | sub authorization_required { |
30 | my ( $c, %opts ) = @_; |
31 | |
32 | return 1 if $c->authenticate_http; |
33 | |
34 | $c->authorization_required_response( %opts ); |
35 | |
36 | $c->detach( sub { } ); |
37 | } |
38 | |
39 | sub authorization_required_response { |
40 | my ( $c, %opts ) = @_; |
41 | |
42 | $c->res->status(401); |
43 | |
44 | my @opts; |
45 | |
46 | if ( my $realm = $opts{realm} ) { |
47 | push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm); |
48 | } |
49 | |
50 | if ( my $domain = $opts{domain} ) { |
51 | Catalyst::Excpetion->throw("domain must be an array reference") |
52 | unless ref($domain) && ref($domain) eq "ARRAY"; |
53 | |
54 | my @uris = |
55 | $c->config->{authentication}{http}{use_uri_for} |
56 | ? ( map { $c->uri_for($_) } @$domain ) |
57 | : ( map { URI::Escape::uri_escape($_) } @$domain ); |
58 | |
59 | push @opts, qq{domain="@uris"}; |
60 | } |
61 | |
62 | $c->res->headers->www_authenticate(join " ", "Basic", @opts); |
63 | } |
64 | |
65 | __PACKAGE__; |
66 | |
67 | __END__ |
68 | |
69 | =pod |
70 | |
71 | =head1 NAME |
72 | |
73 | Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication |
74 | for Catlayst. |
75 | |
76 | =head1 SYNOPSIS |
77 | |
78 | use Catalyst qw/ |
79 | Authentication |
80 | Authentication::Store::Moose |
81 | Authentication::Credential::HTTP |
82 | /; |
83 | |
84 | sub foo : Local { |
85 | my ( $self, $c ) = @_; |
86 | |
87 | $c->authorization_requried( realm => "foo" ); # named after the status code ;-) |
88 | |
89 | # either user gets authenticated or 401 is sent |
90 | |
91 | do_stuff(); |
92 | } |
93 | |
94 | # with ACL plugin |
95 | __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http }); |
96 | |
97 | sub end : Private { |
98 | my ( $self, $c ) = @_; |
99 | |
100 | $c->authorization_required_response( realm => "foo" ); |
101 | $c->error(0); |
102 | } |
103 | |
104 | =head1 DESCRIPTION |
105 | |
106 | This moduule lets you use HTTP authentication with |
107 | L<Catalyst::Plugin::Authentication>. |
108 | |
109 | Currently this module only supports the Basic scheme, but upon request Digest |
110 | will also be added. Patches welcome! |
111 | |
112 | =head1 METHODS |
113 | |
114 | =over 4 |
115 | |
116 | =item authorization_required |
117 | |
118 | Tries to C<authenticate_http>, and if that files calls |
119 | C<authorization_required_response> and detaches the current action call stack. |
120 | |
121 | =item authenticate_http |
122 | |
123 | Looks inside C<< $c->request->headers >> and processes the basic (badly named) |
124 | authorization header. |
125 | |
126 | =item authorization_required_response |
127 | |
128 | Sets C<< $c->response >> to the correct status code, and adds the correct |
129 | header to demand authentication data from the user agent. |
130 | |
131 | =back |
132 | |
133 | =cut |
134 | |
135 | |