File Coverage

blib/lib/Postfix/ContentFilter.pm

Criterion	Covered	Total	%
statement	15	80	18.7
branch	0	38	0.0
condition	0	21	0.0
subroutine	5	13	38.4
pod	3	3	100.0
total	23	155	14.8

package Postfix::ContentFilter;

use Modern::Perl;
use Carp;
use Try::Tiny 0.11;
use IPC::Open3 1.03;
use Scalar::Util qw(blessed);

=head1 NAME

Postfix::ContentFilter - a perl content_filter for postfix

=head1 VERSION

Version 1.11

=cut

our $VERSION = '1.11';

=head1 SYNOPSIS

    use Postfix::ContentFilter;

    $exitcode = Postfix::ContentFilter->process(sub{
	$entity = shift; # isa MIME::Entity

	# do something with $entity

	return $entity;
    });

    # Or specifying the parser
    my $cf = Postfix::ContentFilter->new({ parser => 'Mail::Message' });

    $exitcode = $cf->process(sub{
	$entity = shift; # isa Mail::Message

	# do something with $entity

	return $entity;
    });

    exit $exitcode;

=head1 DESCRIPTION

Postfix::ContentFilter can be used for C scripts, as described here: L.

=cut

our $parser;
our $sendmail = [qw[ /usr/sbin/sendmail -G -i ]];
our $output;
our $error;

=head1 FUNCTIONS

=head2 new($args)
C creates a new Postfix::Contentfilter. It takes an optional argument of a hash with the key 'parser', which specifies the parser to use as per C. This can be either C or C.

Alternatively C can be called directly.

=cut

sub new($%)
{   my ($class, $options) = @_;
    my $self = bless {}, $class;
    if ($options && $options->{parser})
    {
        parser($self, $options->{parser});
    }

    $self;
}

=head2 parser($string)

C specifies the parser to use, which can be either C or C. It defaults to C, if available, or C whichever could be found first. When called without any arguments, it returns the current parser.

=cut

sub _load_any {
	foreach my $module (@_) {
		my $path = $module;
		$path =~ s/::/\//g;
		$path .= '.pm';
		return $module if exists $INC{$path};
		eval "require $module; 1" and return $module;
	}
    croak("Couldn't find any of these implementations: @_");
}

sub parser {
    my ($self, $ptype) = @_;
	my $parsers = {
		# Key is parser, value is returned entity
		'MIME::Parser'  => 'MIME::Entity',
		'Mail::Message' => 'Mail::Message',
	};

	return $self->{parser} if defined $self->{parser} and not defined $ptype;

	$ptype = _load_any($ptype || qw(MIME::Parser Mail::Message));

	if (my $ent = $parsers->{$ptype}) {
        $self->{parser} = $ptype;
        $self->{entity} = $ent;
    } else {
        croak "Unknown parser $ptype";
    }

    return $self->{parser};
}

sub _parse {
	my ($self, $handle) = @_;
}

=head2 process($coderef [, $inputhandle])

C reads the mail from C (or C<$inputhandle>, if given), parses it, calls the coderef and finally runs C with our own command-line arguments (C<@ARGV>).

This function returns the exitcode of C.

=cut

sub process($&;*) {
    my ($class, $coderef, $handle) = @_;

    my $self = blessed $class
	         ? $class
			 : bless {}, $class
			 ; # For backwards compatibility, to enable calling directly

    confess "please call as ".__PACKAGE__."->process(sub{ ... })" unless ref $coderef eq 'CODE';

    $handle = \*STDIN unless ref $handle eq 'GLOB';

    my $entity;
    my $parser = $self->parser;

	given (ref $parser || $parser) {
		when ('Mail::Message') {
			$entity = $parser->read($handle) or confess "failed to parse with Mail::Message";
		}
		when ('MIME::Parser') {
			$parser = $parser->new;
			$entity = $parser->parse($handle) or confess "failed to parse wth MIME::Parser";
		}
		default {
			confess "Unkown parser $parser";
		}
	}

    try {
		$entity = $coderef->($entity);
    } catch {
		given (ref $parser || $parser) {
			when ('Mail::Message') {
	            $entity->DESTROY;
			}
			when ('MIME::Parser') {
	            $parser->filer->purge;
			}
		}
		confess $_;
    };

    confess "subref should return instance of $self->{entity}"
        unless blessed($entity) and $entity->isa($self->{entity});

    my $ret = -1;

    $SIG{CHLD} = sub { wait; $ret = $? if $? >= 0 };

    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'PATH'} if ${^TAINT};

    my ($in, $out, $err);
    my $pid = open3 ($in, $out, $err, @$sendmail, @ARGV) or confess "open3: $!";

    $entity->print($in) or confess "print: $!";

    close $in;

    $output = join '' => <$out> if defined $out;
    $error = join '' => <$err> if defined $err;

    close $out;

    waitpid($pid, 0);
	$ret = $? if $? >= 0;

	given (ref $parser || $parser) {
		when ('Mail::Message') {
			$entity->DESTROY;
		}
		when ('MIME::Parser') {
			$parser->filer->purge;
		}
	}

    return $ret == 0 ? 1 : 0;
}

=head1 VARIABLES

=over 4

=item * C<$sendmail>

C<$sendmail> defaults to C.

    $Postfix::ContentFilter::sendmail = [ '/usr/local/sbin/sendmail', '-G', '-i' ];

Please note C<$sendmail> must be an arrayref. Don't forget to use the proper arguments for C, or just replace the first element in array.

Additional arguments can be added with:

    push @$Postfix::ContentFilter::sendmail => '-t';

=item * C<$output>

Any output from C command is populated in C<$output>.

=item * C<$parser>

The L object is available via C<$parser>. To tell where to put the things, use:

    $Postfix::ContentFilter::parser->output_under('/tmp');

=back

=head1 CAVEATS

If taint mode is on, %ENV will be stripped:

    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'PATH'}

So set C<$Postfix::ContentFilter::sendmail> to an absolute path, if you are using taint mode. See L for more details about unsafe variables and tainted input.

=head1 SEE ALSO

=over 4

=item * L

=item * L

=item * L

=back

=head1 AUTHOR

David Zurborg, C<<  >>

=head1 BUGS

Please report any bugs or feature requests trough L. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Postfix::ContentFilter

You can also look for information at:

=over 4

=item * Redmine: Homepage of this module

L

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 COPYRIGHT & LICENSE

Copyright 2014 David Zurborg, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the terms of the ISC license.

=cut

1; # End of Postfix::ContentFilter