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

   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