]> git.somenet.org - irc/bugbot.git/blob - BotModules/XMLLogger.bm
GITOLITE.txt
[irc/bugbot.git] / BotModules / XMLLogger.bm
1 # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
2 ################################
3 # XMLLogger Module             #
4 ################################
5 # Original Author: Matt Jones
6 # National Center for Ecological Analysis and Synthesis (NCEAS)
7 # University of California Santa Barbara
8 #
9 # This package creates an XML log file of the messages sent to IRC channels
10 # which mozbot has joined.  The content that is logged can be selected using
11 # regular expression filters, although by default all messages are logged
12
13 package BotModules::XMLLogger;
14 use vars qw(@ISA);
15 @ISA = qw(BotModules);
16 1;
17
18 sub Help {
19     my $self = shift;
20     my ($event) = @_;
21     my $help = {
22         '' => 'This module keeps an XML log of channels.',
23     };
24     if ($self->isAdmin($event)) {
25         $help->{''} .= ' It can be configured to only accept messages matching certain patterns. The \'acceptedPatterns\' module variable is a list of regular expressions to use when determining what to log. The \'blockedPatterns\' list is the opposite.';
26         $help->{'rotatelogs'} = 'Creates a new log file for each channel and moves the old one to a date-stamped version, making sure that the XML is valid. Syntax: \'rotatelogs\'.';
27     }
28     return $help;
29 }
30
31 # RegisterConfig - Called when initialised, should call registerVariables
32 sub RegisterConfig {
33     my $self = shift;
34     $self->SUPER::RegisterConfig(@_);
35     $self->registerVariables(
36       # [ name, save?, settable? ]
37         ['acceptedPatterns', 1, 1, ['']], # by default match everything
38         ['blockedPatterns', 1, 1, []], # by default block nothing
39     );
40 }
41
42 sub Told {
43     my $self = shift;
44     my ($event, $message) = @_;
45     if ($self->isAdmin($event)) {
46         if ($message =~ /^\s*rotate\s*logs?\s*$/osi) {
47             $self->RotateLogs($event);
48         } else {
49             return $self->SUPER::Told(@_);
50         }
51     } else {
52         return $self->SUPER::Told(@_);
53     }
54     return 0; # we've dealt with it, no need to do anything else.
55 }
56
57 sub Log {
58     my $self = shift;
59     my ($event) = @_;
60     if (($event->{'firsttype'} eq 'Told') or
61         ($event->{'firsttype'} eq 'Heard')) {
62         $self->DoLog($event, 'msg');
63     } elsif (($event->{'firsttype'} eq 'Felt') or
64              ($event->{'firsttype'} eq 'Saw')) {
65         $self->DoLog($event, 'emote');
66     } elsif (($event->{'firsttype'} eq 'SpottedKick') or
67              ($event->{'firsttype'} eq 'Kicked')) {
68         $self->DoLog($event, 'kick');
69     } elsif ($event->{'firsttype'} eq 'SpottedPart') {
70         $self->DoLog($event, 'part');
71     } elsif ($event->{'firsttype'} eq 'SpottedQuit') {
72         $self->DoLog($event, 'quit');
73     } elsif ($event->{'firsttype'} eq 'SpottedJoin') {
74         $self->DoLog($event, 'join');
75     } elsif ($event->{'firsttype'} eq 'SpottedNickChange') {
76         $self->DoLog($event, 'nick');
77     } elsif ($event->{'firsttype'} eq 'ModeChange') {
78         $self->DoLog($event, 'mode');
79     } elsif ($event->{'firsttype'} eq 'SpottedTopicChange') {
80         $self->DoLog($event, 'topic');
81     } # XXX should log notices
82     return $self->SUPER::Log(@_);
83 }
84
85 sub DoLog {
86     my $self = shift;
87     my ($event, $messageType) = @_;
88     if ($event->{'channel'} ne '') { # don't log private messages
89         foreach my $pattern (@{$self->{'acceptedPatterns'}}) {
90             my $regexp = $self->sanitizeRegexp($pattern);
91             if (($regexp eq '') ||
92                 ($event->{'fulldata'} =~ /$regexp/s) ||
93                 ($event->{'from'} =~ /$regexp/s)) {
94                 # wohay, we have a candidate!
95                 # now check for possible blockers...
96                 unless ($self->isBlocked($event)) {
97                     $self->WriteMessage($event->{'time'},
98                                         $event->{'channel'},
99                                         $event->{'from'},
100                                         $event->{'fulldata'},
101                                         $messageType);
102                     return; # only store each message once, regardless of how many patterns it matches
103                 }
104             }
105         }
106     }
107 }
108
109 sub isBlocked {
110     my $self = shift;
111     my ($event) = @_;
112     foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
113         my $regexp = $self->sanitizeRegexp($blockedPattern);
114         if ($event->{'data'} =~ /$regexp/s) {
115             return 1;
116         }
117     }
118     return 0;
119 }
120
121 sub WriteMessage {
122     my $self = shift;
123     my ($time, $channel, $from, $message, $messageType) = @_;
124     # Open the log file and append the message
125     $channel = $self->sanitiseChannelName($channel);
126     my $logName = $self->getLogFilename("$channel.xml.part");
127     if (open(LOG, ">>$logName")) {
128         my $msgtime = $self->logdate($time);
129         # sanitise the output
130         $_ = $self->escapeXML($_) for ($messageType, $channel, $from, $msgtime, $message);
131         print LOG "<$messageType channel=\"$channel\" nick=\"$from\" time=\"$msgtime\">$message</$messageType>\n";
132         close(LOG);
133     } else {
134         $self->debug("Error logging, failed to open log $logName");
135     }
136 }
137
138 sub RotateLogs {
139     my $self = shift;
140     my ($event) = @_;
141     my $errors = 0;
142     foreach my $channel (@{$self->{'channels'}}) {
143         $self->debug("Rotating log for $channel...");
144         # XXX could (optionally) output message to channel saying so
145         $errors += $self->RotateLogFile($event, $channel);
146     }
147     $errors = $errors == 1 ? "$errors error" : "$errors errors";
148     $self->say($event, "Finished rotating logs, $errors.");
149 }
150
151 sub RotateLogFile {
152     my $self = shift;
153     my ($event, $channel) = @_;
154
155     # create new names
156     $channel = $self->sanitiseChannelName($channel);
157     my $time = $self->filedate($event->{'time'});
158     my $partName = $self->getLogFilename("$channel.xml.part");
159     my $finalName = $self->getLogFilename("$channel-$time.xml");
160
161     # try to finalise file
162     if (-e $finalName) {
163         $self->debug("error rotating log for $channel, destination already existed");
164         return 1; # report error
165     } elsif (not (-e $partName and -s $partName)) {
166         $self->debug("skipping $channel log rotation, log was empty");
167         return 0; # not an error condition
168     } elsif (open(FinalLog, ">$finalName")) {
169         # opened new file, add the XML and copy the data over
170         print FinalLog "<?xml version=\"1.0\"?>\n"; # XXX optional -- do we really want to add this?
171         print FinalLog "<irclog>\n";
172         open(PartLog, "<$partName"); # XXX error checking
173         while (defined($_ = <PartLog>)) {
174             print FinalLog;
175         }
176         close(PartLog);
177         print FinalLog "</irclog>";
178         close(FinalLog);
179         unlink($partName); # delete the part log, ready for new data
180     } else {
181         $self->debug("error rotating log for $channel, failed to open $finalName");
182         return 1; # doh, report error
183     }
184     return 0
185 }
186
187 # logdate: return nice looking date and time stamp
188 sub logdate {
189     my $self = shift;
190     my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
191     return sprintf("%d-%02d-%02dT%02d:%02d:%02dZ", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
192 }
193
194 # return a date and time stamp suitable for file names
195 sub filedate {
196     my $self = shift;
197     my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
198     return sprintf('%d%02d%02d-%02d%02d%02d', $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
199 }
200
201 sub sanitiseChannelName {
202     my $self = shift;
203     my($channel) = @_;
204     $channel =~ s/([^\#&+a-zA-Z0-9-])//gosi; # sanitize
205     $channel =~ m/^(.*)$/os; # detaint
206     return $1;
207 }
208
209 # escape XML characters as needed
210 sub escapeXML {
211     my $self = shift;
212     my ($string) = @_;
213     $string =~ s/&/&amp;/gos;
214     $string =~ s/'/&apos;/gos;
215     $string =~ s/"/&quot;/gos;
216     $string =~ s/</&lt;/gos;
217     $string =~ s/>/&gt;/gos;
218     return $string;
219 }