#!/usr/bin/perl ## This is the first release of BotPossum -- Not very good yet ## Full support only for AIM/Yahoo # Works with bitlbee, a user account must be set up for # the bot before the bot is run. # Edit nickname and $password for your server. use strict; use warnings; use POE qw(Component::IRC); use POE::Component::IRC::Plugin::BotTraffic; my %config = ( nickname => 'mynickname', ircname => 'Bot of Possum', ircserver => 'localhost', port => 6667, channels => ('&bitlbee') ); my $password='mypassword'; my @channels=$config{channels}; #Must be declared here so can be used later my %nickaliases; my $address; my %onlineusers; my %messages; #Create a new PoCo-IRC object/component my ($mykernel,$mysender); my $irc = POE::Component::IRC->spawn( nick => $config{nickname}, server => $config{ircserver}, port => $config{port}, ircname => $config{ircname} ) or die "Crap, not connected...site must be dead?"; $irc->plugin_add( 'BotTraffic', POE::Component::IRC::Plugin::BotTraffic->new() ); $irc->plugin_add( 'BotAddressed', POE::Component::IRC::Plugin::BotTraffic->new() ); POE::Session->create( package_states => [ 'main' => [ qw(_default _start irc_001 irc_public) ], ], heap => { irc => $irc }, ); $poe_kernel->run(); exit 0; sub _start { my ($kernel,$heap) = @_[KERNEL,HEAP]; #Get session ID of component from object, register, #connect to specified server. my $irc_session = $heap->{irc}->session_id(); $kernel->post( $irc_session => register => 'all' ); $kernel->post( $irc_session => connect => { } ); undef; } sub irc_001 { my ($kernel,$sender) = @_[KERNEL,SENDER]; ($mykernel,$mysender)=($kernel,$sender); #Get component's object by accessing heap of SENDER my $poco_object = $sender->get_heap(); print "Connected to ",$poco_object->server_name(),"\n"; #In any irc_* events, the SENDER will be the PoCo IRC session $kernel->post( $sender => join => $_ ) for @channels; $kernel->post( $sender => privmsg => @channels => "identify $password"); # $kernel->post( $sender => privmsg => @channels => ""); undef; } sub irc_public { my ($kernel,$sender,$who,$where,$what) = @_[KERNEL,SENDER,ARG0,ARG1,ARG2]; my $nick = ( split /!/, $who )[0]; my $channel = $where->[0]; #Next lines are commands and how to work with them my @dialogue=&irc_bot_addressed; # print @dialogue; ( $address, undef ) = split(/!/, $dialogue[0]); my $command; my @args; print "<$address> $dialogue[2] \n"; #This is the database of names for which I call people %nickaliases = ( #Anyone with no alias is called by their screenname $address => "$address" ); my ($origalias,undef) = split(/-/, $nickaliases{$address}); #Check the db dbmopen(%nickaliases, 'nickaliases', 0666); unless ( defined $nickaliases{$address} ) {$nickaliases{$address} = $origalias} if ( $address eq 'root') { # $kernel->post( $sender => privmsg => $channel => "yubimusubi: $address said $dialogue[2]" ); } else { # $kernel->post( $sender => privmsg => $channel => "$address: I hear you, $nickaliases{$address}!" ); } ($command,@args) = split(/ /, $dialogue[2]); # print @dialogue[2]; my @randsaying=( "Hi $nickaliases{$address}, I'm BotPossum!", "Sometimes I speak completely randomly.", "I hear you, $nickaliases{$address}!", "I'm bored, give me a cookie.", "You know, $nickaliases{$address}, the bogeyman eats little boys like you." ); if ( $address eq 'yubimusubi-aim' ) { if ( $args[0] eq 'conf' ) { # (undef,@args)=split(/ /, @args ); $kernel->post( $sender => privmsg => $channel => "@args[1..$#args]" ); } } if ($command =~ /possum/){ if ( $args[0] eq 'call' ) { if ( $args[1] eq 'me' ) { unless ($args[2] eq ''){ $nickaliases{$address} = $args[2]; #$kernel->post( $sender => privmsg => $channel => "rename $address $args[2]" ); #$address = $args[2]; $kernel->post( $sender => privmsg => $channel => "$address: I will now call you $nickaliases{$address}." ); } } else { $kernel->post( $sender => privmsg => $channel => "$address: I don't know how to call $args[1]" ); } } elsif ( $args[0] eq 'tell' ) { my $totell = $args[1]; my $protocol; if ($totell =~ /mmailto/ ) { (undef,$totell)=split(/:/,$args[1]); } if ($totell =~ /@/ ) { ( $totell,$protocol) = split(/@/, $totell); if ( $protocol =~ /aim/i or $protocol =~ /aol/i ){ $protocol = 'aim'; $totell="$totell-$protocol"; } elsif ( $protocol =~ /yahoo/i or $protocol =~ /yim/i ) { $protocol = 'yahoo'; $totell = "$totell-$protocol"; } elsif ( $protocol =~ /gmail/i or $protocol =~ /jabber/i or $protocol =~ /gtalk/i ) { #$protocol = 'jabber'; print "\n\n$protocol"; ( $protocol,undef ) = split(/\./, $protocol); $totell = "$totell-$protocol"; print "\n\n$totell\n\n"; } elsif ( $protocol =~ /msn/i ) { $protocol = 'msn'; $totell = "$totell-$protocol"; } elsif ( $protocol =~ /.com/i ) { $kernel->post( $sender => privmsg => $channel => "$address: Assuming MSN!" ); $protocol = 'msn'; $totell = "$totell-$protocol"; } else { $kernel->post( $sender => privmsg => $channel => "$address: You must specify the protocol as screenname\@protocol, where aim, yahoo, msn, and jabber are the understood protocols." ); $protocol = 'NULL'; } my ($hostadd,$hostprot); unless ($protocol eq 'NULL') { ($hostadd,$hostprot) = split(/-/, $address); my $checkname=0; if ( $onlineusers{$totell} == 1) { $checkname=1; } #Let's check if I know them first # foreach my $onname (@namelist) { # if ($onname eq $totell) { # $checkname = 1; # } # } my $newprot; my $toname; #Check once, and try to add the person if not on if ( $checkname == 0) { $newprot = $protocol; if ($protocol eq 'aim'){ $newprot = 'oscar'; } if ($protocol =~ /gmail/i){ $protocol='gmail.com'; $newprot='jabber'; } ($toname,undef) = split(/-/, $totell); $kernel->post( $sender => privmsg => $channel => "add $newprot $toname"); $kernel->post( $sender => privmsg => $channel => "rename $toname $totell" ); } #He might be on now, so we check again if ( $onlineusers{$totell} == 1 ) { $checkname=1;} print $totell,$onlineusers{$totell},"\n"; if ( $checkname == 0) { dbmopen(%messages,"messages.$totell",0666); #Right now we can only have one message.... $messages{number}++; $messages{$messages{number}}="$hostadd\@$hostprot says \"@args[2..$#args]\"..."; dbmclose(%messages); $kernel->post( $sender => privmsg => $channel => "$address: $toname\@$protocol is away. I will give the message to him later."); } else { print "\n$totell\n"; $kernel->post( $sender => privmsg => $channel => "$totell: $hostadd\@$hostprot told me to tell you @args[2..$#args]" ); $kernel->post( $sender => privmsg => $channel => "$address: Message sent to $toname\@$protocol" ); } } } else { $kernel->post( $sender => privmsg => $channel => "$address: You must specify the protocol as screenname\@protocol, where aim, yahoo, msn, and jabber are the understood protocols." ); } } elsif ( $args[0] eq 'set' ) { my %config; dbmopen( %config,"config.$address",0666 ); # my %config = "%config.$address"; if ( $args[1] ) { $config{$args[1]} = $args[2]; } else { print %config,"\n"; $kernel->post( $sender => privmsg => $channel => "$address:",%config ); } dbmclose( %config ); } elsif ( $args[0] eq 'messages' ) { dbmopen(%messages,"messages.$address",0666); # $kernel->post( $sender => privmsg => $channel => "$address: ", %messages ); my @values; # while (my ($key, $value) = each(%messages)){ foreach my $key ( %messages ){ @values = (@values,$messages{$key}); # $kernel->post( $sender => privmsg => $channel => "$address: $messages{$key}"); delete $messages{$key}; } $messages{number}=0; $kernel->post( $sender => privmsg => $channel => "$address: @values"); # $messages{number}=0; dbmclose(%messages); } elsif ( $args[0] eq 'help' ) { if ( $args[1] eq 'help' ) { $kernel->post( $sender => privmsg => $channel => "$address: Well obviously you know how to use this one!" ); } elsif ( $args[1] eq 'call' ) { $kernel->post( $sender => privmsg => $channel => "$address: Say \"call me nick\" replacing \"nick\" with what you want me to call you." ); } elsif ( $args[1] eq 'tell' ) { $kernel->post( $sender => privmsg => $channel => "$address: Say \"tell screenname\@protocol message\" replacing \"screenname\", \"protocol\" and \"message\" appropriately." ); } else { $kernel->post( $sender => privmsg => $channel => "$address: Commands I understand are: help, call, and tell. Type \"help command\" where \"command\" is replaced with the name of the command for more info." ); } } else { unless ( $address eq 'root' ){ my $saying = randint() % @randsaying; $saying = $randsaying[$saying]; $kernel->post( $sender => privmsg => $channel => "$address: $saying"); } } } #CHAT COMMANDS elsif ( $command eq '!help' ) { privmsg($channel, "I can't do much in chat right now."); }elsif ( $command eq 'TOC' or $command eq 'YAHOO' or $command eq 'MSN' or $command eq 'JABBER' ) { # $kernel->post( $sender => ctcp => $channel => "ACTION @args" ); #} elsif ( $command =~ "!kick" ){ if ( $args[1] eq 'Message') { my $protocol; $protocol = 'oscar' if ($command eq 'TOC'); $protocol = 'yahoo' if ($command eq 'YAHOO'); $protocol = 'msn' if ($command eq 'MSN' ); $protocol = 'jabber' if ($command eq 'JABBER'); my ( $addnick,undef ) = split(/:/, $args[5]); my $newprot = $protocol; if ($protocol eq 'oscar') { $newprot = 'aim'; } $kernel->post( $sender => privmsg => $channel => "add $protocol $addnick" ); $address = "$addnick-$protocol"; $kernel->post( $sender => privmsg => $channel => "rename $addnick $address" ); $kernel->post( $sender => privmsg => $channel => "$address: What up, $addnick? I added you to my buddy list" ); } elsif ( $args[1] eq 'New' && $args[2] =~ /request/ ) { privmsg($channel,'yes'); } } #} elsif ($command eq '!np'){ #This requires MPCGet.pm # print '!np\n'; # my $np=MPCout(); # $kernel->post( $sender => privmsg => $channel => "Currently playing: $np" ); #} elsif ( $command =~ /![a-zA-Z_0-9]/ ) { # print "Unkown Command $command!\n"; # $kernel->post( $sender => privmsg => $channel => "@dialogue[0]: Unkown Command\!") ; dbmclose(%nickaliases); undef; } sub _default { my ($kernel,$sender) = (@_[KERNEL,SENDER]); my $channel='&bitlbee'; my ( $event, $args ) = @_[ARG0..$#_]; my @output = ( "$event: " ); my $nick; if ( $event eq 'irc_mode') { $nick = @$args[3]; my $mode = @$args[2]; print "Nick $nick is mode $mode \n"; if ( $mode eq '+v' ) { $onlineusers{$nick}=1; dbmopen(%messages,"messages.$nick",0666); if ( keys(%messages)!=0){ if ( $messages{number}!=0) { $kernel->post( $sender => privmsg => $channel => "$nick: You have $messages{number} messages! Type 'messages' to see them."); } } } elsif ($mode eq '-v') { $onlineusers{$nick}=0; } # $kernel->post( $sender => privmsg => $channel => "$nick: I see you."); } elsif ( $event eq 'irc_quit' ) { # $nick = @$args[0]; ($nick,undef) = split(/!/, @$args[0]); $onlineusers{$nick}=0; print "Nick $nick has quit\n"; } foreach my $arg ( @$args ) { if ( ref($arg) eq 'ARRAY' ) { push( @output, "[" . join(" ,", $arg ) . "]" ); } elsif ( ref($arg) =~ /!/ ) { ( $nick,undef ) = split(/!/, $arg ); } else { push ( @output, "'$arg'" ); } } # print "$nick\n"; # print STDOUT join ' ', @output, "\n"; return 0; } sub irc_bot_addressed { my ( $kernel,$heap ) = @_[KERNEL,HEAP]; my ($nick) = (split /!/, $_[ARG0] )[0]; my ($channel) = $_[ARG1][0]; my ($what) = $_[ARG2]; # $kernel->post( $sender => privmsg => $channel => "$nick: What do you want?" ); # print "$nick addressed me in $channel with the message $what"; return ($nick,$channel,$what); } ##Okay, I stole this sub but I don't think dylan will mind sub randint { open my $hat, "/dev/random" or die "Can't open /dev/random: $!"; my $buf; read $hat, $buf, 1; close $hat; return ord($buf); } sub privmsg { my ($channel,@message)=@_; $mykernel->post( $mysender => privmsg => $channel => "@message" ); }