view release on metacpan or  search on metacpan

lib/Catalyst/Authentication/Credential/Remote.pm  view on Meta::CPAN

package Catalyst::Authentication::Credential::Remote;
use Moose;
use namespace::autoclean;

with 'MooseX::Emulate::Class::Accessor::Fast';

use Try::Tiny qw/ try catch /;

__PACKAGE__->mk_accessors(
    qw/allow_re deny_re cutname_re source realm username_field/);

sub new {
    my ( $class, $config, $app, $realm ) = @_;

    my $self = { };
    bless $self, $class;

    # we are gonna compile regular expresions defined in config parameters
    # and explicitly throw an exception saying what parameter was invalid
    if (defined($config->{allow_regexp}) && ($config->{allow_regexp} ne "")) {
        try { $self->allow_re( qr/$config->{allow_regexp}/ ) }
        catch {
            Catalyst::Exception->throw( "Invalid regular expression in ".
                "'allow_regexp' configuration parameter");
        };
    }
    if (defined($config->{deny_regexp}) && ($config->{deny_regexp} ne "")) {
        try { $self->deny_re( qr/$config->{deny_regexp}/ ) }
        catch {
            Catalyst::Exception->throw( "Invalid regular expression in ".
                 "'deny_regexp' configuration parameter");
        };
    }
    if (defined($config->{cutname_regexp}) && ($config->{cutname_regexp} ne "")) {
        try { $self->cutname_re( qr/$config->{cutname_regexp}/ ) }
        catch {
            Catalyst::Exception->throw( "Invalid regular expression in ".
                "'cutname_regexp' configuration parameter");
        };
    }
    $self->source($config->{source} || 'REMOTE_USER');
    $self->realm($realm);
    $self->username_field($config->{username_field} || 'username');
    return $self;
}

sub authenticate {
    my ( $self, $c, $realm, $authinfo ) = @_;

    my $remuser;
    if ($self->source eq "REMOTE_USER") {    
        if ($c->req->can('remote_user')) {
            # $c->req->remote_users was introduced in 5.80005; if not evailable we are
            # gonna use $c->req->user that is deprecated but more or less works as well 
            $remuser = $c->req->remote_user;
        }
        # compatibility hack:
        elsif ($c->engine->can('env') && defined($c->engine->env)) {
            # BEWARE: $c->engine->env was broken prior 5.80005
            $remuser = $c->engine->env->{REMOTE_USER};
        }
        elsif ($c->req->can('user')) {
            # maybe show warning that we are gonna use DEPRECATED $req->user            
            if (ref($c->req->user)) {
                # I do not know exactly when this happens but it happens
            Catalyst::Exception->throw( "Cannot get remote user from ".
        "\$c->req->user as it seems to be a reference not a string" );