lib/Catalyst/Plugin/Authentication/Credential/HTTP/Proxy.pm

   1 package Catalyst::Plugin::Authentication::Credential::HTTP::Proxy;
   2 use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
   3
   4 use strict;
   5 use warnings;
   6
   7 use String::Escape ();
   8 use URI::Escape    ();
   9 use Catalyst       ();
  10 use Catalyst::Plugin::Authentication::Credential::HTTP::User;
  11 use Carp qw/croak/;
  12
  13 our $VERSION = "0.01";
  14
  15
  16 sub authenticate_http_proxy {
  17     my $c = shift;
  18
  19     my $headers = $c->req->headers;
  20
  21     croak "url setting required for authentication"
  22         unless $c->config->{authentication}{http_proxy}{url};
  23     if ( my ( $user, $password ) = $headers->authorization_basic ) {
  24
  25         my $ua=Catalyst::Plugin::Authentication::Credential::HTTP::User->new;
  26         $ua->credentials($user,$password);
  27         my $resp= $ua->get($c->config->{authentication}{http_proxy}{url});
  28         if ( $resp->is_success ) {
  29             if ( my $store = $c->config->{authentication}{http_proxy}{store} ) {
  30                 $user = $store->get_user($user);
  31             } elsif ( my $user_obj = $c->get_user($user) ) {
  32                 $user = $user_obj;
  33             }
  34             unless ($user) {
  35                 $c->log->debug("User '$user' doesn't exist in the default store")
  36                     if $c->debug;
  37                 return;
  38             }
  39             $c->set_authenticated($user);
  40             return 1;
  41         } elsif ( $c->debug ) {
  42             $c->log->info('Remote authentication failed:'.$resp->message);
  43             return 0;
  44         }
  45     } elsif ( $c->debug ) {
  46         $c->log->info('No credentials provided for basic auth');
  47         return 0;
  48     }
  49 }
  50
  51 sub authorization_required {
  52     my ( $c, %opts ) = @_;
  53
  54     return 1 if $c->authenticate_http_proxy;
  55
  56     $c->authorization_required_response( %opts );
  57
  58     die $Catalyst::DETACH;
  59 }
  60
  61 sub authorization_required_response {
  62     my ( $c, %opts ) = @_;
  63
  64     $c->res->status(401);
  65
  66     my @opts;
  67
  68     if ( my $realm = $opts{realm} ) {
  69         push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm);
  70     }
  71
  72     if ( my $domain = $opts{domain} ) {
  73         Catalyst::Excpetion->throw("domain must be an array reference")
  74           unless ref($domain) && ref($domain) eq "ARRAY";
  75
  76         my @uris =
  77           $c->config->{authentication}{http}{use_uri_for}
  78           ? ( map { $c->uri_for($_) } @$domain )
  79           : ( map { URI::Escape::uri_escape($_) } @$domain );
  80
  81         push @opts, qq{domain="@uris"};
  82     }
  83
  84     $c->res->headers->www_authenticate(join " ", "Basic", @opts);
  85 }
  86
  87 __PACKAGE__;
  88
  89 __END__
  90
  91 =pod
  92
  93 =head1 NAME
  94
  95 Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication
  96 for Catlayst.
  97
  98 =head1 SYNOPSIS
  99
 100     use Catalyst qw/
 101         Authentication
 102         Authentication::Store::Moose
 103         Authentication::Store::Elk
 104         Authentication::Credential::HTTP::Proxy
 105     /;
 106
 107     $c->config->{authentication}{http_proxy}= {
 108         url  =>'http://elkland.no/auth',
 109         store => 'Authentication::Store::Moose'
 110     };
 111
 112     sub foo : Local {
 113         my ( $self, $c ) = @_;
 114
 115         $c->authorization_required( realm => "foo" ); # named after the status code ;-)
 116
 117         # either user gets authenticated or 401 is sent
 118
 119         do_stuff();
 120     }
 121
 122     # with ACL plugin
 123     __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
 124
 125     sub end : Private {
 126         my ( $self, $c ) = @_;
 127
 128         $c->authorization_required_response( realm => "foo" );
 129         $c->error(0);
 130     }
 131
 132 =head1 DESCRIPTION
 133
 134 This moduule lets you use HTTP Proxy authentication with
 135 L<Catalyst::Plugin::Authentication>.
 136
 137 Currently this module only supports the Basic scheme, but upon request Digest
 138 will also be added. Patches welcome!
 139
 140
 141 =head1 CONFIG
 142
 143 This module reads config from $c->config->{authentication}{http_proxy}. The following settings
 144 are supported:
 145
 146 =over 4
 147
 148 =item url
 149
 150 Required. A url protected with basic authentication to authenticate against.
 151
 152 =item store
 153
 154 To specify what store to use. will use the default store if not set.
 155
 156 =cut
 157
 158 =head1 METHODS
 159
 160 =over 4
 161
 162 =item authorization_required
 163
 164 Tries to C<authenticate_http_proxy>, and if that fails calls
 165 C<authorization_required_response> and detaches the current action call stack.
 166
 167 =item authenticate_http_proxy
 168
 169 Looks inside C<< $c->request->headers >> and processes the basic (badly named)
 170 authorization header. Then authenticates this against the provided url.
 171
 172 =item authorization_required_response
 173
 174 Sets C<< $c->response >> to the correct status code, and adds the correct
 175 header to demand authentication data from the user agent.
 176
 177 =back
 178
 179 =head1 AUTHORS
 180
 181 Marcus Ramberg <mramberg@cpan.org
 182
 183 =head1 COPYRIGHT & LICENSE
 184
 185         Copyright (c) 2005 the aforementioned authors. All rights
 186         reserved. This program is free software; you can redistribute
 187         it and/or modify it under the same terms as Perl itself.
 188
 189 =cut
 190