Last active
November 3, 2017 01:51
-
-
Save Warr1024/4298907 to your computer and use it in GitHub Desktop.
Simple Perl IRC bot that connects to a single IRC channel and passively listens and logs conversations to STDOUT. (C)2012 Warr1024, MIT License.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl -w | |
use strict; | |
use warnings; | |
use diagnostics qw(-t -w); | |
use POSIX; | |
use Getopt::Long qw(:config no_ignore_case bundling_override auto_help); | |
use Bot::BasicBot; | |
my $ircserver = 'localhost'; | |
my $ircport = 6667; | |
my $channel = ''; | |
my $nick = ''; | |
my $username = ''; | |
my $realname = ''; | |
my $nickpass = ''; | |
GetOptions( | |
"s=s" => \$ircserver, | |
"p=i" => \$ircport, | |
"c=s" => \$channel, | |
"n=s" => \$nick, | |
"u=s" => \$username, | |
"N=s" => \$realname, | |
"P=s" => \$nickpass); | |
$channel or die('No channel specified'); | |
$nick or die('No nick specified'); | |
$username or $username = $nick; | |
$realname or $realname = $nick; | |
$0 =~ m#([^/]*)$#; | |
my $app = $1; | |
$0 = $app; | |
select STDOUT; | |
$| = 1; | |
eval | |
{ | |
package LogBot; | |
use POSIX; | |
use base 'Bot::BasicBot'; | |
sub log | |
{ | |
my $self = shift(); | |
my $msg = join(' ', @_); | |
chomp($msg); | |
my $now = time(); | |
my $line = $ircserver . ':' . $ircport . ' ' . $channel . ' ' . | |
strftime("%Y-%m-%d %H:%M:%S", gmtime(time)) . ' ' . $msg . $/; | |
print $line; | |
} | |
sub connected | |
{ | |
my $self = $_[0]; | |
$self->{lastevt} = time(); | |
$nickpass and $self->say(who => 'nickserv', channel => 'msg', | |
body => 'IDENTIFY ' . $nickpass); | |
$self->schedule_tick(1); | |
} | |
sub announcenames | |
{ | |
my $self = $_[0]; | |
my $raw = $self->channel_data($channel); | |
$raw or return; | |
my %chan = %{$raw}; | |
my %who = ( ); | |
my %flags = ( ); | |
my $safe = ''; | |
for my $n ( keys %chan ) | |
{ | |
my $f = ''; | |
$chan{$n}{op} and $f .= '@'; | |
$chan{$n}{voice} and $f .= '+'; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
$who{$n} = 1; | |
$flags{$n} = $f; | |
$n eq $nick and $safe = 1; | |
} | |
if(!$safe) | |
{ | |
$self->log('Shutting Down: Kicked'); | |
exit(0); | |
} | |
my $names = join(', ', map { $flags{$_} . $_ } sort { lc($a) cmp lc($b) } keys(%who)); | |
my $ids = $self->{rawnicks} || { }; | |
for my $n ( keys %{$ids} ) | |
{ | |
$who{$n} or delete($ids->{$n}); | |
} | |
$self->{rawnicks} = $ids; | |
my $old = $self->{channames} || ''; | |
if($old ne $names) | |
{ | |
$self->log('Names: ' . $names); | |
$self->{channames} = $names; | |
} | |
} | |
sub tick | |
{ | |
my $self = $_[0]; | |
my $now = time(); | |
my $le = $self->{lastevt}; | |
$le or ($le, $self->{lastevt}) = ($now, $now); | |
$le < ($now - 90) and $self->fail('event timeout'); | |
$le < ($now - 60) and $self->say(who => $self->nick, channel => 'msg', body => 'ping'); | |
$self->announcenames(); | |
return 1; | |
} | |
sub topic | |
{ | |
my ($self, $msg) = @_; | |
my $w = $msg->{who} || ''; | |
$w and $w = ' (set by ' . $w . ')'; | |
$self->log('Topic' . $w . ':', $msg->{topic}); | |
} | |
sub nick_change | |
{ | |
my ($self, $old, $new) = @_; | |
$self->{lastevt} = time(); | |
$old =~ s#_+$##; | |
$old =~ s#^_+##; | |
$new =~ s#_+$##; | |
$new =~ s#^_+##; | |
$self->log('Nick Change:', $old, '->', $new); | |
return undef; | |
} | |
sub said | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
my $body = $msg->{body}; | |
my $n = $msg->{who}; | |
$n eq $self->nick and return; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
if($msg->{address}) | |
{ | |
$msg->{address} eq 'msg' and return undef; | |
$body = $msg->{address} . $body; | |
} | |
my $r = $msg->{raw_nick}; | |
if($r) | |
{ | |
my $ids = $self->{rawnicks} || { }; | |
if(($ids->{$n} || '') ne $r) | |
{ | |
$ids->{$n} = $r; | |
$self->log('User Name:', $n, '=', $r); | |
} | |
$self->{rawnicks} = $ids; | |
} | |
$self->log('<' . $n . '>', $body); | |
return undef; | |
} | |
sub emoted | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
my $body = $msg->{body}; | |
my $n = $msg->{who}; | |
$n eq $self->nick and return; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
if($msg->{address}) | |
{ | |
$msg->{address} eq 'msg' and return undef; | |
$body = $msg->{address} . $body; | |
} | |
$self->log('*', $n, $body); | |
return undef; | |
} | |
sub chanjoin | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
$self->names($msg->{channel}); | |
my $n = $msg->{who}; | |
$n eq $self->nick and return; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
$self->log('Joined:', $n); | |
return undef; | |
} | |
sub chanpart | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
$self->names($msg->{channel}); | |
my $n = $msg->{who}; | |
$n eq $self->nick and exit 1; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
$self->log('Parted:', $n); | |
return undef; | |
} | |
sub kicked | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
$self->names($msg->{channel}); | |
my $n = $msg->{who}; | |
$n eq $self->nick and exit 1; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
$msg->{reason} and $n .= ' (' . $msg->{reason} . ')'; | |
$self->log('Kicked:', $n); | |
return undef; | |
} | |
sub userquit | |
{ | |
my ($self, $msg) = @_; | |
$self->{lastevt} = time(); | |
$self->names($channel); | |
my $n = $msg->{who}; | |
$n eq $self->nick and exit 1; | |
$n =~ s#_+$##; | |
$n =~ s#^_+##; | |
$msg->{body} and $n .= ' (' . $msg->{body} . ')'; | |
$self->log('Quit:', $n); | |
return undef; | |
} | |
sub got_names | |
{ | |
my $self = $_[0]; | |
$self->{lastevt} = time(); | |
$self->announcenames(); | |
} | |
sub irc_disconnected_state | |
{ | |
my $self = $_[0]; | |
exit 1; | |
} | |
sub irc_error_state | |
{ | |
my ( $self, $err, $kernel ) = @_[ 0, 10, 2 ]; | |
exit 1; | |
} | |
}; | |
my $bot = LogBot->new( | |
server => $ircserver, | |
port => $ircport, | |
channels => ( $channel ), | |
nick => $nick, | |
username => $username, | |
realname => $realname | |
); | |
for my $s ( 'TERM', 'INT', 'HUP', 'ALRM', 'PIPE' ) | |
{ | |
$SIG{$s} = sub { $bot->log('Shutting Down:', @_); exit 0; }; | |
} | |
$bot->run(); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment