Postfix mailq viewer. queue_ids -> [From, To, Date, Subject]

README.md

mailq-list.pl - Postfix mailq viewer.

DESCRIPTION

mailq-list.pl is Postfix mailq viewer.

Normal Postfix mailq command shows only envelope information. If you want to know header information, you run postcat command every each time.

maiq-list.pl supports that you can show all queues' header information.

INSTALL

• Set executable permission: chmod +x mailq-list.pl
• Put (copy or move) mailq-list.pl to PATH registered directory.
• Invoke mailq-list.pl. it need no any arguments.

LICENSE

MIT.

AUTHOR

OGATA Tetsuji [email protected] @xtetsuji

mailq-list.pl

#!/usr/bin/perl
# mailq-list.pl - Postfix mailq viewer. queue_ids -> [From, To, Date, Subject]
# tetsuji.ogata 2018/04/06
use strict;
use warnings;

# my $count;

for my $queue_id (queue_ids()) {
    my ($header_lines, $body_lines) = postcat($queue_id);
    my $subject = get_header_value("Subject", $header_lines);
    $subject = encode("utf-8", decode("MIME-Header", $subject));
    my $from = get_header_value("From", $header_lines);
    my $to   = get_header_value("To", $header_lines);
    my $date = get_header_value("Date", $header_lines);
    #print "Subject: $subject ### $from => $to [$date]\n";
    printf "%s\n", join "\t", $queue_id, $date, $subject, $from, $to;
    #last if $count++ > 20; # DEBUG
}

sub queue_ids {
    #print "queue_ids\n";
    open my $pipe, '-|', 'mailq' or die;
    my @queue_ids;
    while (<$pipe>) {
        my ($queue_id, $flag) = /^([0-9A-F]+)([!*]?)/ or next;
        push @queue_ids, $queue_id;
        # TODO: $flag 使っていない
    }
    #print "queue_id count " . @queue_ids . "\n";
    return @queue_ids;
}

sub postcat {
    my $queue_id = shift;
    open my $pipe, '-|', 'postcat', '-q', $queue_id or die;
    my (@header_lines, @body_lines, $seen_blank_line);
    while (<$pipe>) {
        chomp;
        if ( $seen_blank_line ) {
            push @body_lines, $_;
        } else {
            if ( /^$/ ) {
                $seen_blank_line++;
                next;
            }
            push @header_lines, $_;
        }
    }
    return (\@header_lines, \@body_lines);
    # TODO: header_lines に ENVELOPE RECORDS も入っているけれどいいかな
}

# my $subject = get_header_value( "Subject", \@header_lines );
sub get_header_value {
    my ($key, $header_lines) = @_;
    my $whole_header_line = join "\n", @$header_lines;
    $whole_header_line =~ /^$key:\s*(.*?)(?:\n\S|\z)/ims or return;
    my $value = $1;
    $value =~ s/\n[ \t]*/ /g;
    return $value;
}

# %header = header_hashnize(\@header_lines)
sub header_hashnize {
    my ($header_lines) = @_;
    my $whole_header_line = join "\n", @$header_lines;
    my %header;
    while ( $whole_header_line =~ /^([^\s:]+):\s*(.*?)(?:\n\S|\z)/ims ) {
        my ($key, $value) = (lc($1), $2);
        $value =~ s/\n[ \t]*/ /g;
        if ( exists $header{$key} ) {
            # append?
            $header{$key} .= " " . $value;
        } else {
            $header{$key} = $value;
        }
    }
    return %header;
}