view release on metacpan or  search on metacpan

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

                            type => $type,
                            request_id => $req_id,
                            av_list => $av_list,
                            # from is sockaddr binary data
                            from => $from,
                        });
            }

            # Do not reply
            warn "Ignore wrong request type " . $type;
            return
        }

        my ($reply_type, $reply_av_list) = ();

        if($h{on_read}) {
            # custom-reply
            ($reply_type, $reply_av_list) = $h{on_read}->($obj, {
                        type => $type,
                        request_id => $req_id,
                        av_list => $av_list,
                        # from is sockaddr binary data
                        from => $from,
                    });
        }

        if (! $reply_type) {
            # reject by default
            $reply_type = $DEFAUL_REPLY{ $type };
            $reply_av_list = [{Name => 'Reply-Message', Value => 'Default rule: reject'}];
        }

        my ($reply, $r_id, $r_auth) = $obj->packer()->build(
                                type => $reply_type,
                                av_list => $reply_av_list,
                                authenticator => $authenticator,
                                request_id => $req_id,
                            );
        if(! $reply) {
            warn "Failed to build reply";
            return
        }

        $obj->handler()->push_send($reply, $from);

        return;
    };

    # low-level socket errors
    my $on_error_cb = sub {
        my ($handle, $fatal, $error) = @_;
        if ($h{on_error}) {
            $h{on_error}->($obj, $error);
        }
        else {
            warn "Error occured: $error";
        }
    };

    my $server = AnyEvent::Handle::UDP->new(
            bind => [$h{ip}, $h{port} // RADIUS_PORT ],
            on_recv => $on_read_cb,
            on_error => $on_error_cb,
        );
    $obj->handler($server);

    # allow to pass custom object
    my $packer = $h{packer} || Data::Radius::Packet->new(dict => $h{dictionary}, secret => $h{secret});
    $obj->packer($packer);

    return $obj;
}

sub load_dictionary {
    my ($class, $path) = @_;
    my $dict = Data::Radius::Dictionary->load_file($path);

    if(ref($class)) {
        $class->packer()->dict($dict);
    }

    return $dict;
}

1;

__END__

=head1 NAME

AnyEvent::Radius::Server - module to implement AnyEvent based RADIUS server

=head1 SYNOPSYS

    use AnyEvent;
    use AnyEvent::Radius::Server;

    sub radius_reply {
        # $h is hash-ref { request_id, type, av_list }
        my ($self, $h) = @_;
        ...
        return ($reply_type, $reply_av_list);
    }

    my $dict = AnyEvent::Radius::Server->load_dictionary('radius/dictionary');

    my $server = AnyEvent::Radius::Server->new(
                    ip => $ip,
                    port => $port,
                    read_timeout => 60,
                    on_read => \&radius_reply,
                    dictionary => $dict,
                    secret => 'topsecret',
                );
    AnyEvent->condvar->recv;

=head1 DESCRIPTION

The L<AnyEvent::Radius::Server> module allows to handle RADIUS requests in non-blocking way