Re: REPORT ON-DEMAND FOR QMAIL-SEND

[Ted Zlatanov]

On 22 Jul 2004, [EMAIL PROTECTED] wrote:

> It is the PID, but it could not be assumed to be unique across a log file,
> specially if the file is big and/or there are many processes being created
> by the system (busy server). The pid numbers area assigned in sequence
> (by the system) until they reach a limit, then this assignment starts all
> over again from 1.

Please try this version of the script.  It should track messages
properly, plus will show the delivery status beneath the message ID if
that information is available (from the qmail-send log).

Ted


#!/usr/bin/perl -w

# by Ted Zlatanov <[EMAIL PROTECTED]>
# GPL license

use strict;
use Data::Dumper;

my %messages;
my %pids;

while (<>)
{
 # qmail-send FROM line
 if (m/(.*?) info msg (\d+): bytes (\d+) from (\S+)/)
 {
  my $id = $2;

  $messages{$id}->{date} = $1;
  $messages{$id}->{size} = $3;
  $messages{$id}->{from} = $4;
 }

 # qmail-send TO line
 if (m/(.*?) starting delivery (\d+): msg (\d+) to (remote|local) (\S+)/)
 {
  my $id = $3;

  $messages{$id}->{date} = $1;
  $pids{$2} = $id;
  push @{$messages{$id}->{to}}, $5;
 }

 # qmail-send status line
 if (m/(.*?) delivery (\d+): (failure|success)/)
 {
  my $pid = $2;
  my $status = $3;
  my $date = $1;

  next unless exists $pids{$pid};
  next unless exists $messages{$pids{$pid}};

  $messages{$pids{$pid}}->{status} = $status;
  delete $pids{$pid}; # to make sure subsequent PIDs won't use this
 }

 # qmail-smtpd
 if (m/(.*?) qmail-smtpd (\d+): (.*)/)
 {
  my $id = $2;
  my $line = $3;
  $messages{$id}->{date} = $1;

  if ($line =~ m/mail from: (\S+)/)
  {
   $messages{$id}->{from} = $1;
  }
  elsif ($line =~ m/rcpt to: (\S+)/)
  {
   push @{$messages{$id}->{to}}, $1;
  }
  elsif ($line =~ m/size (\d+) bytes/)
  {
   $messages{$id}->{size} = $1;
  }
 }
}

printf "ID         date               from\n";

foreach my $id (sort { $a <=> $b } keys %messages)
{
 next unless complete($messages{$id});

 my $status = (exists $messages{$id}->{status}) ? "\n" . $messages{$id}->{status} : '';
 
 printf "%-10d %s %10s %30s%s\n\t%s\n",
  $id,
   $messages{$id}->{date},
  human($messages{$id}->{size}),
  $messages{$id}->{from},
   $status,
   join ("\n\t", map { "to: $_" } @{$messages{$id}->{to}})
}

# get a human-readable size
sub human
{
 my $i = shift @_;
 my @sizes = qw/k m g/;
 my $size = '';

 do
 {
  $i /= 1024;
  $size = shift @sizes;
 }
 while ($i > 1024 && @sizes);

 return sprintf '%.2f%s', $i, $size;
}

# is the record complete?
sub complete
{
 my $hash = shift @_;

 return exists $hash->{from}
  && exists $hash->{to}
   && exists $hash->{date}
    && exists $hash->{size};
}