Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 204 lines (151 sloc) 4.77 KB
#! /usr/bin/env perl
use strict;
use diagnostics;
use warnings;
#
# postrace - find logentrys for a specific mail
#
# Author: Peter Reich <pr@alles.prima.de>
#
# This program is free software, you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
use 5.10.0;
our $VERSION = '1.1';
#
# where to find the mail logfile
#
my $OS_MAILLOG = '/var/log/mail';
if ($^O =~ /bsd$/) {
$OS_MAILLOG = '/var/log/maillog';
}
################################################
# Change below at your own risk
#
use Getopt::Long;
use Pod::Usage;
use IO::File;
use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError);
my %opt = ();
#
# check arguments
#
GetOptions( \%opt, 'help|?', 'man', 'debug|d', 'id=s', 'email=s', )
or pod2usage(2);
# print help if option help is set or no arguments are given
pod2usage( -exitstatus => 0, -verbose => 2 ) if $opt{man};
pod2usage(1) if ( $opt{help} );
my $MAILLOGS = ( $#ARGV >= 0 ) ? \@ARGV : [$OS_MAILLOG];
my $msgid = $opt{id};
my $email = $opt{email};
#
# main
#
foreach my $MAILLOG (@$MAILLOGS) {
my %QueueIDs = ();
print "searching file $MAILLOG\n" if $opt{debug};
my $fh;
if ( $MAILLOG =~ m/.*\.(bz2|gz|Z)$/xm ) {
$fh = new IO::Uncompress::AnyUncompress $MAILLOG;
}
else {
$fh = new IO::File $MAILLOG;
}
if ( defined $fh ) {
# search queue IDs
while (<$fh>) {
chomp;
if ( $msgid && m/^.+ message-id=<$msgid>.*$/xm ) {
my $queueID = $_;
$queueID =~ s/.*\]:? (.+):.+/$1/xm;
print "$queueID" if ( $opt{debug} );
$QueueIDs{$queueID} += 1;
}
if ( $email && m/postfix\/.+(from|to)=<$email>/ixm ) {
my $queueID = $_;
$queueID =~
s/^.+ postfix\/.*\]:? ([A-Z0-9]{8,10}):?.+/$1/; ## no critic
print "$queueID\n" if ( $opt{debug} );
#print $_."\n" if ($opt{debug});
$QueueIDs{$queueID} += 1;
}
}
$fh->close;
## reopen and print every line with relevant queue IDs
print "\n\n------- Output --------\n\n" if ( $opt{debug} );
print "\nopening logfile $MAILLOG\n\n";
if ( $MAILLOG =~ m/.*\.(bz2|gz|Z)$/xm ) {
$fh = new IO::Uncompress::AnyUncompress $MAILLOG;
}
else {
$fh = new IO::File $MAILLOG;
}
my $tmpMsgId = '';
while (<$fh>) {
my $QID_FOUND = 0;
foreach my $Qid ( keys %QueueIDs ) {
if (m/ $Qid:/xm) {
print $_;
$QID_FOUND = 1;
# check for message-id
if (!$tmpMsgId && m/: message-id=/) {
($tmpMsgId = $_) =~ s/^.+: message-id=<(.+)>$/$1/;
}
}
}
print $_ if ( $QID_FOUND == 0 && $msgid && m/id=<$msgid>/xm );
# look for other lines containing the messagid
if ( $QID_FOUND == 0 && !$msgid && $tmpMsgId && m/id=<$tmpMsgId>/xm ) {
# print and reset $tmpMsgId
print $_;
$tmpMsgId = '';
}
}
$fh->close();
}
else {
warn "cant open $MAILLOG: $!";
}
}
__END__
=head1 NAME
postrace - trace a message trough postfix logfiles
=head1 SYNOPSIS
postrace [-hmd] --id E<lt>I<Message-ID>E<gt> [E<lt>I<log files ...>E<gt>]
postrace [-hmd] --email E<lt>I<Emailaddress>E<gt> [E<lt>I<log files ...>E<gt>]
Options:
--help brief help message
--man full documentation
--debug debug output
--id=<MessageID> Message-ID
--email=<Emailaddress> Email
=head1 OPTIONS
=over 8
=item B<--help | -h>
Print a brief help message and exits.
=item B<--man | -m>
Prints the manual page and exits.
=item B<--id | -i>
Look for entries related to this Message-ID.
=item B<--email | -e>
Look for entries related to this email address.
=back
=head1 DESCRIPTION
B<postrace> takes a message-id or email address as an argument and searches
the relevant lines in postfix mail log files.
Without the log file argument, postrace searches only the actual logfile.
Postrace can also search in compressed log files.
=head1 EXAMPLES
=over 8
=item C<postrace --id 37656f83nedgeft@example.org>
Search for a message ID in the actual logfile.
=item C<postrace -e info@example.org /var/log/mail.1.gz /var/log/mail.2.gz>
Search for a email address (sender or recipient) in the compressed logfiles
C</var/log/mail.1.gz /var/log/mail.2.gz>.
=back
=head1 AUTHOR
Peter Reich <pr@alles.prima.de>
=head1 LICENSE
This program is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
Jump to Line
Something went wrong with that request. Please try again.