rlm_perl script

#!/usr/bin/perl -w

use strict;
use warnings;

use Net::LDAP;

# use ...
use Data::Dumper;

# Bring the global hashes into the package scope
our (%RAD_REQUEST, %RAD_REPLY, %RAD_CHECK);

#
# This the remapping of return values
#
use constant {
        RLM_MODULE_REJECT   => 0, # immediately reject the request
        RLM_MODULE_FAIL     => 1, # there was a script failure
        RLM_MODULE_OK       => 2, # the module is OK, continue
        RLM_MODULE_HANDLED  => 3, # the module handled the request, so stop
        RLM_MODULE_INVALID  => 4, # the module considers the request invalid
        RLM_MODULE_USERLOCK => 5, # reject the request (user is locked out)
        RLM_MODULE_NOTFOUND => 6, # user not found
        RLM_MODULE_NOOP     => 7, # module succeeded without doing anything
        RLM_MODULE_UPDATED  => 8, # OK (pairs modified)
        RLM_MODULE_NUMCODES => 9  # How many return codes there are
};

# Same as src/include/radiusd.h
use constant    L_DBG=>   1;
use constant    L_AUTH=>  2;
use constant    L_INFO=>  3;
use constant    L_ERR=>   4;
use constant    L_PROXY=> 5;
use constant    L_ACCT=>  6;

# Function to handle authenticate
sub authenticate { return RLM_MODULE_NOOP; }
# Function to handle detach
sub detach { return RLM_MODULE_NOOP; }
# Function to handle preacct
sub preacct { return RLM_MODULE_NOOP; }
# Function to handle accounting
sub accounting { return RLM_MODULE_NOOP; }
# Function to handle checksimul
sub checksimul { return RLM_MODULE_NOOP; }
# Function to handle pre_proxy
sub pre_proxy { return RLM_MODULE_NOOP; }
# Function to handle post_proxy
sub post_proxy { return RLM_MODULE_NOOP; }
# Function to handle post_auth
sub post_auth { return RLM_MODULE_NOOP; }
# Function to handle xlat
sub xlat { return RLM_MODULE_NOOP }

sub log_request_attributes {
        # This shouldn't be done in production environments!
        # This is only meant for debugging!
        for (keys %RAD_REQUEST) {
                &radiusd::radlog(L_DBG, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
        }
}

sub authorize {
        &log_request_attributes( );
        my $username = $RAD_REQUEST{'User-Name'};

        if ( $username eq 'nagios' ) {
                return RLM_MODULE_OK;
        }

        my $realm = undef;
        my $authtype = 'System';
        my $mesg = undef;

        my $ldap = Net::LDAP->new( 'ldapi://' ) or return RLM_MODULE_FAIL;

        $mesg = $ldap->bind( );
        $mesg->code && $ldap->disconnect( ) && return RLM_MODULE_FAIL;

        my $base = 'ou=netgroups,dc=example,dc=com';
        my $attrs = ['dn'];

        # Check for YubiKey
        my $filter = "(&(objectClass=nisNetgroup)(cn=yubikey)(nisNetgroupTriple=\\(,$username,\\)))";
        my $result = $ldap->search( base=> "$base", scope => "sub", filter => "$filter", attrs => "$attrs" );
        $result->code && $ldap->unbind( ) && $ldap->disconnect( ) && return RLM_MODULE_FAIL;

        if ( $result->count( ) >= 1 )
        {
                $realm = 'yubiauth.example.com';
                my $realm_user = "$username\@$realm";
                &radiusd::radlog( 1, "Changing User-Name: $realm_user" );
                $RAD_REQUEST{'User-Name'} = $realm_user;
                $RAD_REQUEST{'Stripped-User-Name'} = $username;
                $RAD_REQUEST{'Auth-Type'} = $authtype;
                $ldap->unbind( ) && $ldap->disconnect( );
                return RLM_MODULE_UPDATED;
        }

        # We can't proxy this user
        return RLM_MODULE_NOOP;
}