File Coverage

blib/lib/Mail/POPRelay.pm

Criterion	Covered	Total	%
statement	12	111	10.8
branch	0	64	0.0
condition			n/a
subroutine	4	14	28.5
pod	5	7	71.4
total	21	196	10.7

package Mail::POPRelay;

use strict;
use Mail::Object;
use vars qw[$VERSION @ISA ];

use constant PRESERVE_MESSAGE => "# Above configuration will be preserved by POPRelay.\n";

$VERSION = '2.1.1';
@ISA     = qw[Mail::Object ];

$Mail::POPRelay::DEBUG = 0;


# check any given hash for existence of certain keys
# ---------
sub __initTest {
	my $self   = shift;
	my %qaTest = %{; shift};

	foreach (keys %qaTest) {
		die sprintf "%s was not specified.\n", $qaTest{$_} unless defined $self->{$_};
	}
	return $self;
}


# ---------
sub initWithConfigFile {
	my $configFileName = splice(@_, 1, 1);

	die "Missing argument config-file." unless $configFileName;
	die "$configFileName: No such file exists." unless -f $configFileName;

	# slurp config file
	undef $/;
	open CONFIG, $configFileName or die "Unable to open config-file $configFileName: $!";
	my $configFile = ;
	close CONFIG;
	$/ = "\n"; # disable slurp mode

	# create a hash from the config file
	my $options;
	$configFile =~ s,(.*?=)([\s\t]*)(.*),$1>$2'$3'\,,g;
	eval "\$options = { $configFile };";
	die "Corrupted config-file $configFileName: $@" if $@;

	# store config file used
	$_[0]->addAttributeWithValue('configFile', $configFileName)
		unless $_[0]->respondsTo('configFile');

	# initialize a POPRelay subclass w/ config file hash
	return Mail::POPRelay::init(@_, $options);
}


# ---------
sub init {
	# call proper init if necessary
	return Mail::POPRelay::initWithConfigFile(@_) unless ref $_[1];

	my $myDefaults = {
		mailLogFile               => '/var/log/maillog',
		mailProgram               => 'sendmail',
		mailProgramRestart        => 0,
		mailProgramRestartCommand => '/etc/init.d/%m restart',
		mailRelayIsDatabase       => 0,
		mailRelayDatabaseCommand  => '/usr/sbin/makemap hash %r < %r',
		mailRelayDirectory        => '/var/spool/poprelay',
	};
	splice(@_, 2, 0, splice(@_, 1, 1, $myDefaults));
	my $self = Mail::Object::init(@_);

	my %qualityAssurance = (
		mailLogFile         => 'Mail log file',
		mailProgram         => 'Mail program',
		mailRelayDirectory  => 'Mail relay directory',
		mailRelayFile       => 'Mail relay file',
		mailRelayPeriod     => 'Mail relay period',
		mailRelayFileFormat => 'Mail relay file format',
	);
	$self->__initTest(\%qualityAssurance);

	$self->addAttribute('relayPreserve') unless
		$self->respondsTo('relayPreserve');

	# parse special option variables
	foreach ($self->{'mailRelayFileFormat'}, $self->{'mailProgramRestartCommand'}, $self->{'mailRelayDatabaseCommand'}) {
		s,%m,$self->{'mailProgram'},gi;
		s,%r,$self->{'mailRelayFile'},gi;
	}

	$self->__createRelayDirectory()
		unless (-d $self->{'mailRelayDirectory'});

	return $self;
}


# ---------
sub restartMailProgram {
	my $self = shift;

	$self->{'mailProgramRestartCommand'} =~ s,%m,$self->{'mailProgram'},ig;

	print "o Restarting mail program: $self->{'mailProgramRestartCommand'}"
		if $Mail::POPRelay::DEBUG;
	return `$self->{'mailProgramRestartCommand'}`;
}


# purge all relay address files in spool
# ---------
sub wipeRelayDirectory {
	my $self = shift;

	print "o Wiping relay directory\n" if $Mail::POPRelay::DEBUG;
	my $mailRelayDirectory = $self->{'mailRelayDirectory'};
	foreach (<$mailRelayDirectory/*>) {
		unlink($_) or die "Unable to remove $_: $!";
	}
	return $self;
}


# purge only expired relay address files in spool
# ---------
sub cleanRelayDirectory {
	my $self = shift;

	print "o Cleaning relay directory\n" if $Mail::POPRelay::DEBUG;
	my($mailRelayDirectory, @purgeCount) = ($self->{'mailRelayDirectory'}, 0);
	foreach (<$mailRelayDirectory/*>) {
		chomp();
		my $modifyTime = (stat("$_"))[8] or die "Unable to stat $_: $!";

		if (time > ($modifyTime + $self->{'mailRelayPeriod'})) {
			printf "\t`- removing %s (%d - %d < %d)\n", $_, time, ($modifyTime + $self->{'mailRelayDirectory'}, $self->{'mailRelayPeriod'}) if $Mail::POPRelay::DEBUG;
			unlink($_) or die "Unable to unlink $_: $!";
			push @purgeCount, $_;
		}
	}
	return wantarray ? @purgeCount : scalar @purgeCount;
}


# add relay address file to spool
# ---------
sub addRelayAddress {
	my $self          = shift;
	my $userName      = shift;
	my $userIpAddress = shift;

	if (!-e "$self->{'mailRelayDirectory'}/$userIpAddress") {
		open(OUT, ">$self->{'mailRelayDirectory'}/$userIpAddress") or die "Unable to open $self->{'mailRelayDirectory'}/$userIpAddress: $!";
		print OUT $userName;
		close(OUT);
		return $self;
	}

	return 0;
}


# ---------
sub __generatePreserveList {
	my $self = shift;

	my @preserveList;
	my $mailRelayFile = $self->{'mailRelayFile'};
	open(PACCESS, "<$mailRelayFile") or die "Unable to open $mailRelayFile: $!";
	while () {
		last if $_ eq PRESERVE_MESSAGE;
		push @preserveList, $_;
	}
	close(PACCESS);
	return join('', @preserveList);
}


# ---------
sub __createRelayDirectory {
	my $self = shift;

	die "Unable to create mail relay directory: $!" unless
		mkdir($self->{'mailRelayDirectory'}, 0027);

	return $self;
}


# write out entire relaying file
# ---------
sub generateRelayFile {
	my $self = shift;

	my @relayArray;
	my $mailRelayDirectory = $self->{'mailRelayDirectory'};

	$self->__createRelayDirectory()
		unless (-d $self->{'mailRelayDirectory'});

	# build relay list
	my $entry;
	print "o Building the relay file\n" if $Mail::POPRelay::DEBUG;
	foreach (<$mailRelayDirectory/*>) {
		s,.*/([\d\.]+)$,$1,;
		print "\t`- adding $_\n" if $Mail::POPRelay::DEBUG;
		$entry = $self->{'mailRelayFileFormat'};
		$entry =~ s,%i,$_,g;
		push @relayArray, $entry;
	}

	# recreate preserve list incase of change
	$self->{'relayPreserve'} = $self->__generatePreserveList();

	my $mailRelayFile = $self->{'mailRelayFile'};
	open(RACCESS, ">$mailRelayFile") or die "Unable to open $mailRelayFile: $!";
	print RACCESS $self->{'relayPreserve'}, PRESERVE_MESSAGE, join("\n", @relayArray);
	close RACCESS;

	# generate relay database if needed
	if ($self->{'mailRelayIsDatabase'}) {
		print "o Generating relay database\n" if $Mail::POPRelay::DEBUG;
		warn "Error generating relay database with command: $self->{'mailRelayDatabaseCommand'}\n" if
			system($self->{'mailRelayDatabaseCommand'});
	}

	# restart mail server if needed
	if ($self->{'mailProgramRestart'}) {
		sleep(3);
		print "o Restarting mail daemon\n" if $Mail::POPRelay::DEBUG;
		$self->restartMailProgram();
	}
	return $self;
}


1337;


__END__