Hello all. (sent this once before, didn't seem to get through)

I wrote a perl script that can be used in combination with qmail-scanner to use
the regular archiving functionality to sort messages by their local senders and
recipients.  That way you can just open up a mutt session (or something else)
and browse recent backup messages by username instead of all together.

In Summary:
Takes a message as standard input (requires the envelope headers
Delivered-To and Return-Path to be present) and saves it into a
Maildir directory with the name of the recipient and the sender, if
either or both is a local user (as defined by username and domain).
If neither the sender nor the recipient are local users or aliases,
it saves the message into a miscellanious Maildir, if that option
is set.

In order to make this work nicely, I had to insert a call to it into the
qmail-scanner-queue.pl code directly (I used the archiving section, see code
for details), and I thought that perhaps this would be useful to others, so
I'll post it here. I also thought that maybe it might be a nice additional
option to qmail-scanner, if that's seen as a good idea by the powers that be.

#!/usr/bin/perl

#------------------------------------------------------------------
# qlogparse
# A script to parse logged messages from qmail's logging facility.
#
# Takes a message as standard input (requires the envelope headers
# Delivered-To and Return-Path to be present) and saves it into a
# Maildir directory with the name of the recipient and the sender, if
# either or both is a local user (as defined by username and domain).
#
# If neither the sender nor the recipient are local users or aliases,
# it saves the message into a miscellanious Maildir, if that option
# is set below.
#
# Uses correct Maildir write/link code (although possibly not NFS safe).
#
# For this script to function, you should insert it into qmail-scanner's
# code, generally as follows at line 1516 of qmail-scanner-queue.pl:
#
#      open(QMESSAGE, "$scandir/$wmaildir/new/$file_id") or &debug("(qlogparse)
Error: could not open message for reading.");
#      my @qmessage = <QMESSAGE>;
#      close(QMESSAGE);
#      foreach my $deliveredto (split(/,/, $recips))
#      {
#            open(QLOGPARSE, "|/var/qmail/bin/qlogparse.pl >>
/var/spool/qmailscan/qlogparse.log 2>&1");
#            print QLOGPARSE "Return-Path: <".$returnpath.">\n";
#            print QLOGPARSE "Delivered-To: ".$deliveredto."\n";
#            print QLOGPARSE @qmessage;
#            close(QLOGPARSE);
#      }
#
# It's also probably a good idea to put something like this line
# into your crontab to avoid messages piling up forever:
# 0 1 * * *    /usr/bin/find /var/spool/qmailscan/backups/ -ctime +186 -type f|
/usr/bin/xargs rm -f
#
# Store each message in a Maildir-style mailbox in the format:
# $Maildir/username
# where username is the name of the local user who sent or recieved
# the message. Note that only users whose names are listed in qmail's
# $qmail_home/control/rcpthosts will be considered valid local users.
# Non-matching messages are stored in a separate box called
# $Maildir/$qunknown_user
# (Hopefully you don't have a user on your system called "qunknown_user",
# if you somehow do, change the variable $qunknown_user below.)
#
# Made by Payton Swick
# 03-15-2004
# Much thanks to qmail (http://www.qmail.org/)
# and to qmail-scanner (http://qmail-scanner.sourceforge.net/)
#
# Warning: Use at your own risk!! I do not guarantee that your messages
# will be correctly logged or filtered or that your computer won't
# explode as a result of using it.
#
# You may distribute the code or modify it as you wish, but please
# try to keep this information intact.
#------------------------------------------------------------------

####################
##    Options     ##
####################

# The amount of output to print.4
# Default: $verbose = 0;
$verbose = 1;

# The home directory of qmail.
# ex: my $qmail_home = "/var/qmail";
my $qmail_home = "/var/qmail";

# The Maildir to use. No trialing slash.
# ex: my $Maildir = "/var/spool/qmailscan/backups/Maildir";
my $Maildir = "/var/spool/qmailscan/backups/Maildir";

# The name of the box to deliver messages
# to/from unknown users. Leave blank to disable
# unknown user logging.
# Default: my $qunknown_user = "qunknown_user";
my $qunknown_user = "qunknown_user";

# The location of the passwd file, or any other
# file that lists the allowed usernames on the
# local system.
# Default: my $passwd = "/etc/passwd";
my $passwd = "/etc/passwd";

# The location of the aliases folder, so as to
# parse any other local addresses.
# Default: my $aliases = $qmail_home."/alias";
my $aliases = $qmail_home."/alias";

# If set, prepends this string to the created
# Maildir files before the username.
# ex: my $maildir_prepend = "INBOX.";
my $maildir_prepend = ".";

# The number of times to try delivering a message
# before giving up.
# Default: $max_tries = 20;
$max_tries = 20;

# The header to use for the recipient, no colon, escape '-'.
# Default: my $rcpt_header = "Delivered\-To";
my $rcpt_header = "Delivered\-To";

# The header to use for the sender, no colon, escape '-'.
# Default: my $from_header = "Return\-Path";
my $from_header = "Return\-Path";

####################
## End of Options ##
####################
my $version = "0.7"; # Don't change this unless you modify the code.

print scalar(localtime)." qlogparse version $version starting.\n" if ($verbose
>= 1);

my $rcpthosts = $qmail_home."/control/rcpthosts";
die "Error: I have to be able to read the rcpthosts file (".$rcpthosts.")\n" if
(!-r $rcpthosts);

# Recieve the message.
my @message = ();
while (my $line = <STDIN>)
{
    push @message, $line;
}

# Headers:
# Delivered-To: contains the recipient address.
# Return-Path: contains the sender address.

# Create a maildir.
# makeMaildir($path)
sub makeMaildir
{
        my $box = shift;

        mkdir($box) or die "Error: Maildir '".$box."' doesn't exist and couldn't
create
it: ".$!."\n";
        print "Created maildir '".$box."'\n" if ($verbose >= 2);
        mkdir($box."/tmp") or die "Error: Problem while creating Maildir tmp
file in
'".$box."': ".$!."\n";
        mkdir($box."/new") or die "Error: Problem while creating Maildir new
file in
'".$box."': ".$!."\n";
        mkdir($box."/cur") or die "Error: Problem while creating Maildir cur
file in
'".$box."': ".$!."\n";
}

# Deliver the message to a box.
# deliver($box, @message) where $box is a valid Maildir.
# If the Maildir doesn't exist, create it.
# Tries to conform to correct Maildir delivery.
sub deliver
{
    my $box = shift;
    my @message = @_;
    unless (-d $box)
    {
        makeMaildir($box);
    }
    die "Error: Insufficient permissions to write to Maildir '".$box."'\n"
unless (-w $box);
    die "Error: Insufficient permissions to write to tmp dir in '".$box."'\n"
unless (-w $box."/tmp");
    die "Error: Insufficient permissions to write to new dir in '".$box."'\n"
unless (-w $box."/new");
    die "Error: Insufficient permissions to write to cur dir in '".$box."'\n"
unless (-w $box."/cur");

    my $stamp = time;
    my $file_name = $stamp.'.'.$$.'.mbox';
    my $tmp_file = $box."/tmp/".$file_name;
    my $new_file = $box."/new/".$file_name;
    my $tries = 0;
    while (-e $tmp_file)
    {
        print "Warning: tmp file '".$tmp_file."' exists, sleeping...\n" if
($verbose >=
3);
        $tries++;
        sleep 2;
        die "Error: reached maximum delivery attempts (".$max_tries.") on
message
'".$tmp_file."'.\n" if ($tries > $max_tries);
    }
    open(BOX, ">".$tmp_file) or die "Error: Cannot write to Maildir
'".$box."'\n";
    print BOX @message;
    close(BOX);
    print "Writing successful, linking delivery to '".$new_file."'...\n" if
($verbose >= 3);
    link($tmp_file, $new_file) or die "Error: Problem while linking delivery
file '".$new_file."': ".$!."\n";
    print "Delivery successful, unlinking temp file...\n" if ($verbose >= 3);
    unlink($tmp_file) or print "Warning: tmp file '".$tmp_file."' not deleted:
".$!."\n";
}

my $from_sort_name = '';
my $from_domain_name = '';
my $rcpt_sort_name = '';
my $rcpt_domain_name = '';
foreach (@message)
{
    print "Message: ".$_ if ($verbose >= 4);
    if (/^$from_header\:\s+<(\S+)\@(\S+)>/i)
    {
        next if ($from_sort_name); # Accept only the first one.
        print "Found Sender line: ".$_."\n" if ($verbose >= 3);
        $from_sort_name = $1;
        $from_domain_name = $2;
    }

    if (/^$rcpt_header\:\s+(\S+)\@(\S+)/i)
    {
        next if ($rcpt_sort_name); # Accept only the first one.
        print "Found Recipient line: ".$_."\n" if ($verbose >= 3);
        $rcpt_sort_name = $1;
        $rcpt_domain_name = $2;
    }
}

# Do not log this username if the domain isn't in rcpthosts.
open(RCPTHOSTS, $rcpthosts) or die "Error: Could not open rcpthosts file
(".$rcpthosts."): ".$!."\n";
my @rcpthosts = <RCPTHOSTS>;
close(RCPTHOSTS);
$from_sort_name = 0 unless (scalar grep(/$from_domain_name/, @rcpthosts));
$rcpt_sort_name = 0 unless (scalar grep(/$rcpt_domain_name/, @rcpthosts));
print $from_domain_name." is a local host.\n" if ($from_sort_name and $verbose
>= 3);
print $rcpt_domain_name." is a local host.\n" if ($rcpt_sort_name and $verbose
>= 3);

# Do not log this username if it isn't in the passwd file or the aliases.
open(PASSWD, $passwd) or die "Error: Could not open passwd file (".$passwd."):
".$!."\n";
my @passwd = <PASSWD>;
close(PASSWD);
opendir(ALIASES, $aliases) or die "Error: Could not open alias folder
(".$aliases."): ".$!."\n";
my @aliases = grep(/^\.qmail\-/, readdir(ALIASES));
closedir(ALIASES);
push(@passwd, @aliases);
$from_sort_name = 0 unless (scalar grep(/$from_sort_name/, @passwd));
$rcpt_sort_name = 0 unless (scalar grep(/$rcpt_sort_name/, @passwd));
print $from_sort_name." is a local user.\n" if ($from_sort_name and $verbose >=
3);
print $rcpt_sort_name." is a local user.\n" if ($rcpt_sort_name and $verbose >=
3);

# Do not log the same username twice.
$rcpt_sort_name = 0 if ($from_sort_name eq $rcpt_sort_name);

makeMaildir($Maildir) unless (-d $Maildir);
my $delivered = 0;
if ($from_sort_name)
{
    deliver($Maildir."/".$maildir_prepend.$from_sort_name, @message);
    $delivered = 1;
    print "Delivered message to sender box
(".$maildir_prepend.$from_sort_name.").\n" if ($verbose >= 1);
}
if ($rcpt_sort_name)
{
    deliver($Maildir."/".$maildir_prepend.$rcpt_sort_name, @message);
    $delivered = 1;
    print "Delivered message to rcpt box
(".$maildir_prepend.$rcpt_sort_name.").\n" if ($verbose >= 1);
}
unless ($delivered)
{
    if ($qunknown_user)
    {
        deliver($Maildir."/".$maildir_prepend.$qunknown_user, @message);
        print "Delivered message to unknown user box
(".$maildir_prepend.$qunknown_user.").\n" if ($verbose >= 1);
    }
}

print scalar(localtime)." qlogparse done.\n" if ($verbose >= 1);
print " ----------------- \n" if ($verbose >= 1);


--
;; Payton Swick             ;;
;; IT Systems Administrator ;;
;; [EMAIL PROTECTED]      ;;
;; 781-250-0111 x2273       ;;



-------------------------------------------------------
This SF.Net email is sponsored by: IBM Linux Tutorials
Free Linux tutorial presented by Daniel Robbins, President and CEO of
GenToo technologies. Learn everything from fundamentals to system
administration.http://ads.osdn.com/?ad_id=1470&alloc_id=3638&op=click
_______________________________________________
Qmail-scanner-general mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/qmail-scanner-general

Reply via email to