view release on metacpan or  search on metacpan

lib/Catalyst/Plugin/Authentication/Credential/HTTP/Proxy.pm  view on Meta::CPAN

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 );

lib/Catalyst/Plugin/Authentication/Credential/HTTP/User.pm  view on Meta::CPAN

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.