source: LATMOS-Accounts-Web/lib/Catalyst/Authentication/Credential/La.pm @ 895

package Catalyst::Authentication::Credential::La;

use strict;
use warnings;
use MIME::Base64;

sub new {
    my ($class) = @_;
    return bless({}, $class);
}

sub _search_user {
    my ($self, $c) = @_;
    
    my $attribute = $c->config->{ssl}->{ATTRIBUTE_ID} || 'mail';
    my $sslid     = $c->config->{ssl}->{SSL_ID}       || 'HTTP_SSL_CLIENT_S_DN_EMAIL';
    my $value     = $ENV{$sslid} or do {
        $c->log->debug("Cannot find user: ENV{$sslid} is empty");
        return;
    };

    my $base = $c->model('Accounts')->db;
    # quick prefilter
    my @res = $base->search_objects(
        'user',
        sprintf('%s~%s', $attribute, $value)
    );

    @res = grep {
        my $o = $base->get_object('user', $_);
        $o && grep { lc($_) eq lc($value) } $o->get_attributes($attribute);    
    } @res;

    if (@res == 1) {
        return $res[0];
    } else {
        $c->log->error(sprintf
            "Can't identify `%s' user from `%s' attributes, multiple user found: %s",
            $value,
            $attribute,
            join(', ', @res),
        );
        return;
    }
}

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

    foreach my $f (@{ $c->config->{ssl}->{filters} }) {
        my $matchtype = $f->{op} || '=';
        my $var = $ENV{$f->{var}};
        if ($matchtype eq '=') {
            do {
                $c->log->debug(sprintf
                    'Filter failed: %s = %s',
                    $var, $f->{value}
                );
                return;
            } unless($var eq $f->{value});
        }
        elsif ($matchtype eq 're') {
            my $value = $f->{value};
            do {
                $c->log->debug(sprintf
                    'Filter failed: %s match %s',
                    $var, $f->{value}
                );
                return;
            } unless($var =~ m/$value/);
        }
        else {
            $c->log->error(sprintf 'Wrong filter op: %s', $matchtype);
            return;
        }
    }

    return 1;
}

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

    if ($c->config->{ssl}->{filters}) {
        if (!$self->_ssl_filter($c, $realm, $authinfo)) {
            return;
        }
    }

    if (my $u = $self->_search_user($c)) {
        $c->log->info(sprintf 'SSL auth for %s', $u);
        $authinfo->{username} = $u;
        return 1;
    } else {
        return;
    }
}

sub _login_auth {
    my ($self, $c, $realm, $authinfo) = @_;
    my $authheader = $c->req->headers->header('Authorization')
        or do {
        $c->log->debug('No Authorization header found');   
        return;
    };
    # TODO check auth type
    my ($type, $base64) = $authheader =~ /(\w+) (\S+)/;
    ($authinfo->{username}, $authinfo->{password})
        = decode_base64($base64) =~ /^([^:]+):(.*)/;
    
    if($c->model('Accounts')->db->connect(
        $authinfo->{username},
        $authinfo->{password}
    )) {
        $c->log->info(sprintf 'basic auth for %s', $authinfo->{username});
        return $realm->find_user($authinfo)
    } else {
        return;
        $c->log->error(sprintf
            'Invalid password or user for user %s',
            $authinfo->{username} ||
            '(none)'
        );
    }
}

sub authenticate {
    my ($self, $c, $realm, $authinfo) = @_;
    if (! (
        $self->_ssl_auth  ($c, $realm, $authinfo) ||
        $self->_login_auth($c, $realm, $authinfo)
        )) { return; }

    $c->model('Accounts')->db->{_user} = $authinfo->{username};
    return $realm->find_user($authinfo);
}

1;