view release on metacpan or  search on metacpan

lib/AnyEvent/Radius/Client.pm  view on Meta::CPAN

package AnyEvent::Radius::Client;
# AnyEvent-based radius client
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Handle::UDP;

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(
                handler packer send_cache
                queue_cv write_cv read_cv
                sent_cnt reply_cnt queue_cnt
                last_request_id
            ));

use Data::Radius v1.2.8;
use Data::Radius::Constants qw(%RADIUS_PACKET_TYPES);
use Data::Radius::Dictionary ();
use Data::Radius::Packet ();

use constant {
    READ_TIMEOUT_SEC => 5,
    WRITE_TIMEOUT_SEC => 5,
    RADIUS_PORT => 1812,
    MAX_REQUEST_ID => 0xFF,
};

# deprecated?
use constant MAX_QUEUE => MAX_REQUEST_ID() + 1;

# new 'NAS'
# args:
#   ip
#   port
#   secret
#   dictionary
#   read_timeout
#   write_timeout
#   bind_ip
#   initial_last_request_id - random by default
#- callbacks:
#    on_read
#    on_read_raw
#    on_read_timeout
#    on_write_timeout
#    on_error
sub new {
    my ($class, %h) = @_;

    my $obj = bless {}, $class;

    # either pre-created packer object, or need radius secret to create new one
    # dictionary is optional
    if ( defined $h{packer} ) {
        $obj->packer( $h{packer} );
    } elsif ( defined $h{secret} ) {
        $obj->packer( Data::Radius::Packet->new(dict => $h{dictionary}, secret => $h{secret}) );
    } else {
        die "No radius secret";
    }

    my %udp_handle_args = (
        rtimeout => $h{read_timeout} // READ_TIMEOUT_SEC,
        wtimeout => $h{write_timeout} // WRITE_TIMEOUT_SEC,
    );

    die "No IP argument" if ! exists $h{ip};
    $udp_handle_args{connect} = [ $h{ip}, $h{port} // RADIUS_PORT ];
    $udp_handle_args{bind} = [$h{bind_ip}, 0] if exists $h{bind_ip};

    $udp_handle_args{on_recv} = sub {
        my ($data, $handle, $from) = @_;
        $obj->read_cv->end;
        $obj->reply_cnt($obj->reply_cnt + 1);

        if ($h{on_read_raw}) {
            # dump raw data
            $h{on_read_raw}->($obj, $data, $from);
        }

        # using authenticator from request to verify reply
        my $request_id = $obj->packer()->request_id($data);
        # FIXME how to react on unknown request_id ?
        my $send_info = delete $obj->send_cache()->{ $request_id };
        if (! $send_info ) {
            # got unknown reply (with wrong request id?)
            if ($h{on_error}) {
                $h{on_error}->($obj, 'Unknown reply');
            }
            else {
                warn "Error: unknown reply";
            }
        }
        else {
            my $on_read = $h{on_read};
            my $req_callback = $send_info->{callback};
            if ( $on_read || $req_callback ) {
                # how to decode $from
                # my($port, $host) = AnyEvent::Socket::unpack_sockaddr($from);
                # my $ip = format_ipv4($host);

                my ($type, $req_id, $auth, $av_list) = $obj->packer()->parse($data, $send_info->{authenticator});

                $on_read->($obj, {
                            type => $type,
                            request_id => $req_id,
                            av_list => $av_list,
                            # from is sockaddr binary data
                            from => $from,
                            authenticator => $auth,
                        }) if $on_read;
                $req_callback->($type, $av_list) if $req_callback;
            }
        }

        $obj->queue_cv->end;
    };

    $udp_handle_args{on_rtimeout} = sub {
        my $handle = shift;
        if(! $obj->read_cv->ready) {
            if($h{on_read_timeout}) {
                $h{on_read_timeout}->($obj, $handle);
            }
            $obj->clear_send_cache();
            # stop queue
            $obj->queue_cv->send;
        }
        $handle->clear_rtimeout();

lib/AnyEvent/Radius/Client.pm  view on Meta::CPAN

    return $self->send_packet(COA => @_);
}

1;

__END__

=head1 NAME

AnyEvent::Radius::Client - module to implement AnyEvent based RADIUS client

=head1 SYNOPSYS

    use AnyEvent;
    use AnyEvent::Radius::Client;

    my $dict = AnyEvent::Radius::Client->load_dictionary('path-to-radius-dictionary');

    sub read_reply_callback {
        # $h is HASH-REF {type, request_id, av_list, from, authenticator}
        my ($self, $h) = @_;
        ...
    }

    my $client = AnyEvent::Radius::Client->new(
                        ip => $ip,
                        port => $port,
                        on_read => \&read_reply_callback,
                        dictionary => $dict,
                        secret => $secret,
                    );
    $client->send_auth(AV_LIST1);
    $client->send_auth(AV_LIST2);
    ...
    $client->wait;
    ...
    $client->destroy;

=head1 DESCRIPTION

The L<AnyEvent::Radius::Client> module allows to send multiple RADIUS requests in non-blocking way,
and then wait for responses.


=head1 CONSTRUCTOR

=over

=item new ( ..options hash )

=over

=item ip

=item port - where to connect

=item secret - RADIUS secret string for remote server

=item dictionary - optional, dictionary loaded by L<load_dictionary()> method

=item bind_ip - optional, the local ip address to bind client to

=item read_timeout

=item write_timeout - network I/O timeouts (default is 5 second)

=item initial_last_request_id - explicit radius id initialization, the next request will use it+1

=item Callbacks:

=over

=item on_read - called when reply received, arguments is hash-ref with {request_id, type, av_list, authenticator} keys

=item on_read_raw - called when reply received, raw data packet is provided as argument

=item on_read_timeout - timeout waiting for reply from server. Aborts the waiting state

=item on_write_timeout - timeout sending request

=item on_error - invalid packet received, or low-level socket error

=back

=back

=back

=head1 METHODS

=over

=item load_dictionary ($dictionary-file)

Class method to load dictionary - returns the object to be passed to constructor

=item send_packet ( $type, $av_list, $cb )

Builds RADIUS packet using L<Data::Radius::Packet> and store it to outgoing queue.

The type can be either the direct RFC packet type id, or one of its aliases,
like COA, DM, POD, ACCT, AUTH ... see C<Data::Radius::Constants>

Passing the optional callback $cb to be called upon receiving response to this request in form

  $cb->($resp_type, $resp_av_list)

or with empty parameters in case of missing response - eg. being timed out or unmatched authenticator

  $cb->()

Returns request id.
Note that it's not possible to schedule more than 255 requests - trying to add more will return undef

=item send_auth ($av_list, $cb)

=item send_acct ($av_list, $cb)

=item send_pod ($av_list, $cb)

=item send_coa ($av_list, $cb)