### NOTE: Bot is optomised for Quakenet, using their AUTH system.
### It may in fact fail to work on other networks
use strict;
use IO::Socket;
use Switch;
use LWP::UserAgent;
# Pointless info hash, wooo!
my %info = (
Version => "0.2b",
Author => "Erasmus, with much help from Al",
Description => "A basic IRC bot with a few functions"
);
# Variables to control some parts of the script. Most of these are pretty obvious.
my $channel_rejoin = 1;
my $kick_retaliate = 1; # This one doesn't work, and I'm not sure why.
my $invite_respond = 1;
my $quoting = 1; # Sets the logging of new quotes, !quote will be available even if this is set to 0
# The server to connect to and various connect details.
my $server = "irc.quakenet.org";
my $mynick = "eeeee";
my $login = "eeeee";
# A message commands hash. A hash of commands that can be contained in messages, as you may guess.
my %msgcommands = (
qr/^!tea$/ => 'unprotected_command("tea",$who{Nick},$target)',
qr/^!tea (.+$)/ => 'unprotected_command("teafoo",$who{Nick},$target,$params)',
qr/^!grue$/ => 'unprotected_command("grue",$who{Nick},$target)',
qr/^!grue (.+$)/ => 'unprotected_command("gruefoo",$who{Nick},$target,$params)',
qr/(\W|^)life(\W|$)/ => 'unprotected_command("life",$who{Nick},$target)',
qr/^!g (.+$)/ => 'unprotected_command("google",$who{Nick},$target,$params)',
qr/^die$/ => 'protected_command("die",$who{Nick},$target)',
qr/^!insult (.+$)/ => 'unprotected_command("insult",$who{nick},$target,$params)',
qr/^hai2u, $mynick/ => 'unprotected_command("hai", $who{nick},$target)',
qr/^!topic (\S+$)/ => 'unprotected_command("get_topic",$who{nick},$target,$params)'
);
# A part commands hash. Similar to %msgcommands but with PART not PRIVMSG
my %partcommands = (
qr/^aaaarrrrghh\!\!\! \*crunch\*$/ => 'unprotected_command("crunch",$who{Nick},$target)'
);
# The channel(s) which the bot will join.
my @channels = qw(#rtere);
# Channel hash with one example channel. The channel hash is as yet unimplemented in any meaningful way.
my %channels = (
'#falsechannel' => (
users => 3,
nicklist => qw(foo bar baz),
modes => qw(t m n),
status => 'operator',
topic => 'Yaaah'
)
);
# Individuals hash that tracks users
my %individuals = (
'false!user@somewhere.lol' => (
channels => qw(#falsechannel),
auth => 'bleh',
nick => 'foobarface'
)
);
# List of trusted auths
my @trusted = qw(
Erasmu1
Shiyiya
);
# Connect to the IRC server.
my $sock = new IO::Socket::INET(PeerAddr => $server, PeerPort => 6667, Proto => 'tcp') or die "Can't connect!\n";
# Log on to the server.
print $sock "NICK $mynick\r\n";
print $sock "USER $login 8 * :eeeee, the once and future bot!\r\n";
# Keep reading lines from the server.
while (my $input = <$sock>) {
# Parsing (such as it is)
$input =~ s/\r\n//g;
my @stream = split(' ',$input,4);
# Print input to console
print "$input\n";
###
### @stream[0] contains info on who sent the data (*!*@* format) and PING if it's a ping.
### @stream[1] contains number code [001 is just connected code] or message type (such as PRIVMSG)
### @stream[2] holds the target of the message, so generally either a channel name or the bot's nick.
### @stream[3] contains any other things, such as messages and whatnot.
###
# Deal with PINGs
if (@stream[0] eq "PING") {
print $sock "PONG @stream[1]\r\n";
print "PING answered.\n";
}
# Change my nick if some cunt has stolen it.
if (@stream[1] eq "433") {
$mynick = $mynick."e";
print $sock "NICK $mynick\r\n";
}
# Join channels and other just-connected-things
if (@stream[1] eq "001") {
print "Connected!\n";
# Join the channels
map { print $sock "JOIN $_\r\n" } @channels;
# Quakenet AUTH /msg Q@CServe.quakenet.org AUTH I-R-A-RBOT A3kFmuoN7P, and add Qnet hostmask
action ("message","Q\@CServe.quakenet.org","AUTH I-R-A-RBOT A3kFmuoN7P");
action ("selfmode", "+x");
}
# Grab channel data and basic user data:
# First, get the topic for all channels
if (@stream[1] eq "332") {
my @t = split(' :',@stream[3],2);
$channels{$t[0]}{topic} = $t[1];
}
# Then, get the userlists
if (@stream[1] eq "353") {
my @t = split(' ',@stream[3]);
my $chan_list = $t[1];
splice (@t, 0, 3);
foreach my $r (@t) {
#push ($channels{$chan_list}{nicklist}, $r);
$individuals{known} = 1;
#push ($individuals{$r}{channels}, $chan_list);
}
}
# A little bit of parsing...
@stream[0] =~ s/://;
my %who = host_parse(@stream[0]);
my $target = @stream[2];
@stream[3] =~ s/://;
# Message commands
if (@stream[1] eq "PRIVMSG") {
my @catches = grep { @stream[3] =~ $_ } keys %msgcommands;
my $params = (@stream[3] =~ @catches[0])[0];
## print "\n\n\nP: $params\n\n\n";
if(scalar @catches) {
my $eval = $msgcommands{$catches[0]};
eval $eval;
}
}
if (@stream[1] eq "PART") {
my @catches = grep { @stream[3] =~ $_ } keys %partcommands;
my $params = (@stream[3] =~ @catches[0])[0];
if(scalar @catches) {
my $eval = $partcommands{$catches[0]};
eval $eval;
}
}
# I have been kicked, ohno!
if (@stream[1] eq "KICK" && @stream[3] =~ /^$mynick/) {
# If we're allowed, rejoin.
if ($channel_rejoin) {
action("join",@stream[2]);
}
# If we're allowed, kick the fucker.
if ($kick_retaliate) {
sleep 2;
action("kick",@stream[2],"$who{Nick} :NO U!");
}
}
# I have been invited, YAY!
if (@stream[1] eq "INVITE") {
# If we're allowed, join and say hi.
if ($invite_respond) {
action("join",@stream[3]);
action("action",@stream[3],"sits on ".$who{Nick});
}
}
}
# Unprotected commands
sub unprotected_command {
my ($command, $nick, $target, $param) = @_;
if ($command eq "tea") { action ("action",$target,"pours tea on $nick"); }
if ($command eq "teafoo") { action ("action",$target,"pours tea on $param"); }
if ($command eq "grue") {
my @nicklist = nick_list($target);
action ("message",$target,@nicklist[int(rand()*scalar(@nicklist))]." was eaten by a grue!");
}
if ($command eq "gruefoo") { action ("message",$target,"$param was eaten by a grue!"); }
if ($command eq "life") { action ("message",$target,"Life. Don't talk to me about life."); }
if ($command eq "google") {
my @results = google($param);
map { action ("message",$target,$_) } @results ;
}
if ($command eq "insult") {
my $insult = make_insult();
action ("message",$target,$param.", ".$insult."!");
}
if ($command eq "crunch" && lc($nick) eq "vurl") {
action ("message",$target,"Oh no! Vurl, come back!");
sleep 2;
action ("invite","vurl",$target);
}
if ($command eq "hai" && lc($nick) eq "vurl") {
print "\n\n\n\n\n\n\n\n\n\n\n\n";
action ("message",$target,"hai2u, vurl! ^_^");
}
if ($command eq "get_topic") {
action ("message",$target,"topic is ".$channels{$target}{topic});
}
}
# Protected commands
sub protected_command {
my ($command, $nick, $target, $param) = @_;
my $auth = auth($nick);
my $access = scalar grep {$_ eq $auth} @trusted;
if (!$access) { return 0; }
if ($command eq "die") { action ("message",$target,"Ouch!"); exit "im ded"; }
}
# Retrieves a list of people on a channel.
sub nick_list {
my $channel = shift;
# Send a request to the server and retrieve the reply.
print $sock "NAMES $channel\r\n";
my $names = <$sock>;
# Oh good, more parsing.
$names =~ s/\r\n//g;
$names =~ s/(.*):(.*):(.*)/\3/;
$names =~ s/@//g;
# Print names to console for good measure.
print $names."\n";
# Split and return
my @list = split (" ",$names);
return @list;
}
# Parses a host of format foo!bar@baz into a hash.
sub host_parse {
# Parse, parse, parse...
my $host = shift;
$host =~ /(.+)\!(.+)\@(.+)/;
# Stick the result in a hash, for ease of access
my %parsed_host = (
Nick => $1,
Ident => $2,
Host => $3
);
# Return the hash
return %parsed_host;
}
# Gets some whois info on a nickname and parses it to something vaguely readable.
sub whois {
my $nick = shift;
print "\n\nwhois invoked\n\n";
# Send a request to the server and retrieve the reply.
print $sock "WHOIS $nick\r\n";
my $whois = <$sock>;
#Print to console
print "\n".$whois."\n\n";
# DJ... parse dat shit!
$whois =~ s/\r\n//g;
$whois =~ s/://g;
# If nickname does no exist return 0
if ($whois =~ /401.*No such nick/) {
return 0;
}
# Extract me some variables
my ($ident, $vhost) = ( $whois =~ /311 .* .* (.*) (.*) \*/ );
my $host = $nick."!".$ident."@".$vhost;
return $host;
}
# Streamlines sending messages to the server
sub action {
my ($action_type, $location, $parameters) = @_;
my $action;
# Work out exactly what we need to send to the server
switch (lc($action_type)) {
case "message" { $action = "PRIVMSG $location :$parameters\r\n" }
case "action" { $action = "PRIVMSG $location :\001ACTION $parameters \001\r\n" }
case "join" { $action = "JOIN $location\r\n" }
case "part" { $action = "PART $location\r\n" }
case "invite" { $action = "INVITE $location $parameters\r\n" }
case "kick" { $action = "KICK $location $parameters\r\n" }
case "selfmode" { $action = "MODE $mynick $location\r\n" }
else { return 0; }
}
# Send it and return. No additional parsing required.
print $sock $action;
return 1;
}
# Queries google and parses the result
sub google {
my $search = shift;
$search =~ s/\s/+/g;
# Get the page (I really, really don't understand this chunk o' code)
my $ua = new LWP::UserAgent;
$ua->agent("AgentName/0.1 " . $ua->agent);
my $req = new HTTP::Request GET => "http://www.google.com/search?hl=en&q=$search";
my $res = $ua->request($req);
my $content = $res->content;
# Some horrific parsing
$content =~ s/\"http:\/\/.*?(google\.com).*?\"//g;
my @s = ($content =~ /\"(http:\/\/.*?)\"/g);
my @results;
# Remove google cache urls in a rather clumsy manner.
foreach my $url (@s) {
if ($url !~ /cache/) {
push @results, $url;
}
}
# splice to three results
splice (@results,3);
#Return
return @results
}
# Finds out if someone is auth'd
sub auth {
my $nick = shift;
print "\n\nwhois invoked on $nick\n\n";
# Send a request to the server and retrieve the reply.
print $sock "WHOIS $nick\r\n";
my $whois;
while (<$sock>) {
$whois = <$sock>;
#Print to console
#print "\n".$whois."\n\n";
# Some parsing that I don't think is needed, but can't be bothered to test
$whois =~ s/\r\n//g;
print "\n".$whois."\n";
# If nickname does no exist return 0
if ($whois =~ /401.*No such nick|End of \/WHOIS/) {
return 0;
}
# Find the auth and return it
if ($whois =~ /330 .* (.+?) :is/) {
my $auth = $1;
print "found:: $auth\n\n";
return $auth;
}
}
# Return 0 if not auth'd
return 0;
}
# Sub for the insult command
sub make_insult {
my @one = qw(
artless bawdy beslubbering bootless churlish cockered clouted craven currish dankish dissembling droning errant fawning
fobbing froward frothy gleeking goatish gorbellied impertinent infectious jarring loggerheaded lumpish mammering mangled
mewling paunchy pribbling puking puny qualling rank reeky roguish ruttish saucy spleeny spongy surly tottering unmuzzled
vain venomed villainous warped wayward weedy yeasty
);
my @two = qw(
base-court bat-fowling beef-witted beetle-headed boil-brained clapper-clawed clay-brained common-kissing crook-pated
dismal-dreaming dizzy-eyed doghearted dread-bolted earth-vexing elf-skinned fat-kidneyed fen-sucked flap-mouthed fly-bitten
folly-fallen fool-born full-gorged guts-griping half-faced hasty-witted hedge-born hell-hated idle-headed ill-breeding
ill-nurtured knotty-pated milk-livered motley-minded onion-eyed plume-plucked pottle-deep pox-marked reeling-ripe
rough-hewn rude-growing rump-fed shard-borne sheep-biting spur-galled swag-bellied tardy-gaited tickle-brained toad-spotted
unchin-snouted weather-bitten
);
my @three = qw(
apple-john baggage barnacle bladder boar-pig bugbear bum-bailey canker-blossom clack-dish clotpole coxcomb codpiece death-token
dewberry flap-dragon flax-wench flirt-gill foot-licker fustilarian giglet gudgeon haggard harpy hedge-pig horn-beast
hugger-mugger joithead lewdster lout maggot-pie malt-worm mammet measle minnow miscreant moldwarp mumble-news nut-hook
pigeon-egg pignut puttock pumpion ratsbane scut skainsmate strumpet varlot vassal whey-face wagtail
);
my $partone = @one[int(rand()*scalar(@one))];
my $parttwo = @two[int(rand()*scalar(@two))];
my $partthree = @three[int(rand()*scalar(@three))];
return "thou ".$partone." ".$parttwo." ".$partthree;
}