-
Notifications
You must be signed in to change notification settings - Fork 8
/
Logger.pm
497 lines (409 loc) · 16.6 KB
/
Logger.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
package POE::Component::IRC::Plugin::Logger;
use strict;
use warnings;
use Carp;
use Encode qw(decode);
use Encode::Guess;
use Fcntl qw(O_WRONLY O_APPEND O_CREAT);
use File::Spec::Functions qw(catdir catfile);
use POE::Component::IRC::Plugin qw( :ALL );
use POE::Component::IRC::Plugin::BotTraffic;
use POE::Component::IRC::Common qw( l_irc parse_user strip_color strip_formatting irc_to_utf8);
use POSIX qw(strftime);
our $VERSION = '6.05_01';
sub new {
my ($package) = shift;
croak "$package requires an even number of arguments" if @_ & 1;
my %self = @_;
if (!defined $self{Path}) {
die "$package requires a Path";
}
return bless \%self, $package;
}
sub PCI_register {
my ($self, $irc) = @_;
if (!$irc->isa('POE::Component::IRC::State')) {
die __PACKAGE__ . ' requires PoCo::IRC::State or a subclass thereof';
}
if ( !grep { $_->isa('POE::Component::IRC::Plugin::BotTraffic') } values %{ $irc->plugin_list() } ) {
$irc->plugin_add('BotTraffic', POE::Component::IRC::Plugin::BotTraffic->new());
}
if ($self->{Restricted}) {
$self->{dir_perm} = oct 755;
$self->{file_perm} = oct 644;
}
else {
$self->{dir_perm} = oct 700;
$self->{file_perm} = oct 600;
}
if (! -d $self->{Path}) {
mkdir $self->{Path}, $self->{dir_perm} or die 'Cannot create directory ' . $self->{Path} . ": $!; aborted";
}
$self->{irc} = $irc;
$self->{logging} = { };
$self->{Private} = 1 if !defined $self->{Private};
$self->{Public} = 1 if !defined $self->{Public};
$self->{DCC} = 1 if !defined $self->{DCC};
$self->{Format} = {
'+b' => sub { my ($nick, $mask) = @_; "--- $nick sets ban on $mask" },
'-b' => sub { my ($nick, $mask) = @_; "--- $nick removes ban on $mask" },
'+e' => sub { my ($nick, $mask) = @_; "--- $nick sets exempt on $mask" },
'-e' => sub { my ($nick, $mask) = @_; "--- $nick removes exempt on $mask" },
'+I' => sub { my ($nick, $mask) = @_; "--- $nick sets invite on $mask" },
'-I' => sub { my ($nick, $mask) = @_; "--- $nick removes invite on $mask" },
'+h' => sub { my ($nick, $subject) = @_; "--- $nick gives channel half-operator status to $subject" },
'-h' => sub { my ($nick, $subject) = @_; "--- $nick removes channel half-operator status from $subject" },
'+o' => sub { my ($nick, $subject) = @_; "--- $nick gives channel operator status to $subject" },
'-o' => sub { my ($nick, $subject) = @_; "--- $nick removes channel operator status from $subject" },
'+v' => sub { my ($nick, $subject) = @_; "--- $nick gives voice to $subject" },
'-v' => sub { my ($nick, $subject) = @_; "--- $nick removes voice from $subject" },
'+k' => sub { my ($nick, $key) = @_; "--- $nick sets channel keyword to $key" },
'-k' => sub { my ($nick) = @_; "--- $nick removes channel keyword" },
'+l' => sub { my ($nick, $limit) = @_; "--- $nick sets channel user limit to $limit" },
'-l' => sub { my ($nick) = @_; "--- $nick removes channel user limit" },
'+i' => sub { my ($nick) = @_; "--- $nick enables invite-only channel status" },
'-i' => sub { my ($nick) = @_; "--- $nick disables invite-only channel status" },
'+m' => sub { my ($nick) = @_; "--- $nick enables channel moderation" },
'-m' => sub { my ($nick) = @_; "--- $nick disables channel moderation" },
'+n' => sub { my ($nick) = @_; "--- $nick disables external messages" },
'-n' => sub { my ($nick) = @_; "--- $nick enables external messages" },
'+p' => sub { my ($nick) = @_; "--- $nick enables private channel status" },
'-p' => sub { my ($nick) = @_; "--- $nick disables private channel status" },
'+s' => sub { my ($nick) = @_; "--- $nick enables secret channel status" },
'-s' => sub { my ($nick) = @_; "--- $nick disables secret channel status" },
'+t' => sub { my ($nick) = @_; "--- $nick enables topic protection" },
'-t' => sub { my ($nick) = @_; "--- $nick disables topic protection" },
nick_change => sub { my ($old_nick, $new_nick) = @_; "--- $old_nick is now known as $new_nick" },
topic_is => sub { my ($chan, $topic) = @_; "--- Topic for $chan is: $topic" },
topic_change => sub { my ($nick, $topic) = @_; "--- $nick changes the topic to: $topic" },
privmsg => sub { my ($nick, $msg) = @_; "<$nick> $msg" },
action => sub { my ($nick, $action) = @_; "* $nick $action" },
dcc_start => sub { my ($nick, $address) = @_; "--> Opened DCC chat connection with $nick ($address)" },
dcc_done => sub { my ($nick, $address) = @_; "<-- Closed DCC chat connection with $nick ($address)" },
join => sub { my ($nick, $userhost, $chan) = @_; "--> $nick ($userhost) joins $chan" },
part => sub {
my ($nick, $userhost, $chan, $msg) = @_;
my $line = "<-- $nick ($userhost) leaves $chan";
$line .= " ($msg)" if $msg ne '';
return $line;
},
quit => sub {
my ($nick, $userhost, $msg) = @_;
my $line = "<-- $nick ($userhost) quits";
$line .= " ($msg)" if $msg ne '';
return $line;
},
kick => sub {
my ($kicker, $victim, $chan, $msg) = @_;
my $line = "<-- $kicker kicks $victim from $chan";
$line .= " ($msg)" if $msg ne '';
return $line;
},
topic_set_by => sub {
my ($chan, $user, $time) = @_;
my $date = localtime $time;
return "--- Topic for $chan was set by $user at $date";
},
} if !defined $self->{Format};
$irc->plugin_register($self, 'SERVER', qw(001 332 333 chan_mode
ctcp_action bot_action bot_msg bot_public join kick msg nick part
public quit topic dcc_start dcc_chat dcc_done));
$irc->plugin_register($self, 'USER', 'dcc_chat');
return 1;
}
sub PCI_unregister {
return 1;
}
sub S_001 {
my ($self, $irc) = splice @_, 0, 2;
$self->{logging} = { };
return PCI_EAT_NONE;
}
sub S_332 {
my ($self, $irc) = splice @_, 0, 2;
my $chan = ${ $_[2] }->[0];
my $topic = ${ $_[2] }->[1];
# only log this if we were just joining the channel
$self->_log_entry($chan, topic_is => $chan, $topic) if !$irc->channel_list($chan);
return PCI_EAT_NONE;
}
sub S_333 {
my ($self, $irc) = splice @_, 0, 2;
my ($chan, $user, $time) = @{ ${ $_[2] } };
# only log this if we were just joining the channel
$self->_log_entry($chan, topic_set_by => $chan, $user, $time) if !$irc->channel_list($chan);
return PCI_EAT_NONE;
}
sub S_chan_mode {
my ($self, $irc) = splice @_, 0, 2;
my $nick = parse_user(${ $_[0] });
my $chan = ${ $_[1] };
my $mode = ${ $_[2] };
my $arg = ${ $_[3] };
$self->_log_entry($chan, $mode => $nick, $arg);
return PCI_EAT_NONE;
}
sub S_ctcp_action {
my ($self, $irc) = splice @_, 0, 2;
my $sender = parse_user(${ $_[0] });
my $recipients = ${ $_[1] };
my $msg = ${ $_[2] };
my $me = $irc->nick_name();
for my $recipient (@{ $recipients }) {
if ($recipient eq $me) {
$self->_log_entry($sender, action => $sender, $msg);
}
else {
$self->_log_entry($recipient, action => $sender, $msg);
}
}
return PCI_EAT_NONE;
}
sub S_bot_action {
my ($self, $irc) = splice @_, 0, 2;
my $recipients = ${ $_[0] };
my $msg = ${ $_[1] };
for my $recipient (@{ $recipients }) {
$self->_log_entry($recipient, action => $irc->nick_name(), $msg);
}
return PCI_EAT_NONE;
}
sub S_bot_msg {
my ($self, $irc) = splice @_, 0, 2;
my $recipients = ${ $_[0] };
my $msg = ${ $_[1] };
for my $recipient (@{ $recipients }) {
$self->_log_entry($recipient, privmsg => $irc->nick_name(), $msg);
}
return PCI_EAT_NONE;
}
sub S_bot_public {
my ($self, $irc) = splice @_, 0, 2;
my $channels = ${ $_[0] };
my $msg = ${ $_[1] };
for my $chan (@{ $channels }) {
$self->_log_entry($chan, privmsg => $irc->nick_name(), $msg);
}
return PCI_EAT_NONE;
}
sub S_join {
my ($self, $irc) = splice @_, 0, 2;
my ($joiner, $user, $host) = parse_user(${ $_[0] });
my $chan = ${ $_[1] };
$self->_log_entry($chan, join => $joiner, "$user\@$host", $chan);
return PCI_EAT_NONE;
}
sub S_kick {
my ($self, $irc) = splice @_, 0, 2;
my $kicker = parse_user(${ $_[0] });
my $chan = ${ $_[1] };
my $victim = ${ $_[2] };
my $msg = ${ $_[3] };
$self->_log_entry($chan, kick => $kicker, $victim, $chan, $msg);
return PCI_EAT_NONE;
}
sub S_msg {
my ($self, $irc) = splice @_, 0, 2;
my $sender = parse_user(${ $_[0] });
my $msg = ${ $_[2] };
$self->_log_entry($sender, privmsg => $sender, $msg);
return PCI_EAT_NONE;
}
sub S_nick {
my ($self, $irc) = splice @_, 0, 2;
my $old_nick = parse_user(${ $_[0] });
my $new_nick = ${ $_[1] };
my $channels = @{ $_[2] }[0];
for my $chan (@{ $channels }) {
$self->_log_entry($chan, nick_change => $old_nick, $new_nick);
}
return PCI_EAT_NONE;
}
sub S_part {
my ($self, $irc) = splice @_, 0, 2;
my ($parter, $user, $host) = parse_user(${ $_[0] });
my $chan = ${ $_[1] };
my $msg = ref $_[2] eq 'SCALAR' ? ${ $_[2] } : '';
$self->_log_entry($chan, part => $parter, "$user\@$host", $chan, $msg);
return PCI_EAT_NONE;
}
sub S_public {
my ($self, $irc) = splice @_, 0, 2;
my $sender = parse_user(${ $_[0] });
my $channels = ${ $_[1] };
my $msg = ${ $_[2] };
for my $chan (@{ $channels }) {
$self->_log_entry($chan, privmsg => $sender, $msg);
}
return PCI_EAT_NONE;
}
sub S_quit {
my ($self, $irc) = splice @_, 0, 2;
my ($quitter, $user, $host) = parse_user(${ $_[0] });
my $msg = ${ $_[1] };
my $channels = @{ $_[2] }[0];
for my $chan (@{ $channels }) {
$self->_log_entry($chan, quit => $quitter, "$user\@$host", $msg);
}
return PCI_EAT_NONE;
}
sub S_topic {
my ($self, $irc) = splice @_, 0, 2;
my $changer = parse_user(${ $_[0] });
my $chan = ${ $_[1] };
my $new_topic = ${ $_[2] };
$self->_log_entry($chan, topic_change => $changer, $new_topic);
return PCI_EAT_NONE;
}
sub S_dcc_start {
my ($self, $irc) = splice @_, 0, 2;
my $nick = ${ $_[1] };
my $type = ${ $_[2] };
my $port = ${ $_[3] };
my $addr = ${ $_[6] };
return if $type ne 'CHAT';
$self->_log_entry("=$nick", dcc_start => $nick, "$addr:$port");
return PCI_EAT_NONE;
}
sub S_dcc_chat {
my ($self, $irc) = splice @_, 0, 2;
my $nick = ${ $_[1] };
my $msg = ${ $_[3] };
if (my ($action) = $msg =~ /\001ACTION (.*?)\001/) {
$self->_log_entry("=$nick", action => $nick, $action);
}
else {
$self->_log_entry("=$nick", privmsg => $nick, $msg);
}
return PCI_EAT_NONE;
}
sub U_dcc_chat {
my ($self, $irc) = splice @_, 0, 2;
my ($id, @lines) = @_;
$_ = $$_ for @lines;
my $me = $irc->nick_name();
my ($dcc) = grep { $_->isa('POE::Component::IRC::Plugin::DCC') } values %{ $irc->plugin_list() };
my $info = $dcc->dcc_info($$id);
my $nick = $info->{nick};
for my $msg (@lines) {
if (my ($action) = $msg =~ /\001ACTION (.*?)\001/) {
$self->_log_entry("=$nick", action => $me, $action);
}
else {
$self->_log_entry("=$nick", privmsg => $me, $msg);
}
}
return PCI_EAT_NONE;
}
sub S_dcc_done {
my ($self, $irc) = splice @_, 0, 2;
my $nick = ${ $_[1] };
my $type = ${ $_[2] };
my $port = ${ $_[3] };
my $addr = ${ $_[7] };
return if $type ne 'CHAT';
$self->_log_entry("=$nick", dcc_done => $nick, "$addr:$port");
return PCI_EAT_NONE;
}
sub _log_entry {
my ($self, $context, $type, @args) = @_;
my ($date, $time) = split / /, (strftime '%Y-%m-%d %H:%M:%S ', localtime);
$context = l_irc $context, $self->{irc}->isupport('CASEMAPPING');
if ($context =~ /^[#&+!]/) {
return if !$self->{Public};
}
elsif ($context =~ /^=/) {
return if !$self->{DCC};
}
else {
return if !$self->{Private};
}
return if !defined $self->{Format}->{$type};
# slash is problematic in a filename, replace it with underscore
$context =~ s!/!_!g;
my $log_file;
if ($self->{Sort_by_date}) {
my $log_dir = catdir($self->{Path}, $context);
if (! -d $log_dir) {
mkdir $log_dir, $self->{dir_perm}
or die "Couldn't create directory $log_dir: $!; aborted";
}
$log_file = catfile($self->{Path}, $context, "$date.log");
}
else {
$log_file = catfile($self->{Path}, "$context.log");
}
$log_file = $self->_open_log($log_file);
if (!$self->{logging}->{$context}) {
print $log_file "***\n*** LOGGING BEGINS\n***\n";
$self->{logging}->{$context} = 1;
}
my $line = "$time " . $self->{Format}->{$type}->(@args);
$line = "$date $line" if !$self->{Sort_by_date};
print $log_file $self->_normalize($line) . "\n";
return;
}
sub _open_log {
my ($self, $file_name) = @_;
sysopen(my $log, $file_name, O_WRONLY|O_APPEND|O_CREAT, $self->{file_perm})
or die "Couldn't open or create file '$file_name': $!; aborted";
binmode($log, ':utf8');
$log->autoflush(1);
return $log;
}
sub _normalize {
my ($self, $line) = @_;
$line = irc_to_utf8($line);
$line = strip_color($line) if $self->{Strip_color};
$line = strip_formatting($line) if $self->{Strip_formatting};
return $line;
}
1;
__END__
=head1 NAME
POE::Component::IRC::Plugin::Logger - A PoCo-IRC plugin which
logs public, private, and DCC chat messages to disk
=head1 SYNOPSIS
use POE::Component::IRC::Plugin::Logger;
$irc->plugin_add('Logger', POE::Component::IRC::Plugin::Logger->new(
Path => '/home/me/irclogs',
Private => 0,
Public => 1,
));
=head1 DESCRIPTION
POE::Component::IRC::Plugin::Logger is a L<POE::Component::IRC|POE::Component::IRC>
plugin. It logs messages and CTCP ACTIONs to either F<#some_channel.log> or
F<some_nickname.log> in the supplied path. In the case of DCC chats, a '=' is
prepended to the nickname (like in irssi).
The plugin tries to detect UTF-8 encoding of every message or else falls back
to CP1252, like irssi (and, supposedly, mIRC) does by default. Resulting log
files will be UTF-8 encoded. The default log format is similar to xchat's,
except that it's sane and parsable.
This plugin requires the IRC component to be L<POE::Component::IRC::State|POE::Component::IRC::State>
or a subclass thereof. It also requires a L<POE::Component::IRC::Plugin::BotTraffic|POE::Component::IRC::Plugin::BotTraffic>
to be in the plugin pipeline. It will be added automatically if it is not
present.
=head1 METHODS
=head2 C<new>
Arguments:
B<'Path'>, the place where you want the logs saved.
B<'Private'>, whether or not to log private messages. Defaults to 1.
B<'Public'>, whether or not to log public messages. Defaults to 1.
B<'DCC'>, whether or not to log DCC chats. Defaults to 1.
B<'Sort_by_date'>, whether or not to split log files by date, i.e.
F<#channel/YYYY-MM-DD.log> instead of F<#channel.log>. If enabled, the date
will be omitted from the timestamp. Defaults to 0.
B<'Strip_color'>, whether or not to strip all color codes from messages. Defaults
to 0.
B<'Strip_formatting'>, whether or not to strip all formatting codes from messages.
Defaults to 0.
B<'Restricted'>, set this to 1 if you want all directories/files to be created
without read permissions for other users (i.e. 700 for dirs and 600 for files).
Defaults to 0.
B<'Format'>, a hash reference representing the log format, if you want to define
your own. See the source for details.
Returns a plugin object suitable for feeding to
L<POE::Component::IRC|POE::Component::IRC>'s C<plugin_add> method.
=head1 AUTHOR
Hinrik E<Ouml>rn SigurE<eth>sson, hinrik.sig@gmail.com
=cut