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 }