#!/usr/bin/perl -w

use 5.010;
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 Einträgen, 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 Einträge, in denen (mindestens
einer) der angegebene(s) Pattern(s) gefunden wird; bei Einträgen, die zu einer
bestimmten Mail gehören (und mit deren ID gekennzeichnet sind), werden immer
alle entsprechenden Einträge angezeigt.

Es können 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 verfüttert 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 können (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 Einträge anzeigen, die auch zu diesem Muster passen

=item --exclude MUSTER

Einträge, die zu diesem Muster passen, I<nicht> anzeigen

=back

Beide Optionen können mehrfach verwendet werden, um die Suchkriterien weiter
einzuschränken.

Wer hingegen nach Einträgen suchen möchte, die A I<oder> B enthalten, möge dazu
bitte einen entsprechenden regulären 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 reguläre Ausdrücke, sondern als feste
Zeichenketten interpretieren.

=item --nofixed-strings

reguläre Ausdrücke als Suchmuster (Default)

Zeichen, denen in regulären Ausdrücken eine spezielle Bedeutung zukommt,
(z. B. der Punkt, der für ein beliebiges Zeichen steht) müssen dann also
entschärft werden.

=back

=head2 weitere Suchoptionen

=over 4

=item --ok

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

=item --nook

Vorgänge ausschließen, die mindestens eine erfolgreiche Zustellung (C<=E<gt>>)
enthalten

=item --tempfail

Vorgänge selektieren, die mindestens einen weich fehlgeschlagenen Zustellversuch
(C<==>) enthalten

=item --notempfail

Vorgänge ausschließen, die mindestens einen weich fehlgeschlagenen Zustellversuch
(C<==>) enthalten

=item --hardfail

Vorgänge selektieren, die mindestens eine endgültig fehlgeschlagene Zustellung
(C<**>) enthalten

=item --nohardfail

Vorgänge ausschließen, die mindestens eine endgültig fehlgeschlagene Zustellung
(C<**>) enthalten

=item --completed

nur Vorgänge anzeigen, die bereits abgeschlossen sind

=item --nocompleted

Vorgänge ausschließen, die bereits abgeschlossen sind

=back

Bei Verwendung dieser Optionen werden grundsätzlich nur noch Einträge angezeigt,
die exim-Message-IDs enthalten, also keine einzeiligen sonstigen Einträge mehr.

=head2 sonstige

=over 4

=item --nomerge-bounces

=item --no-merge-bounces

Normalerweise werden lokal erzeugte Bounces im Zusammenhang mit der sie
auslösenden E-Mail angezeigt.
Dies lässt sich hiermit abschalten; die Bounces werden dann als eigenständige
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

zusätzliche Timestamps ausgeben (Optimierung für 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-EINTRÄGEN 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>
 für 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;
}

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) = @_;
    say $delivery->[I_LOGDATA] if matches($delivery);
}

my $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 für Zeilenumbrüche, 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) ) { say $line }
    }
    continue {
        if ($Heartbeat && $. % 10_000 == 0
                && $line =~ /^(${\RE_EXIM_DATE}|${\RE_SYSLOG_DATE})/ ) {
            say "$1\n";
        }
    }
}

{
    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 );
    }
}

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 verfügbaren 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

