#!/usr/bin/perl -w # # This bot is a simple telnet proxy. You DCC CHAT with it, and it # connects to somewhere else, and you talk to the somewhere else over # the CHAT connection in your IRC client. I originally wrote it because # I wanted to use XChat as an interface to a MOO instead of telnet. :-) # # All things considered, a good demonstration of DCC code. # # -- dennis taylor, <dennis@funkplanet.com> use strict; use Socket; use POE qw( Wheel::SocketFactory Wheel::ReadWrite Filter::Line Driver::SysRW ); use POE::Component::IRC; my $mynick = "moo"; my $user = "(fimm(tiu)?|(Half|Semi)jack|stimps)"; my $telnethost = "binky"; my $telnetport = 7788; my $verbose = 0; # turn this on to enable lots of garbage. my $chatsession = undef; sub _start { my ($kernel, $session) = @_[KERNEL, SESSION]; # $session->option( trace => 1 ); $kernel->post( 'irc', 'register', 'all'); $kernel->post( 'irc', 'connect', { Debug => 0, Nick => $mynick, Server => $ARGV[0] || 'irc.phreeow.net', Port => $ARGV[1] || 6667, Username => 'neenio', Ircname => 'Ask me about my colon!', } ); $kernel->sig( INT => "sigint" ); } sub _connected { my ($kernel, $heap, $sock, $addr, $port) = @_[KERNEL, HEAP, ARG0 .. ARG2]; $heap->{wheel} = POE::Wheel::ReadWrite->new( Handle => $sock, Filter => POE::Filter::Line->new(), Driver => POE::Driver::SysRW->new(), InputEvent => '_conn_data', ErrorEvent => '_conn_error', ); $kernel->post( 'irc', 'dcc_chat', $chatsession, "*** Connected." ); print "Connected.\n" if $verbose; } sub _connect_failed { my ($kernel, $heap, $function, $errstr) = @_[KERNEL, HEAP, ARG0, ARG2]; $kernel->post( 'irc', 'dcc_chat', $chatsession, "*** Couldn't connect to $telnethost:$telnetport: $errstr in $function" ); print "Couldn't connect to $telnethost:$telnetport: $errstr in $function\n"; delete $heap->{wheel}; } sub _conn_data { my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; $line = " " unless length $line; $kernel->post( 'irc', 'dcc_chat', $chatsession, $line ); print "<== $line\n" if $verbose; } sub _conn_error { my ($kernel, $heap, $function, $errstr) = @_[KERNEL, HEAP, ARG0, ARG2]; $kernel->post( 'irc', 'dcc_chat', $chatsession, "*** Connection to $telnethost:$telnetport lost: $errstr in $function" ); print "Connection to $telnethost:$telnetport lost: $errstr in $function\n"; delete $heap->{wheel}; } # After we successfully log into the IRC server, make ourselves invisible. sub irc_001 { $_[KERNEL]->post( 'irc', 'mode', $mynick, '+i' ); } sub irc_dcc_request { my ($kernel, $heap, $nick, $type, $port, $cookie) = @_[KERNEL, HEAP, ARG0 .. ARG3]; $nick =~ s/^(.+?)!.*$/$1/; unless ($nick =~ /^$user$/o and $type eq "CHAT") { $kernel->post( 'irc', 'notice', $nick, "Buzz off." ); return; } if ($port < 1024) { $kernel->post( 'irc', 'notice', $nick, "Reserved ports are beneath me." ); return; } if (defined $chatsession) { $kernel->post( 'irc', 'notice', $nick, "There's already a user on." ); return; } $kernel->post( 'irc', 'dcc_accept', $cookie ); } sub irc_dcc_start { my ($kernel, $heap, $cookie, $nick, $port) = @_[KERNEL, HEAP, ARG0, ARG1, ARG3]; unless ($chatsession) { die "Who the hell is \"$nick\"?" unless $nick =~ /^$user!.*$/o; print "DCC CHAT connection established with $nick on port $port.\n" if $verbose; } $chatsession = $cookie; # save the magic cookie $kernel->post( 'irc', 'dcc_chat', $chatsession, "*** Connecting to $telnethost, port $telnetport..." ); $heap->{factory} = POE::Wheel::SocketFactory->new( RemoteAddress => $telnethost, RemotePort => $telnetport, SuccessEvent => '_connected', FailureEvent => '_connect_failed', ); } sub irc_dcc_chat { my ($kernel, $heap, $peer, $line) = @_[KERNEL, HEAP, ARG1, ARG3]; if ($line eq "***reconnect" and not exists $heap->{wheel}) { $kernel->yield( 'irc_dcc_start', $chatsession, '', $peer, 0 ); } elsif ($line eq "***quit") { delete $heap->{factory}; delete $heap->{wheel}; } else { if ($line =~ /^\001ACTION (.*)\001\015?$/) { $line = ":$1"; } $heap->{wheel}->put( $line ) if exists $heap->{wheel}; print "==> $line\n" if $verbose; } } sub irc_dcc_done { my ($nick, $type) = @_[ARG0, ARG1]; print "DCC $type to $nick closed.\n" if $verbose; $chatsession = undef; } sub irc_dcc_error { my ($err, $nick, $type) = @_[ARG1 .. ARG3]; print "DCC $type to $nick failed: $err.\n" if $verbose; $chatsession = undef; } sub sigint { my ($kernel, $heap) = @_[KERNEL, HEAP]; delete $heap->{factory}; delete $heap->{wheel}; $kernel->sig_handled(); } sub _stop { my ($kernel) = $_[KERNEL]; print "Control session stopped.\n"; $kernel->call( 'irc', 'quit', 'Control session stopped.' ); } sub irc_disconnected { my ($server) = $_[ARG0]; print "Lost connection to server $server.\n"; } sub irc_error { my $err = $_[ARG0]; print "Server error occurred! $err\n"; } sub irc_socketerr { my $err = $_[ARG0]; print "Couldn't connect to server: $err\n"; } POE::Component::IRC->new( 'irc', trace => undef ) or die "Can't instantiate new IRC component!\n"; POE::Session->new( 'main' => [qw( _start _stop _connected sigint _connect_failed _conn_data _conn_error irc_001 irc_error irc_disconnected irc_socketerr irc_dcc_start irc_dcc_done irc_dcc_chat irc_dcc_error irc_dcc_request)] ); $poe_kernel->run(); exit 0;