#! /usr/bin/perl
#
#
# $Id: Proxy.pm 75 2009-08-12 22:08:28Z lem $
package Net::Radius::Server::Set::Proxy;
use 5.008;
use strict;
use warnings;
our $VERSION = do { sprintf "%0.3f", 1+(q$Revision: 75 $ =~ /\d+/g)[0]/1000 };
use IO::Select;
use IO::Socket::INET;
use Net::Radius::Packet 1.51;
use Net::Radius::Dictionary;
use Net::Radius::Server::Base qw/:set/;
use base qw/Net::Radius::Server::Set/;
__PACKAGE__->mk_accessors(qw/
server port secret dictionary result
timeout tries
/);
sub _proxy
{
my $self = shift;
my $r_data = shift;
my $secret = shift;
my $dict = shift;
my $req = $r_data->{request};
my $pass = $req->password($r_data->{secret});
# Construct a packet for our server, passing all the attributes
# from the original packet - Note that the dict may be different
# XXX - It may be more efficient to take the chance and use
# ->{request} instead of re-decoding the packet
my $p = new Net::Radius::Packet $dict, $r_data->{packet};
# Send password protected with our shared secret
$p->set_password($pass, $secret) if $p->attr('User-Password');
my $packet = undef;
my $tries = 0;
my $reply = undef;
# Format packet properly according to type
if ($req->code =~ m/Accounting-Request/)
{
$p->set_authenticator("\x0" x 16);
$packet = auth_resp($p->pack, $secret);
}
else
{
$packet = $p->pack();
}
# Attempt to send the request to the real RADIUS server
while ($tries < $self->tries)
{
if ($self->{_socket}->send($packet))
{
if ($self->{_select}->can_read($self->timeout))
{
last if $self->{_socket}->recv($reply, 1024);
$self->log(2, "[$tries] Failed to recv(): $!");
}
else
{
$self->log(2, "[$tries] Timeout waiting for server response");
}
}
else
{
$self->log(1, "[$tries] Send failed: $!");
}
$tries ++;
}
# No reply - Simply drop this packet and wait
unless (defined $reply and length($reply) > 0)
{
$self->log(2, "Server reply is undef or empty");
return;
}
# Compose reply to the client depending on the packet type
$r_data->{response} = new Net::Radius::Packet $dict, $reply;
unless ($r_data->{response})
{
$self->log(2, "Failed to parse response packet from server");
return;
}
# Adjust authenticators according to the response type
my $res = $r_data->{response};
if ($res->code =~ m/
Access-Accept
|Access-Reject
|Access-Challenge
|Accounting-Response/x)
{
$res->set_authenticator($req->authenticator);
}
elsif ($res->code =~ m/Accounting-Request/)
{
$res->set_authenticator("\x0" x 16);
}
# Copy response packet back to our client
$self->log(4, "Copying packet to my response");
return 1;
}
sub _set
{
my $self = shift;
my $r = $self->set_server(@_);
unless ($r)
{
$self->log(3, "Failure: Return CONTINUE by default");
return NRS_SET_CONTINUE;
}
if ($self->can('result'))
{
my $r = $self->result;
$self->log(4, "Return $r as given result");
return $r;
}
else
{
$self->log(4, "Return CONTINUE | RESPOND as given result");
return NRS_SET_CONTINUE | NRS_SET_RESPOND;
}
}
sub set_server
{
my $self = shift;
my $r_data = shift;
$self->timeout(3) unless $self->timeout;
$self->tries(2) unless $self->tries;
my $secret = $self->secret || $r_data->{secret};
my $port = $self->port || $r_data->{port};
my $dict = defined $self->dictionary
? Net::Radius::Dictionary->new($self->dictionary)
: $r_data->{dict};
$self->log(4, "Creating udp socket to " . $self->server . ":$port");
$self->{_socket} = IO::Socket::INET->new
(
PeerAddr => $self->server,
PeerPort => $port,
Proto => 'udp',
);
unless ($self->{_socket})
{
$self->log(2, "Failed to create socket: $!");
return;
}
$self->{_select} = new IO::Select $self->{_socket};
unless ($self->{_select})
{
$self->log(2, "Failed to select object: $!");
return;
}
$self->log(4, "Proxying request to "
. $self->server . ":$port");
$self->_proxy($r_data, $secret, $dict);
}
42;
__END__
=head1 NAME
Net::Radius::Server::Set::Server - Proxy the RADIUS request to a RADIUS server
=head1 SYNOPSIS
use Net::Radius::Server::Set::Proxy;
use Net::Radius::Server::Base qw/:set/;
my $proxy = Net::Radius::Server::Set::Proxy->new
({
server => $real_server_ip,
port => $real_server_port,
dictionary => $dictionary_file,
tries => 2,
timeout => 3,
result => NRS_SET_RESPOND,
});
my $proxy_sub = $proxy->mk;
=head1 DESCRIPTION
C<Net::Radius::Server::Set::Proxy> allows for proxying the (matching)
RADIUS requests through a RADIUS server. The following attributes are
supported:
=over
=item B<server>
This entry is mandatory and specifies the address of the server to
which the RADIUS request must be sent.
=item B<port>
The port in the RADIUS server where the current request must be
sent. Defaults to the current port.
=item B<secret>
The RADIUS shared secret to be used to protect the interaction with
the server. Defaults to the secret used to handle the current request.
=item B<dictionary>
Dictionary to use for packet coding/decoding when talking to the
RADIUS server. If left unspecified, the currently configured
dictionary will be used to handle that interaction as well.
=item B<timeout>
How many seconds before retrying request to the real RADIUS
server. Defaults to 3 seconds.
=item B<tries>
How many attempts to proxy the request to the real RADIUS
server. Defaults to 2 attempts.
=item B<result>
The result to be returned by the method. See Net::Server::Base(3) for
more information.
=back
When proxying is succesful, C<$self-E<gt>result> will be returned (if
specified). Otherwise, C<NRS_SET_CONTINUE | NRS_SET_RESPOND> will be
returned by default.
Upon a failure in the proxying, C<NRS_SET_CONTINUE> is returned.
=head2 EXPORT
None by default.
=head1 HISTORY
$Log$
Revision 1.13 2007/01/03 00:29:58 lem
Improve check for non-responses
Revision 1.12 2006/12/14 16:33:17 lem
Rules and methods will only report failures in log level 3 and
above. Level 4 report success and failure, for deeper debugging
Revision 1.11 2006/12/14 15:52:25 lem
Fix CVS tags
=head1 SEE ALSO
Perl(1), Net::Radius::Server(3), Net::Radius::Server::Radius(3),
Net::Radius::Packet(3).
=head1 AUTHOR
Luis E. Muñoz, E<lt>luismunoz@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Luis E. Muñoz
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl 5.8.6 itself.
=cut