Download | Plain Text | Line Numbers
#!/usr/bin/perl
#
# Copyright (C) 2007 Manuel Mausz (manuel@mausz.at)
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
use strict;
use warnings;
our $VERSION = '0.2';
use Mail::DKIM 0.29;
use Mail::DKIM::Signer;
# enable support for "pretty" signatures, if available
eval 'require Mail::DKIM::TextWrap';
=head
config file structure
- missing settings will be merged from the global-node
- domain-entry will also match its subdomains
- create empty domain-node to omit signing (or specify "none" as id)
<dkimsign>
<!-- per default sign all mails using dkim -->
<global algorithm="rsa-sha256" domain="/var/qmail/control/me" keyfile="/var/qmail/control/dkim/global.key" method="simple" selector="beta">
<types id="dkim" />
</global>
<!-- use dkim + domainkey for example.com -->
<example.com selector="beta2">
<types id="dkim" />
<types id="domainkey" method="nofws" />
</example.com>
<!-- no signing for example2.com -->
<example2.com />
</dkimsign>
=cut
my $configfile = undef;
$configfile = '/var/qmail/control/dkim/signconf.xml';
my $debugfile = undef;
#$debugfile = '/tmp/dkim.debug';
my $qremote = '/var/qmail/bin/qmail-remote.orig';
my $binary = 0;
our $config;
$config->{'global'} = {
types => { dkim => {} },
keyfile => '/var/qmail/control/dkim/global.key',
algorithm => 'rsa-sha256',
method => 'simple',
selector => 'beta',
# either string or file (first line of file will be used)
#domain => '/var/qmail/control/me'
};
#-------------------------------------------------------------------------------
# read config file. safely
if (defined($configfile) && -r $configfile)
{
eval 'use XML::Simple';
if (!$@)
{
my $xmlconf;
eval { $xmlconf = XMLin($configfile, ForceArray => ['types'], KeyAttr => ['id']); };
qexit_deferral('Unable to read config file: ', $@)
if ($@);
ConfigMerge::merge($config, $xmlconf);
}
}
# open debug file
my $debugfh = undef;
if (defined($debugfile))
{
open($debugfh, '>', $debugfile)
or qexit_deferral('Unable to open ', $debugfile, ' to writing: ', $!);
}
# generate signatures
my $dkim;
my $mailbuf = '';
eval
{
my $conf = $config->{'global'};
$dkim = Mail::DKIM::Signer->new(
Policy => 'MySignerPolicy',
Debug_Canonicalization => $debugfh
);
if ($binary)
{
binmode STDIN;
}
while (<STDIN>)
{
$mailbuf .= $_;
unless ($binary)
{
chomp $_;
s/\015?$/\015\012/s;
}
$dkim->PRINT($_);
}
$dkim->CLOSE();
};
qexit_deferral('Error while signing: ', $@)
if ($@);
# close debug file
close($debugfh)
if (defined($debugfh));
# execute qmail-remote
unshift(@ARGV, $qremote);
open(QR, '|-') || exec { $ARGV[0] } @ARGV
or qexit_deferral('Unable to run qmail-remote: ', $!);
foreach my $dkim_signature ($dkim->signatures)
{
my $sig = $dkim_signature->as_string;
$sig =~ s/\015\012\t/\012\t/g;
print QR $sig."\012";
}
print QR $mailbuf;
close(QR);
#-------------------------------------------------------------------------------
sub qexit
{
print @_, "\0";
exit(0);
}
sub qexit_deferral
{
return qexit('Z', @_);
}
sub qexit_failure
{
return qexit('D', @_);
}
sub qexit_success
{
return qexit('K', @_);
}
#-------------------------------------------------------------------------------
package ConfigMerge;
# merge config hashes. arrays and scalars will be copied.
sub merge
{
my ($left, $right) = @_;
foreach my $rkey (keys(%$right))
{
my $rtype = ref($right->{$rkey}) eq 'HASH' ? 'HASH'
: ref($right->{$rkey}) eq 'ARRAY' ? 'ARRAY'
: defined($right->{$rkey}) ? 'SCALAR'
: '';
my $ltype = ref($left->{$rkey}) eq 'HASH' ? 'HASH'
: ref($left->{$rkey}) eq 'ARRAY' ? 'ARRAY'
: defined($left->{$rkey}) ? 'SCALAR'
: '';
if ($rtype ne 'HASH' || $ltype ne 'HASH')
{
$left->{$rkey} = $right->{$rkey};
}
else
{
merge($left->{$rkey}, $right->{$rkey});
}
}
return;
}
#-------------------------------------------------------------------------------
package MySignerPolicy;
use Mail::DKIM::SignerPolicy;
use base 'Mail::DKIM::SignerPolicy';
use Mail::DKIM::Signature;
use Mail::DKIM::DkSignature;
use Carp;
use strict;
use warnings;
sub apply
{
my ($self, $signer) = @_;
my $domain = undef;
$domain = lc($signer->message_sender->host)
if (defined($signer) && defined($signer->message_sender)
&& defined($signer->message_sender->host));
# merge configs
while($domain)
{
if (defined($config->{$domain}))
{
$config->{'global'}->{'types'} = undef;
ConfigMerge::merge($config->{'global'}, $config->{$domain});
last;
}
(undef, $domain) = split(/\./, $domain, 2);
}
my $conf = $config->{'global'};
return 0
if (!defined($conf->{'types'}) || defined($conf->{'types'}->{'none'}));
# set key file
$signer->key_file($conf->{'keyfile'});
# parse (signature) domain
if (substr($conf->{'domain'}, 0, 1) eq '/')
{
open(FH, '<', $conf->{'domain'})
or croak('Unable to open domain-file: '.$!);
my $newdom = (split(/ /, <FH>))[0];
close(FH);
croak("Unable to read domain-file. Maybe empty file.")
if (!$newdom);
chomp($newdom);
$conf->{'domain'} = $newdom;
}
# generate signatures
my $sigdone = 0;
foreach my $type (keys(%{$conf->{'types'}}))
{
my $sigconf = $conf->{'types'}->{$type};
if ($type eq 'dkim')
{
$signer->add_signature(
new Mail::DKIM::Signature(
Algorithm => $sigconf->{'algorithm'} || $conf->{'algorithm'} || $signer->algorithm,
Method => $sigconf->{'method'} || $conf->{'method'} || $signer->method,
Headers => $sigconf->{'headers'} || $conf->{'headers'} || $signer->headers,
Domain => $sigconf->{'domain'} || $conf->{'domain'} || $signer->domain,
Selector => $sigconf->{'selector'} || $conf->{'selector'} || $signer->selector,
Query => $sigconf->{'query'} || $conf->{'query'},
Identity => $sigconf->{'identity'} || $conf->{'identity'},
Expiration => $sigconf->{'expiration'} || $conf->{'expiration'}
)
);
$sigdone = 1;
}
elsif ($type eq 'domainkey')
{
$signer->add_signature(
new Mail::DKIM::DkSignature(
Algorithm => 'rsa-sha1', # only rsa-sha1 supported
Method => $sigconf->{'method'} || $conf->{'method'} || $signer->method,
Headers => $sigconf->{'selector'} || $conf->{'headers'} || $signer->headers,
Domain => $sigconf->{'domain'} || $conf->{'domain'} || $signer->domain,
Selector => $sigconf->{'selector'} || $conf->{'selector'} || $signer->selector,
Query => $sigconf->{'query'} || $conf->{'query'}
)
);
$sigdone = 1;
}
}
return $sigdone;
}