package POE::Component::IRC::Plugin::QueryDNSBL; use strict; use warnings; use POE; use POE::Component::Client::DNSBL; use POE::Component::IRC::Plugin qw(:ALL); use POE::Component::IRC::Common qw(irc_ip_is_ipv4); use vars qw($VERSION); $VERSION = '1.00'; sub new { my $package = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; delete $args{resolver} unless ref $args{resolver} and $args{resolver}->isa('POE::Component::Client::DNS'); bless \%args, $package; } sub PCI_register { my ($self,$irc) = @_; $irc->plugin_register( $self, 'SERVER', qw(public msg) ); $self->{resolver} = $irc->resolver(); $self->{_dnsbl} = POE::Component::Client::DNSBL->spawn( resolver => $self->{resolver}, dnsbl => $self->{dnsbl}, ); return 1; } sub PCI_unregister { my $self = shift; $self->{_dnsbl}->shutdown(); return 1; } sub S_public { my ($self,$irc) = splice @_, 0 , 2; my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1]; my $channel = ${ $_[1] }->[0]; my $what = ${ $_[2] }; my $mynick = $irc->nick_name(); my $cmdstr = $self->{command} || 'dnsbl'; my ($command) = $what =~ m/^\s*\Q$mynick\E[\:\,\;\.]?\s*(.*)$/i; return PCI_EAT_NONE unless ( $command and $command =~ /^\Q$cmdstr\E/i ); $self->_dns_query( $irc, $channel, 'privmsg', split(/\s+/, $command) ); return PCI_EAT_NONE; } sub S_msg { my ($self,$irc) = splice @_, 0 , 2; my ($nick,$userhost) = ( split /!/, ${ $_[0] } )[0..1]; my $string = ${ $_[2] }; my $cmdstr = $self->{command} || 'dnsbl'; return PCI_EAT_NONE unless ( $string and $string =~ /^\Q$cmdstr\E\s+/i ); $self->_dns_query( $irc, $nick, ( $self->{privmsg} ? 'privmsg' : 'notice' ), split(/\s+/, $string) ); return PCI_EAT_NONE; } sub _dns_query { my ($self,$irc,$target,$method,$cmdstr,$query,$type) = @_; return unless $cmdstr and $query; unless ( irc_ip_is_ipv4( $query ) ) { $irc->yield( $method, $target, 'That isn\'t an IPv4 address' ); return; } $poe_kernel->state( '_querydnsbl_response', $self, '_response' ); $self->{_dnsbl}->lookup( event => '_querydnsbl_response', address => $query, _context => { targ => $target, meth => $method, irc => $irc }, ); return 1; } sub _response { my $response = $_[ARG0]; my $target = $response->{_context}->{targ}; my $method = $response->{_context}->{meth}; my $irc = $response->{_context}->{irc}; if ( $response->{error} ) { $irc->yield( $method, $target, 'Thanks, that generated an error!' ); } else { if ( $response->{response} eq 'NXDOMAIN' ) { $irc->yield( $method, $target, 'That address is not blacklisted.' ); } else { $irc->yield( $method, $target, join(' ', $response->{response}, ( $response->{reason} ? "[$response->{reason}]" : '' ) ) ); } } $poe_kernel->state( '_querydnsbl_response' ); return; } 1; __END__ =head1 NAME POE::Component::IRC::Plugin::QueryDNSBL - A POE::Component::IRC plugin for IRC based DNSBL queries =head1 SYNOPSIS use strict; use warnings; use POE qw(Component::IRC Component::IRC::Plugin::QueryDNSBL); my $nickname = 'qdnsbl' . $$; my $ircname = 'QueryDNSBL Bot'; my $ircserver = $ENV{IRCSERVER} || 'irc.bleh.net'; my $port = 6667; my $channel = '#IRC.pm'; my $irc = POE::Component::IRC->spawn( nick => $nickname, server => $ircserver, port => $port, ircname => $ircname, debug => 0, plugin_debug => 1, options => { trace => 0 }, ) or die "Oh noooo! $!"; POE::Session->create( package_states => [ 'main' => [ qw(_start irc_001) ], ], ); $poe_kernel->run(); exit 0; sub _start { # Create and load our QueryDNSBL plugin $irc->plugin_add( 'QueryDNSBL' => POE::Component::IRC::Plugin::QueryDNSBL->new() ); $irc->yield( register => 'all' ); $irc->yield( connect => { } ); undef; } sub irc_001 { $irc->yield( join => $channel ); undef; } =head1 DESCRIPTION POE::Component::IRC::Plugin::QueryDNS is a L plugin that provides DNSBL query facilities to the channels it occupies and via private messaging. It uses L to do non-blocking DNSBL queries. By default the plugin attempts to use L's internal PoCo-Client-DNS resolver object, but will spawn its own copy. You can supply your own resolver object via the constructor. =head1 CONSTRUCTOR =over =item C Creates a new plugin object. Takes some optional parameter: 'command', define the command that will trigger DNSBL queries, default is 'dnsbl'; 'privmsg', set to a true value to specify that the bot should reply with PRIVMSG instead of NOTICE to privmsgs that it receives. 'resolver', specify a POE::Component::Client::DNS object that the plugin should use, the default is to try and use POE::Component::IRC's resolver; 'dnsbl', the DNSBL zone to send queries to, default zen.spamhaus.org; =back =head1 IRC USAGE The bot replies to requests in the following form, when addressed: dnsbl Of course, if you changed the C in the constructor it will be something different to C. =head1 AUTHOR Chris C Williams =head1 LICENSE Copyright E Chris Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L