my $build = Module::Build->new(
create_makefile_pl => 'traditional',
license => 'perl',
- module_name => 'Catalyst::Plugin::Authentication::Credential::TypeKey',
+ module_name => 'Catalyst::Plugin::Authentication::Credential::HTTP::Proxy',
requires => {
'Catalyst' => '5.5',
'Catalyst::Plugin::Authentication' => 0,
- 'Authen::TypeKey' => 0,
'Test::MockObject' => '1.01',
+ 'LWP::Simple' => 0,
},
create_readme => 1,
sign => 1,
--- /dev/null
+package Catalyst::Plugin::Authentication::Credential::HTTP::Proxy;
+use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
+
+use strict;
+use warnings;
+
+use String::Escape ();
+use URI::Escape ();
+use Catalyst ();
+use Catalyst::Plugin::Authentication::Credential::HTTP::User;
+use Carp qw/croak/;
+
+our $VERSION = "0.01";
+
+
+sub authenticate_http_proxy {
+ my $c = shift;
+
+ my $headers = $c->req->headers;
+
+ croak "url setting required for authentication"
+ unless $c->config->{authentication}{http_proxy}{url};
+ if ( my ( $user, $password ) = $headers->authorization_basic ) {
+
+ my $ua=Catalyst::Plugin::Authentication::Credential::HTTP::User->new;
+ $ua->credentials($user,$password);
+ my $resp= $ua->get($c->config->{authentication}{http_proxy}{url});
+ if ( $resp->is_success ) {
+ if ( my $store = $c->config->{authentication}{http_proxy}{store} ) {
+ $user = $store->get_user($user);
+ } elsif ( my $user_obj = $c->get_user($user) ) {
+ $user = $user_obj;
+ }
+ unless ($user) {
+ $c->log->debug("User '$user' doesn't exist in the default store")
+ if $c->debug;
+ return;
+ }
+ $c->set_authenticated($user);
+ return 1;
+ } elsif ( $c->debug ) {
+ $c->log->info('Remote authentication failed:'.$resp->message);
+ return 0;
+ }
+ } elsif ( $c->debug ) {
+ $c->log->info('No credentials provided for basic auth');
+ return 0;
+ }
+}
+
+sub authorization_required {
+ my ( $c, %opts ) = @_;
+
+ return 1 if $c->authenticate_http_proxy;
+
+ $c->authorization_required_response( %opts );
+
+ die $Catalyst::DETACH;
+}
+
+sub authorization_required_response {
+ my ( $c, %opts ) = @_;
+
+ $c->res->status(401);
+
+ my @opts;
+
+ if ( my $realm = $opts{realm} ) {
+ push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm);
+ }
+
+ if ( my $domain = $opts{domain} ) {
+ Catalyst::Excpetion->throw("domain must be an array reference")
+ unless ref($domain) && ref($domain) eq "ARRAY";
+
+ my @uris =
+ $c->config->{authentication}{http}{use_uri_for}
+ ? ( map { $c->uri_for($_) } @$domain )
+ : ( map { URI::Escape::uri_escape($_) } @$domain );
+
+ push @opts, qq{domain="@uris"};
+ }
+
+ $c->res->headers->www_authenticate(join " ", "Basic", @opts);
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic authentication
+for Catlayst.
+
+=head1 SYNOPSIS
+
+ use Catalyst qw/
+ Authentication
+ Authentication::Store::Moose
+ Authentication::Store::Elk
+ Authentication::Credential::HTTP::Proxy
+ /;
+
+ $c->config->{authentication}{http_proxy}= {
+ url =>'http://elkland.no/auth',
+ store => 'Authentication::Store::Moose'
+ };
+
+ sub foo : Local {
+ my ( $self, $c ) = @_;
+
+ $c->authorization_required( realm => "foo" ); # named after the status code ;-)
+
+ # either user gets authenticated or 401 is sent
+
+ do_stuff();
+ }
+
+ # with ACL plugin
+ __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
+
+ sub end : Private {
+ my ( $self, $c ) = @_;
+
+ $c->authorization_required_response( realm => "foo" );
+ $c->error(0);
+ }
+
+=head1 DESCRIPTION
+
+This moduule lets you use HTTP Proxy authentication with
+L<Catalyst::Plugin::Authentication>.
+
+Currently this module only supports the Basic scheme, but upon request Digest
+will also be added. Patches welcome!
+
+
+=head1 CONFIG
+
+This module reads config from $c->config->{authentication}{http_proxy}. The following settings
+are supported:
+
+=over 4
+
+=item url
+
+Required. A url protected with basic authentication to authenticate against.
+
+=item store
+
+To specify what store to use. will use the default store if not set.
+
+=cut
+
+=head1 METHODS
+
+=over 4
+
+=item authorization_required
+
+Tries to C<authenticate_http_proxy>, and if that fails calls
+C<authorization_required_response> and detaches the current action call stack.
+
+=item authenticate_http_proxy
+
+Looks inside C<< $c->request->headers >> and processes the basic (badly named)
+authorization header. Then authenticates this against the provided url.
+
+=item authorization_required_response
+
+Sets C<< $c->response >> to the correct status code, and adds the correct
+header to demand authentication data from the user agent.
+
+=back
+
+=head1 AUTHORS
+
+Marcus Ramberg <mramberg@cpan.org
+
+=head1 COPYRIGHT & LICENSE
+
+ Copyright (c) 2005 the aforementioned authors. All rights
+ reserved. This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
+
+=cut
+
--- /dev/null
+package Catalyst::Plugin::Authentication::Credential::HTTP::User;
+
+use base 'LWP::UserAgent';
+
+sub credentials {
+ my ($self,$user,$pass)=@_;
+ @{$self->{credentials}}=($user,$pass);
+}
+sub get_basic_credentials {
+ my $self = shift;
+ return @{$self->{credentials}};
+}
+
+1;
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Credential::HTTP::User - Wrapper for LWP::UserAgent
+
+=head1 DESCRIPTION
+
+A thin wrapper for L<LWP::UserAgent> to make basic auth simpler.
+
+=head1 METHODS
+
+=head2 credentials
+
+now takes just a username and password
+
+=head2 get_basic_credentials
+
+Returns the set credentials, takes no options.
+
+=head1 AUTHOR
+
+Marcus Ramberg <mramberg@cpan.org
+
+=head1 LICENSE
+
+This software is licensed under the same terms as perl itself.
+++ /dev/null
-package Catalyst::Plugin::Authentication::Credential::TypeKey;
-
-use strict;
-use warnings;
-
-use Authen::TypeKey;
-use File::Spec;
-use Catalyst::Utils ();
-use NEXT;
-use UNIVERSAL::require;
-use Scalar::Util ();
-
-our $VERSION = '0.3';
-
-sub setup {
- my $c = shift;
-
- my $config = $c->config->{authentication}{typekey} ||= {};
-
- $config->{typekey_object} ||= do {
- ( $config->{user_class} ||=
- "Catalyst::Plugin::Authentication::User::Hash" )->require;
-
- $config->{key_cache} ||=
- File::Spec->catfile( Catalyst::Utils::class2tempdir( $c, 1 ),
- 'regkeys.txt' );
-
- my $typekey = Authen::TypeKey->new;
-
- for ( grep { exists $config->{$_} }
- qw/expires key_cache key_url token version skip_expiry_check/ )
- {
- $typekey->$_( $config->{$_} );
- }
-
- $typekey;
- };
-
- $c->NEXT::setup(@_);
-}
-
-sub authenticate_typekey {
- my ( $c, @p ) = @_;
-
- my ( $user, $p );
- if ( @p == 1 ) {
- if ( Scalar::Util::blessed( $p[0] ) ) {
- $user = $p[0];
- Catalyst::Exception->throw(
- "Attempted to authenticate user object, but "
- . "user doesnt't support 'typekey_credentials'" )
- unless $user->supports(qw/typekey_credentials/);
- $p = $user->typekey_credentials;
- }
- else {
- $p = $p[0];
- }
- }
- else {
- $p = @p ? {@p} : undef;
- }
-
- my $config = $c->config->{authentication}{typekey};
-
- my $typekey = $p && delete( $p->{typekey_object} )
- || $config->{typekey_object};
-
- $p ||= $c->req;
-
- if ( my $res = $typekey->verify($p) ) {
- $c->log->debug("Successfully authenticated user '$res->{name}'.")
- if $c->debug;
-
- if ( !$user and my $store = $config->{auth_store} ) {
- $store = $c->get_auth_store($store) unless ref $store;
- $user = $store->get_user( $res->{name}, $p, $res );
- }
-
- if ( !$user ) {
- my $user_class = $config->{user_class};
- $user = $user_class->new($res);
- }
-
- $c->set_authenticated($user);
-
- return 1;
- }
- else {
- $c->log->debug(
- sprintf "Failed to authenticate user '%s'. Reason: '%s'",
- $p->{name} || $p->param("name"),
- $typekey->errstr
- )
- if $c->debug;
-
- return;
- }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Catalyst::Plugin::Authentication::Credential::TypeKey - TypeKey Authentication
-for Catalyst.
-
-=head1 SYNOPSIS
-
- use Catalyst qw/Authentication::Credential::TypeKey/;
-
- MyApp->config->{authentication}{typekey} = {
- token => 'xxxxxxxxxxxxxxxxxxxx',
- };
-
- sub foo : Local {
- my ( $self, $c ) = @_;
-
- if ( $c->authenticate_typekey ) {
-
- # you can also specify the params manually: $c->authenticate_typekey(
- # name => $name,
- # email => $email,
- # ...
- #)
-
- # successful autentication
-
- $c->user; # this is set
- }
- }
-
-
- sub auto : Private {
- my ( $self, $c ) = @_;
-
- $c->authenticate_typekey; # uses $c->req
-
- return 1;
- }
-
-=head1 DESCRIPTION
-
-This module integrates L<Authen::TypeKey> with
-L<Catalyst::Plugin::Authentication>.
-
-=head1 METHODS
-
-=head3 authenticate_typekey %parameters
-
-=head3 authenticate_typekey
-
-=head3 EXTENDED METHODS
-
-=head3 setup
-
-Fills the config with defaults.
-
-=head1 CONFIGURATION
-
-C<<$c->config->{autentication}{typekey}>> is a hash with these fields (all can
-be left out):
-
-=over 4
-
-=item typekey_object
-
-If this field does not exist an L<Authen::TypeKey> object will be created based
-on the other param and put here.
-
-=item expires
-
-=item key_url
-
-=item token
-
-=item version
-
-See L<Authen::TypeKey> for all of these. If they aren't specified
-L<Authen::TypeKey>'s defaults will be used.
-
-=item key_cache
-
-Also see L<Authen::TypeKey>.
-
-Defaults to C<regkeys.txt> under L<Catalyst::Utils/class2tempdir>.
-
-=item auth_store
-
-A store (or store name) to retrieve the user from.
-
-When a user is successfully authenticated it will call this:
-
- $store->get_user( $name, $parameters, $result_of_verify );
-
-Where C<$parameters> is a the hash reference passed to
-L<Authen::TypeKey/verify>, and C<$result_of_verify> is the value returned by
-L<Authen::TypeKey/verify>.
-
-If this is unset, L<Catalyst::Plugin::Authentication/default_auth_store> will
-be used instead.
-
-=item user_class
-
-If C<auth_store> or the default store returns nothing from get_user, this class
-will be used to instantiate an object by calling C<new> on the class with the
-return value from L<Authen::TypeKey/verify>.
-
-=back
-
-=head1 SEE ALSO
-
-L<Authen::TypeKey>, L<Catalyst>, L<Catalyst::Plugin::Authentication>.
-
-=head1 AUTHOR
-
-Christian Hansen
-
-Yuval Kogman, C<nothingmuch@woobling.org>
-
-=head1 LICENSE
-
-This library is free software . You can redistribute it and/or modify it under
-the same terms as perl itself.
-
-=cut
projects / catagits/Catalyst-Authentication-Credential-HTTP-Proxy.git / commitdiff