File Coverage

blib/lib/Mail/Postfix/Postdrop.pm

Criterion	Covered	Total	%
statement	24	111	21.6
branch	0	32	0.0
condition	0	7	0.0
subroutine	8	20	40.0
pod	6	7	85.7
total	38	177	21.4

# $Id: Postdrop.pm 2376 2008-10-27 09:36:02Z makholm $
package Mail::Postfix::Postdrop;

use strict;
use warnings;

our $VERSION = '0.3';

use Carp;
use Exporter qw(import);
our @EXPORT_OK = qw(inject);

use Email::Abstract;
use Email::Address;

use File::Temp qw(tempfile);

use IO::Socket::UNIX;

# Can we deduce these?
our $MAILDROP_QUEUE_DIR    = '/var/spool/postfix/maildrop/';
our $PICKUP_SERVICE_SOCKET = '/var/spool/postfix/public/pickup';

my %rec_types;
%rec_types = (
    REC_TYPE_SIZE => 'C',    # first record, created by cleanup
    REC_TYPE_TIME => 'T',    # time stamp, required
    REC_TYPE_FULL => 'F',    # full name, optional
    REC_TYPE_INSP => 'I',    # inspector transport
    REC_TYPE_FILT => 'L',    # loop filter transport
    REC_TYPE_FROM => 'S',    # sender, required
    REC_TYPE_DONE => 'D',    # delivered recipient, optional
    REC_TYPE_RCPT => 'R',    # todo recipient, optional
    REC_TYPE_ORCP => 'O',    # original recipient, optional
    REC_TYPE_WARN => 'W',    # warning message time
    REC_TYPE_ATTR => 'A',    # named attribute for extensions

    REC_TYPE_MESG => 'M',    # start message records

    REC_TYPE_CONT => 'L',    # long data record
    REC_TYPE_NORM => 'N',    # normal data record

    REC_TYPE_XTRA => 'X',    # start extracted records

    REC_TYPE_RRTO => 'r',    # return-receipt, from headers
    REC_TYPE_ERTO => 'e',    # errors-to, from headers
    REC_TYPE_PRIO => 'P',    # priority
    REC_TYPE_VERP => 'V',    # VERP delimiters

    REC_TYPE_END => 'E',     # terminator, required

);

sub inject {
    my $postdrop = __PACKAGE__->new(@_);

    $postdrop->build   or return;
    $postdrop->write   or return;
    $postdrop->release or return;

    $postdrop->notify;

    return 1;
}

sub new {
    my ( $class, $message, %overrides ) = @_;

    # Email::Abstract->new() is just a no-op when called with
    # an object taht allready is an Email::Abstract. So this is ok:
    $message = Email::Abstract->new($message);

    $overrides{Attr}      ||= { rewrite_context => 'local' };
    $overrides{Timestamp}   = time() unless exists $overrides{Timestamp};

    unless ( exists $overrides{Sender} ) {
        my $sender = $message->get_header("Sender");
        $sender ||= $message->get_header("From");

        $overrides{Sender} = ( Email::Address->parse($sender) )[0]->address;
    }

    unless ( exists $overrides{Recipients} ) {
        $overrides{Recipients} = [
            map   { $_->address }
              map { Email::Address->parse($_) }
              map { $message->get_header($_) } qw(To Cc Bcc)
        ];
    }

    return bless {
        message => $message,
        args    => \%overrides,
    }, $class;
}

sub build {
    my ($self) = @_;

    $self->_build_rec_time();
    $self->_build_attr( %{ $self->{args}->{Attr} } );
    $self->_build_rec( 'REC_TYPE_FROM', $self->{args}->{Sender} || "" );
    for ( @{ $self->{args}->{Recipients} } ) {
        $self->_build_rec( 'REC_TYPE_RCPT', $_ );
    }

    # add an empty message length record.
    # cleanup is supposed to understand that.
    # see src/pickup/pickup.c
    $self->_build_rec( 'REC_TYPE_MESG', "" );

    # a received header has already been added in SMTP.pm
    # so we can just copy the message:

    for ( split( /\r?\n/, $self->{message}->as_string() ) ) {
        $self->_build_msg_line($_);
    }

    # finish it.
    $self->_build_rec( 'REC_TYPE_XTRA', "" );
    $self->_build_rec( 'REC_TYPE_END',  "" );

    return $self->{content};
}

# We're a method so it ok
sub write {    ## no critic  (ProhibitBuiltinHomonyms)
    my $self = shift;

    my $oldumask = umask oct(177)
      or return;

    my ( $fh, $filename ) = tempfile( DIR => $MAILDROP_QUEUE_DIR )
      or return;

    $self->{filename} = $filename;

    print $fh $self->{content}
      or return;

    close $fh
      or return;

    umask $oldumask;

    return 1;
}

sub release {
    my $self = shift;

    chmod oct(744), $self->{filename}
      or return;

    return 1;
}

sub drop {
    my $self = shift;

    unlink $self->{filename};

    return 1;
}

sub notify {
    my $fh;

    open $fh, ">", $PICKUP_SERVICE_SOCKET
      or return;

    print $fh "W"
      or return;

    close $fh;

    return 1;
}

############################################################
#
# Auxillary functions for building the queue file
#
############################################################

sub _build_rec {
    my ( $self, $type, @list ) = @_;

    croak "unknown record type" unless ( $rec_types{$type} );
    $self->{content} .= ( $rec_types{$type} );

    # the length is a little endian base-128 number where each
    # byte except the last has the high bit set:
    my $s  = "@list";
    my $ln = length($s);
    while ( $ln >= 0x80 ) {
        my $lnl = $ln & 0x7F;
        $ln >>= 7;
        $self->{content} .= ( chr( $lnl | 0x80 ) );
    }
    $self->{content} .= ( chr($ln) );

    $self->{content} .= ($s);

    return;
}

sub _build_rec_size {
    my ( $self, $content_size, $data_offset, $rcpt_count ) = @_;

    my $s = sprintf( "%15ld %15ld %15ld", $content_size, $data_offset, $rcpt_count );
    $self->_build_rec( 'REC_TYPE_SIZE', $s );
    return;
}

sub _build_rec_time {
    my ( $self, $time ) = @_;

    $time = $self->{args}->{Timestamp} unless ( defined($time) );

    return unless defined $time;

    my $s = sprintf( "%d", $time );
    $self->_build_rec( 'REC_TYPE_TIME', $s );
    return;
}

sub _build_attr {
    my ( $self, %kv ) = @_;
    for ( keys %kv ) {
        $self->_build_rec( 'REC_TYPE_ATTR', "$_=$kv{$_}" );
    }
    return;
}

sub _build_msg_line {
    my ( $self, $line ) = @_;

    $line =~ s/\r?\n$//s;

    # split into 1k chunks.
    while ( length($line) > 1024 ) {
        my $s = substr( $line, 0, 1024 );
        $line = substr( $line, 1024 );
        $self->_build_rec( 'REC_TYPE_CONT', $s );
    }
    $self->_build_rec( 'REC_TYPE_NORM', $line );
    return;
}

1;

__END__