Download | Plain Text | No Line Numbers 

  1. #!/usr/bin/perl
  2. #
  3. # Copyright (C) 2007 Manuel Mausz (manuel@mausz.at)
  4. #
  5. # This program is free software; you can redistribute it and/or
  6. # modify it under the terms of the GNU General Public License
  7. # as published by the Free Software Foundation; either
  8. # version 2 of the License, or (at your option) any later
  9. # version.
  10. #
  11. # This program is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with this program; if not, write to the Free Software Foundation,
  18. # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19.  
  20. use strict;
  21. use warnings;
  22. our $VERSION = '0.3';
  23.  
  24. use Mail::DKIM 0.29;
  25. use Mail::DKIM::Signer;
  26.  
  27. # enable support for "pretty" signatures, if available
  28. eval 'require Mail::DKIM::TextWrap';
  29.  
  30. =head
  31. config file structure
  32.  - missing settings will be merged from the global-node
  33.  - domain-entry will also match its subdomains
  34.  - create empty domain-node to omit signing (or specify "none" as id)
  35.  
  36. <dkimsign>
  37.   <!-- per default sign all mails using dkim -->
  38.   <global algorithm="rsa-sha256" domain="/var/qmail/control/me" keyfile="/var/qmail/control/dkim/global.key" method="simple" selector="beta">
  39.     <types id="dkim" />
  40.   </global>
  41.  
  42.   <!-- use dkim + domainkey for example.com -->
  43.   <example.com selector="beta2">
  44.     <types id="dkim" />
  45.     <types id="domainkey" method="nofws" />
  46.   </example.com>
  47.  
  48.   <!-- no signing for example2.com -->
  49.   <example2.com />
  50. </dkimsign>
  51. =cut
  52.  
  53. my $configfile = undef;
  54. $configfile    = '/var/qmail/control/dkim/signconf.xml';
  55. my $debugfile  = undef;
  56. #$debugfile    = '/tmp/dkim.debug';
  57. my $qremote    = '/var/qmail/bin/qmail-remote.orig';
  58. my $rcpthosts  = '/var/qmail/control/rcpthosts';
  59. my $binary     = 0;
  60. our $config;
  61. $config->{'global'} = {
  62.   types     => { dkim => {} },
  63.   keyfile   => '/var/qmail/control/dkim/global.key',
  64.   algorithm => 'rsa-sha256',
  65.   method    => 'simple',
  66.   selector  => 'beta',
  67.   # either undefined (=sender), string or file (first line of file will be used)
  68.   #domain   => '/var/qmail/control/me'
  69. };
  70.  
  71. #-------------------------------------------------------------------------------
  72.  
  73. # read config file. safely
  74. if (defined($configfile) && -r $configfile)
  75. {
  76.   eval 'use XML::Simple';
  77.   if (!$@)
  78.   {
  79.     my $xmlconf;
  80.     eval { $xmlconf = XMLin($configfile, ForceArray => ['types'], KeyAttr => ['id']); };
  81.     qexit_deferral('Unable to read config file: ', $@)
  82.       if ($@);
  83.     ConfigMerge::merge($config, $xmlconf);
  84.   }
  85. }
  86.  
  87. # open debug file
  88. my $debugfh = undef;
  89. if (defined($debugfile))
  90. {
  91.   open($debugfh, '>', $debugfile)
  92.     or qexit_deferral('Unable to open ', $debugfile, ' to writing: ', $!);
  93. }
  94.  
  95. # generate signatures
  96. my $dkim;
  97. my $mailbuf = '';
  98. eval
  99. {
  100.   my $conf = $config->{'global'};
  101.   $dkim =  Mail::DKIM::Signer->new(
  102.     Policy => 'MySignerPolicy',
  103.     Debug_Canonicalization => $debugfh
  104.   );
  105.  
  106.   if ($binary)
  107.   {
  108.     binmode STDIN;
  109.   }
  110.  
  111.   while (<STDIN>)
  112.   {
  113.     $mailbuf .= $_;
  114.     unless ($binary)
  115.     {
  116.       chomp $_;
  117.       s/\015?$/\015\012/s;
  118.     }
  119.     $dkim->PRINT($_);
  120.   }
  121.   $dkim->CLOSE();
  122. };
  123. qexit_deferral('Error while signing: ', $@)
  124.   if ($@);
  125.  
  126. # close debug file
  127. close($debugfh)
  128.   if (defined($debugfh));
  129.  
  130. # execute qmail-remote
  131. unshift(@ARGV, $qremote);
  132. open(QR, '|-') || exec { $ARGV[0] } @ARGV
  133.   or qexit_deferral('Unable to run qmail-remote: ', $!);
  134. foreach my $dkim_signature ($dkim->signatures)
  135. {
  136.   my $sig = $dkim_signature->as_string;
  137.   $sig =~ s/\015\012\t/\012\t/g;
  138.   print QR $sig."\012";
  139. }
  140. print QR $mailbuf;
  141. close(QR);
  142.  
  143. #-------------------------------------------------------------------------------
  144.  
  145. sub qexit
  146. {
  147.   print @_, "\0";
  148.   exit(0);
  149. }
  150.  
  151. sub qexit_deferral
  152. {
  153.   return qexit('Z', @_);
  154. }
  155.  
  156. sub qexit_failure
  157. {
  158.   return qexit('D', @_);
  159. }
  160.  
  161. sub qexit_success
  162. {
  163.   return qexit('K', @_);
  164. }
  165.  
  166. #-------------------------------------------------------------------------------
  167.  
  168. package ConfigMerge;
  169.  
  170. # merge config hashes. arrays and scalars will be copied.
  171. sub merge
  172. {
  173.   my ($left, $right) = @_;
  174.   foreach my $rkey (keys(%$right))
  175.   {
  176.     my $rtype = ref($right->{$rkey}) eq 'HASH' ? 'HASH'
  177.               : ref($right->{$rkey}) eq 'ARRAY' ? 'ARRAY'
  178.               : defined($right->{$rkey}) ? 'SCALAR'
  179.               : '';
  180.     my $ltype = ref($left->{$rkey}) eq 'HASH' ? 'HASH'
  181.               : ref($left->{$rkey}) eq 'ARRAY' ? 'ARRAY'
  182.               : defined($left->{$rkey}) ? 'SCALAR'
  183.               : '';
  184.     if ($rtype ne 'HASH' || $ltype ne 'HASH')
  185.     {
  186.       $left->{$rkey} = $right->{$rkey};
  187.     }
  188.     else
  189.     {
  190.       merge($left->{$rkey}, $right->{$rkey});
  191.     }
  192.   }
  193.   return;
  194. }
  195.  
  196. #-------------------------------------------------------------------------------
  197.  
  198. package MySignerPolicy;
  199. use Mail::DKIM::SignerPolicy;
  200. use base 'Mail::DKIM::SignerPolicy';
  201. use Mail::DKIM::Signature;
  202. use Mail::DKIM::DkSignature;
  203. use Carp;
  204. use strict;
  205. use warnings;
  206.  
  207. sub apply
  208. {
  209.   my ($self, $signer) = @_;
  210.   my $domain = undef;
  211.   $domain = lc($signer->message_sender->host)
  212.     if (defined($signer) && defined($signer->message_sender)
  213.       && defined($signer->message_sender->host));
  214.   my $sender = $domain;
  215.  
  216.   # merge configs
  217.   while($domain)
  218.   {
  219.     if (defined($config->{$domain}))
  220.     {
  221.       $config->{'global'}->{'types'} = undef;
  222.       ConfigMerge::merge($config->{'global'}, $config->{$domain});
  223.       last;
  224.     }
  225.     (undef, $domain) = split(/\./, $domain, 2);
  226.   }
  227.  
  228.   my $conf = $config->{'global'};
  229.   return 0
  230.     if (!defined($conf->{'types'}) || defined($conf->{'types'}->{'none'}));
  231.  
  232.   # set key file
  233.   $signer->key_file($conf->{'keyfile'});
  234.  
  235.   # parse (signature) domain
  236.   if (!defined($conf->{'domain'}) || $conf->{'domain'} eq 'sender')
  237.   {
  238.     return 0
  239.       if (!defined($sender));
  240.  
  241.     $conf->{'domain'} = undef;
  242.     open(FH, '<', $rcpthosts)
  243.       or croak('Unable to open rcpthosts: '.$!);
  244.     while (my $row = <FH>)
  245.     {
  246.       chomp($row);
  247.       if ($row eq $sender)
  248.       {
  249.         $conf->{'domain'} = $sender;
  250.         last;
  251.       }
  252.     }
  253.     close(FH);
  254.     return 0
  255.       if (!defined($conf->{'domain'}));
  256.   }
  257.   elsif (substr($conf->{'domain'}, 0, 1) eq '/')
  258.   {
  259.     open(FH, '<', $conf->{'domain'})
  260.       or croak('Unable to open domain-file: '.$!);
  261.     my $newdom = (split(/ /, <FH>))[0];
  262.     close(FH);
  263.     croak("Unable to read domain-file. Maybe empty file.")
  264.       if (!$newdom);
  265.     chomp($newdom);
  266.     $conf->{'domain'} = $newdom;
  267.   }
  268.  
  269.   # generate signatures
  270.   my $sigdone = 0;
  271.   foreach my $type (keys(%{$conf->{'types'}}))
  272.   {
  273.     my $sigconf = $conf->{'types'}->{$type};
  274.  
  275.     if ($type eq 'dkim')
  276.     {
  277.       $signer->add_signature(
  278.         new Mail::DKIM::Signature(
  279.           Algorithm  => $sigconf->{'algorithm'}  || $conf->{'algorithm'} || $signer->algorithm,
  280.           Method     => $sigconf->{'method'}     || $conf->{'method'}    || $signer->method,
  281.           Headers    => $sigconf->{'headers'}    || $conf->{'headers'}   || $signer->headers,
  282.           Domain     => $sigconf->{'domain'}     || $conf->{'domain'}    || $signer->domain,
  283.           Selector   => $sigconf->{'selector'}   || $conf->{'selector'}  || $signer->selector,
  284.           Query      => $sigconf->{'query'}      || $conf->{'query'},
  285.           Identity   => $sigconf->{'identity'}   || $conf->{'identity'},
  286.           Expiration => $sigconf->{'expiration'} || $conf->{'expiration'}
  287.         )
  288.       );
  289.       $sigdone = 1;
  290.     }
  291.     elsif ($type eq 'domainkey')
  292.     {
  293.       $signer->add_signature(
  294.         new Mail::DKIM::DkSignature(
  295.           Algorithm  => 'rsa-sha1', # only rsa-sha1 supported
  296.           Method     => $sigconf->{'method'}   || $conf->{'method'}   || $signer->method,
  297.           Headers    => $sigconf->{'selector'} || $conf->{'headers'}  || $signer->headers,
  298.           Domain     => $sigconf->{'domain'}   || $conf->{'domain'}   || $signer->domain,
  299.           Selector   => $sigconf->{'selector'} || $conf->{'selector'} || $signer->selector,
  300.           Query      => $sigconf->{'query'}    || $conf->{'query'}
  301.         )
  302.       );
  303.       $sigdone = 1;
  304.     }
  305.   }
  306.  
  307.   return $sigdone;
  308. }
  309.