#!/usr/bin/perl
=head1 NAME

dkimsign -- Compute and insert a DKIM signature into a message

=head1 DESCRIPTION

This plugin will check the message against the specified list of domains 
and DKIM sign it if it's from an address that it's authorized to sign for.

Warning! Currently generate wrong DomainKeys signature.

=head1 CONFIG

One incoming parameter: /path/to/config/file
Example:
dkimsign /etc/qpsmtpd/dkimsign.conf

=item config file
Example structure in config file:
----- cut -----
example.com
      max_size = 2097152
      keyfile = /etc/ssl/certs/dkim.alpha.example.com.private
      method = relaxed
      selector = alpha
      domain = example.com
      type = all

# Next domain
example2.com
      keyfile = /etc/ssl/certs/dkim.alpha.example2.com.private
      selector = alpha
----- end cut -----

max_size - mail size in kb. Default $def_max_size
keyfile  - path to key file. Required.
method - (simple|nowsp|relaxed|nofws) is current value. Default $def_method.
selector - 's' parameter in dkim|domainkey signature. Required.
domain => 'd' parameter  in dkim|domainkey signature. Default $domain. domainkey - not recommend
type => (all|dkim|domainkey) is current value. Default $def_type.

=back

=head1 KEY CREATION

First generate a public / private key pair with OpenSSL:

	openssl genrsa -out dkim.private 1024

	openssl rsa -in dkim.private -pubout -out dkim.public

Ensure the private key is not world readable but is readable by the qpsmtpd
user.

Finally create the DNS entry using the public key data and a selector name
of your choice:

	<selector>._domainkey IN TXT "k=rsa; p=<key text>; t=y"

=back

=head1 TODO

Fixed problem in DomainKeys signing (inherent in the DKIM library). 
Currently generate wrong DomainKeys signature.

=head1 REQUIREMENTS

This module requires the Mail::DKIM module found on CPAN here:

L<http://search.cpan.org/~jaslong/Mail-DKIM-0.26/lib/Mail/DKIM.pm>

=head1 AUTHOR

Written by Matthew Harrell <mharrell@bittwiddlers.com>.

Modified by Zombilius <zombilius@gmail.com>

=cut


use strict;
use Mail::DKIM;
use Mail::DKIM::Signer;
#use Data::Dumper;

# enable support for "pretty" signatures, if available
#	seems to break when using qmail but works for postfix?
#eval "require Mail::DKIM::TextWrap";


sub register {
	my ( $self, $qp, @args ) = @_;

	my $def_max_size = 2048;
	my $def_method = 'relaxed';
	my $def_type = 'dkim';
	my $conf;

	# Read config file
	if ( -f $args[0] ) {
	# Read config file
	open CONF, $args[0] or die "Config file";
	while(my $str = <CONF>){
		next if $str=~/^(\s*#.*|\s*)$/;
		chomp $str;
		if( $str=~/^\S/ ){
			my $dom_t = $str;
			$str = <CONF>;
			while( $str =~/^\s+\S+/ ){
				$str=~tr/ \t\n//d;
				$$conf{$dom_t}{$1} = $2 if $str =~ /(\S+)=(\S+)/;
				$str = <CONF>;
				last unless $str;
				chomp $str;
			}
		}
	}
	close CONF;

		unless( $conf ){
			$self->log(LOGERROR, "Zero or bad config structure");
			return undef;
		}
	}else{
		$self->log(LOGERROR, "No such config file");
		return undef;
	}

	# Normalization structure ***

	foreach my $domain (keys %$conf){
		unless( $domain=~ /^[-\.a-z0-9A-Z]*$/ ){
			$self->log(LOGERROR, "dksign: Bad domain");
		}
	
		my $hdom = $$conf{$domain};
	
		unless( $$hdom{'keyfile'} && $$hdom{'selector'} ){
			$self->log(LOGERROR, "dksign: No keyfile or selector");
		}
		$$hdom{'max_size'} = $def_max_size unless $$hdom{'max_size'};
		$$hdom{'method'} = $def_method unless $$hdom{'method'};
		$$hdom{'type'} = $def_type unless $$hdom{'type'};
		$$hdom{'domain'} = $domain unless $$hdom{'domain'};
	}

	$$self{'_conf'} = $conf;

	1;
}


sub hook_data_post {
	my ( $self, $transaction ) = @_;
	
	# don't bother to continue if we're not allowed to relay for this client
	#
	unless ( $self->qp->connection->relay_client ) {
		$self->log(LOGNOTICE, "dksign: relay_client");
		return DECLINED;
	}


	#my @domains = split ( ",", $self->{_domains} );
	my $address = $transaction->sender->host;

	# ensure that the domain we're sending from is one of the signing domains
	#
	#foreach my $domain ( @domains ) {
		# $self->log ( LOGNOTICE, "comparing $domain to $address" );

	if ( exists $$self{'_conf'}{$address} ) {
		$self->log(LOGNOTICE, "dksign: address match: $address");
		my $conf = $$self{'_conf'}{$address};
		#$self->log(LOGNOTICE, "dksign: ".Dumper($conf));
		
		# ignore messages above the max size
		if ( $transaction->body_size > $conf->{'max_size'} * 1024 ) {
			$self->log ( LOGNOTICE, "dksign: Message size " . $transaction->body_size
														. " too large to sign".$conf->{'max_size'}."-" );
			return DECLINED;
		}

		my $policyfn = sub {
		   my $dkim = shift;
   		if( $conf->{'type'} eq 'all' || $conf->{'type'} eq 'dkim' ){
			$dkim->add_signature(
				new Mail::DKIM::Signature(
					Algorithm => "rsa-sha1",
					Headers => $dkim->headers,
					Domain => $conf->{'domain'},
					Method => $conf->{'method'},
					Selector => $conf->{'selector'},
				));
			}
			if( $conf->{'type'} eq 'all' || $conf->{'type'} eq 'domainkey' ){
			$dkim->add_signature(
				new Mail::DKIM::DkSignature(
					Algorithm => "rsa-sha1",
					Method => "nofws",
					Headers => $dkim->headers,
					Domain => $conf->{'domain'},
					Selector => $conf->{'selector'},
				));
			}
			return;
		};

		my $dkim = new Mail::DKIM::Signer (
			KeyFile	=> $conf->{'keyfile'},
			Policy => $policyfn,
		);

		# take all the headers, reformat them to eliminate cr/lf and push into
		#	dkim.	dkim seems particular about the cr/lf
		#
		my %hdrs = %{ $transaction->header->header_hashref() };

		foreach my $key ( keys %hdrs ) {
			my $val = join ( "", @{$hdrs{$key}} );
			$val =~ s/[\n\r]//g;

			# $self->log ( LOGNOTICE, "Hdr: " . $key . ": " . $val );
			$dkim->PRINT ( $key . ": " . $val . "\x0D\x0A" );
		}

		# push the body of the message on ensuring the cr/lf are correct
		#
		$transaction->body_resetpos;

		while ( my $line = $transaction->body_getline ) {
			chomp ( $line );
			$line =~ s/\015$//;

			# $self->log ( LOGNOTICE, "Body: " . $line );
			$dkim->PRINT ( $line . "\x0D\x0A" );
		}

		$dkim->CLOSE;
		$self->log ( LOGNOTICE, $dkim->result_detail . "; "
														. join(", ", $dkim->message_attributes) );

		# add each signature
		#
		foreach my $sig ( $dkim->signatures ) {
			# $self->log ( LOGNOTICE, $sig->as_string );
			$transaction->header->add ( undef, $sig->as_string );
		}

		# eventually we need the capability to do multiple signatures
		return ( DECLINED );
	}else{
		$self->log(LOGNOTICE, "dksign: address missmatch: $address");
	}
	#}

	return ( DECLINED );
}