#!/usr/bin/perl -I../lib # # Copyright (c) 2005-2006 Messiah College. This program is free software. # You can redistribute it and/or modify it under the terms of the # GNU Public License as found at http://www.fsf.org/copyleft/gpl.html. # # Written by Jason Long, jlong@messiah.edu. # Modified by Kyle Wheeler # # dkimsign.pl --type=domainkeys --selector=default --key=/etc/domainkeys/memoryhole.net/default --method=nofws < email # dkimsign.pl --type=dkim --selector=default --key=/etc/domainkeys/memoryhole.net/default --method=relaxed < email use strict; use warnings; use Mail::DKIM::Signer; use Mail::DKIM::TextWrap; use Getopt::Long; use Pod::Usage; my $type = "dkim"; my $selector = "selector1"; my $key = "private.key"; my $algorithm = "rsa-sha1"; my $method = "simple"; my $domain; # undef => auto-select domain my $expiration; my $identity; my $key_protocol; my @extra_tag; my $debug_canonicalization; my $binary; my $help; GetOptions( "type=s" => \$type, "algorithm=s" => \$algorithm, "method=s" => \$method, "selector=s" => \$selector, "domain=s" => \$domain, "key=s" => \$key, "expiration=i" => \$expiration, "identity=s" => \$identity, "key-protocol=s" => \$key_protocol, "debug-canonicalization=s" => \$debug_canonicalization, "extra-tag=s" => \@extra_tag, "binary" => \$binary, "help|?" => \$help, ) or pod2usage(2); pod2usage(1) if $help; pod2usage("Error: unrecognized argument(s)") unless (@ARGV == 0); my $debugfh; if (defined $debug_canonicalization) { open $debugfh, ">", $debug_canonicalization or die "Error: cannot write $debug_canonicalization: $!\n"; } if ($binary) { binmode STDIN; } my $dkim = new Mail::DKIM::Signer( Policy => \&signer_policy, Algorithm => $algorithm, Method => $method, Selector => $selector, KeyFile => $key, Debug_Canonicalization => $debugfh, ); while () { unless ($binary) { chomp $_; s/\015?$/\015\012/s; } $dkim->PRINT($_); } $dkim->CLOSE; if ($debugfh) { close $debugfh; print STDERR "wrong canonicalized message to $debug_canonicalization\n"; } print $dkim->signature->as_string . "\n"; sub signer_policy { my $dkim = shift; use Mail::DKIM::DkSignature; $dkim->domain($domain || $dkim->message_sender->host); my $class = $type eq "domainkeys" ? "Mail::DKIM::DkSignature" : $type eq "dkim" ? "Mail::DKIM::Signature" : die "unknown signature type '$type'\n"; my $sig = $class->new( Algorithm => $dkim->algorithm, Method => $dkim->method, Headers => $dkim->headers, Domain => $dkim->domain, Selector => $dkim->selector, defined($expiration) ? (Expiration => time() + $expiration) : (), defined($identity) ? (Identity => $identity) : (), ); $sig->protocol($key_protocol) if defined $key_protocol; foreach my $extra (@extra_tag) { my ($n, $v) = split /=/, $extra, 2; $sig->set_tag($n, $v); } $dkim->add_signature($sig); return; } __END__ =head1 NAME dkimsign.pl - computes a DKIM signature for an email message =head1 SYNOPSIS dkimsign.pl [options] < original_email.txt options: --type=TYPE --method=METHOD --selector=SELECTOR --expiration=INTEGER --debug-canonicalization=FILE dkimsign.pl --help to see a full description of the various options =head1 OPTIONS =over =item B<--expiration> Optional. Specify the desired signature expiration, as a delta from the signature timestamp. =item B<--type> Determines the desired signature. Use dkim for a DKIM-Signature, or domainkeys for a DomainKey-Signature. =item B<--method> Determines the desired canonicalization method. Possible values are simple, simple/simple, simple/relaxed, relaxed, relaxed/relaxed, relaxed/simple. =item B<--debug-canonicalization> Outputs the canonicalized message to the specified file, in addition to computing the DKIM signature. This is helpful for debugging canonicalization methods. =back =head1 AUTHOR Jason Long, Ejlong@messiah.eduE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2007 by Messiah College This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available. =cut