File Coverage

blib/lib/Mail/IspMailGate/Filter/PGP.pm

Criterion	Covered	Total	%
statement	3	48	6.2
branch	0	24	0.0
condition	0	9	0.0
subroutine	1	7	14.2
pod	6	6	100.0
total	10	94	10.6

# -*- perl -*-
#

package Mail::IspMailGate::Filter::PGP;

require 5.004;
use strict;

require Mail::IspMailGate::Filter;
require MIME::Decoder::PGP;

MIME::Decoder::PGP->install('x-pgp');


@Mail::IspMailGate::Filter::PGP::ISA = qw(Mail::IspMailGate::Filter::InOut);

sub getSign { "X-ispMailGate-PGP"; };

#####################################################################
#
#   Name:     mustFilter
#
#   Purpose:  determines wether this message must be filtered and
#             allowed to modify $self the message and so on
#
#   Inputs:   $self   - This class
#             $entity - the whole message
#
#   Returns:  1 if it must be, else 0
#
#####################################################################

sub mustFilter ($$) {
    my($self, $entity) = @_;
    if (!$self->SUPER::mustFilter($entity)) {
	return 0;
    }

    if ($self->{'recDirection'} eq 'pos') {
	if (!$self->{'uid'}) {
	    return 0;
	}
    } else {
	my($head) = $entity->head();
	my($uid) = $head->mime_attr('X-ispMailGate-PGP.uid');
	if (!$uid  ||  !$self->{'passPhrases'}->{$uid}) {
	    return 0;
	}
    }

    return 1;
}


#####################################################################
#
#   Name:     filterFile
#
#   Purpse:   do the filter process for one file. Compress it or
#             uncompress it. the direction will be guessed, if this
#             fails the initial one will be used
#             If the direction is 'neg' the packer will
#             be guessed. Only if this fails the 'packer' attribute will
#             be tried
#
#   Inputs:   $self   - This class
#             $attr   - hash-ref to filter attribute
#                       1. 'body'
#                       2. 'parser'
#                       3. 'head'
#                       4. 'globHead'
#
#   Returns:  error message, if any
#
#####################################################################

sub filterFile ($$) {
    my ($self, $attr) = @_;

    my ($ret);
    if($ret = $self->SUPER::filterFile($attr)) {
	return $ret;
    }

    my($head) = $attr->{'head'};
    $head->delete('Content-Transfer-Encoding');
    if ($self->{'recDirection'} eq 'pos') {
	#
	#   All we do is setting the encoding type to x-pgp.
	#   MIME::Decoder::PGP will do the rest.
	#
	$head->mime_attr("Content-Transfer-Encoding", "x-pgp");
	$head->mime_attr("Content-Transfer-Encoding.uid", $self->{'uid'});
    } else {
	#
	#   All we do is resetting the encoding type.
	#
	my ($type) = split('/', $head->get("Content-Type"));
	if ($type eq 'text'  ||  $type eq 'message') {
	    $head->set('Content-Transfer-Encoding', 'quoted-printable');
	} else {
	    $head->set('Content-Transfer-Encoding', 'base64');
	}
    }

    '';
}


sub IsEq ($$) {
    my($self, $cmp) = @_;
    $self->SUPER::IsEq($cmp)  &&
	($self->{'direction'} eq 'neg'  ||
	 $self->{'uid'} eq $cmp->{'uid'});
}


sub hookFilter ($$) {
    my($self, $entity) = @_;
    my($head) = $entity->head;
    if ($self->{'recDirection'} eq 'pos') {
	$head->mime_attr($self->getSign(), $self->{'recDirection'});
	$head->mime_attr($self->getSign() . ".uid", $self->{'uid'});
    } else {
	$head->delete($self->getSign());
    }
    delete $self->{'recDirection'};
    '';
}


sub new ($$) {
    my($class, $attr) = @_;
    my($self) = $class->SUPER::new($attr);
    my $cfg = $Mail::IspMailGate::Config::config;
    if ($self) {
	if (!exists($self->{'uid'})) {
	    $self->{'uid'} = $cfg->{'pgp'}->{'uid'};
	}
	if (!exists($self->{'passPhrases'})) {
	    $self->{'passPhrases'} = $cfg->{'pgp'}->{'uids'};
	}
    }

    $self;
}


1;


__END__