package POE::Component::IRC::Plugin::Proxy;
BEGIN {
$POE::Component::IRC::Plugin::Proxy::AUTHORITY = 'cpan:HINRIK';
}
BEGIN {
$POE::Component::IRC::Plugin::Proxy::VERSION = '6.78';
}
use strict;
use warnings FATAL => 'all';
use Carp;
use Socket qw(inet_ntoa);
use POE qw(Wheel::SocketFactory Wheel::ReadWrite Filter::IRCD
Filter::Line Filter::Stackable);
use POE::Component::IRC::Plugin qw(PCI_EAT_NONE);
sub new {
my ($package) = shift;
croak "$package requires an even number of arguments" if @_ & 1;
my %args = @_;
$args{ lc $_ } = delete $args{ $_ } for keys %args;
return bless \%args, $package;
}
sub PCI_register {
my ($self, $irc) = splice @_, 0, 2;
if (!$irc->isa('POE::Component::IRC::State')) {
die __PACKAGE__ . ' requires PoCo::IRC::State or a subclass thereof';
}
$irc->raw_events(1);
$self->{irc} = $irc;
$irc->plugin_register(
$self,
'SERVER',
qw(
connected
disconnected
001
error
socketerr
raw
)
);
POE::Session->create(
object_states => [
$self => [qw(
_client_error
_client_flush
_client_input
_listener_accept
_listener_failed
_start
_shutdown
_spawn_listener
)],
],
);
return 1;
}
sub PCI_unregister {
my ($self, $irc) = splice @_, 0, 2;
$poe_kernel->post($self->{SESSION_ID} => _shutdown => delete $self->{irc});
$poe_kernel->refcount_decrement($self->{SESSION_ID}, __PACKAGE__);
return 1;
}
sub S_connected {
my ($self, $irc) = splice @_, 0, 2;
$self->{stashed} = 0;
$self->{stash} = [ ];
return PCI_EAT_NONE;
}
sub S_001 {
my ($self, $irc) = splice @_, 0, 2;
$poe_kernel->post($self->{SESSION_ID} => '_shutdown');
$poe_kernel->post($self->{SESSION_ID} => '_spawn_listener');
return PCI_EAT_NONE;
}
sub S_disconnected {
my ($self, $irc) = splice @_, 0, 2;
$poe_kernel->post($self->{SESSION_ID} => '_shutdown');
return PCI_EAT_NONE;
}
sub S_socketerr {
my ($self, $irc) = splice @_, 0, 2;
$poe_kernel->post($self->{SESSION_ID} => '_shutdown');
return PCI_EAT_NONE;
}
sub S_error {
my ($self, $irc) = splice @_, 0, 2;
$poe_kernel->post($self->{SESSION_ID} => '_shutdown');
return PCI_EAT_NONE;
}
sub S_raw {
my ($self, $irc) = splice @_, 0, 2;
my $line = ${ $_[0] };
my $input = $self->{irc_filter}->get( [$line] )->[0];
return PCI_EAT_NONE if $input->{command} eq 'PING';
for my $wheel_id (keys %{ $self->{wheels} }) {
$self->_send_to_client($wheel_id, $line);
}
return PCI_EAT_NONE if $self->{stashed};
if ($input->{command} =~ /^(?:NOTICE|\d{3})$/) {
push @{ $self->{stash} }, $line;
}
$self->{stashed} = 1 if $input->{command} =~ /^(?:376|422)$/;
return PCI_EAT_NONE;
}
sub _send_to_client {
my ($self, $wheel_id, $line) = splice @_, 0, 3;
return if !defined $self->{wheels}->{ $wheel_id }->{wheel};
return if !$self->{wheels}->{ $wheel_id }->{reg};
$self->{wheels}->{ $wheel_id }->{wheel}->put($line);
return;
}
sub _close_wheel {
my ($self, $wheel_id) = splice @_, 0, 2;
return if !defined $self->{wheels}->{ $wheel_id };
delete $self->{wheels}->{ $wheel_id };
$self->{irc}->send_event(irc_proxy_close => $wheel_id);
return;
}
sub _start {
my ($kernel, $self) = @_[KERNEL, OBJECT];
$self->{SESSION_ID} = $_[SESSION]->ID();
$kernel->refcount_increment($self->{SESSION_ID}, __PACKAGE__);
$self->{irc_filter} = POE::Filter::IRCD->new();
$self->{ircd_filter} = POE::Filter::Stackable->new(
Filters => [
POE::Filter::Line->new(),
$self->{irc_filter},
],
);
if ($self->{irc}->connected()) {
$kernel->yield('_spawn_listener');
}
return;
}
sub _spawn_listener {
my $self = $_[OBJECT];
$self->{listener} = POE::Wheel::SocketFactory->new(
BindAddress => $self->{bindaddress} || 'localhost',
BindPort => $self->{bindport} || 0,
SuccessEvent => '_listener_accept',
FailureEvent => '_listener_failed',
Reuse => 'yes',
);
if (!$self->{listener}) {
my $irc = $self->{irc};
$irc->plugin_del($self);
return;
}
$self->{irc}->send_event(irc_proxy_up => $self->{listener}->getsockname());
return;
}
sub _listener_accept {
my ($self, $socket, $peeradr, $peerport) = @_[OBJECT, ARG0 .. ARG2];
my $wheel = POE::Wheel::ReadWrite->new(
Handle => $socket,
InputFilter => $self->{ircd_filter},
OutputFilter => POE::Filter::Line->new(),
InputEvent => '_client_input',
ErrorEvent => '_client_error',
FlushedEvent => '_client_flush',
);
if ($wheel) {
my $wheel_id = $wheel->ID();
$self->{wheels}->{ $wheel_id }->{wheel} = $wheel;
$self->{wheels}->{ $wheel_id }->{port} = $peerport;
$self->{wheels}->{ $wheel_id }->{peer} = inet_ntoa( $peeradr );
$self->{wheels}->{ $wheel_id }->{start} = time;
$self->{wheels}->{ $wheel_id }->{reg} = 0;
$self->{wheels}->{ $wheel_id }->{register} = 0;
$self->{irc}->send_event(irc_proxy_connect => $wheel_id);
}
else {
$self->{irc}->send_event(irc_proxy_rw_fail => inet_ntoa( $peeradr ) => $peerport);
}
return;
}
sub _listener_failed {
delete ( $_[OBJECT]->{listener} );
return;
}
sub _client_flush {
my ($self, $wheel_id) = @_[OBJECT, ARG0];
return if !defined $self->{wheels}->{ $wheel_id } || !$self->{wheels}->{ $wheel_id }->{quiting};
$self->_close_wheel($wheel_id);
return;
}
# this code needs refactoring
## no critic (Subroutines::ProhibitExcessComplexity)
sub _client_input {
my ($self, $input, $wheel_id) = @_[OBJECT, ARG0, ARG1];
my ($irc, $wheels) = ($self->{irc}, $self->{wheels});
return if $wheels->{$wheel_id}{quiting};
if ($input->{command} eq 'QUIT') {
$self->_close_wheel($wheel_id);
return;
}
if ($input->{command} eq 'PASS' && $wheels->{$wheel_id}{reg} < 2) {
$wheels->{$wheel_id}{pass} = $input->{params}[0];
}
if ($input->{command} eq 'NICK' && $wheels->{$wheel_id}{reg} < 2) {
$wheels->{$wheel_id}{nick} = $input->{params}[0];
$wheels->{$wheel_id}{register}++;
}
if ($input->{command} eq 'USER' && $wheels->{$wheel_id}{reg} < 2) {
$wheels->{$wheel_id}{user} = $input->{params}[0];
$wheels->{$wheel_id}{register}++;
}
if (!$wheels->{$wheel_id}{reg} && $wheels->{$wheel_id}{register} >= 2) {
my $password = delete $wheels->{$wheel_id}{pass};
$wheels->{$wheel_id}{reg} = 1;
if (!$password || $password ne $self->{password}) {
$self->_send_to_client($wheel_id,
'ERROR :Closing Link: * ['
. ($wheels->{$wheel_id}{user} || 'unknown')
. '@' . $wheels->{$wheel_id}{peer}
. '] (Unauthorised connection)'
);
$wheels->{$wheel_id}{quiting}++;
return;
}
my $nickname = $irc->nick_name();
my $fullnick = $irc->nick_long_form($nickname);
if ($nickname ne $wheels->{$wheel_id}{nick}) {
$self->_send_to_client($wheel_id, "$wheels->{$wheel_id}{nick} NICK :$nickname");
}
for my $line (@{ $self->{stash} }) {
$self->_send_to_client($wheel_id, $line);
}
for my $channel ($irc->nick_channels($nickname)) {
$self->_send_to_client($wheel_id, ":$fullnick JOIN $channel");
$irc->yield(names => $channel);
$irc->yield(topic => $channel);
}
$irc->send_event(irc_proxy_authed => $wheel_id);
return;
}
return if !$wheels->{$wheel_id}{reg};
if ($input->{command} =~ /^(?:NICK|USER|PASS)$/) {
return;
}
if ($input->{command} eq 'PING') {
$self->_send_to_client($wheel_id, "PONG $input->{params}[0]");
return;
}
if ($input->{command} eq 'PONG' and $input->{params}[0] =~ /^[0-9]+$/) {
$wheels->{$wheel_id}{lag} = time() - $input->{params}[0];
return;
}
$irc->yield(quote => $input->{raw_line});
return;
}
sub _client_error {
my ($self, $wheel_id) = @_[OBJECT, ARG3];
$self->_close_wheel($wheel_id);
return;
}
sub _shutdown {
my $self = $_[OBJECT];
my $irc = $self->{irc} || $_[ARG0];
my $mysockaddr = $self->getsockname();
delete $self->{listener};
for my $wheel_id ( $self->list_wheels() ) {
$self->_close_wheel( $wheel_id );
}
delete $self->{wheels};
$irc->send_event(irc_proxy_down => $mysockaddr);
return;
}
sub getsockname {
my ($self) = @_;
return if !$self->{listener};
return $self->{listener}->getsockname();
}
sub list_wheels {
my ($self) = @_;
return keys %{ $self->{wheels} };
}
sub wheel_info {
my ($self, $wheel_id) = @_;
return if !defined $self->{wheels}->{ $wheel_id };
return $self->{wheels}->{ $wheel_id }->{start} if !wantarray;
return map { $self->{wheels}->{ $wheel_id }->{$_} } qw(peer port start lag);
}
1;
=encoding utf8
=head1 NAME
POE::Component::IRC::Plugin::Proxy - A PoCo-IRC plugin that provides a
lightweight IRC proxy/bouncer
=head1 SYNOPSIS
use strict;
use warnings;
use POE qw(Component::IRC::State Component::IRC::Plugin::Proxy Component::IRC::Plugin::Connector);
my $irc = POE::Component::IRC::State->spawn();
POE::Session->create(
package_states => [
main => [ qw(_start) ],
],
heap => { irc => $irc },
);
$poe_kernel->run();
sub _start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
$heap->{irc}->yield( register => 'all' );
$heap->{proxy} = POE::Component::IRC::Plugin::Proxy->new( bindport => 6969, password => "m00m00" );
$heap->{irc}->plugin_add( 'Connector' => POE::Component::IRC::Plugin::Connector->new() );
$heap->{irc}->plugin_add( 'Proxy' => $heap->{proxy} );
$heap->{irc}->yield ( connect => { Nick => 'testbot', Server => 'someserver.com' } );
return;
}
=head1 DESCRIPTION
POE::Component::IRC::Plugin::Proxy is a L<POE::Component::IRC>
plugin that provides lightweight IRC proxy/bouncer server to your
L<POE::Component::IRC> bots. It enables multiple IRC
clients to be hidden behind a single IRC client-server connection.
Spawn a L<POE::Component::IRC::State> session and add in a
POE::Component::IRC::Plugin::Proxy plugin object, specifying a bindport and a
password the connecting IRC clients have to use. When the component is
connected to an IRC network a listening port is opened by the plugin for
multiple IRC clients to connect.
Neat, huh? >;o)
This plugin will activate L<POE::Component::IRC>'s raw
events (L<C<irc_raw>|POE::Component::IRC/irc_raw>) by calling
C<< $irc->raw_events(1) >>.
This plugin requires the IRC component to be
L<POE::Component::IRC::State> or a subclass thereof.
=head1 METHODS
=head2 C<new>
Takes a number of arguments:
B<'password'>, the password to require from connecting clients;
B<'bindaddress'>, a local address to bind the listener to, default is 'localhost';
B<'bindport'>, what port to bind to, default is 0, ie. randomly allocated by OS;
Returns an object suitable for passing to
L<POE::Component::IRC>'s C<plugin_add> method.
=head2 C<getsockname>
Takes no arguments. Accesses the listeners C<getsockname> method. See
L<POE::Wheel::SocketFactory> for details of the
return value;
=head2 C<list_wheels>
Takes no arguments. Returns a list of wheel ids of the current connected clients.
=head2 C<wheel_info>
Takes one parameter, a wheel ID to query. Returns undef if an invalid wheel id
is passed. In a scalar context returns the time that the client connected in
unix time. In a list context returns a list consisting of the peer address,
port, tthe connect time and the lag in seconds for that connection.
=head1 OUTPUT EVENTS
The plugin emits the following L<POE::Component::IRC>
events:
=head2 C<irc_proxy_up>
Emitted when the listener is successfully started. C<ARG0> is the result of the
listener C<getsockname>.
=head2 C<irc_proxy_connect>
Emitted when a client connects to the listener. C<ARG0> is the wheel ID of the
client.
=head2 C<irc_proxy_rw_fail>
Emitted when the L<POE::Wheel::ReadWrite> fails on a
connection. C<ARG0> is the wheel ID of the client.
=head2 C<irc_proxy_authed>
Emitted when a connecting client successfully negotiates an IRC session with
the plugin. C<ARG0> is the wheel ID of the client.
=head2 C<irc_proxy_close>
Emitted when a connected client disconnects. C<ARG0> is the wheel ID of the
client.
=head2 C<irc_proxy_down>
Emitted when the listener is successfully shutdown. C<ARG0> is the result of the
listener C<getsockname>.
=head1 QUIRKS
Connecting IRC clients will not be able to change nickname. This is a feature.
=head1 AUTHOR
Chris 'BinGOs' Williams
=head1 SEE ALSO
L<POE::Component::IRC>
L<POE::Component::IRC::State>
=cut