File Coverage

blib/lib/Net/Radius/Server/Match/Simple.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

#! /usr/bin/perl
#
#
# $Id: Simple.pm 75 2009-08-12 22:08:28Z lem $

package Net::Radius::Server::Match::Simple;

use 5.008;
use strict;
use warnings;

our $VERSION = do { sprintf "%0.3f", 1+(q$Revision: 75 $ =~ /\d+/g)[0]/1000 };

use NetAddr::IP 4;
use Net::Radius::Server::Base qw/:match/;
use base qw/Net::Radius::Server::Match/;
__PACKAGE__->mk_accessors(qw/addr attr code peer_addr peer_port port/);

sub _match_addr
{
    my $self = shift;
    my $peer = shift;
    my $mpeer = shift;

    if (ref($mpeer) eq 'Regexp')
    {
	if ($peer =~ m/$mpeer/)
	{
	    $self->log(4, "_match_addr ok: $mpeer matches $peer");
	    return NRS_MATCH_OK;
	}
    }
    elsif (ref($mpeer) eq 'NetAddr::IP')
    {
	my $pip = NetAddr::IP->new($peer);
	if (!$pip)
	{
	    $self->log
		(4,
		 "_match_addr fails: Cannot convert $peer to a NetAddr::IP");
	    return NRS_MATCH_FAIL;
	}

	if ($mpeer->contains($pip))
	{
	    $self->log(4, "_match_addr ok: $mpeer contains $pip");
	    return NRS_MATCH_OK;
	}
    }
    elsif ($peer eq $mpeer)
    {
	$self->log(4, "_match_addr ok: $mpeer eq $peer");
	return NRS_MATCH_OK;
    }

    $self->log(3, "_match_addr fails: Don't know how to handle '$mpeer'");
    return NRS_MATCH_FAIL;
}

sub _match_port
{
    my $self = shift;
    my $port = shift;
    my $mport = shift;

    if (ref($mport) eq 'Regexp')
    {
	if ($port =~ m/$mport/)
	{
	    $self->log(4, "_match_port ok: $mport matches $port");
	    return NRS_MATCH_OK;
	}
    }
    else
    {
	if ($port == $mport)
	{
	    $self->log(4, "_match_port ok: $mport == $port");
	    return NRS_MATCH_OK;
	}
    }

    $self->log(3, "_match_port fails: Don't know how to handle '$mport'");
    return NRS_MATCH_FAIL;
}

sub match_peer_addr
{
    my $self = shift;
    my $peer = $_[0]->{peer_addr};
    my $mpeer = $self->peer_addr;

    $self->log(4, "Invoked match_peer_addr");
    return $self->_match_addr($peer, $mpeer);
}

sub match_addr
{
    my $self = shift;
    my $peer = $_[0]->{addr};
    my $mpeer = $self->addr;

    $self->log(4, "Invoked match_addr");
    return $self->_match_addr($peer, $mpeer);
}

sub match_port
{
    my $self = shift;
    my $port = $_[0]->{port};
    my $mport = $self->port;

    $self->log(4, "Invoked match_port");
    return $self->_match_port($port, $mport);
}

sub match_peer_port
{
    my $self = shift;
    my $port = $_[0]->{peer_port};
    my $mport = $self->peer_port;

    $self->log(4, "Invoked match_peer_port");
    return $self->_match_port($port, $mport);
}

sub match_attr
{
    my $self = shift;
    my $req = $_[0]->{request};

    my %conds = @{$self->attr};

    while (my ($a, $v) = each %conds)
    {
	my $V = $req->attr($a);
	$self->log(4, "match_attr: ($a, $v, " . ($V || 'undef value') . ")");
	if (defined $V)
	{
	    if (ref($v) eq 'Regexp')
	    {
		if ($V =~ m/$v/)
		{
		    $self->log(4, "match_attr: Regexp $v matches $V ($a)");
		    next;
		}
	    }
	    elsif (ref($v) eq 'NetAddr::IP')
	    {
		my $ip = NetAddr::IP->new($V);
		if ($ip and $v->contains($ip))
		{
		    $self->log(4, "match_attr: $v contains $ip ($a)");
		    next;
		}
	    }
	    else
	    {
		if ($V eq $v)
		{
		    $self->log(4, "match_attr: $V eq $v ($a)");
		    next;
		}
	    }
	}
	$self->log(3, "match_attr: No match - Return FAIL");
	return NRS_MATCH_FAIL;
    }
    $self->log(4, "match_attr: Default - Return OK");
    return NRS_MATCH_OK;
}

sub match_code
{
    my $self = shift;
    my $req = $_[0]->{request};

    if (ref($self->code) eq 'Regexp')
    {
	my $re = $self->code;
	if ($req->code =~ m/$re/)
	{
	    $self->log(4, "match_code: match: $re did not match "
		       . $req->code);
	    return NRS_MATCH_OK;
	}
    }
    else
    {
	if ($req->code eq $self->code)
	{
	    $self->log(4, "match_code: match: "
		       . $self->code . " eq "
		       . $req->code);
	    return NRS_MATCH_OK;
	}
    }
    $self->log(3, "match_code: fail by default");
    return NRS_MATCH_FAIL;
}

# Preloaded methods go here.

42;
__END__