Debbugs/Log.pm

   1 package Debbugs::Log;
   2
   3 use strict;
   4
   5 use Exporter ();
   6 use vars qw($VERSION @ISA @EXPORT);
   7
   8 BEGIN {
   9     $VERSION = 1.00;
  10
  11     @ISA = qw(Exporter);
  12     @EXPORT = qw(read_log_records write_log_records);
  13 }
  14
  15 =head1 NAME
  16
  17 Debbugs::Log - an interface to debbugs .log files
  18
  19 =head1 DESCRIPTION
  20
  21 The Debbugs::Log module provides a convenient way for scripts to read and
  22 write the .log files used by debbugs to store the complete textual records
  23 of all bug transactions.
  24
  25 =head2 The .log File Format
  26
  27 .log files consist of a sequence of records, of one of the following four
  28 types. ^A, ^B, etc. represent those control characters.
  29
  30 =over 4
  31
  32 =item incoming-recv
  33
  34   ^G
  35   [mail]
  36   ^C
  37
  38 C<[mail]> must start with /^Received: \(at \S+\) by \S+;/, and is copied to
  39 the output.
  40
  41 =item autocheck
  42
  43 Auto-forwarded messages are recorded like this:
  44
  45   ^A
  46   [mail]
  47   ^C
  48
  49 C<[mail]> must contain /^X-Debian-Bugs(-\w+)?: This is an autoforward from
  50 \S+/. The first line matching that is removed; all lines in the message body
  51 that begin with 'X' will be copied to the output, minus the 'X'.
  52
  53 Nothing in debbugs actually generates this record type any more, but it may
  54 still be in old .logs at some sites.
  55
  56 =item recips
  57
  58   ^B
  59   [recip]^D[recip]^D[...] OR -t
  60   ^E
  61   [mail]
  62   ^C
  63
  64 Each [recip] is output after "Message sent"; C<-t> represents the same
  65 sendmail option, indicating that the recipients are taken from the headers
  66 of the message itself.
  67
  68 =item html
  69
  70   ^F
  71   [html]
  72   ^C
  73
  74 [html] is copied unescaped to the output. The record immediately following
  75 this one is considered "boring" and only shown in certain output modes.
  76
  77 (This is a design flaw in the log format, since it makes it difficult to
  78 change the HTML presentation later, or to present the data in an entirely
  79 different format.)
  80
  81 =back
  82
  83 No other types of records are permitted, and the file must end with a ^C
  84 line.
  85
  86 =head2 Perl Record Representation
  87
  88 Each record is a hash. The C<type> field is C<incoming-recv>, C<autocheck>,
  89 C<recips>, or C<html> as above; C<text> contains text from C<[mail]> or
  90 C<[html]> as above; C<recips> is a reference to an array of recipients
  91 (strings), or undef for C<-t>.
  92
  93 =head1 FUNCTIONS
  94
  95 =over 4
  96
  97 =item read_log_records
  98
  99 Takes a .log filehandle as input, and returns an array of all records in
 100 that file. Throws exceptions using die(), so you may want to wrap this in an
 101 eval().
 102
 103 =cut
 104
 105 sub read_log_records (*)
 106 {
 107     my $logfh = shift;
 108
 109     # This comes from bugreport.cgi, but is much simpler since it doesn't
 110     # worry about the details of output.
 111
 112     my %states = (
 113         1 => 'autocheck',
 114         2 => 'recips',
 115         3 => 'kill-end',
 116         5 => 'go',
 117         6 => 'html',
 118         7 => 'incoming-recv',
 119     );
 120
 121     my @records;
 122
 123     my $normstate = 'kill-init';
 124     my $linenum = 0;
 125     my $record = {};
 126
 127     while (defined (my $line = <$logfh>)) {
 128         chomp $line;
 129         ++$linenum;
 130         if (length($line) == 1 and exists $states{ord($line)}) {
 131             # state transitions
 132             my $newstate = $states{ord($line)};
 133
 134             # disallowed transitions
 135             $_ = "$normstate $newstate";
 136             unless (/^(go|go-nox|html) kill-end$/ or
 137                     /^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ or
 138                     /^kill-body go$/) {
 139                 die "transition from $normstate to $newstate at $linenum disallowed";
 140             }
 141
 142             if ($newstate =~ /^(autocheck|recips|html|incoming-recv)$/) {
 143                 $record->{type} = $newstate;
 144             } elsif ($newstate eq 'kill-end') {
 145                 push @records, $record;
 146                 $record = {};
 147             }
 148
 149             $normstate = $newstate;
 150             next;
 151         }
 152
 153         $_ = $line;
 154         if ($normstate eq 'incoming-recv') {
 155             my $pl = $_;
 156             unless (/^Received: \(at \S+\) by \S+;/) {
 157                 die "bad line '$pl' in state incoming-recv";
 158             }
 159             $normstate = 'go';
 160             $record->{text} .= "$_\n";
 161         } elsif ($normstate eq 'html') {
 162             $record->{text} .= "$_\n";
 163         } elsif ($normstate eq 'go') {
 164             s/^\030//;
 165             $record->{text} .= "$_\n";
 166         } elsif ($normstate eq 'go-nox') {
 167             $record->{text} .= "$_\n";
 168         } elsif ($normstate eq 'recips') {
 169             if (/^-t$/) {
 170                 undef $record->{recips};
 171             } else {
 172                 # preserve trailing null fields, e.g. #2298
 173                 $record->{recips} = [split /\04/, $_, -1];
 174             }
 175             $normstate = 'kill-body';
 176         } elsif ($normstate eq 'autocheck') {
 177             $record->{text} .= "$_\n";
 178             next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
 179             $normstate = 'autowait';
 180         } elsif ($normstate eq 'autowait') {
 181             $record->{text} .= "$_\n";
 182             next if !/^$/;
 183             $normstate = 'go-nox';
 184         } else {
 185             die "state $normstate at line $linenum ('$_')";
 186         }
 187     }
 188     die "state $normstate at end" unless $normstate eq 'kill-end';
 189
 190     return @records;
 191 }
 192
 193 =item write_log_records
 194
 195 Takes a filehandle and a list of records as input, and prints the .log
 196 format representation of those records to that filehandle.
 197
 198 =cut
 199
 200 sub write_log_records (*@)
 201 {
 202     my $logfh = shift;
 203     my @records = @_;
 204
 205     for my $record (@records) {
 206         my $type = $record->{type};
 207         my $text = $record->{text};
 208         die "type '$type' with no text field" unless defined $text;
 209         if ($type eq 'autocheck') {
 210             print $logfh "\01\n$text\03\n";
 211         } elsif ($type eq 'recips') {
 212             print $logfh "\02\n";
 213             my $recips = $record->{recips};
 214             if (defined $recips) {
 215                 die "recips not undef or array"
 216                     unless ref($recips) eq 'ARRAY';
 217                 print $logfh join("\04", @$recips) . "\n";
 218             } else {
 219                 print $logfh "-t\n";
 220             }
 221             $text =~ s/^([\01-\07\030])/\030$1/gm;
 222             print $logfh "\05\n$text\03\n";
 223         } elsif ($type eq 'html') {
 224             print $logfh "\06\n$text\03\n";
 225         } elsif ($type eq 'incoming-recv') {
 226             $text =~ s/^([\01-\07\030])/\030$1/gm;
 227             print $logfh "\07\n$text\03\n";
 228         } else {
 229             die "unknown type '$type'";
 230         }
 231     }
 232
 233     1;
 234 }
 235
 236 =back
 237
 238 =head1 CAVEATS
 239
 240 This module does none of the formatting that bugreport.cgi et al do. It's
 241 simply a means for extracting and rewriting raw records.
 242
 243 =cut
 244
 245 1;