New features:
- keeps track of mailfrom/rcptto so they're included when mail/rcpt
  hooks return DENY (No address here by that name => now you know which
  name).
- can send log lines (without timestamp, intentional) over UDP; we're
  using this for central logging (with cronolog).

Scripts attached.
-- 
Met vriendelijke groet,  Kind regards,  Korajn salutojn,

  Juerd Waalboer:  Perl hacker  <[EMAIL PROTECTED]>  <http://juerd.nl/sig>
  Convolution:     ICT solutions and consultancy <[EMAIL PROTECTED]>
our $VERSION = '0.05';

=head1 NAME

logcompact - qpsmtpd plugin for concise logging

=head1 DESCRIPTION

This plugin logs a single line for each command denied or message queued. The
logged line is configurable, and is written using qpsmtpd's normal logging
mechanism.

=head2 Configuration

The suggested filename for this plugin is "logging/logcompact". To enable the
plugin, add "logging/logcompact" to your qpsmtpd plugins file.

The following configuration options are available:

=over 20

=item format

A string describing the line to be written. The default begins with a backtick
character to ease grepping it from the mail log file.

See L</FORMAT> for a list of supported values, and modifiers.

Because there cannot be any whitespace in a qpsmtpd plugin config string, any ^
is replaced by whitespace. There is currently no way to use a literal ^.

Default value: `L=%L%;^R=%R%;^F=%F%;^T=%T%;^P=%P%;^S=%S%;^I=%I%;^H=%H%

=item loglevel

The level with which to log the line. Must be a valid qpsmtpd loglevel name.

Default value: LOGALERT

=item autoquote_regex

A regular expression to override the definition of "sufficiently special" as
mentioned under L</FORMAT>.

Default value: [\0\s;"]|^\s*$

(That is, by default it will use quoting/escaping when there's a null byte,
whitespace, semicolon, double quote or nothing at all.)

=back

=head1 FORMAT

Variables:

    %L%     - Local IP address
    %R%     - Remote IP address
    %H%     - Remote hostname and HELO/EHLO line in parens if given
    %F%     - Envelope sender (MAIL FROM)
    %T%     - Envelope recipient (RCPT TO)
    %S%     - Status (return value: DENY or DENYSOFT)
    %P%     - Plugin that denied, or "queued"
    %I%     - Info (deny message or <message ID>)
    %X:foo% - Value in connection note "foo"
    %N:foo% - Value in transaction note "foo"

Modifiers:

    %A%     - Quote if containing sufficiently special chars
    %-A%    - Never quote the value
    %+A%    - Always quote the value

Unquoted strings have non-printable/non-ascii characters replaced by question
marks.

Quoted strings have non-printable/non-ascii characters escaped as \x00, where
00 is the hexadecimal character code, and have " and \ escaped as \" and
\\. The entire value is surrounded in "".

=head1 CAVEATS

For denied recipients, only the value of the I<last> "RCPT TO" command is
logged for %F%.

Many protocol errors are handled by qpsmtpd internally, and not logged.

Hostnames and addresses are lowercased, except for the HELO string.

=head1 AUTHOR

Juerd Waalboer <[EMAIL PROTECTED]>

=head1 ACKNOWLEDGEMENTS

This plugin was inspired by, and is based on, the "logterse" plugin, written by
Charles Butcher who took a lot from logging/adaptive by John Peacock. Thank you
both.

=head1 LICENSE

(MIT License)

 Copyright (c) 2008
     - Juerd Waalboer  <http://juerd.nl/>
     - TNX             <http://tnx.nl/>

Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

The software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall the
authors or copyright holders be liable for any claim, damages or other
liability, whether in an action of contract, tort or otherwise, arising from,
out of or in connection with the software or the use or other dealings in the
software.

=cut

use strict;
use Socket;

sub register {
    my ($self, $qp, %args) = @_;

    $self->{_loglevel} = defined $args{loglevel}
        ? log_level($args{loglevel})
        : LOGALERT;

    $self->{_format}   = defined $args{format}
        ? $args{format}
        : "`L=%L%;^R=%R%;^F=%F%;^T=%T%;^P=%P%;^S=%S%;^I=%I%;^H=%H%";
    $self->{_format} =~ s/\^/ /g;

    $self->{_special}  = defined $args{autoquote_regex}
        ? qr/$args{autoquote_regex}/
        : qr/[\0\s;"]|^\s*$/;

    $self->{_udpdest}  = defined $args{udpdest}
        ? $args{udpdest} =~ /([A-Za-z0-9.-]+):([0-9]+)/
            ? sockaddr_in($2, inet_aton($1))
            : $self->log(LOGERROR, "Invalid udpdest in logcompact config")
        : undef;

    if ($self->{_udpdest}) {
        socket $self->{_udpsock}, PF_INET, SOCK_DGRAM, getprotobyname("udp")
            or die "logcompact could not create UDP socket: $!";
    }
}


# Hooks on SMTP commands: record data so it is known if a plugin does DENY.

sub hook_mail {
    my ($self, $transaction, $sender) = @_;
    $transaction->notes("mail_from", $sender);
    return DECLINED;
}

sub hook_rcpt {
    my ($self, $transaction, $recipient) = @_;
    $transaction->notes("in_rcpt_phase", 1);
    $transaction->notes("last_rcpt_to", $recipient);
    return DECLINED;
}

sub hook_data {
    my ($self, $transaction) = @_;
    $transaction->notes("in_rcpt_phase", 0);
    return DECLINED;
}


# Other hooks

sub hook_deny {
    my ($self, $transaction, $prev_hook, $retval, $return_text) = @_;

    $self->_log($transaction, $prev_hook, $retval, $return_text);
    return DECLINED;
}

sub hook_queue {
    my ($self, $transaction) = @_;

    my $msg_id = $transaction->header->get('Message-Id') || '';
    $msg_id =~ s/\s+\z//;  # strip trailing whitespace
    $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>\z/;

    $self->_log($transaction, "queued", "", $msg_id);
    return DECLINED;
}

sub hook_post_connection {
    my ($self) = @_;
    return DECLINED if $self->qp->connection->notes("logcompact");

    $self->_log(undef, "logcompact", "", "Connection gone");
    return DECLINED;
}


# Private methods

sub _quote {
    my ($string) = @_;
    $string =~ s/([\\"])/\\$1/g;
    $string =~ s/([^\x20-\x7e])/sprintf "\\x%02x", ord $1/ge;
    return qq("$string");
}

sub _strip {
    my ($string) = @_;
    $string =~ s/([^\x20-\x7e])/?/g;
    return $string;
}

my %retval = (
    DENY()                => "DENY",
    DENYSOFT()            => "DENYSOFT",
    DENY_DISCONNECT()     => "DENY+",
    DENYSOFT_DISCONNECT() => "DENYSOFT+",
);

sub _log {
    my ($self, $transaction, $plugin, $retval, $info) = @_;

    my $c = $self->qp->connection;
    my $t = $transaction;

    my %info = (
        L => $c->local_ip,
        R => $c->remote_ip,
        H => lc($c->remote_host),
        F => ($t ? lc($t->notes("mail_from")) : ""),
        T => (
            $t
            ? $t->notes("in_rcpt_phase")
                ? lc($t->notes("last_rcpt_to"))
                : join(',', map lc, $t->recipients)
            : ""
        ),
        S => $retval{$retval},
        P => $plugin,
        I => $info,
        X => sub { $c->notes(shift) },
        N => ($t ? sub { $t->notes(shift) } : ""),
    );
    not defined and $_ = "" for values %info;

    my $hello = $c->hello;
    $info{H} .= " (\U$hello\E " . $c->hello_host . ")" if $hello;

    my $string = $self->{_format};
    $string =~ s[%([-+]?)(\w)(?::([^%]+))?%] {
        my ($mod, $letter, $arg) = ($1, $2, $3);

        my $val = $info{$letter};
        $val = eval { $val->($arg) } if ref $val;

        + $mod eq '-'                 ? _strip($val)
        : $mod eq '+'                 ? _quote($val)
        : $val =~ /$self->{_special}/ ? _quote($val)
        :                               _strip($val);
    }ge;

    $self->log($self->{_loglevel}, $string);

    if ($self->{_udpdest}) {
        $string .= "\n";
        send($self->{_udpsock}, $string, 0, $self->{_udpdest})==length($string)
            or $self->log(LOGERROR, "logcompact couldn't send UDP packet.");
    }

    $c->notes("logcompact" => 1);
}

1;
#!/usr/bin/perl -w
use strict;
use IO::Socket::INET;
use POSIX qw(strftime);

# TODO: Make this a real daemon

my $server = IO::Socket::INET->new(
    LocalPort => 50505,
    Proto     => "udp",
) or die "Couldn't create socket: [EMAIL PROTECTED]";

my %cronolog;

$| = 1;
while ($server->recv(my $line, 4096)) {
    $line =~ /`L=([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/ or next;
    my $ip = $1;

    if (not $cronolog{$ip}) {
        warn "Creating cronolog for $ip.\n";
        open(
            $cronolog{$ip}, 
            "|-",
            "cronolog", "/home/juerd/qplog/%Y/%m/%d/$ip"
        ) or warn "Could not start cronolog for $ip.\n";
    }

    my $ts = strftime "%Y-%m-%d %H:%M:%S ", localtime;
    print {$cronolog{$ip}} $ts, $line;
    print $ts, $line;

    die "Someone's messing with us or the mail cluster grew fast."
        if keys(%cronolog) > 32;
}

Reply via email to