File Coverage

blib/lib/Dancer2/Plugin/Auth/ActiveDirectory.pm

Criterion	Covered	Total	%
statement	17	75	22.6
branch	0	18	0.0
condition			n/a
subroutine	6	13	46.1
pod			n/a
total	23	106	21.7

package Dancer2::Plugin::Auth::ActiveDirectory;

=head1 NAME

Dancer2::Plugin::Auth::ActiveDirectory - Authentication module for MS ActiveDirectory

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

use 5.10.0;
use strict;
use warnings FATAL => 'all';
use Dancer2::Plugin;
use Net::LDAP qw[];
use Net::LDAP::Constant qw[LDAP_INVALID_CREDENTIALS];

# -----------------------------------------------
# Preloaded methods go here.
# -----------------------------------------------
# Encapsulated class data.

sub _authenticate {
    my ( $dsl, $s_username, $s_auth_password ) = @_;
    my $hr_stg = plugin_setting();
    my $or_connection = Net::LDAP->new( $hr_stg->{host}, port => 389, timeout => 60 );
    unless ( defined $or_connection ) {
        my $host = $hr_stg->{host};
        $dsl->error(qq/Failed to connect to '$host'. Reason: '$@'/);
        return undef;
    }
    my $s_principal = $hr_stg->{principal};
    my $s_user      = sprintf( '%s@%s', $s_username, $s_principal );
    my $message     = $or_connection->bind( $s_user, password => $s_auth_password );
    return undef if ( $dsl->_v_is_error( $message, $s_user ) );
    my $s_domain = $hr_stg->{domain};
    my $result   = $or_connection->search(    # perform a search
        base   => qq/dc=$s_principal,dc=$s_domain/,
        filter => qq/(&(objectClass=person)(userPrincipalName=$s_user.$s_domain))/,
    );
    foreach ( $result->entries ) {
        my $groups = [];
        foreach my $group ( $_->get_value(q/memberOf/) ) {
            push( @$groups, $1 ) if ( $group =~ m/^CN=(.*),OU=.*$/ );
        }
        return {
            uid       => $s_username,
            firstname => $_->get_value(q/givenName/),
            surname   => $_->get_value(q/sn/),
            groups    => $groups,
            rights    => _rights_by_user( $hr_stg, $groups ),
            user      => $s_user,
        };
    }
    return undef;
}

sub _authenticate_config {
    return plugin_setting();
}

sub _has_right {
    my ( $dsl, $o_session_user, $s_right_name ) = @_;
    my $hr_rights  = plugin_setting()->{rights};
    my $s_ad_group = $hr_rights->{$s_right_name};
    return grep( /$s_ad_group/, @{ $o_session_user->{groups} } );
}

sub _list_users {
    my ( $dsl, $o_session_user, $search_string ) = @_;
    my $hr_stg = plugin_setting();
    my $or_connection = Net::LDAP->new( $hr_stg->{host}, port => 389, timeout => 60 );
    unless ( defined $or_connection ) {
        my $host = $hr_stg->{host};
        $dsl->error(qq/Failed to connect to '$host'. Reason: '$@'/);
        return undef;
    }
    my $s_user = $o_session_user->{user};
    my $message = $or_connection->bind( $s_user, password => $o_session_user->{password} );

    return undef if ( $dsl->_v_is_error( $message, $s_user ) );
    my $s_principal = $hr_stg->{principal};
    my $s_domain    = $hr_stg->{domain};
    my $result      = $or_connection->search(
        base   => qq/dc=$s_principal,dc=$s_domain/,
        filter => qq/(&(objectClass=person)(name=$search_string*))/,
    );
    my $return_names = [];
    push( @$return_names, { name => $_->get_value(q/name/), uid => $_->get_value(q/sAMAccountName/), } ) foreach ( $result->entries );
    return $return_names;
}

sub _v_is_error {
    my ( $dsl, $message, $s_user ) = @_;
    if ( $message->is_error ) {
        my $error = $message->error;
        my $level = $message->code == LDAP_INVALID_CREDENTIALS ? 'debug' : 'error';
        $dsl->error(qq/Failed to authenticate user '$s_user'. Reason: '$error'/);
        return 1;
    }
    return 0;
}

sub _rights {
    return plugin_setting()->{rights};
}

sub _rights_by_user {
    my ( $hr_stg, $a_user_groups ) = @_;
    my $hr_rights = $hr_stg->{rights};
    return unless $hr_rights;
    my $ret_rights = {};
    foreach ( keys %$hr_rights ) {
        my $s_ad_group = $hr_rights->{$_};
        $ret_rights->{$_} = 1 if ( grep( /$s_ad_group/, @{$a_user_groups} ) );
    }
    return $ret_rights;
}

=head1 SYNOPSIS

Configuration:

    plugins:
      Auth::ActiveDirectory:
        host: 0.0.0.0
        principal: yourprincpal
        domain: somedomain
        rights:
          definedright1: ad-group
          definedright2: ad-group
          definedright3: another-ad-group
          definedright4: another-ad-group

Code:

    post '/login' => sub {
        session 'user' => authenticate( params->{user}, params->{pass} );
        return template 'index', { html_error => 'Authentication failed!!' }
            unless ( session('user') );
        return template 'index', { html_error => 'No right for this page!!' }
            if( !has_right( session('user'), 'definedright1') );
        template 'index', { loggedin => 1 };
    };

=head1 SUBROUTINES/METHODS

=head2 authenticate

Basicaly the subroutine for authentication in the ActiveDirectory

=cut

register authenticate => \&_authenticate;

=head2 authenticate_config

Subroutine to get configuration for ActiveDirectory

=cut

register authenticate_config => \&_authenticate_config;

=head2 has_right

Check if loged in user has one of the configured rights

=cut

register has_right => \&_has_right;

=head2 list_users

=cut

register list_users => \&_list_users;

=head2 rights

Subroutine to get configurated rights

=cut

register rights => \&_rights;

=head2 for_versions

=cut

register_plugin for_versions => [2];

1;    # Dancer2::Plugin::Auth::ActiveDirectory

__END__