Download | Plain Text | No 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.1';
-
- use Mail::DKIM 0.29;
- use Mail::DKIM::Signer;
-
- # enable support for "pretty" signatures, if available
-
- =head
- config file structure
- - missing settings will be merged from global
- - domain-entry will also match its subdomains
- - specify "none" in types-tag to omit signing
-
- <dkimsign>
- <global algorithm="rsa-sha256" domain="/var/qmail/control/me" keyfile="/var/qmail/control/dkim/global.key" method="simple" selector="beta">
- <types>dkim</types>
- </global>
- <example.com selector="beta2">
- <types>dkim</types>
- <types>domainkey</types>
- </example.com>
- </dkimsign>
- =cut
-
- $configfile = '/var/qmail/control/dkim/signconf.xml';
- #$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 (!$@)
- {
- my $xmlconf;
- qexit_deferral('Unable to read config file: ', $@)
- if ($@);
- ConfigMerge::merge($config, $xmlconf);
- }
- }
-
- # open debug file
- {
- or qexit_deferral('Unable to open ', $debugfile, ' to writing: ', $!);
- }
-
- # generate signatures
- my $dkim;
- my $mailbuf = '';
- {
- my $conf = $config->{'global'};
- $dkim = Mail::DKIM::Signer->new(
- Policy => 'MySignerPolicy',
- Debug_Canonicalization => $debugfh
- );
-
- if ($binary)
- {
- }
-
- while (<STDIN>)
- {
- $mailbuf .= $_;
- unless ($binary)
- {
- s/\015?$/\015\012/s;
- }
- $dkim->PRINT($_);
- }
- $dkim->CLOSE();
- };
- qexit_deferral('Error while signing: ', $@)
- if ($@);
-
- # close debug file
-
- # execute qmail-remote
- 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;
- }
-
- #-------------------------------------------------------------------------------
-
- sub qexit
- {
- }
-
- sub qexit_deferral
- {
- }
-
- sub qexit_failure
- {
- }
-
- sub qexit_success
- {
- }
-
- #-------------------------------------------------------------------------------
-
- package ConfigMerge;
- our $VERSION = '0.1';
-
- # merge config hashes. arrays and scalars will be copied.
- sub merge
- {
- my ($left, $right) = @_;
- {
- : 'SCALAR';
- {
- $left->{$rkey} = $right->{$rkey};
- }
- else
- {
- merge($left->{$rkey}, $right->{$rkey});
- }
- }
- }
-
- #-------------------------------------------------------------------------------
-
- package MySignerPolicy;
- use Mail::DKIM::SignerPolicy;
- use base 'Mail::DKIM::SignerPolicy';
- use Mail::DKIM::Signature;
- use Mail::DKIM::DkSignature;
- use Carp;
- our $VERSION = '0.1';
-
- sub apply
- {
- my ($self, $signer) = @_;
-
- # merge configs
- while($domain)
- {
- {
- ConfigMerge::merge($config->{'global'}, $config->{$domain});
- last;
- }
- }
-
- my $conf = $config->{'global'};
- return 0
-
- # set key file
- $signer->key_file($conf->{'keyfile'});
-
- # parse (signature) domain
- {
- or croak('Unable to open domain-file: '.$!);
- croak("Unable to read domain-file. Maybe empty file.")
- if (!$newdom);
- $conf->{'domain'} = $newdom;
- }
-
- # generate signatures
- foreach my $type (@$types)
- {
- if ($type eq 'dkim')
- {
- $signer->add_signature(
- new Mail::DKIM::Signature(
- Algorithm => $conf->{'algorithm'} || $signer->algorithm,
- Method => $conf->{'method'} || $signer->method,
- Headers => $conf->{'headers'} || $signer->headers,
- Domain => $conf->{'domain'} || $signer->domain,
- Selector => $conf->{'selector'} || $signer->selector,
- Query => $conf->{'query'},
- Identity => $conf->{'identity'},
- Expiration => $conf->{'expiration'}
- )
- );
- }
- elsif ($type eq 'domainkey')
- {
- $signer->add_signature(
- new Mail::DKIM::DkSignature(
- Algorithm => 'rsa-sha1', # only rsa-sha1 supported
- Method => $conf->{'method'} || $signer->method,
- Headers => $conf->{'headers'} || $signer->headers,
- Domain => $conf->{'domain'} || $signer->domain,
- Selector => $conf->{'selector'} || $signer->selector,
- Query => $conf->{'query'}
- )
- );
- }
- }
-
- }
-