#!/usr/bin/perl -w

use 5.006;
use strict;
use warnings;

=head1 NAME

nexigrep - noris-exim-Logs durchsuchen

=head1 SYNOPSE

  nexigrep pat.*tern /data/maillogs/mail.noris.net-mainlog.1.gz

sucht im gestrigen Log von mail.noris.net nach Eintrgen, die in einer Zeile
die Zeichenkette "pat" und weiter hinten in dieser Zeile die Zeichenkette
"tern" enthalten, wobei die Gro-/Kleinschreibung egal ist.

=head1 BESCHREIBUNG

Dieses Script extrahiert aus exim-Logs alle Eintrge, in denen (mindestens
einer) der angegebene(s) Pattern(s) gefunden wird; bei Eintrgen, die zu einer
bestimmten Mail gehren (und mit deren ID gekennzeichnet sind), werden immer
alle entsprechenden Eintrge angezeigt.

Es knnen wahlweise die Namen zu durchsuchender Log-Dateien auf der
Kommandozeile angegeben (mit gzip oder compress gepackte Dateien werden dabei
automagisch erkannt) oder die Daten auf der Standardeingabe verfttert werden.

=head1 OPTIONEN

Alle Optionen werden mittels L<GetOptions() aus
Getopt::Long|Getopt::Long/GetOptions> analysiert, wobei Bundling aktiv ist.

=head1 Angabe der/des Suchmuster(s)

Normalerweise wird (wie etwa bei grep) das Suchmuster ohne Option als erstes
Argument bergeben.

Alternativ knnen (ggf. mehrere) Suchmuster auch mit den folgenden Optionen
angegeben werden.
(In diesem Fall wird das erste Argument -- wiederum analog zu grep -- I<nicht>
als Suchmuster betrachtet.)

=over 4

=item --search MUSTER

nur Eintrge anzeigen, die auch zu diesem Muster passen

=item --exclude MUSTER

Eintrge, die zu diesem Muster passen, I<nicht> anzeigen

=back

Beide Optionen knnen mehrfach verwendet werden, um die Suchkriterien weiter
einzuschrnken.

Wer hingegen nach Eintrgen suchen mchte, die A I<oder> B enthalten, mge dazu
bitte einen entsprechenden regulren Ausdruck formulieren: C<A|B>

=head1 Modifikationen des Suchmodus

=over 4

=item -I

=item --noignore-case

=item --no-ignore-case

Beachtung der Gro-/Kleinschreibung aktivieren

=item --ignore-case

um die Gro-/Kleinschreibung (wieder) zu ignorieren (Default)

=item -l

=item -F

=item --fixed-strings

angegeben Suchmuster nicht als regulre Ausdrcke, sondern als feste
Zeichenketten interpretieren.

=item --nofixed-strings

regulre Ausdrcke als Suchmuster (Default)

Zeichen, denen in regulren Ausdrcken eine spezielle Bedeutung zukommt,
(z. B. der Punkt, der fr ein beliebiges Zeichen steht) mssen dann also
entschrft werden.

=back

=head2 weitere Suchoptionen

=over 4

=item --ok

Vorgnge selektieren, die mindestens eine erfolgreiche Zustellung (C<=E<gt>>)
enthalten

=item --nook

Vorgnge ausschlieen, die mindestens eine erfolgreiche Zustellung (C<=E<gt>>)
enthalten

=item --tempfail

Vorgnge selektieren, die mindestens einen weich fehlgeschlagenen Zustellversuch
(C<==>) enthalten

=item --notempfail

Vorgnge ausschlieen, die mindestens einen weich fehlgeschlagenen Zustellversuch
(C<==>) enthalten

=item --hardfail

Vorgnge selektieren, die mindestens eine endgltig fehlgeschlagene Zustellung
(C<**>) enthalten

=item --nohardfail

Vorgnge ausschlieen, die mindestens eine endgltig fehlgeschlagene Zustellung
(C<**>) enthalten

=item --completed

nur Vorgnge anzeigen, die bereits abgeschlossen sind

=item --nocompleted

Vorgnge ausschlieen, die bereits abgeschlossen sind

=back

Bei Verwendung dieser Optionen werden grundstzlich nur noch Eintrge angezeigt,
die exim-Message-IDs enthalten, also keine einzeiligen sonstigen Eintrge mehr.

=head2 sonstige

=over 4

=item --nomerge-bounces

=item --no-merge-bounces

Normalerweise werden lokal erzeugte Bounces im Zusammenhang mit der sie
auslsenden E-Mail angezeigt.
Dies lsst sich hiermit abschalten; die Bounces werden dann als eigenstndige
E-Mails betrachtet.

=item --nativelogs

zur Optimierung: nur exim-bliche (keine via syslog geschriebenen)
Protokolldateien verarbeiten

=item --nonativelogs

zur Optimierung: nur syslog-Dateien verarbeiten

=item --heartbeat

zustzliche Timestamps ausgeben (Optimierung fr C<mailgrep>).

=item --buffered-output

Ausgabe puffern

=item --nobuffered-output

Ausgabe nicht puffern (Default)

=item -h

=item -?

=item --help

Wird diese Option angegeben, wird (nur) diese Dokumentation angezeigt.

=back

=head1 TYPEN VON EXIM-LOG-EINTRGEN ZU E-MAILS

  <=    message arrival
  =>    normal message delivery
  ->    additional address in same delivery
  *>    delivery suppressed by -N
  **    delivery failed; address bounced
  ==    delivery deferred; temporary problem

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 fr die noris network AG

Dieses Script basiert auf exigrep,
Copyright (c) 2003 University of Cambridge.

=cut

use Getopt::Long qw(GetOptions);

use constant {
    CRE_EXIM_MSG_ID => qr/(\w{6}\-\w{6}\-\w{2})/,
    CRE_SERVER      => qr/(\S+)/,
    I_LOGDATA       => 0,
    I_TYPES         => 1,
    RE_EXIM_DATE    => qr/\d{4}-\d\d-\d\d \d\d:\d\d:\d\d (?:[+-]\d{4} )?/,
    RE_SYSLOG_DATE  => qr/\w\w\w [ 123]\d \d\d:\d\d:\d\d/,
};

my ( $CRE_begin, $CRE_r_id, $Heartbeat, $NativeLogs, $Completed );

Getopt::Long::Configure('bundling');

{
    my $ignore_case = 1;

    GetOptions(
        'h|?|help' => sub {
            exec perldoc => -F => $0
              or die "exec('perldoc $0') returned $?: $!\n";
        },
        'i|ignore-case'                  => sub { $ignore_case = 1 },
        'I|noignore-case|no-ignore-case' => sub { $ignore_case = '' },
        'l|F|fixed-strings' => \my $fixed_strings,
        'search=s'          => sub { register_pattern( 1, $_[1] ) },
        'exclude=s'         => sub { register_pattern( '', $_[1] ) },
        'ok!'               => sub { register_type( $_[1], '=>' ) },
        'tempfail!'  => sub { register_type( $_[1], '==' ) },
        'hardfail!'  => sub { register_type( $_[1], '**' ) },
        'completed!' => \$Completed,
        'merge-bounces!' => \( my $merge_bounces = 1 ),
        'nativelogs!'    => \$NativeLogs,
        'buffered-output!' => \my $buffered_output,
        'heartbeat=i'      => \( $Heartbeat = 0 ),
    ) or exit 1;

    {
        my @patterns;

        sub register_pattern {
            my ( $expect, $pattern ) = @_;
            $pattern = quotemeta $pattern if $fixed_strings;
            $pattern = "(?i:$pattern)"    if $ignore_case;
            $pattern = qr/$pattern/;
            push @patterns, [ $expect, $pattern ];
        }

        register_pattern( 1, shift ) if !@patterns && @ARGV;
        die "USAGE: $0 [OPTIONS] <pattern> [<log file>]...\n" unless @patterns;

        my %type;

        sub register_type {
            my ( $expect, @types ) = @_;
            $type{$_} = $expect for @types;
        }

        sub matches($) {
            my ($entry) = @_;

            if ( ref $entry ) {
                if ( keys %type ) {
                    my $types = $entry->[I_TYPES];
                    keys %type;
                    while ( my ( $type, $expect ) = each %type ) {
                        return '' if $types->{$type} xor $expect;
                    }
                }
                $entry = $entry->[I_LOGDATA];
            }
            elsif ( keys %type ) { return '' }

            ( $entry =~ $_->[1] xor $_->[0] ) and return '' for @patterns;
            1;
        }
    }

    $CRE_begin =
      $NativeLogs ? qr/^${\RE_EXIM_DATE}()()/
      : defined $NativeLogs
      ? qr/^${\RE_SYSLOG_DATE} ${\CRE_SERVER} [^\[]+\[(\d+)\]: /
      : qr/^${\RE_EXIM_DATE}|${\RE_SYSLOG_DATE} ${\CRE_SERVER} [^\[]+\[(\d+)\]: /;

    $CRE_r_id = $merge_bounces ? "(?: <> R=${\CRE_EXIM_MSG_ID})?" : '';

    $| = !$buffered_output;
}

sub writeln { print join "\n", @_, '' }

my %Saved;

sub process {
    my ( $line, $id, $finished, $type, $r_id ) = @_;

    $Saved{$id} = $Saved{$r_id} if defined $r_id && exists $Saved{$r_id};
    {
        ( my $delivery = $Saved{$id} ||= bless [], 'my::delivery' )->[I_LOGDATA]
          .= $line;
        ++$delivery->[I_TYPES]{$type} if defined $type;
    }
    delete $Saved{$id} if $finished;
}

sub my::delivery::DESTROY {
    my ($delivery) = @_;
    writeln( $delivery->[I_LOGDATA] ) if matches($delivery);
}

my ( $last_line_done, $last_id );

sub do_file($;$) {
    my ( $fh, $file ) = @_;
    while ( defined( my $line = <$fh> ) ) {
        $line .= "\n" if $line !~ /\n\z/;

        unless ( my ( $server, $pid, $entry, $id, $type, $r_id ) =
            $line =~ /^$CRE_begin((?:${\CRE_EXIM_MSG_ID} (\S+)$CRE_r_id)?.*)/o )
        {
            if (   $line !~ /\S/
                || $line =~
/^(\+\+\+ (?:(?:${\CRE_SERVER} )?${\CRE_EXIM_MSG_ID} )?not completed \+\+\+)$/o
              )
            {
            }

            # Workaround fr Zeilenumbrche, vgl. RT#346655:
            elsif ( defined $last_id ) { $Saved{$last_id}[I_LOGDATA] .= $line }

            else {
                warn 'Cannot parse'
                  . ( $. ? " line $." : '' )
                  . ( defined $file && qq( (file "$file")) )
                  . ": $line";
            }
        }
        elsif ( defined $id ) {
            process(
                $line,
                $last_id =
                  defined $server ? "$server $id" : $id,
                $type      eq 'Completed'
                  || $type eq 'SMTP'
                  && $entry =~
/^${\CRE_EXIM_MSG_ID} SMTP data timeout \(message abandoned\) on connection from /
                  || scalar $entry =~
                  /\brejected (?:by local_scan\(\)|by non-SMTP ACL|after DATA)/,
                $type,
                $CRE_r_id
                ? (
                    $type eq '<='
                      && defined $r_id
                    ? defined $server
                    ? "$server $r_id"
                    : $r_id
                    : undef
                  )
                : ()
            );
        }
        elsif ( my ( $lineno, $lines ) = $entry =~ /^\[(\d+)[\/\\](\d+)\] / ) {
            process(
                $line,
                join( ' ', defined $server ? $server : (), $pid, $lines ),
                $lineno == $lines
            );
        }
        elsif ( matches($line) ) { writeln($line) }
    }
    continue { $last_line_done = $line }
}

if ($Heartbeat) {
    {
        no warnings 'redefine';
        *writeln = sub {
            alarm 0;
            print join "\n", @_, '';
            alarm $Heartbeat;
        };
    }
    $SIG{ALRM} = sub {
        if ( defined $last_line_done
            && $last_line_done =~ /^(${\RE_EXIM_DATE}|${\RE_SYSLOG_DATE})/ )
        {
            writeln( $1, '' );
        }
        else { alarm 1 }
    };
    alarm $Heartbeat;
}

{
    no warnings 'redefine';
    local *matches = sub { return '' }
      if defined $Completed && !$Completed;

    if (@ARGV) {
        for my $file (@ARGV) {
            open my $fh, '-|', zcat => -f => $file
              or die qq(Error trying to read from "$file": $!\n);
            do_file( $fh, $file );
        }
    }
    else {
        warn <<_ if -t STDIN;
Kein Dateiname auf der Kommandozeile, und STDIN zeigt auf (D)ein Terminal!?
Dann mal viel Spa beim Log-Daten-Eintippen...
_
        do_file( \*STDIN );
    }
}

alarm 0 if $Heartbeat;

undef &my::delivery::DESTROY;
unless ( defined $Completed && $Completed ) {
    matches( $Saved{$_} )
      and print "+++ $_ not completed +++\n$Saved{$_}[I_LOGDATA]\n"
      for sort keys %Saved;
}
{
    no warnings 'misc';
    undef %Saved;
}

__END__

=head1 ANDERE INTERESSANTE TOOLS ZU EXIM

=over 4

=item lslogs

Anzeige der verfgbaren exim-Log-Dateien

=item nexicount

Anzahl der Mails in einer exim-Queue anzeigen

=item nexim

=item nexim4

exim aufrufen

=item nexim-M

Zustellung bestimmter Mails forcieren

=item nexim_checkaccess

Abfrage, was ein Host darf

=item nexinext

exim-Retry-Datenbank durchforsten

=item nexiqgrep

exim-Queues durchsuchen

=item nexiqsumm

Statistiken zum Inhalt der exim-Queues

=item nexiwhat

Was tut welcher exim-Prozess?

=item nmailq

Inhalt von Mail-Queues anzeigen

=back

=cut

