File Coverage

blib/lib/Net/Radius/SSG.pm

Criterion	Covered	Total	%
statement	51	141	36.1
branch	0	26	0.0
condition			n/a
subroutine	17	26	65.3
pod	2	9	22.2
total	70	202	34.6

package Net::Radius::SSG;

# $Revision: 34 $

#use 5.008001;
use strict;
use warnings;
use Net::Radius::Dictionary;
use Net::Radius::Packet;
use Net::Inet;
use Net::UDP;
use Fcntl;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;
use AutoLoader qw(AUTOLOAD);

@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::Radius::SSG ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(

) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(
	SSG_ACCOUNT_PING SSG_ACCOUNT_LOGON
	SSG_ACCOUNT_LOGOFF SSG_SERVICE_LOGON
	SSG_SERVICE_LOGOFF
);

$VERSION = '0.04';


# Preloaded methods go here.

use constant VSA_CISCO => 9;
use constant SECRET => 'cisco';
use constant SSG_ACCOUNT_PING 	=> "\004 &";
use constant SSG_ACCOUNT_LOGON 	=> "\001";
use constant SSG_ACCOUNT_LOGOFF => "\002";
use constant SSG_SERVICE_LOGON 	=> "\013";
use constant SSG_SERVICE_LOGOFF => "\014";
use constant DEFAULT_TIMEOUT	=> 10;

sub new {
	my $class	= shift;
	my $ssg_ip	= shift;
	my $ssg_port	= shift;
	my $secret	= shift;
	my $dictionary	= shift;

	my $self		= { };
	if (!defined $ssg_ip) {
		die "Please specify an IP for the SSG.";
	}
	$self->{'SSG_IP'}	= $ssg_ip;
	if (!defined $ssg_port) {
		die "Please specify a port for the SSG.";
	}
	$self->{'SSG_PORT'} = $ssg_port;
	if (!defined $secret) {
		die "Please specify a shared secret for the SSG.";
	}
	$self->{'SECRET'} = $secret;
	if (!defined $dictionary) {
		die "Please specify a dictionary file";
	}
	if ( ! -r $dictionary) {
		die "Unable to read dictionary file: $dictionary";
	}

	$self->{'DICTIONARY'} = new Net::Radius::Dictionary($dictionary);

	$self->{'SOCKET'} = &create_udp_handle($ssg_ip,$ssg_port);

	bless $self,$class;
	return $self;
}

sub create_udp_handle {
	my $server	= shift;
	my $port	= shift;
	my $udp		= new Net::UDP $server, $port;
	$udp->bind;
	$udp->fcntl(F_SETFL, $udp->fcntl(F_GETFL,0) | O_NONBLOCK) or die "Failed to create a Non-blocking socket: $!";
	return $udp;
}

sub action {
	my $self	= shift;
	my $action	= shift;
	my $values	= shift;
	my $data;

	my $packet = new Net::Radius::Packet($self->{DICTIONARY});
	$packet->set_authenticator('1234w6t890123a5c');

	if ($action eq SSG_ACCOUNT_PING) {
		&account_ping($packet,$values->{user_ip});
	} elsif ($action eq SSG_ACCOUNT_LOGON) {
		&account_logon($packet,$values->{user_ip},$values->{user_id},$values->{password}, $self->{SECRET});
	} elsif ($action eq SSG_ACCOUNT_LOGOFF) {
		&account_logoff($packet,$values->{user_ip},$values->{user_id});
	} elsif ($action eq SSG_SERVICE_LOGON) {
		&service($packet,$values->{user_ip},$values->{service}, SSG_SERVICE_LOGON);
	} elsif ($action eq SSG_SERVICE_LOGOFF) {
		&service($packet,$values->{user_ip},$values->{service}, SSG_SERVICE_LOGOFF);
	} else {
		die ("Unknown action");
	}
	&send_packet($self->{SOCKET},$packet);
	my $reply = &receive_reply($self->{SOCKET}, $values->{timeout});
	my $rp = new Net::Radius::Packet $self->{DICTIONARY}, $reply;
	return $rp;
}

sub receive_reply {
	my $udp		= shift;
	my $timeout 	= shift;
	$timeout = DEFAULT_TIMEOUT if (!defined $timeout);
	my ($rec, $whence);
	my $nfound = $udp->select(1, 0, 1, $timeout);
	if ($nfound > 0) {
		$rec = $udp->recv(undef, undef, $whence);
		return $rec;
	}
}

sub send_packet {
	my $udp		= shift;
	my $packet	= shift;
	$udp->send($packet->pack());
}


sub account_ping {
	my $packet	= shift;
	my $user_ip	= shift;
	$packet->set_code('Access-Request');
	$packet->set_identifier(57);
	$packet->set_vsattr(VSA_CISCO,'Account-Info','S'.$user_ip);
	$packet->set_vsattr(VSA_CISCO,'Command-Code', SSG_ACCOUNT_PING);
}

sub account_logon {
	my $packet	= shift;
	my $user_ip	= shift;
	my $user_id	= shift;
	my $password	= shift;
	my $secret	= shift;
	$packet->set_code('Access-Request');
	$packet->set_identifier(57);
	$packet->set_attr('User-Name',$user_id);
	$packet->set_password($password,$secret);
	$packet->set_vsattr(VSA_CISCO,'Account-Info','S'.$user_ip);
	$packet->set_vsattr(VSA_CISCO,'Command-Code', SSG_ACCOUNT_LOGON."$user_id");
}

sub account_logoff {
	my $packet	= shift;
	my $user_ip	= shift;
	my $user_id	= shift;
	$packet->set_code('Access-Request');
	$packet->set_identifier(57);
	$packet->set_attr('User-Name',$user_id);
	$packet->set_vsattr(VSA_CISCO,'Account-Info','S'.$user_ip);
	$packet->set_vsattr(VSA_CISCO,'Command-Code', SSG_ACCOUNT_LOGOFF."$user_id");
}

sub service {
	my $packet	= shift;
	my $user_ip	= shift;
	my $service	= shift;
	my $action	= shift;
	$packet->set_code('Access-Request');
	$packet->set_identifier(23);
	$packet->set_vsattr(VSA_CISCO,'Account-Info','S'.$user_ip);
	$packet->set_vsattr(VSA_CISCO,'Command-Code', $action."$service");
}




# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__