File Coverage

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

Criterion	Covered	Total	%
statement	58	75	77.3
branch	13	30	43.3
condition	1	3	33.3
subroutine	7	7	100.0
pod	6	6	100.0
total	85	121	70.2

# -*- perl -*-
#

package Mail::IspMailGate::Filter::Packer;

require 5.004;
use strict;

require Mail::IspMailGate::Filter;

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

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

#####################################################################
#
#   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) = @_;
    my $cfg = $Mail::IspMailGate::Config::config;

    if (!$self->SUPER::mustFilter($entity)) {
	return 0;
    }

    my($packer) = $self->{'packer'};
    my($direction) = $self->{'recDirection'};
    my($head) = $entity->head();
    if ($direction eq 'neg') {
	my $prevPack = $head->mime_attr('X-IspMailGate-Packer-Type');
	$prevPack = '' unless defined $prevPack;
	if(exists($cfg->{'packer'}->{$prevPack})) {
	    $packer=$prevPack;
	} else {
	    return 0;
	}
    } else {
	$head->mime_attr('X-IspMailGate-Packer-Type', $packer);
    }
    $self->{'recPacker'} = $packer;

    return 1;
}


#####################################################################
#
#   Name:     hookFilter
#
#   Purpse:   a function which is called after the filtering process
#
#   Inputs:   $self   - This class
#             $entity - the whole message
#
#   Returns:  errormessage if any
#
#####################################################################

sub hookFilter ($$) {
    my($self, $entity) = @_;
    my($direction) = $self->{'recDirection'};
    $self->SUPER::hookFilter($entity);
    if ($direction eq 'neg') {
	$entity->head()->delete('X-Ispmailgate-Packer-Type');
	$entity->head()->delete('X-Ispmailgate-Packer');
    }
    delete $self->{'recPacker'};
    '';
}



#####################################################################
#
#   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 $cfg = $Mail::IspMailGate::Config::config;

    my ($ret) = 0;
    if($ret = $self->SUPER::filterFile($attr)) {
	return $ret;
    }
    my $head = $attr->{'head'};
    my $body = $attr->{'body'};
    my $parser = $attr->{'parser'};
    my $globHead = $attr->{'globHead'};
    my $ifile = $body->path();
    my $ofile = $parser->output_path($head);
    my $packer = $self->{'recPacker'};
    my $direction = $self->{'recDirection'};
    my $sign = '';

    if((!defined($packer)) || (!defined($direction))) {
	return "Invalid invoke";
    }
    return "Unknown packer: $packer"
	unless exists($cfg->{'packer'}->{$packer});
    my $cmd = $cfg->{'packer'}->{$packer}->{$direction};
    $cmd =~ s/\$(\w+)/$cfg->{$1}/g;

    if ($ret=system("$cmd " . quotemeta($ifile) . " >" . quotemeta($ofile))) {
	return $ret;
    } else {
	$body->path($ofile);
    }
    $self->setEncoding({('head' => $head, 'direction' => $direction)});
    '';
}

#####################################################################
#
#   Name:     setEncoding
#
#   Purpse:   set a reasonable encoding type, for the filtered mail
#
#   Inputs:   $self   - This class
#             $attr   - the attributes
#                       'head'
#                       'direction'
#
#   Returns:  error message, if any
#
#####################################################################

sub setEncoding ($$$) {
    my ($self, $attr) = @_;
    my ($head) = $attr->{'head'};
    my ($direction) = $attr->{'direction'};
    my ($actuEnc) = $head->mime_attr('Content-Transfer-Encoding');
    if (!defined($actuEnc)) {
	$actuEnc = '';
    }
    my ($prevEnc) = $head->mime_attr('X-ispMailGate-Packer-PEncoding');
    if (!defined($prevEnc)) {
	$prevEnc = '';
    }
    my ($newEnc) = '';

    if ($direction eq 'neg') {
	if ($prevEnc) {
	    $newEnc = $prevEnc;
	} else {
	    # Assume base64 to go the sure way
	    $newEnc = "base64";
	}
	$head->delete('X-IspMailgate-Packer-PEncoding');
    }  else {
	$newEnc = "base64";
	if ($actuEnc) {
	    $head->replace("X-ispMailGate-Packer-PEncoding", $actuEnc);
	} else {
	    # Assume base64 as encoding if not clear
	    $head->replace("X-ispMailGate-Packer-PEncoding", "base64");
	}
    }
    $head->replace("Content-Transfer-Encoding", $newEnc);

    '';
}


sub IsEq ($$) {
    my($self, $cmp) = @_;
    $cmp->isa('Mail::IspMailGate::Filter::Packer') &&
	$self->{'packer'} eq $cmp->{'packer'};
}

$Mail::IspMailGate::Filter::VERSION = "1.000";

1;

__END__