#! /usr/bin/perl -w

=head1 NAME

dkimcheck -- Check the DKIM / DomainKeys signatures in a message

=head1 DESCRIPTION

If an incoming message has a DKIM signature then this plugin will check
the validity of the message and report the results as a header in the 
mail message.

=head1 CONFIG

None needed right now

=head1 TODO

Verify that checks on DomainKeys are working

Determine if there is a way to individually check signatures.  The DKIM
library wants to return the best result of the available signatures.

Possibly put a timeout in there for the DNS lookups

Add in ability to reject messages that fail the check

=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>.

=cut


use strict;
use Mail::DKIM;
use Mail::DKIM::Verifier;


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

  $self->log(LOGERROR, "Bad parameters for the dkimcheck plugin")
    if @_ % 2;

  %{$self->{_args}} = @args;
}

sub hook_data_post
{
  my ($self, $transaction) = @_;

  # Accept mail if relaying is valid.
  if ( exists( $ENV{ RELAYCLIENT } ) ||
       $self->qp->connection->relay_client() )
  {
    return ( DECLINED, "DKIMCHECK:(0) Mail Accepted: Relay client." );
  }

  # Get the signature count.
  my $dkimcount = $transaction->header->count ( 'DKIM-Signature' );
  my $dkcount = $transaction->header->count ( 'DomainKey-Signature' );

  my $dkim = new Mail::DKIM::Verifier;
  if ( !$dkim )
  {
    $self->log( LOGERROR, "DKIMCHECK:(1) - Could not create Mail::DKIM::Verifier" );
    return DECLINED;
  }
  
  # take all the headers, reformat them to eliminate cr/lf and push into
  #  dkim.  dkim seems particular about the cr/lf
  #
  foreach my $line ( split ( /\n/s, $transaction->header->as_string ) )
  {
    $line =~ s/\r?$/\015\012/s;
    # $self->log ( LOGDEBUG, "DKIMCHECK: Hdr: " . $line );
    $dkim->PRINT ( $line );
  }

  # 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 ( LOGDEBUG, "DKIMCHECK: Body: " . $line );
    $dkim->PRINT ( $line . "\x0D\x0A" );
  }

  $dkim->CLOSE;

  my $result = $dkim->result;

  # get the key policy - need to act on this
  #
  my $dns_policy = $dkim->fetch_author_policy;
  my $policy = $dns_policy;
  
  # If we could not fetch a policy then set our local default policy "o=-"
  if ( $dns_policy->is_implied_default_policy )
  {
    $self->log( LOGDEBUG, "DKIMCHECK:(2) NO DNS POLICY FOUND for " .
      $dkim->message_sender->host . " - USING LOCAL POLICY" );

    $policy = Mail::DKIM::DkimPolicy->parse( String => "o=-" );
  }

  my $policy_result = $policy->apply ( $dkim );

  $self->log( LOGDEBUG, "DKIMCHECK:(3) " .
    "DKIM Headers: "      . $dkimcount    .
    "  DK Headers: "      . $dkcount      .
    ", Result: "          . $dkim->result_detail .
    ", Policy: "          . $policy->as_string .
    ", Policy Location: " . ($policy->location ? $policy->location : "undef") .
    ", Policy Result: "   . $policy_result );

  # Deny mail if we find a sign-all policy but no signature.
  if ( ($result eq "none" ||
        $dkim->result_detail =~ /no public key available/ ) &&
       !$dns_policy->is_implied_default_policy && # We found a DNS policy.
       $dns_policy->signall )
  {
    return ( DENY, "DKIM:(4) Mail Denied: No DKIM sig found but sign-all " .
      "policy found for domain " . $dkim->message_sender->host );
  }

  # Accept mail if we found no sig and no policy for domain.
  if ( ($result eq "none" ||
        $dkim->result_detail =~ /no public key available/ ) &&
       $dns_policy->is_implied_default_policy )
  {
    $self->log( LOGDEBUG, "DKIMCHECK:(5) Mail Accepted: No DKIM signature " .
      "and no policy found for domain " . $dkim->message_sender->host );

    add_header( $transaction, $dkim, $policy, $policy_result );

    return ( DECLINED, "DKIM:(6) Mail Accepted: No DKIM signature and " .
      "no policy found for domain " . $dkim->message_sender->host );
  }

  # Accept mail with no signature and neutral policy.
  if ( $result eq "none" && $policy_result eq "neutral" )
  {
    add_header( $transaction, $dkim, $policy, $policy_result );

    return( DECLINED, "DKIM:(7) Mail Accepted: Result: " .
      $dkim->result_detail .  ", Policy: " . $policy_result );
  }

  # Accept mail with good sig and neutral policy.
  if ( $result eq "pass" && $policy_result eq "neutral" )
  {
    add_header( $transaction, $dkim, $policy, $policy_result );

    return( DECLINED, "DKIM:(8) Mail Accepted: Result " . $dkim->result_detail .
      ", Policy: " . $policy_result );
  }

  # Accept mail with signature but no key.
  if ( $result eq "invalid" &&
       $dkim->result_detail =~ /public key: not available/ )
  {
    add_header( $transaction, $dkim, $policy, $policy_result );

    return ( DECLINED, "DKIM:(9) Mail Accepted: Found signature but " .
      "no public key." );
  }

  # Accept mail that doesn't pass but the policy is neutral.
  if ( $result ne "pass" && $policy_result eq "neutral" )
  {
    return ( DECLINED, "DKIM:(10) Result: " . $dkim->result_detail .
      ", Policy: " . $policy_result );
  }

  # Try again later because we got a DNS query timeout.
  if ( $result eq "invalid" && $dkim->result_detail =~ /DNS query timeout/i )
  {
    return( DENYSOFT, "DKIM:(11) Please try again later - " . $dkim->result_detail );
  }

  # Accept Whitelist hosts.
  $self->log( LOGERROR, "DKIMCHECK: Whitelist parameter not found." ) unless $self->{_args}->{whitelist};
  if ( $self->{_args}->{whitelist} )
  {
    open( WHITELIST, "<" . $self->{_args}->{whitelist} ) || die "Can't open " . $self->{_args}->{whitelist} . "\n";
    while ( <WHITELIST> )
    {
      chomp;
      $self->log( LOGWARN, "Comparing received '" . $dkim->message_sender->host . "' to whitelist '" . $_ . "'" );
      if ( lc( $dkim->message_sender->host ) eq lc( $_ ) )
      {
        add_header( $transaction, $dkim, $policy, $policy_result );

        return( DECLINED, "DKIM:(12) Accept: From host ". $dkim->message_sender->host . " on whitelist." );
      }
    }
    close( WHITELIST ) || die "Can't close WHITELIST file.\n";
  }

  # Deny mail that doesn't pass or is not accepted by the policy.
  if ( $result ne "pass" || $policy_result ne "accept" )
  {
    return ( DENY, "DKIM:(13) Result: " . $result . ", ResultDetail: " . $dkim->result_detail .
      ", Policy: " . $policy_result );
  }


  # print the result
  #

  $self->log ( LOGDEBUG, "DKIMCHECK:(14) domain: " . $dkim->signature->domain .
                          ", selector: " . $dkim->signature->selector .
                          ", result: " . $dkim->result_detail .
                          ", policy: " . $policy_result .
                          ", policy_location: " . $policy->location );


  add_header( $transaction, $dkim, $policy, $policy_result );

  return ( DECLINED, "DKIM:(15) Mail Accepted, Result: " . $result .
    ", Policy: " . $policy_result );
}

sub add_header
{
  my ( $transaction, $dkim, $policy, $policy_result ) = @_;

  eval
  {
    $transaction->header->replace (
      "X-DKIM-Authentication: ",
      "domain: " . $dkim->signature->domain .
      ", selector: " . $dkim->signature->selector .
      ", result: " . $dkim->result_detail .
      ", policy: " . $policy_result .
      ", policy_location: ". $policy->location );
  }
}
