AnyEvent-Ident
view release on metacpan or search on metacpan
- Documentation cleanup
0.06 2014-04-08 14:38:03 -0400
- support for Perl 5.8
0.05 2013-02-09 18:48:43 America/New_York
- simplify inheritence by removing dep on base
0.04 2013-02-09 09:53:32 America/New_York
- do not call recv from module
- use on_bind callback if you need bindport after start but before client connection
0.03 2013-01-19 18:16:47 America/New_York
- documentation updates
0.02 2013-01-17 11:01:45 America/New_York
- allow custom response classes
0.01 2013-01-15 11:45:47 America/New_York
- initial version
stopwords:
- hostname
- TCP
- ident
- IP
- MSWin32
- MSWin
- Ident
- IRC
- RFC1413
- bindport
- req
pod_coverage:
private:
- AnyEvent::Ident.*#new
lib/AnyEvent/Ident.pm view on Meta::CPAN
use Exporter ();
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( ident_server ident_client );
# ABSTRACT: Simple asynchronous ident client and server
our $VERSION = '0.08'; # VERSION
# keep the server object in scope so that
# we don't unbind from the port. If you
# don't want this, then use the OO interface
# for ::Server instead.
my $keep = [];
sub ident_server ($$$;$)
{
my $hostname = shift;
my $port = shift;
my $cb = shift;
require AnyEvent::Ident::Server;
lib/AnyEvent/Ident/Server.pm view on Meta::CPAN
sub new
{
my $class = shift;
my $args = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
my $port = $args->{port};
$port = 113 unless defined $port;
bless {
hostname => $args->{hostname},
port => $port,
on_error => $args->{on_error} || sub { carp $_[0] },
on_bind => $args->{on_bind} || sub { },
}, $class;
}
sub start
{
my($self, $callback) = @_;
croak "already started" if $self->{guard};
lib/AnyEvent/Ident/Server.pm view on Meta::CPAN
$handle->on_read(sub {
$handle->push_read( line => sub {
my($handle, $line) = @_;
$line =~ s/\015?\012//g;
my $req = eval { AnyEvent::Ident::Request->new($line) };
return $handle->push_write("$line:ERROR:INVALID-PORT\015\012") if $@;
my $tx = bless {
req => $req,
remote_port => $port,
local_port => $self->{bindport},
remote_address => $host,
cb => sub {
my($res) = @_;
$handle->push_write($res->as_string . "\015\012");
},
}, 'AnyEvent::Ident::Transaction';
$callback->($tx);
})
});
};
$self->{guard} = tcp_server $self->{hostname}, $self->{port}, $cb, sub {
my($fh, $host, $port) = @_;
$self->{bindport} = $port;
$self->{on_bind}->($self);
};
$self;
}
sub bindport { shift->{bindport} }
sub stop
{
my($self) = @_;
delete $self->{guard};
delete $self->{bindport};
$self;
}
1;
__END__
=pod
=encoding UTF-8
lib/AnyEvent/Ident/Server.pm view on Meta::CPAN
The port to connect to.
=head2 on_error
default carp error
A callback subref to be called on error (either connection or transmission error).
Passes the error string as the first argument to the callback.
=head2 on_bind
A callback subref to be called when the socket has been bound to a port. Useful
when using an ephemeral and you do not know the port number in advance.
=head2 start
$server->start( $callback );
Start the Ident server. The given callback will be called on each ident
request (there may be multiple ident requests for each connection). The
first and only argument passed to the callback is the transaction, an
instance of L<AnyEvent::Ident::Transaction>. The most important attribute
on the transaction object are C<res>, the response object (itself an instance of
L<AnyEvent::Ident::Transaction> with C<server_port> and C<client_port>
attributes) and the most important methods on the transaction object are
C<reply_with_user> and C<reply_with_error> which reply with a successful and
error response respectively.
=head2 bindport
my $port = $server->bindport;
The bind port. If port is set to zero in the constructor or on
start, then an ephemeral port will be used, and you can get the
port number here.
=head2 stop
$server-E<gt>stop
Stop the server and unbind to the port.
=head1 AUTHOR
Graham Ollis <plicease@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
t/alt_res_class.t view on Meta::CPAN
use warnings;
use Test::More tests => 7;
use AnyEvent::Ident::Client;
use AnyEvent::Ident::Server;
our $timeout = AnyEvent->timer(
after => 10,
cb => sub { diag "TIMEOUT"; exit },
);
my $bindport = AnyEvent->condvar;
my $server = eval { AnyEvent::Ident::Server->new(
hostname => '127.0.0.1', port => 0, on_bind => sub { $bindport->send(shift->bindport) },
) };
diag $@ if $@;
isa_ok $server, 'AnyEvent::Ident::Server';
eval {
$server->start(sub {
shift->reply_with_user('UNIX','grimlock');
});
};
diag $@ if $@;
like $bindport->recv, qr/^[1-9]\d*$/, 'bind port = ' . $server->bindport;
my $w = AnyEvent->timer( after => 5, cb => sub { diag 'TIMEOUT'; exit });
my $done = AnyEvent->condvar;
my $client = AnyEvent::Ident::Client->new(
hostname => '127.0.0.1',
port => $server->bindport,
response_class => 'Foo::Bar::Baz',
)->ident(1,2, sub {
my $res = shift;
isa_ok $res, 'Foo::Bar::Baz';
ok $res->is_success, 'is_success';
is $res->username, 'grimlock', ' username = grimlock ';
is $res->os, 'UNIX', ' os = UNIX ';
is eval { $res->answer }, 42, ' answer = 42 ';
diag $@ if $@;
use warnings;
use Test::More tests => 25;
use AnyEvent::Ident::Client;
use AnyEvent::Ident::Server;
our $timeout = AnyEvent->timer(
after => 10,
cb => sub { diag "TIMEOUT"; exit },
);
my $bind;
my $server = eval { AnyEvent::Ident::Server->new( hostname => '127.0.0.1', port => 0, on_bind => sub { $bind->send } ) };
isa_ok $server, 'AnyEvent::Ident::Server';
eval {
$bind = AnyEvent->condvar;
$server->start(sub {
my $tx = shift;
if($tx->req->server_port == 400
&& $tx->req->client_port == 500)
{
$tx->reply_with_user('UNIX', 'grimlock');
}
else
{
$tx->reply_with_error('NO-USER');
}
});
$bind->recv;
};
diag $@ if $@;
like $server->bindport, qr/^[123456789]\d*$/, "bind port = " . $server->bindport;
my $w = AnyEvent->timer( after => 5, cb => sub { diag "TIMEOUT"; exit } );
my $client = AnyEvent::Ident::Client->new( hostname => '127.0.0.1', port => $server->bindport );
do {
my $done = AnyEvent->condvar;
my $res;
$client->ident(400, 500, sub {
$res = shift;
$done->send;
});
$done->recv;
isa_ok $res, 'AnyEvent::Ident::Response';
ok !$res->is_success, '!is_success';
is $res->error_type, 'INVALID-PORT', 'error_type = INVALID-PORT';
};
eval {
$server->stop;
$bind = AnyEvent->condvar;
$server->start(sub {
my $tx = shift;
if($tx->req->server_port == 999
&& $tx->req->client_port == 888)
{
$tx->reply_with_user('UNIX', 'grimlock');
}
else
{
$tx->reply_with_error('NO-USER');
}
});
$bind->recv;
};
diag $@ if $@;
$client = AnyEvent::Ident::Client->new( hostname => '127.0.0.1', port => $server->bindport );
do {
my $done = AnyEvent->condvar;
my $res;
$client->ident(999, 888, sub {
$res = shift;
$done->send;
});
use warnings;
use Test::More tests => 11;
use AnyEvent;
use AnyEvent::Ident qw( ident_server ident_client );
our $timeout = AnyEvent->timer(
after => 10,
cb => sub { diag "TIMEOUT"; exit },
);
my $bindport = eval {
my $bind = AnyEvent->condvar;
ident_server '127.0.0.1', 0, sub {
my $tx = shift;
if($tx->req->server_port == 400
&& $tx->req->client_port == 500)
{
$tx->reply_with_user('UNIX', 'grimlock');
}
else
{
$tx->reply_with_error('NO-USER');
}
}, { on_bind => sub { $bind->send(shift) } };
$bind->recv->bindport;
};
like $bindport, qr/^[123456789]\d*$/, "bind port = " . $bindport;
my $w = AnyEvent->timer( after => 5, cb => sub { diag "TIMEOUT"; exit } );
do {
my $done = AnyEvent->condvar;
my $res;
ident_client '127.0.0.1', $bindport, 400, 500, sub {
$res = shift;
$done->send;
};
$done->recv;
isa_ok $res, 'AnyEvent::Ident::Response';
ok $res->is_success, 'is_success';
is $res->username, 'grimlock', 'username = grimlock';
is $res->os, 'UNIX', 'os = UNIX';
};
do {
my $done = AnyEvent->condvar;
my $res;
ident_client '127.0.0.1', $bindport, 1,1, sub {
$res = shift;
$done->send;
};
$done->recv;
isa_ok $res, 'AnyEvent::Ident::Response';
ok !$res->is_success, '!is_success';
is $res->error_type, 'NO-USER', 'error_type = NO-USER';
};
do {
my $done = AnyEvent->condvar;
my $res;
ident_client '127.0.0.1', $bindport, -1, -1, sub {
$res = shift;
$done->send;
};
$done->recv;
isa_ok $res, 'AnyEvent::Ident::Response';
ok !$res->is_success, '!is_success';
is $res->error_type, 'INVALID-PORT', 'error_type = INVALID-PORT';
};
( run in 1.323 second using v1.01-cache-2.11-cpan-2398b32b56e )