File Coverage

blib/lib/Postfix/ContentFilter.pm

Criterion	Covered	Total	%
statement	66	77	85.7
branch	20	36	55.5
condition	10	24	41.6
subroutine	13	16	81.2
pod	3	3	100.0
total	112	156	71.7

use strict;
use warnings;
package Postfix::ContentFilter;
# ABSTRACT: a perl content_filter for postfix

use Carp;
use Try::Tiny 0.11;
use IPC::Run 0.92 qw(start pump finish timeout);
use Scalar::Util qw(blessed);
use Class::Load qw(load_first_existing_class);

our $VERSION = '1.12'; # VERSION


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


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


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_first_existing_class(map { $_ => {} } ($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) = @_;
}


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;
    my $module = ref $parser || $parser;

    if ($module eq 'Mail::Message') {
        $entity = $parser->read($handle) or confess "failed to parse with Mail::Message";
    } elsif ($module eq 'MIME::Parser') {
        $parser = $parser->new;
        $entity = $parser->parse($handle) or confess "failed to parse wth MIME::Parser";
    } else {
        confess "Unkown parser $parser";
    }

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

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

    my $ret;

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

    $output = undef;
    $error = undef;

	my $in;

	try {

		my $h = start [ @$sendmail, @ARGV ], \$in, \$output, \$error, timeout(60);

		my $module = ref $parser || $parser;
		if ($module eq 'Mail::Message') {
                        $in = $entity->string;
                } elsif ($module eq 'MIME::Parser') {
                        $in = $entity->as_string;
		}

		pump $h;

		$ret = finish $h;

	} catch {

		local $, = ' ';
		confess "error: $_ with @$sendmail @ARGV";

	} finally {

	        my $module = ref $parser || $parser;
		if ($module eq 'Mail::Message') {
                        $entity->DESTROY;
                } elsif ($module eq 'MIME::Parser') {
                        $parser->filer->purge;
		}

	};

    return $ret;
}


1;

__END__