+++ /dev/null
-#! /usr/bin/perl -w
-
-###----- Licensing notice ---------------------------------------------------
-###
-### 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 License along with
-### mLib. If not, write to the Free Software Foundation, Inc., 59 Temple
-### Place - Suite 330, Boston, MA 02111-1307, USA.
-
-###--------------------------------------------------------------------------
-### External modules.
-
-use autodie qw{ :all };
-use strict;
-
-use Carp;
-use IO::Handle;
-use MIME::Base32;
-use MIME::Base64;
-use POSIX;
-use Time::Local;
-
-###--------------------------------------------------------------------------
-### Other preliminaries.
-
-(our $PROG = $0) =~ s!^.*/!!;
-
-sub maybe_mkdir ($;$) {
- my ($dir, $mode) = @_;
- ## Create a directory DIR with permissions MODE, defaulting to 0777, before
- ## umask. Ignore errors complaining that the directory already exists.
-
- eval { mkdir $dir, $mode // 0777; }; die if $@ && $@->errno != EEXIST;
-}
-
-sub maybe_unlink ($) {
- my ($file) = @_;
- ## Delete FILE. Ignore errors complaining that the FILE doesn't exist.
-
- eval { unlink $file; }; die if $@ and $@->errno != ENOENT;
-}
-
-sub present_time ($) {
- my ($t) = @_;
- ## Format T as a human-readable time.
-
- return strftime "%Y-%m-%d %H:%M:%S %z", localtime $t;
-}
-
-###--------------------------------------------------------------------------
-### Logging.
-
-maybe_mkdir "log";
-open our $LOGF, ">>", "log/dkim-keys.log";
-
-{
- my $verbose = $ENV{"DKIM_KEYS_VERBOSE"} // 0;
-
- sub verbose ($) {
- my ($msg) = @_;
- ## Print MSG to the log. If `DKIM_KEYS_VERBOSE' is set in the
- ## environment, then also print the message to stderr.
-
- my $ts = present_time time;
- print $LOGF "$ts: $msg\n";
- print STDERR "$PROG: $msg\n" if $verbose;
- }
-}
-
-sub gag (&) {
- my ($body) = @_;
- ## Execute the BODY with stdout and stderr redirected to the log.
-
- $LOGF->flush;
- open my $oldout, ">&", \*STDOUT; open my $olderr, ">&", \*STDERR;
- open STDOUT, ">&", $LOGF; open STDERR, ">&", $LOGF;
- my @r;
- if (wantarray) { @r = &$body; }
- else { push @r, scalar &$body; }
- open STDOUT, ">&", $oldout; open STDERR, ">&", $olderr;
- close $oldout; close $olderr;
- return @r;
-}
-
-###--------------------------------------------------------------------------
-### Configuration.
-
-## Conversion functions take two arguments, PARSEP and VAL. If PARSEP is
-## truish, then VAL is a value read from the configuration file, and the
-## function should parse it and return the Perl internal value. If PARSE is
-## falsish, then do the reverse conversion.
-
-sub conf_token ($$) {
- my ($parsep, $val) = @_;
- ## Do-nothing conversion function for text.
-
- return $val;
-}
-
-sub conf_stamp ($$) {
- my ($parsep, $val) = @_;
- ## Convert ISO8859 Zulu-time stamps to POSIX `time_t'.
-
- if ($parsep) {
- my ($y, $mo, $d, $h, $mi, $s) =
- $val =~ m{^ (\d{4}) - (\d{2}) - (\d{2}) T
- (\d{2}) : (\d{2}) : (\d{2}) Z $}x
- or die "bad timestamp `$val'";
- return timegm $s, $mi, $h, $d, $mo - 1, $y - 1900;
- } else {
- confess "undefined stamp" unless defined $val;
- my ($s, $mi, $h, $d, $mo, $y, $wd, $yd, $dstp) = gmtime $val;
- return sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
- $y + 1900, $mo + 1, $d, $h, $mi, $s;
- }
-}
-
-{
- ## Map between unit names and scales.
- my %unitmap; my @unitmap;
-
- for my $item ([7*24*60*60, qw{wk w wks week weeks}],
- [24*60*60, qw{dy d dys day days}],
- [60*60, qw{hr h hrs hour hours}],
- [60, qw{min m mins minute minutes}],
- [1, "", qw{s sec secs second seconds}]) {
- my ($scale, @names) = @$item;
- for my $name (@names) { $unitmap{$name} = $scale; }
- push @unitmap, [$scale, $names[0]];
- }
-
- sub conf_duration ($$) {
- my ($parsep, $val) = @_;
- ## Convert time durations with units.
-
- if ($parsep) {
- my ($x, $u) = $val =~ m{^ \s* (\.\d+ | \d+ (?: \. \d*)?)
- \s* (| \S+) $}x
- or die "bad duration `$val'";
- my $scale = $unitmap{$u} or die "bad duration `$val'";
- return $x*$scale;
- } else {
- my $x = 1; my $u = "s";
- UNIT: for my $item (@unitmap) {
- my ($scale, $unit) = @$item;
- if ($val >= $scale) { $x = $val/$scale; $u = $unit; last UNIT; }
- }
- return sprintf "%.4g %s", $x, $u;
- }
- }
-}
-
-sub read_config ($$) {
- my ($spec, $file) = @_;
- ## Read configuration from FILE, as described by SPEC. Return a hash
- ## mapping names to values.
- ##
- ## The SPEC is a hashref mapping configuration keys to [CONV, DFLT] pairs,
- ## where CONV is a conversion function (as described above) and DFLT is the
- ## default value.
-
- my %c;
- open my $f, "<", $file;
- LINE: while (<$f>) {
- chomp; next LINE unless /^\s*[^#]/;
- my ($k, $v) = m{^ \s* ([^=\s]+) \s* = (.*) $}x
- or die "bad assignment `$_'";
- $v =~ s/^\s+//; $v =~ s/\s+$//;
- my $def = $spec->{$k} or die "unknown setting `$k'";
- exists $c{$k} and die "duplicate setting `$k'";
- $c{$k} = $def->[0](1, $v);
- }
- close $f;
- for my $k (keys %$spec) { exists $c{$k} or $c{$k} = $spec->{$k}[1]; }
- return \%c;
-}
-
-sub write_config ($$$) {
- my ($spec, $file, $conf) = @_;
- ## Write configuration back FILE from CONF, as described by SPEC. See
- ## `read_config' for the format of SPEC.
-
- open my $f, ">", "$file.new";
- KEY: for my $k (keys %$spec) {
- defined $conf->{$k} or next KEY;
- printf $f "%s = %s\n", $k, $spec->{$k}[0](0, $conf->{$k});
- }
- close $f;
- rename "$file.new", $file;
-}
-
-###--------------------------------------------------------------------------
-### Dynamic DNS update.
-
-{
- my $nodns = $ENV{"DKIM_KEYS_NODNS"} // 0;
-
- sub nsupdate ($) {
- my ($updates) = @_;
- ## Submit UPDATES in nsupdate(1) format.
-
- my @nsucmd = ("nsupdate");
- push @nsucmd, "-k", $::C{"ddns-key"} if defined $::C{"ddns-key"};
- @nsucmd = ("sh", "-c", 'echo ";; $*" && exec cat', ".", @nsucmd)
- if $nodns;
- my $f; gag { open $f, "|-", @nsucmd; };
- print $f "server $::C{'ddns-server'}\n" if defined $::C{"ddns-server"};
- print $f "ttl $::C{'ddns-ttl'}\n" if defined $::C{"ddns-ttl"};
- print $f $updates;
- print $f "send\n";
- print $f "answer\n";
- close $f;
-
- }
-}
-
-###--------------------------------------------------------------------------
-### BER decoding.
-
-## BER tag classes.
-sub C_UNV { return 0; } # universal
-sub C_APP { return 1; } # application
-sub C_CTX { return 2; } # contextual
-sub C_PRV { return 3; } # private
-
-## BER universal tag numbers.
-sub TY_INT { return 2; } # INTEGER
-sub TY_BITSTR { return 3; } # BIT STRING
-sub TY_OCTSTR { return 4; } # OCTET STRING
-sub TY_NULL { return 5; } # NULL
-sub TY_OID { return 6; } # OBJECT IDENTIFIER
-sub TY_SEQ { return 16; } # SEQUENCE
-sub TY_SET { return 17; } # SET
-
-sub ber_decoid ($) {
- my ($oid) = @_;
- ## Decode an encoded OID body. Return the OID in text format, as a list
- ## of integers separated by `.'.
-
- my ($h, @d) = unpack "C w*", $oid;
- if ($h >= 0x80) { die "malformed BER (invalid OID)"; }
- return join ".", int($h/40), $h%40, @d;
-}
-
-sub ber_decnext (\$) {
- my ($str_inout) = @_;
- ## Decode the next value from a BER-encoded string, updating STR_INOUT to
- ## hold the remaining material. Returns four items (C, K, T, X), where C
- ## is the tag class; K is a flag which is truish if the encoding is
- ## constructed or falsish if primitive; T is the tag number; and X is the
- ## encoded body.
-
- my ($h0, $r) = unpack "C a*", $$str_inout;
- my ($c, $k, $t) = (($h0 >> 6)&0x03, ($h0 >> 5)&0x01, ($h0 >> 0)&0x1f);
- if ($t == 0x1f) { ($t, $r) = unpack "w a*", $r; }
-
- (my $n, $r) = unpack "C a*", $r;
- if ($n == 0x80) { die "indefinite encodings not supported"; }
- elsif ($n == 0xff) { die "malformed BER (invalid length)"; }
- elsif ($n > 0x80) {
- $n &= 0x7f;
- my @n = unpack +(sprintf "C%d", $n), $r;
- $r = substr $r, $n;
- $n = 0; for my $i (@n) { $n = 256*$n + $i; }
- }
- $$str_inout = substr $r, $n; return ($c, $k, $t, substr $r, 0, $n);
-}
-
-sub read_pem ($$) {
- my ($file, $label) = @_;
- ## Read a PEM-encoded message from FILE, with LABEL quoted in the boundary
- ## markers, and return the binary contents.
-
- my $body = "";
- open my $f, "<", $file;
- LINE: while (<$f>)
- { last LINE if /^-----BEGIN \Q$label\E-----$/; }
- LINE: while (<$f>)
- { last LINE if /^-----END \Q$label\E-----$/; $body .= $_; }
- close $f;
-
- return decode_base64 $body;
-}
-
-sub ident ($) {
- my ($pub) = @_;
- ## Parse the (raw BER) RSA public key data PUB, returning a key identifier.
- ## This is the least significant 80 bits of the modulus, Base32-encoded,
- ## which comes out at 16 characters.
-
- my ($c, $k, $t);
-
- ## Outer SEQUENCE.
- ($c, $k, $t, my $x) = ber_decnext $pub;
- $c == C_UNV && $k && $t == TY_SEQ
- or die "malformed key (expected seq)";
-
- ## Inner SEQUENCE.
- ($c, $k, $t, my $y) = ber_decnext $x;
- $c == C_UNV && $k && $t == TY_SEQ
- or die "malformed key (expected seq)";
-
- ## Key type OID; must be `rsaEncryption'.
- ($c, $k, $t, my $o) = ber_decnext $y;
- $c == C_UNV && !$k && $t == TY_OID
- or die "malformed key (expected oid)";
- ber_decoid($o) eq "1.2.840.113549.1.1.1"
- or die "malformed key (wrong oid)";
-
- ## Parameters; must be NULL.
- ($c, $k, $t, my $z) = ber_decnext $y;
- $c == C_UNV && !$k && $t == TY_NULL && $z eq ""
- or die "malformed key (expected null)";
-
- ## End inner SEQUENCE.
- $y eq "" or die "malformed key (trailing junk)";
-
- ## BIT STRING holding the actual public key data. I have no idea what
- ## they were thinking when they came up with this.
- ($c, $k, $t, my $u) = ber_decnext $x;
- $c == C_UNV && !$k && $t == TY_BITSTR
- or die "malformed key (expected bitstr)";
- (my $n, $u) = unpack "C a*", $u;
- $n == 0 or die "malformed key (odd-length bitstr)";
-
- ## Inner SEQUENCE.
- ($c, $k, $t, $y) = ber_decnext $u;
- $c == C_UNV && $k && $t == TY_SEQ
- or die "malformed key (expected seq)";
-
- ## INTEGER holding the modulus.
- ($c, $k, $t, $n) = ber_decnext $y;
- $c == C_UNV && !$k && $t == TY_INT
- or die "malformed key (expected int)";
-
- ## INTEGER holding the public exponent, which we don't care about.
- ($c, $k, $t, my $e) = ber_decnext $y;
- $c == C_UNV && !$k && $t == TY_INT
- or die "malformed key (expected int)";
-
- ## Close the inner SEQUENCE, BIT STRING, outer SEQUENCE, and the
- ## top-level.
- $y eq "" or die "malformed key (trailing junk)";
- $u eq "" or die "malformed key (trailing junk)";
- $x eq "" or die "malformed key (trailing junk)";
- $pub eq "" or die "malformed key (trailing junk)";
-
- ## Extract the low bits of the modulus and encode them.
- length $n >= 10 or die "malformed key (too small)";
- return lc encode_base32 substr($n, -10), "";
-}
-
-sub generate_key ($) {
- my ($file) = @_;
-
- my $oldmask = umask 0037;
- verbose "generate new key";
- gag { system "openssl", "genrsa", "-out", $file, "3072"; };
- umask $oldmask;
-}
-
-sub extract_public_key ($$) {
- my ($pub, $priv) = @_;
-
- verbose "extract public key";
- gag { system "openssl", "rsa", "-pubout", "-in", $priv, "-out", $pub; };
- return read_pem($pub, "PUBLIC KEY");
-}
-
-###--------------------------------------------------------------------------
-### Schedule objects.
-
-{ package Scheduler;
-
- sub new {
- my ($pkg) = @_;
-
- return bless { dns_update => { }, cleanups => [] }, $pkg;
- }
-
- sub add_record {
- my ($me, $label, $type, $data) = @_;
-
- $me->{dns_update}{$label}{$type} = $data;
- }
-
- sub delete_record {
- my ($me, $label, $type, $data) = @_;
-
- $me->{dns_update}{$label}{$type} = undef;
- }
-
- sub add_cleanup {
- my ($me, $op) = @_;
-
- push $me->{cleanups}->@*, $op;
- }
-
- sub execute {
- my ($me) = @_;
-
- my $updates = "";
- for my $label (keys $me->{dns_update}->%*) {
- for my $type (keys $me->{dns_update}{$label}->%*) {
- my $data = $me->{dns_update}{$label}{$type};
- $updates .= "update delete $label IN $type\n";
- if (!defined $data) {
- ::verbose "delete dns record $label $type";
- } else {
- $updates .= "update add $label IN $type $data\n" if defined $data;
- ::verbose "create dns record $label $type";
- }
- }
- }
- if ($updates eq "") { ::verbose "no dns updates"; }
- else { ::nsupdate $updates; }
-
- for my $op ($me->{cleanups}->@*) { $op->(); }
- }
-}
-
-sub schedule_cleanup (&$) {
- my ($op, $sched) = @_;
-
- $sched->add_cleanup($op);
-}
-
-###--------------------------------------------------------------------------
-### Key objects.
-
-{ package Key;
-
- ## External modules.
- use autodie qw{ :all };
- use strict;
-
- use Carp;
- use MIME::Base64;
-
- sub publish_components ($) {
- my ($me) = @_;
- ## Split the key ID into pieces. This is how we map key IDs into the
- ## filesystem and URI space: if we return n pieces, that's n - 1 levels
- ## of directory, with leaves at the bottom.
-
- my $id = $me->{id};
- return (substr($id, 0, 3), substr($id, 3, 5), substr($id, 8));
- }
-
- sub publish_uri ($) {
- my ($me) = @_;
-
- my @cc = $me->publish_components;
- return $::C{"publish-uri"} . join("/", @cc) . ".html";
- }
-
- sub new {
- my ($pkg, $t) = @_;
-
- ## Make the new key.
- ::maybe_mkdir "NEW", 0700;
- ::generate_key "NEW/new.priv";
-
- ## Extract the public key and determine its id.
- my $pub = ::extract_public_key "NEW/new.pub", "NEW/new.priv";
- my $id = ::ident $pub;
-
- ## Rename the private key. It won't go away now: we're committed to this
- ## one.
- ::verbose "commit to new key $id";
- my $file = sprintf "NEW/%s.%s.priv", ::conf_stamp(0, $t), $id;
- rename "NEW/new.priv", $file;
-
- ## Report the public key as active.
- ::verbose "activated new public key $id";
- ::maybe_mkdir "active";
- rename "NEW/new.pub", "active/$id.pub";
-
- ## It's now a proper key.
- my $me = $pkg->load($file);
- $me->{pub} = $pub;
- return $me;
- }
-
- sub load {
- my ($pkg, $file) = @_;
-
- -r $file or confess "key file `$file' not found";
- $file =~ m{^ (\w+) /
- (\d{4} - \d{2} - \d{2} T \d{2} : \d{2} : \d{2} Z) \.
- ([abcdefghijklmnopqrstuvwxyz234567]+) \.priv $}x
- or confess "bad key name `$file'";
- my $st = $1; my $tm = $2; my $id = $3;
- return bless {
- st => $st, id => $id, t => ::conf_stamp(1, $tm),
- file => $file, file0 => $file
- }, $pkg;
- }
-
- sub set_state {
- my ($me, $sched, $newst, $newtime) = @_;
-
- return if $newst eq $me->{st} && $newtime eq $me->{t};
- my $id = $me->{id};
- ::verbose sprintf "prepare key %s state %s %s -> %s %s",
- $id, $me->{st},
- ::present_time($me->{t}), $newst, ::present_time($newtime);
- my $from = $me->{file};
- my $to = $newst . "/" . ::conf_stamp(0, $newtime) . "." . $id . ".priv";
- ::maybe_mkdir $newst;
- ::schedule_cleanup {
- ::verbose "key $id rename $from -> $to";
- rename $from, $to;
- } $sched;
- $me->{st} = $newst; $me->{t} = $newtime; $me->{file} = $to;
- }
-
- sub announce {
- my ($me, $sched, $t_publish) = @_;
-
- ::verbose "announce new key";
- my $id = $me->{id};
-
- unless (defined $me->{pub}) {
- ::maybe_mkdir "active";
- $me->{pub} = ::extract_public_key "active/$id.pub", $me->{file0};
- }
-
- my $key = sprintf
- "v=DKIM1; s=email; t=s:y; k=rsa; h=sha256; " .
- "n=Not suitable for non-repudiation! " .
- "Private key revealed at %s by %s; " .
- "p=%s",
- $me->publish_uri,
- ::conf_stamp(0, $t_publish),
- encode_base64($me->{pub}, "");
- my @key = ();
- while (length $key > 255) {
- my $chunk = substr $key, 0, 255, "";
- if ($chunk =~ m{^ (.* \;\s+) ([^\s;] [^;]*) $}x)
- { $chunk = $1; $key = $2 . $key; }
- push @key, $chunk;
- }
- push @key, $key;
- $key = join " ", map qq'"$_"', @key;
-
- my $zone = $::C{"ddns-zone"};
- $sched->add_record("$id.$zone", "TXT", $key);
- }
-
- sub deploy {
- my ($me, $sched) = @_;
-
- my $id = $me->{id};
- ::verbose "deploy private key $id";
- ::maybe_mkdir "active";
- ::maybe_unlink "active/$id.priv.new";
- link $me->{file0}, "active/$id.priv.new";
- rename "active/$id.priv.new", "active/$id.priv";
- }
-
- sub withdraw {
- my ($me, $sched) = @_;
-
- my $id = $me->{id}; my $zone = $::C{"ddns-zone"};
- ::verbose "withdraw key $id from dns";
- $sched->delete_record("$id.$zone", "TXT");
- }
-
- sub delete {
- my ($me, $sched) = @_;
-
- my $id = $me->{id}; ::verbose "delete key $id";
- ::schedule_cleanup {
- ::verbose "delete published key $id";
- ::maybe_unlink "active/$id.pub";
- ::maybe_unlink "active/$id.priv";
- unlink $me->{file};
- } $sched;
- }
-}
-
-my %CONF_SPEC = ("ddns-zone" => [\&conf_token, undef],
- "ddns-server" => [\&conf_token, undef],
- "ddns-key" => [\&conf_token, undef],
- "ddns-ttl" => [\&conf_duration, 4*60*60],
- "dns-delay" => [\&conf_duration, 2*24*60*60],
- "instance" => [\&conf_token, "untitled"],
- "publish-uri" => [\&conf_token, undef],
- "publish-script" => [\&conf_token, undef],
- "active-duration" => [\&conf_duration, 24*60*60],
- "cycle-period" => [\&conf_duration, 3*24*60*60],
- "mail-persistence" => [\&conf_duration, 7*24*60*60],
- "dns-persistence" => [\&conf_duration, 3*24*60*60]);
-
-our %C = %{read_config \%CONF_SPEC, "dkim-keys.conf"};
-
-## State model.
-##
-## There are six states that a key can be in. Keys always advance through
-## these states in order.
-##
-## * `NEW'. This is rather complicated, and there are multiple steps and
-## a fiddly cleanup procedure.
-##
-## 1. Create `NEW/new.priv'. Cleanup: delete it.
-## 2. Create `NEW/new.pub'. Determine key id. Cleanup: delete both.
-## 3. Rename to `NEW/TS.ID.priv'. Cleanup: continue to ANNOUNCE.
-## 4. Rename `MEW/new.pub' to `active/ID.pub'. (If it's not there,
-## then this has been done already.)
-## 5. Announce the key in the DNS.
-## 6. Promote the key to ANNOUNCE: rename `NEW/TS.ID.priv' to
-## `ANNOUNCE/TS.ID.priv'.
-##
-## * `ANNOUNCE'. The key has been announced in the DNS, and we're waiting
-## for the announcement to propagate before we deploy the key. Unless
-## we're in catch-up mode, keys will remain in `ANNOUNCE' state for
-## DNS-DELAY seconds. The timestamp is the time at which we expect the
-## key to become active.
-##
-## * `DEPLOY'. The key is ready for use in the upcoming cycle. The
-## timestamp is the time at which we expect the key to become active.
-## The key will be active for ACTIVE-DURATION seconds.
-##
-## * `RETIRE'. The key has been deployed and replaced, and will no longer
-## be used for signing. However, messages bearing its signatures are
-## potentially still in flight, so the key is still visible in DNS. Keys
-## will remain in `RETIRE' state for MAIL-PERSISTENCE seconds. The
-## timestamp is the time at which we expect that the key can be
-## withdrawn.
-##
-## * `WITHDRAW'. The key is no longer needed by verifiers because all
-## messages signed under it have either been delivered or abandoned. The
-## key is withdrawn from DNS, and we're waiting for the withdrawal to
-## propagate. Keys remain in `WITHDRAW' state for DNS-PERSISTENCE
-## seconds. The timestamp is the time at which we expect that the key
-## can be published.
-##
-## * `PUBLISH'. The key is no longer available to verifiers, because it is
-## no longer visible in DNS. It is therefore now safe to publish the
-## private key. This is the final state, and we stop tracking keys in
-## `PUBLISH' state.
-
-our @STNAME;
-our %STIX = ();
-for my $st (qw{ NEW ANNOUNCE DEPLOY RETIRE WITHDRAW PUBLISH })
- { $STIX{$st} = scalar @STNAME; push @STNAME, $st; }
-
-sub publication_time ($;$$) {
- my ($k, $newst, $newtime) = @_;
-
- $newst //= $k->{st}; $newtime //= $k->{t};
- defined (my $newix = $STIX{$newst})
- or confess "unexpected state `$newst'";
- my $t_publish = $newtime + $C{"cycle-period"};
- if ($newix < $STIX{PUBLISH})
- { $t_publish += $C{"dns-persistence"}; }
- if ($newix < $STIX{WITHDRAW})
- { $t_publish += $C{"mail-persistence"}; }
- if ($newix < $STIX{RETIRE})
- { $t_publish += $C{"active-duration"} + $C{"cycle-period"}; }
- return $t_publish;
-}
-
-sub dump_file ($$) {
- my ($fout, $file) = @_;
-
- open my $fin, "<", $file;
- my $buf;
- while (sysread $fin, $buf, 65536) { print $fout $buf; }
- close $fin;
-}
-
-sub publish_filename ($) {
- my ($k) = @_;
-
- my @cc = $k->publish_components;
- my $name = "publish";
- for my $c (@cc) { maybe_mkdir $name, 0751; $name .= "/" . $c; }
- return $name . ".html";
-}
-
-sub publish_placeholder ($;$$) {
- my ($k, $newst, $newtime) = @_;
-
- my $id = $k->{id}; my $inst = $C{"instance"};
- my $file = publish_filename $k;
- my $t_publish = publication_time $k, $newst, $newtime;
- my $th_publish = present_time $t_publish;
-
- verbose "publish placeholder for $id";
- open my $f, ">", "$file.new";
- print $f <<EOF;
-<!DOCTYPE html>
-<html>
-<head>
- <title>$inst DKIM key $id</title>
-</head>
-<body>
-<h1>$inst DKIM key <code>$id</code></h1>
-<p>This is a placeholder page.
-The private key <code>$id</code> is scheduled for publication
-on or before $th_publish.
-$inst DKIM private keys are published in order to make them
-unsuitable as evidence after the fact.
-
-<p>The public key is
-<pre>
-EOF
- dump_file $f, "active/$id.pub";
- print $f <<EOF;
-</pre>
-</body>
-</html>
-EOF
- close $f;
- rename "$file.new", $file;
-}
-
-sub publish_key ($) {
- my ($k) = @_;
-
- my $id = $k->{id}; my $inst = $C{"instance"};
- my $file = publish_filename $k;
-
- verbose "publish private key for $id";
- open my $f, ">", "$file.new";
- print $f <<EOF;
-<!DOCTYPE html>
-<html>
-<head>
- <title>$inst DKIM key $id</title>
-</head>
-<body>
-<h1>$inst DKIM key <code>$id</code></h1>
-<p>The key <code>$id</code> was used as a key to authenticate
-that email passed through the $inst server.
-$inst DKIM keys are published after they are no longer in active use,
-to make them unsuitable as evidence after the fact.
-
-<p>The private and public keys are
-<pre>
-EOF
- dump_file $f, "active/$id.priv";
- dump_file $f, "active/$id.pub";
- print $f <<EOF;
-</pre>
-</body>
-</html>
-EOF
- close $f;
- rename "$file.new", $file;
-}
-
-sub set_key_state ($$$$) {
- my ($k, $sched, $newst, $newtime) = @_;
-
- my $oldst = $k->{st}; my $id = $k->{id};
- defined (my $ix = $STIX{$oldst})
- or confess "unexpected key state `$oldst'";
- defined (my $newix = $STIX{$newst})
- or confess "unexpected new state `$newst'";
- $ix <= $newix
- or confess "attempted state regression `$oldst' -> `$newst'";
-
- while ($ix < $newix) {
- $ix++; my $curst = $STNAME[$ix];
- verbose "advance key $id state $oldst -> $curst";
- if ($curst eq "ANNOUNCE") {
- $k->announce($sched, publication_time $k, $newst, $newtime);
- publish_placeholder $k, $newst, $newtime;
- }
- elsif ($curst eq "DEPLOY") { $k->deploy($sched); }
- elsif ($curst eq "RETIRE") { ; }
- elsif ($curst eq "WITHDRAW") { $k->withdraw($sched); }
- elsif ($curst eq "PUBLISH") { publish_key $k; }
- else { confess "unexpected state $curst" }
- }
- if ($newst eq "PUBLISH") { $k->delete($sched); }
- else { $k->set_state($sched, $newst, $newtime); }
-}
-
-sub keys_in_state ($) {
- my ($st) = @_;
-
- my @k; my $d;
- eval { opendir $d, $st; };
- if ($@) {
- die if $@->errno != ENOENT;
- } else {
- FILE: for my $f (readdir $d) {
- next FILE if $f eq "." || $f eq "..";
- next FILE if $st eq "NEW" && ($f eq "new.priv" || $f eq "new.pub");
- push @k, Key->load("$st/$f");
- }
- }
- return @k;
-}
-
-our $NOW;
-
-if (!defined $ENV{"DKIM_KEYS_TIMENOW"}) {
- $NOW = time;
-} else {
- $NOW = conf_stamp 1, $ENV{"DKIM_KEYS_TIMENOW"};
- verbose "pretending time is " . conf_stamp 0, $NOW;
-}
-
-## Our first order of business is to ensure that there are keys lined up for
-## the current deployment cycle. The candidates are the keys which are
-## currently in `ANNOUNCE' and `DEPLOY' states. We arrange to use these in
-## ascending order of their current timestamps. This might cause keys to
-## become active earlier than before.
-
-my @candidates;
-my @to_retire;
-my $cutoff = $NOW - $C{"active-duration"};
-my $sched = Scheduler->new;
-
-sub notice_candidate ($) {
- my ($k) = @_;
-
- if ($k->{t} < $cutoff) { push @to_retire, $k; }
- else { push @candidates, $k; }
-}
-
-## Work through the `NEW' keys and advance them on to `ANNOUNCE'. Pick up
-## all of the unretired keys so that we can plan how to use them.
-for my $k (keys_in_state "NEW")
- { $k->announce($sched, publication_time $k); notice_candidate $k; }
-for my $st (qw{ NEW ANNOUNCE DEPLOY })
- { for my $k (keys_in_state $st) { notice_candidate $k; } }
-@candidates = sort { $a->{t} <=> $b->{t} } @candidates;
-
-## Determine the current start time of the oldest key we can deploy. If this
-## is earlier than now then things are chugging along OK and we continue with
-## the current plan. Otherwise, we need to arrange keys for immediate use.
-my $t0 = @candidates && $candidates[0]{t} <= $NOW ? $candidates[0]{t} : $NOW;
-my $nk = 0;
-
-## Start producing the state file for the mail server.
-maybe_mkdir "active";
-open my $mcf, ">", "active/dkim-keys.state.new";
-printf $mcf <<EOF, present_time $t0;
-### dkim-keys deployment state, starting from %s
-
-EOF
-
-## Make sure that the current cycle is covered.
-my $t = $t0; my $t_limit = $NOW + $C{"cycle-period"};
-while ($t < $t_limit) {
- my $k = @candidates ? shift @candidates : Key->new($t);
- set_key_state $k, $sched, "DEPLOY", $t; $t += $C{"active-duration"};
- printf $mcf "info.%d: k = %s u = %s tpub = \"%s\"\n",
- $nk, $k->{id}, $k->publish_uri, present_time publication_time $k;
- $nk++;
-}
-printf $mcf "params: t0 = %d step = %d n = %d\n",
- $t0, $C{"active-duration"}, $nk;
-close $mcf; rename "active/dkim-keys.state.new", "active/dkim-keys.state";
-
-## And now make sure there are enough new keys announced to cover the next
-## cycle.
-$t_limit = $NOW + 2*$C{"cycle-period"};
-while ($t < $t_limit) {
- my $k = @candidates ? shift @candidates : Key->new($t);
- set_key_state $k, $sched, "ANNOUNCE", $t; $t += $C{"active-duration"};
-}
-
-## If there are keys to retire, then arrange that.
-for my $k (@to_retire) {
- set_key_state $k, $sched, "RETIRE",
- $k->{t} + $C{"active-duration"} + $C{"mail-persistence"};
-}
-
-## If there are keys to withdraw, then arrange that too.
-for my $k (keys_in_state "RETIRE") {
- if ($k->{t} <= $NOW)
- { set_key_state $k, $sched, "WITHDRAW", $NOW + $C{"dns-persistence"}; }
-}
-
-## And, finally, if there are keys to be published, then arrange that.
-for my $k (keys_in_state "WITHDRAW")
- { if ($k->{t} <= $NOW) { set_key_state $k, $sched, "PUBLISH", -1; } }
-
-## The planning is done. It's now time to do all the things.
-verbose "running cleanup actions";
-$sched->execute;
-
-###----- That's all, folks --------------------------------------------------
--- /dev/null
+#! /usr/bin/perl -w
+
+###----- Licensing notice ---------------------------------------------------
+###
+### 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 License along with
+### mLib. If not, write to the Free Software Foundation, Inc., 59 Temple
+### Place - Suite 330, Boston, MA 02111-1307, USA.
+
+###--------------------------------------------------------------------------
+### External modules.
+
+use autodie;
+use strict;
+
+use Carp;
+use IO::Handle;
+use MIME::Base32;
+use MIME::Base64;
+use POSIX;
+use Time::Local;
+
+###--------------------------------------------------------------------------
+### Other preliminaries.
+
+(our $PROG = $0) =~ s!^.*/!!;
+our $VERSION = '@VERSION@';
+
+## Check arguments. This is easy: there aren't any.
+sub usage (*) { my ($f) = @_; print $f "usage: $PROG\n"; }
+if (@ARGV) {
+ my $arg = $ARGV[0];
+ if (@ARGV > 1) { }
+ elsif ($arg eq "-h" || $arg eq "--help")
+ { usage STDOUT; exit 0; }
+ elsif ($arg eq "-v" || $arg eq "--version")
+ { print "$PROG, version $VERSION\n"; exit 0; }
+ usage STDERR; exit 2;
+}
+
+sub maybe_mkdir ($;$) {
+ my ($dir, $mode) = @_;
+ ## Create a directory DIR with permissions MODE, defaulting to 0777, before
+ ## umask. Ignore errors complaining that the directory already exists.
+
+ eval { mkdir $dir, $mode // 0777; }; die if $@ && $@->errno != EEXIST;
+}
+
+sub maybe_unlink ($) {
+ my ($file) = @_;
+ ## Delete FILE. Ignore errors complaining that the FILE doesn't exist.
+
+ eval { unlink $file; }; die if $@ and $@->errno != ENOENT;
+}
+
+sub present_time ($) {
+ my ($t) = @_;
+ ## Format T as a human-readable time.
+
+ return strftime "%Y-%m-%d %H:%M:%S %z", localtime $t;
+}
+
+sub dump_file ($$) {
+ my ($fout, $file) = @_;
+ ## Copy the contents of FILE to the stream FOUT.
+
+ open my $fin, "<", $file;
+ my $buf;
+ while (sysread $fin, $buf, 65536) { print $fout $buf; }
+ close $fin;
+}
+
+sub parse_stamp ($) {
+ my ($stamp) = @_;
+ ## Parse an ISO8601 zulu-time stamp to POSIX `time_t'.
+
+ my ($y, $mo, $d, $h, $mi, $s) =
+ $stamp =~ m{^ (\d{4}) - (\d{2}) - (\d{2}) T
+ (\d{2}) : (\d{2}) : (\d{2}) Z $}x
+ or die "bad timestamp `$stamp'";
+ return timegm $s, $mi, $h, $d, $mo - 1, $y - 1900;
+}
+
+sub present_stamp ($) {
+ my ($t) = @_;
+ ## Format a POSIX `time_t' as a string.
+
+ my ($s, $mi, $h, $d, $mo, $y, $wd, $yd, $dstp) = gmtime $t;
+ return sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ",
+ $y + 1900, $mo + 1, $d, $h, $mi, $s;
+}
+
+sub running (&@) {
+ my ($body, @prog) = @_;
+ ## Run the BODY, printing a banner above and below, including a proposed
+ ## program name and arguments PROG, and the exit status.
+
+ my $label = sprintf "RUN %s ", join " ", @prog;
+ print $label . ">" x (77 - length $label) . "\n";
+ my @r;
+ if (wantarray) { @r = $body->(); }
+ else { @r = scalar $body->(); }
+ print "<" x 77 . "\n";
+ if (!$?) { }
+ elsif ($?%256) { printf "command killed by signal %d\n", $?%256; }
+ else { printf "command exited with status %d\n", int($?/256); }
+ die "command failed" if $?;
+ return @r;
+}
+
+sub run (@) {
+ my (@prog) = @_;
+ ## Run PROG.
+
+ running { system @prog; } @prog;
+}
+
+## Set the current time.
+our $NOW;
+if (!defined $ENV{"DKIM_KEYS_TIMENOW"}) {
+ $NOW = time;
+} else {
+ $NOW = parse_stamp $ENV{"DKIM_KEYS_TIMENOW"};
+ printf "pretending time is %s\n", present_time $NOW;
+}
+
+printf "%s BEGINS at %s\n", $PROG, present_time $NOW;
+
+###--------------------------------------------------------------------------
+### BER decoding.
+
+## BER tag classes.
+sub C_UNV () { return 0; } # universal
+sub C_APP () { return 1; } # application
+sub C_CTX () { return 2; } # contextual
+sub C_PRV () { return 3; } # private
+
+## BER universal tag numbers.
+sub TY_INT () { return 2; } # INTEGER
+sub TY_BITSTR () { return 3; } # BIT STRING
+sub TY_OCTSTR () { return 4; } # OCTET STRING
+sub TY_NULL () { return 5; } # NULL
+sub TY_OID () { return 6; } # OBJECT IDENTIFIER
+sub TY_SEQ () { return 16; } # SEQUENCE
+sub TY_SET () { return 17; } # SET
+
+sub ber_decoid ($) {
+ my ($oid) = @_;
+ ## Decode an encoded OID body. Return the OID in text format, as a list
+ ## of integers separated by `.'.
+
+ my ($h, @d) = unpack "C w*", $oid;
+ if ($h >= 0x80) { die "malformed BER (invalid OID)"; }
+ return join ".", int($h/40), $h%40, @d;
+}
+
+sub ber_decnext (\$) {
+ my ($str_inout) = @_;
+ ## Decode the next value from a BER-encoded string, updating STR_INOUT to
+ ## hold the remaining material. Returns four items (C, K, T, X), where C
+ ## is the tag class; K is a flag which is truish if the encoding is
+ ## constructed or falsish if primitive; T is the tag number; and X is the
+ ## encoded body.
+
+ my ($h0, $r) = unpack "C a*", $$str_inout;
+ my ($c, $k, $t) = (($h0 >> 6)&0x03, ($h0 >> 5)&0x01, ($h0 >> 0)&0x1f);
+ if ($t == 0x1f) { ($t, $r) = unpack "w a*", $r; }
+
+ (my $n, $r) = unpack "C a*", $r;
+ if ($n == 0x80) { die "indefinite encodings not supported"; }
+ elsif ($n == 0xff) { die "malformed BER (invalid length)"; }
+ elsif ($n > 0x80) {
+ $n &= 0x7f;
+ my @n = unpack +(sprintf "C%d", $n), $r;
+ $r = substr $r, $n;
+ $n = 0; for my $i (@n) { $n = 256*$n + $i; }
+ }
+ $$str_inout = substr $r, $n; return ($c, $k, $t, substr $r, 0, $n);
+}
+
+sub read_pem ($$) {
+ my ($file, $label) = @_;
+ ## Read a PEM-encoded message from FILE, with LABEL quoted in the boundary
+ ## markers, and return the binary contents.
+
+ my $body = "";
+ open my $f, "<", $file;
+ LINE: while (<$f>)
+ { last LINE if /^-----BEGIN \Q$label\E-----$/; }
+ LINE: while (<$f>)
+ { last LINE if /^-----END \Q$label\E-----$/; $body .= $_; }
+ close $f;
+
+ return decode_base64 $body;
+}
+
+sub ident ($) {
+ my ($pub) = @_;
+ ## Parse the (raw BER) RSA public key data PUB, returning a key identifier.
+ ## This is the least significant 80 bits of the modulus, Base32-encoded,
+ ## which comes out at 16 characters.
+
+ my ($c, $k, $t);
+
+ ## Outer SEQUENCE.
+ ($c, $k, $t, my $x) = ber_decnext $pub;
+ $c == C_UNV && $k && $t == TY_SEQ
+ or die "malformed key (expected seq)";
+
+ ## Inner SEQUENCE.
+ ($c, $k, $t, my $y) = ber_decnext $x;
+ $c == C_UNV && $k && $t == TY_SEQ
+ or die "malformed key (expected seq)";
+
+ ## Key type OID; must be `rsaEncryption'.
+ ($c, $k, $t, my $o) = ber_decnext $y;
+ $c == C_UNV && !$k && $t == TY_OID
+ or die "malformed key (expected oid)";
+ ber_decoid($o) eq "1.2.840.113549.1.1.1"
+ or die "malformed key (wrong oid)";
+
+ ## Parameters; must be NULL.
+ ($c, $k, $t, my $z) = ber_decnext $y;
+ $c == C_UNV && !$k && $t == TY_NULL && $z eq ""
+ or die "malformed key (expected null)";
+
+ ## End inner SEQUENCE.
+ $y eq "" or die "malformed key (trailing junk)";
+
+ ## BIT STRING holding the actual public key data. I have no idea what
+ ## they were thinking when they came up with this.
+ ($c, $k, $t, my $u) = ber_decnext $x;
+ $c == C_UNV && !$k && $t == TY_BITSTR
+ or die "malformed key (expected bitstr)";
+ (my $n, $u) = unpack "C a*", $u;
+ $n == 0 or die "malformed key (odd-length bitstr)";
+
+ ## Inner SEQUENCE.
+ ($c, $k, $t, $y) = ber_decnext $u;
+ $c == C_UNV && $k && $t == TY_SEQ
+ or die "malformed key (expected seq)";
+
+ ## INTEGER holding the modulus.
+ ($c, $k, $t, $n) = ber_decnext $y;
+ $c == C_UNV && !$k && $t == TY_INT
+ or die "malformed key (expected int)";
+
+ ## INTEGER holding the public exponent, which we don't care about.
+ ($c, $k, $t, my $e) = ber_decnext $y;
+ $c == C_UNV && !$k && $t == TY_INT
+ or die "malformed key (expected int)";
+
+ ## Close the inner SEQUENCE, BIT STRING, outer SEQUENCE, and the
+ ## top-level.
+ $y eq "" or die "malformed key (trailing junk)";
+ $u eq "" or die "malformed key (trailing junk)";
+ $x eq "" or die "malformed key (trailing junk)";
+ $pub eq "" or die "malformed key (trailing junk)";
+
+ ## Extract the low bits of the modulus and encode them.
+ length $n >= 10 or die "malformed key (too small)";
+ return lc encode_base32 substr($n, -10), "";
+}
+
+###--------------------------------------------------------------------------
+### Configuration.
+
+## Conversion functions take two arguments, PARSEP and VAL. If PARSEP is
+## truish, then VAL is a value read from the configuration file, and the
+## function should parse it and return the Perl internal value. If PARSE is
+## falsish, then do the reverse conversion.
+
+sub conf_token ($$) {
+ my ($parsep, $val) = @_;
+ ## Do-nothing conversion function for text.
+
+ return $val;
+}
+
+sub conf_stamp ($$) {
+ my ($parsep, $val) = @_;
+ ## Convert ISO8601 zulu-time stamps to POSIX `time_t'.
+
+ if ($parsep) { return parse_stamp $val; }
+ else { return present_stamp $val; }
+}
+
+{
+ ## Map between unit names and scales.
+ my %unitmap; my @unitmap;
+
+ for my $item ([7*24*60*60, qw{wk w wks week weeks}],
+ [24*60*60, qw{dy d dys day days}],
+ [60*60, qw{hr h hrs hour hours}],
+ [60, qw{min m mins minute minutes}],
+ [1, "", qw{s sec secs second seconds}]) {
+ my ($scale, @names) = @$item;
+ for my $name (@names) { $unitmap{$name} = $scale; }
+ push @unitmap, [$scale, $names[0]];
+ }
+
+ sub conf_duration ($$) {
+ my ($parsep, $val) = @_;
+ ## Convert time durations with units.
+
+ if ($parsep) {
+ my ($x, $u) = $val =~ m{^ \s* (\.\d+ | \d+ (?: \. \d*)?)
+ \s* (| \S+) $}x
+ or die "bad duration `$val'";
+ my $scale = $unitmap{$u} or die "bad duration `$val'";
+ return $x*$scale;
+ } else {
+ my $x = 1; my $u = "s";
+ UNIT: for my $item (@unitmap) {
+ my ($scale, $unit) = @$item;
+ if ($val >= $scale) { $x = $val/$scale; $u = $unit; last UNIT; }
+ }
+ return sprintf "%.4g %s", $x, $u;
+ }
+ }
+}
+
+sub read_config ($$) {
+ my ($spec, $file) = @_;
+ ## Read configuration from FILE, as described by SPEC. Return a hash
+ ## mapping names to values.
+ ##
+ ## The SPEC is a hashref mapping configuration keys to [CONV, DFLT] pairs,
+ ## where CONV is a conversion function (as described above) and DFLT is the
+ ## default value.
+
+ my %c;
+ open my $f, "<", $file;
+ LINE: while (<$f>) {
+ chomp; next LINE unless /^\s*[^#]/;
+ my ($k, $v) = m{^ \s* ([^=\s]+) \s* = (.*) $}x
+ or die "bad assignment `$_'";
+ $v =~ s/^\s+//; $v =~ s/\s+$//;
+ my $def = $spec->{$k} or die "unknown setting `$k'";
+ exists $c{$k} and die "duplicate setting `$k'";
+ $c{$k} = $def->[0](1, $v);
+ }
+ close $f;
+ for my $k (keys %$spec) {
+ if (exists $c{$k}) { }
+ elsif ($spec->{$k}->@* > 1) { $c{$k} = $spec->{$k}[1]; }
+ else { die "missing setting for `$k'"; }
+ }
+ return \%c;
+}
+
+sub write_config ($$$) {
+ my ($spec, $file, $conf) = @_;
+ ## Write configuration back FILE from CONF, as described by SPEC. See
+ ## `read_config' for the format of SPEC.
+
+ open my $f, ">", "$file.new";
+ KEY: for my $k (keys %$spec) {
+ defined $conf->{$k} or next KEY;
+ printf $f "%s = %s\n", $k, $spec->{$k}[0](0, $conf->{$k});
+ }
+ close $f;
+ rename "$file.new", $file;
+}
+
+###--------------------------------------------------------------------------
+### Configuration.
+
+my %CONF_SPEC = ("ddns-zone" => [\&conf_token],
+ "ddns-server" => [\&conf_token, undef],
+ "ddns-key" => [\&conf_token],
+ "ddns-ttl" => [\&conf_duration, 4*60*60],
+ "dns-delay" => [\&conf_duration, 2*24*60*60],
+ "instance" => [\&conf_token],
+ "publish-uri" => [\&conf_token],
+ "active-duration" => [\&conf_duration, 24*60*60],
+ "cycle-period" => [\&conf_duration, 3*24*60*60],
+ "mail-persistence" => [\&conf_duration, 7*24*60*60],
+ "dns-persistence" => [\&conf_duration, 3*24*60*60]);
+
+our %C = %{read_config \%CONF_SPEC, "dkim-keys.conf"};
+
+###--------------------------------------------------------------------------
+### State model.
+
+## There are six states that a key can be in. Keys always advance through
+## these states in order. Except in `NEW' and `PUBLISH', the key's
+## private-key file is reliably named `ST/TS.ID.priv', and this is the
+## primary means to determine which state the key is actually in.
+##
+## * `NEW'. This is rather complicated, and there are multiple steps and
+## a fiddly cleanup procedure.
+##
+## 1. Create `NEW/new.priv'. Cleanup: delete it.
+## 2. Create `NEW/new.pub'. Determine key id. Cleanup: delete both.
+## 3. Rename to `NEW/TS.ID.priv'. Cleanup: continue to ANNOUNCE.
+## 4. Rename `MEW/new.pub' to `active/ID.pub'. (If it's not there,
+## then this has been done already.)
+## 5. Announce the key in the DNS.
+## 6. Promote the key to ANNOUNCE: rename `NEW/TS.ID.priv' to
+## `ANNOUNCE/TS.ID.priv'.
+##
+## * `ANNOUNCE'. The key has been announced in the DNS, and we're waiting
+## for the announcement to propagate before we deploy the key. A
+## placeholder HTML file is written to `publish/I/D.html'. Unless we're
+## in catch-up mode, keys will remain in `ANNOUNCE' state for DNS-DELAY
+## seconds. The timestamp is the time at which we expect the key to
+## become active.
+##
+## * `DEPLOY'. The key is ready for use in the upcoming cycle; the private
+## key file is in `active/ID.priv', and the key is named in the
+## `dkim-keys.state' file. The timestamp is the time at which we expect
+## the key to become active. The key will be active for ACTIVE-DURATION
+## seconds.
+##
+## * `RETIRE'. The key has been deployed and replaced, and will no longer
+## be used for signing. However, messages bearing its signatures are
+## potentially still in flight, so the key is still visible in DNS. Keys
+## will remain in `RETIRE' state for MAIL-PERSISTENCE seconds. The
+## timestamp is the time at which we expect that the key can be
+## withdrawn.
+##
+## * `WITHDRAW'. The key is no longer needed by verifiers because all
+## messages signed under it have either been delivered or abandoned. The
+## key is withdrawn from DNS, and we're waiting for the withdrawal to
+## propagate. Keys remain in `WITHDRAW' state for DNS-PERSISTENCE
+## seconds. The timestamp is the time at which we expect that the key
+## can be published.
+##
+## * `PUBLISH'. The key is no longer available to verifiers, because it is
+## no longer visible in DNS. It is therefore now safe to publish the
+## private key. This is the final state, and we stop tracking keys in
+## `PUBLISH' state. The `active/ID.priv' and `active/ID.pub' files are
+## deleted; the placeholder `publish/I/D.html' is replaced with a file
+## holding the actual key data. The private key file is deleted.
+
+## Mapping between state names and indices.
+our @STNAME;
+our %STIX = ();
+for my $st (qw{ NEW ANNOUNCE DEPLOY RETIRE WITHDRAW PUBLISH })
+ { $STIX{$st} = scalar @STNAME; push @STNAME, $st; }
+
+###--------------------------------------------------------------------------
+### Schedule objects.
+
+{ package Scheduler;
+ ## A `Scheduler' object keeps track of things to do in the future. Most
+ ## notably, it accumulates DNS update tasks so that they can be performed
+ ## in a single transaction, and a list of miscellaneous subs to run.
+ ##
+ ## Operations which create new files should be done immediately.
+ ## Operations which delete files (or rename them -- such as committing
+ ## state transitions by renaming the `.priv' file) should be deferred using
+ ## `add_cleanup'.
+
+ sub new {
+ my ($pkg) = @_;
+ ## Create and return a new `Scheduler'.
+
+ return bless { dns_update => { }, cleanups => [] }, $pkg;
+ }
+
+ sub add_record {
+ my ($me, $label, $type, $data) = @_;
+ ## Add a DNS record for LABEL, with the given TYPE and DATA.
+ ##
+ ## This is collected as part of the single DNS update transaction. Any
+ ## existing record for the LABEL and TYPE is deleted, which is probably
+ ## terrible for general use, but works just fine in this program.
+
+ $me->{dns_update}{$label}{$type} = $data;
+ }
+
+ sub delete_record {
+ my ($me, $label, $type) = @_;
+ ## Delete the DNS record(s) for LABEL with the given TYPE.
+
+ $me->{dns_update}{$label}{$type} = undef;
+ }
+
+ sub add_cleanup {
+ my ($me, $op) = @_;
+ ## Arrange to run OP at the end of the program.
+
+ push $me->{cleanups}->@*, $op;
+ }
+
+ sub execute {
+ my ($me) = @_;
+ ## Perform the scheduled activities.
+
+ ## Do the DNS update.
+ my $updates = "";
+ for my $label (keys $me->{dns_update}->%*) {
+ for my $type (keys $me->{dns_update}{$label}->%*) {
+ my $data = $me->{dns_update}{$label}{$type};
+ $updates .= "update delete $label IN $type\n";
+ if (!defined $data) {
+ print "delete dns record $label $type\n";
+ } else {
+ $updates .= "update add $label IN $type $data\n" if defined $data;
+ print "create dns record $label $type $data\n";
+ }
+ }
+ }
+ if ($updates eq "") {
+ print "no dns updates\n";
+ } else {
+ my @nsucmd = ("nsupdate");
+ push @nsucmd, "-k", $::C{"ddns-key"} if defined $::C{"ddns-key"};
+ ::running {
+ @nsucmd = ("cat") if $ENV{"DKIM_KEYS_NODNS"} // 0;
+ open my $f, "|-", @nsucmd;
+ my $server = $::C{"ddns-server"}; my $ttl = $::C{"ddns-ttl"};
+ print $f "server $server\n" if defined $server;
+ print $f "ttl $ttl\n" if defined $ttl;
+ print $f $updates;
+ print $f "send\n";
+ print $f "answer\n";
+ close $f
+ } @nsucmd;
+ }
+
+ ## Run the deferred cleanup operations.
+ for my $op ($me->{cleanups}->@*) { $op->(); }
+ }
+}
+
+sub schedule_cleanup (&$) {
+ my ($op, $sched) = @_;
+ ## Get SCHED to run OP during its cleanup.
+ ##
+ ## This just has slightly nicer syntax than calling `SCHED->add_cleanup'.
+
+ $sched->add_cleanup($op);
+}
+
+###--------------------------------------------------------------------------
+### Key management.
+
+sub generate_key ($) {
+ my ($file) = @_;
+ ## Make a new RSA key and save it in PEM format in FILE.
+ ##
+ ## No particular effort is taken to ensure that FILE is updated atomically.
+
+ my $oldmask = umask 0037;
+ print "generate new key\n";
+ run "openssl", "genrsa", "-out", $file, "3072";
+ umask $oldmask;
+}
+
+sub extract_public_key ($$) {
+ my ($pub, $priv) = @_;
+ ## Store the public key corresponding to PRIV in the file PUB.
+ ##
+ ## No particular effort is taken to ensure that PUB is updated atomically.
+
+ print "extract public key\n";
+ run "openssl", "rsa", "-pubout", "-in", $priv, "-out", $pub;
+ return read_pem($pub, "PUBLIC KEY");
+}
+
+{ package Key;
+ ## A `Key' object keeps track of a DKIM key's lifecycle stages.
+ ##
+ ## Key objects are blessed hashrefs with the following public slots.
+ ##
+ ## * `id' is the key's identifier, as a lowercase Base32 string.
+ ## * `st' is the key's state, as an uppercase string.
+ ## * `t' is the key's timestamp, as an integer count of seconds.
+ ##
+ ## It also has private slots.
+ ##
+ ## * `file0' is the filename holding the private key.
+ ## * `file' is the filename that the private key /would/ have if the
+ ## currently scheduled operations were executed.
+ ## * `pub' is the key's public key, in binary BER format.
+
+ ## External modules.
+ use autodie;
+ use strict;
+
+ use Carp;
+ use MIME::Base64;
+
+ sub publish_components {
+ my ($me) = @_;
+ ## Split the key ID into pieces. This is how we map key IDs into the
+ ## filesystem and URI space: if we return n pieces, that's n - 1 levels
+ ## of directory, with leaves at the bottom.
+
+ my $id = $me->{id};
+ return (substr($id, 0, 3), substr($id, 3, 5), substr($id, 8));
+ }
+
+ sub publish_uri {
+ my ($me) = @_;
+ ## Return the URI at which the key will be published.
+
+ my @cc = $me->publish_components;
+ return $::C{"publish-uri"} . join("/", @cc) . ".html";
+ }
+
+ sub publish_filename {
+ my ($me) = @_;
+ ## Return the filename at which the key publication HTML file is stored.
+
+ my @cc = $me->publish_components;
+ my $name = "publish";
+ for my $c (@cc) { ::maybe_mkdir $name, 0751; $name .= "/" . $c; }
+ return $name . ".html";
+ }
+
+ sub new {
+ my ($pkg, $t) = @_;
+ ## Return a new `Key' object with initial timestamp T.
+ ##
+ ## The `pub' slot is set on exit.
+
+ ## Make the new key.
+ ::maybe_mkdir "NEW", 0700;
+ ::generate_key "NEW/new.priv";
+
+ ## Extract the public key and determine its id.
+ my $pub = ::extract_public_key "NEW/new.pub", "NEW/new.priv";
+ my $id = ::ident $pub;
+
+ ## Rename the private key. It won't go away now: we're committed to this
+ ## one.
+ print "commit to new key $id\n";
+ my $file = sprintf "NEW/%s.%s.priv", ::present_stamp($t), $id;
+ rename "NEW/new.priv", $file;
+
+ ## Report the public key as active.
+ print "activated new public key $id\n";
+ ::maybe_mkdir "active";
+ rename "NEW/new.pub", "active/$id.pub";
+
+ ## It's now a proper key.
+ my $me = $pkg->load($file);
+ $me->{pub} = $pub;
+ return $me;
+ }
+
+ sub load {
+ my ($pkg, $file) = @_;
+ ## Return a key object for the given FILE. We probably don't actually
+ ## bother reading the file.
+
+ ## Check that the file is sane.
+ -r $file or confess "key file `$file' not found";
+ $file =~ m{^ (\w+) /
+ (\d{4} - \d{2} - \d{2} T \d{2} : \d{2} : \d{2} Z) \.
+ ([abcdefghijklmnopqrstuvwxyz234567]+) \.priv $}x
+ or confess "bad key name `$file'";
+
+ ## Build the object.as the primary
+ my $st = $1; my $tm = $2; my $id = $3;
+ return bless {
+ st => $st, id => $id, t => ::parse_stamp($tm),
+ file => $file, file0 => $file
+ }, $pkg;
+ }
+
+ sub set_state {
+ my ($me, $sched, $newst, $newtime) = @_;
+ ## Change the state of the key to be NEWST, with timestamp NEWTIME.
+ ## Arrange to commit this state change by renaming the private key to
+ ## `ST/TS.ID.priv'.
+
+ return if $newst eq $me->{st} && $newtime eq $me->{t};
+ my $id = $me->{id};
+ printf "prepare key %s state %s %s -> %s %s\n",
+ $id, $me->{st},
+ ::present_time($me->{t}), $newst, ::present_time($newtime);
+ my $from = $me->{file};
+ my $to = $newst . "/" . ::present_stamp($newtime) . "." . $id . ".priv";
+ ::maybe_mkdir $newst;
+ ::schedule_cleanup {
+ print "key $id rename $from -> $to\n";
+ rename $from, $to;
+ } $sched;
+ $me->{st} = $newst; $me->{t} = $newtime; $me->{file} = $to;
+ }
+
+ sub announce {
+ my ($me, $sched, $t_publish) = @_;
+ ## Announce the public key in DNS as `ID.ZONE', and create a placeholder
+ ## HTML file in `publish/I/D.html' explaining that the key will be
+ ## published before T_PUBLISH.
+
+ ## Initial preparation.
+ print "announce new key\n";
+ my $id = $me->{id};
+
+ ## If we don't already have the public key then this must be a leftover
+ ## key from a previous aborted run. Create the public key file and
+ ## retrieve the key. Either way, we don't need it any more after this,
+ ## so save the memory.
+ my $pub = $me->{pub}; delete $me->{pub};
+ unless (defined $pub) {
+ ::maybe_mkdir "active";
+ $pub = ::extract_public_key "active/$id.pub", $me->{file0};
+ }
+
+ ## Prepare the record data.
+ my $key = sprintf
+ "v=DKIM1; s=email; t=s:y; k=rsa; h=sha256; " .
+ "n=Not suitable for non-repudiation! " .
+ "Private key revealed at %s by %s; " .
+ "p=%s",
+ $me->publish_uri,
+ ::present_time($t_publish),
+ encode_base64($pub, "");
+
+ ## A TXT record data consists of a sequence of strings of length at most
+ ## 255 each. The split positions are not significant. Split the data
+ ## into sufficiently small pieces, preferring to split at semantic
+ ## boundaries.
+ my @key = ();
+ while (length $key > 255) {
+ my $chunk = substr $key, 0, 255, "";
+ if ($chunk =~ m{^ (.* \;\s+) ([^\s;] [^;]*) $}x)
+ { $chunk = $1; $key = $2 . $key; }
+ push @key, $chunk;
+ }
+ push @key, $key;
+ $key = join " ", map qq'"$_"', @key;
+
+ ## Add the record.
+ $sched->add_record($id . "." . $::C{"ddns-zone"}, "TXT", $key);
+ }
+
+ sub deploy {
+ my ($me, $sched) = @_;
+ ## Make the key suitable for deployment. Hard link the private key to
+ ## `active/ID.priv'.
+
+ my $id = $me->{id};
+ print "deploy private key $id\n";
+ ::maybe_mkdir "active";
+ ::maybe_unlink "active/$id.priv.new";
+ link $me->{file0}, "active/$id.priv.new";
+ rename "active/$id.priv.new", "active/$id.priv";
+ }
+
+ sub withdraw {
+ my ($me, $sched) = @_;
+ ## Withdraw the key data from DNS so that legitimate reliers won't
+ ## believe signatures any more.
+
+ my $id = $me->{id}; my $zone = $::C{"ddns-zone"};
+ print "withdraw key $id from dns\n";
+ $sched->delete_record("$id.$zone", "TXT");
+ }
+
+ sub delete {
+ my ($me, $sched) = @_;
+ ## Delete the key from everywhere except the publication tree.
+
+ my $id = $me->{id}; print "delete key $id\n";
+ ::schedule_cleanup {
+ print "delete published key $id\n";
+ ::maybe_unlink "active/$id.pub";
+ ::maybe_unlink "active/$id.priv";
+ unlink $me->{file};
+ } $sched;
+ }
+}
+
+###--------------------------------------------------------------------------
+### Publication archive.
+
+sub publication_time ($;$$) {
+ my ($k, $newst, $newtime) = @_;
+ ## Return the approximate publication time of key K. If NEWST and NEWTIME
+ ## are given, then they override the key's state and timestamp.
+
+ $newst //= $k->{st}; $newtime //= $k->{t};
+ defined (my $newix = $STIX{$newst})
+ or confess "unexpected state `$newst'";
+ my $t_publish = $newtime + $C{"cycle-period"};
+ if ($newix < $STIX{PUBLISH})
+ { $t_publish += $C{"dns-persistence"}; }
+ if ($newix < $STIX{WITHDRAW})
+ { $t_publish += $C{"mail-persistence"}; }
+ if ($newix < $STIX{RETIRE})
+ { $t_publish += $C{"active-duration"} + $C{"cycle-period"}; }
+ return $t_publish;
+}
+
+sub publish_placeholder ($;$$) {
+ my ($k, $newst, $newtime) = @_;
+ ## Write a placeholder HTML file at the URI that key K's private key will
+ ## be published later. If NEWST and NEWTIME are given, then the override
+ ## the key's state and timestamp in the computation of the publication
+ ## time.
+
+ ## Determine the things we need to know.
+ my $id = $k->{id}; my $inst = $C{"instance"};
+ my $file = $k->publish_filename;
+ my $t_publish = publication_time $k, $newst, $newtime;
+ my $th_publish = present_time $t_publish;
+
+ ## Produce the placeholder file.
+ print "publish placeholder for $id\n";
+ open my $f, ">", "$file.new";
+ print $f <<EOF;
+<!DOCTYPE html>
+<html>
+<head>
+ <title>$inst DKIM key $id</title>
+</head>
+<body>
+<h1>$inst DKIM key <code>$id</code></h1>
+<p>This is a placeholder page.
+The private key <code>$id</code> is scheduled for publication
+on or before $th_publish.
+$inst DKIM private keys are published in order to make them
+unsuitable as evidence after the fact.
+
+<p>The public key is
+<pre>
+EOF
+ dump_file $f, "active/$id.pub";
+ print $f <<EOF;
+</pre>
+</body>
+</html>
+EOF
+ close $f;
+ rename "$file.new", $file;
+}
+
+sub publish_key ($) {
+ my ($k) = @_;
+ ## Publish key K's private key.
+
+ ## Determine the things we need to know.
+ my $id = $k->{id}; my $inst = $C{"instance"};
+ my $file = $k->publish_filename;
+
+ ## Produce the publication file.
+ print "publish private key for $id\n";
+ open my $f, ">", "$file.new";
+ print $f <<EOF;
+<!DOCTYPE html>
+<html>
+<head>
+ <title>$inst DKIM key $id</title>
+</head>
+<body>
+<h1>$inst DKIM key <code>$id</code></h1>
+<p>The key <code>$id</code> was used as a key to authenticate
+that email passed through the $inst server.
+$inst DKIM keys are published after they are no longer in active use,
+to make them unsuitable as evidence after the fact.
+
+<p>The private and public keys are
+<pre>
+EOF
+ dump_file $f, "active/$id.priv";
+ dump_file $f, "active/$id.pub";
+ print $f <<EOF;
+</pre>
+</body>
+</html>
+EOF
+ close $f;
+ rename "$file.new", $file;
+}
+
+###--------------------------------------------------------------------------
+### State transitions.
+
+sub set_key_state ($$$$) {
+ my ($k, $sched, $newst, $newtime) = @_;
+ ## Advance K to state NEWST, and set its timestamp to NEWTIME. Arrange for
+ ## SCHED to complete the transition.
+
+ ## Preliminary checking.
+ my $oldst = $k->{st}; my $id = $k->{id};
+ defined (my $ix = $STIX{$oldst})
+ or confess "unexpected key state `$oldst'";
+ defined (my $newix = $STIX{$newst})
+ or confess "unexpected new state `$newst'";
+ $ix <= $newix
+ or confess "attempted state regression `$oldst' -> `$newst'";
+
+ ## Advance the key through each intermediate state in turn.
+ while ($ix < $newix) {
+ $ix++; my $curst = $STNAME[$ix];
+ print "advance key $id state $oldst -> $curst\n";
+ if ($curst eq "ANNOUNCE") {
+ $k->announce($sched, publication_time $k, $newst, $newtime);
+ publish_placeholder $k, $newst, $newtime;
+ }
+ elsif ($curst eq "DEPLOY") { $k->deploy($sched); }
+ elsif ($curst eq "RETIRE") { ; }
+ elsif ($curst eq "WITHDRAW") { $k->withdraw($sched); }
+ elsif ($curst eq "PUBLISH") { publish_key $k; }
+ else { confess "unexpected state $curst" }
+ }
+
+ ## Finally commit the key in its new state.
+ if ($newst eq "PUBLISH") { $k->delete($sched); }
+ else { $k->set_state($sched, $newst, $newtime); }
+}
+
+sub keys_in_state ($) {
+ my ($st) = @_;
+ ## Return a list of the keys in state ST.
+
+ my @k; my $d;
+ eval { opendir $d, $st; };
+ if ($@) {
+ die if $@->errno != ENOENT;
+ } else {
+ FILE: for my $f (readdir $d) {
+ next FILE if $f eq "." || $f eq "..";
+ next FILE if $st eq "NEW" && ($f eq "new.priv" || $f eq "new.pub");
+ push @k, Key->load("$st/$f");
+ }
+ }
+ return @k;
+}
+
+###--------------------------------------------------------------------------
+### Main program.
+
+## Our first order of business is to ensure that there are keys lined up for
+## the current deployment cycle. The candidates are the keys which are
+## currently in `NEW', `ANNOUNCE', and `DEPLOY' states. We arrange to use
+## these in ascending order of their current timestamps. This might cause
+## keys to become active earlier than before.
+
+my @candidates; # candidates for future deployment
+my @to_retire; # keys which are too old
+my $cutoff = $NOW - $C{"active-duration"}; # threshold between the two
+my $sched = Scheduler->new; # a `Scheduler' instance
+
+## Work through the `NEW' keys and advance them on to `ANNOUNCE'. Pick up
+## all of the unretired keys so that we can plan how to use them.
+
+sub notice_candidate ($) {
+ my ($k) = @_;
+ ## Notice a key and add it to one of the lists above. If K's deployment
+ ## time window is entirely in the past then add it to `@to_retire';
+ ## otherwise, add it to `@candidates'.
+
+ if ($k->{t} < $cutoff) { push @to_retire, $k; }
+ else { push @candidates, $k; }
+}
+
+for my $k (keys_in_state "NEW")
+ { $k->announce($sched, publication_time $k); notice_candidate $k; }
+for my $st (qw{ ANNOUNCE DEPLOY })
+ { for my $k (keys_in_state $st) { notice_candidate $k; } }
+@candidates = sort { $a->{t} <=> $b->{t} } @candidates;
+
+## Determine the current start time of the oldest key we can deploy. If this
+## is earlier than now then things are chugging along OK and we continue with
+## the current plan. Otherwise, we need to arrange keys for immediate use.
+my $t0 = @candidates && $candidates[0]{t} <= $NOW ? $candidates[0]{t} : $NOW;
+my $nk = 0;
+
+## Start producing the state file for the mail server. Make sure that the
+## current cycle is covered.
+my $info = "";
+my $t = $t0; my $t_limit = $NOW + $C{"cycle-period"};
+while ($t < $t_limit) {
+ my $k = @candidates ? shift @candidates : Key->new($t);
+ set_key_state $k, $sched, "DEPLOY", $t; $t += $C{"active-duration"};
+ $info .= sprintf "info.%d: k = %s u = %s tpub = \"%s\"\n",
+ $nk, $k->{id}, $k->publish_uri, present_time publication_time $k;
+ $nk++;
+}
+
+## Write the new state file.
+maybe_mkdir "active";
+open my $mcf, ">", "active/dkim-keys.state.new";
+printf $mcf "### dkim-keys deployment state, from %s up to %s\n\n",
+ present_time($t0), present_time($t);
+printf $mcf "params: t0 = %d step = %d n = %d\n",
+ $t0, $C{"active-duration"}, $nk;
+print $mcf $info;
+close $mcf; rename "active/dkim-keys.state.new", "active/dkim-keys.state";
+
+## And now make sure there are enough new keys announced to cover the next
+## cycle.
+$t_limit = $NOW + 2*$C{"cycle-period"};
+while ($t < $t_limit) {
+ my $k = @candidates ? shift @candidates : Key->new($t);
+ set_key_state $k, $sched, "ANNOUNCE", $t; $t += $C{"active-duration"};
+}
+
+## If there are keys to retire, then arrange that.
+for my $k (@to_retire) {
+ set_key_state $k, $sched, "RETIRE",
+ $k->{t} + $C{"active-duration"} + $C{"mail-persistence"};
+}
+
+## If there are keys to withdraw, then arrange that too.
+for my $k (keys_in_state "RETIRE") {
+ if ($k->{t} <= $NOW)
+ { set_key_state $k, $sched, "WITHDRAW", $NOW + $C{"dns-persistence"}; }
+}
+
+## And, finally, if there are keys to be published, then arrange that.
+for my $k (keys_in_state "WITHDRAW")
+ { if ($k->{t} <= $NOW) { set_key_state $k, $sched, "PUBLISH", -1; } }
+
+## The planning is done. It's now time to do all the things.
+print "running cleanup actions\n";
+$sched->execute;
+
+###--------------------------------------------------------------------------
+### Manual.
+
+=head1 NAME
+
+dkim-keys - manage short-lived DKIM keys
+
+=head1 SYNOPSIS
+
+B<dkim-keys>
+
+=head1 DESCRIPTION
+
+=head2 Background
+
+DKIM , RFC6376, is a mechanism for authenticating email messages. An
+originating mail server signs each message that it sends using a private
+signing key, and adds a header to the message containing the signature and a
+reference to where the public verification key can be found in the DNS.
+A receiving mail server can parse the header, retrieve the verification key,
+verify the signature, and be convinced that the message at least passed
+through the originating server. This is intended to reduce the effectiveness
+of forged email messages for fraud and spam.
+
+A DKIM signature must cover email headers I<and> the body, to prevent an
+adversary from altering them in order to construct a forgery. This creates
+a problem which the designers of DKIM failed to foresee. Messages bearing
+DKIM signatures can remain verifiable long after delivery, providing
+convincing evidence that a particular mail server transmitted a particular
+message, and, moreover, at a particular time, and that was sent by a
+particular user. This may be undesirable, to say the least.
+
+In 2020, Matthew Green wrote an article describing this problem on his
+I<Cryptography Engineering> blog, and suggesting a solution: that DKIM
+signing keys should cycle rapidly, each key being used only for a short time,
+say a day, and, once all messages bearing signatures from a particular key
+have been delivered or abandoned, the I<private> signing key should be
+published. Once this is done, the DKIM signature on an old message becomes
+worthless as evidence of anything, since anyone with a little technical
+ability can forge convincing-looking messages bearing a valid signature from
+the key.
+
+This is what B<dkim-keys> does.
+
+=head2 Inovking B<dkim-keys>
+
+The B<dkim-keys> doesn't usually take any command-line arguments. It does
+recognize B<--help> (B<-h>) and B<--version> (B<-v>) options, for
+consistency's sake. It reports an error if other command-line arguments are
+given.
+
+=head2 Operation
+
+The B<dkim-keys> program works in the current directory. It expects to find
+a configuration file B<dkim-keys.conf>. It will create directories for its
+own use as necessary.
+
+=head2 State model
+
+Each key has an I<identifier>, notated I<id> here. For RSA keys, which are
+the only kind currently implemented, this is the least significant 80 bits of
+the modulus, encoded in lowercase Base32. (This means that the identifier
+can easily be determined from just the public key.) There are no padding
+characters because 80 is a multiple of five. The key identifier is used in
+the DKIM selector when the key is in use.
+
+Keys advance through six states.
+
+=over
+
+=item *
+
+A key in the B<NEW> state has just been created, and nobody else knows
+anything about it. Under normal circumstances, keys immediately advance to
+B<ANNOUNCE>, but the B<NEW> state is separate for technical reasons.
+
+=item *
+
+A key in the B<ANNOUNCE> state has a record listed in the DNS, and we're
+waiting for the DNS records to propagate before the key can be used.
+
+=item *
+
+A key in the B<DEPLOY> state is ready for use by a mail server to sign
+outgoing messages. There are usually multiple keys in this state so that the
+mail server can cycle from one to the next at the appropriate time without
+any further action from B<dkim-keys>.
+
+=item *
+
+A key in the B<RETIRE> state has completed its time in service. It may have
+been used to sign outgoing messages which are still on their way to being
+delivered or abandoned, so legitimate verifiers need access to the public
+key, but it won't be used to sign new messages.
+
+=item *
+
+A key in the B<WITHDRAW> state should no longer be of use to receiving
+servers. All messages signed using the key have either been delivered or
+abandoned. The public key record is withdrawn from the DNS, and we're
+waiting for this withdrawal to propagate before the private key can be
+published. At this stage, a forgery made using the key might be accepted by
+a receiving server which still has access to stale DNS records, so the
+private key can't quite be published yet.
+
+=item *
+
+A key in the B<PUBLISH> state is published for all to see. Nobody should
+beleive it for anything, and nobody should have any reason to.
+
+=back
+
+=head2 Configuration file
+
+The configuration syntax is simple and line-based. Lines consisting only of
+whitespace, and lines whose first whitespace character is C<#>, are ignored.
+Other lines must be I<assignments> of the form I<key> B<=> I<value>. The
+recognized keys and their values are as follows.
+
+=over
+
+=item B<instance>
+
+A name for the instance of B<dkim-keys>. This is used in the published HTML
+files. There is no default.
+
+=item B<publish-uri>
+
+The base URL at which keys will be published. The web server should be
+configured to publish the contents of the B<publish> directory at this URL.
+There is no default.
+
+=item B<ddns-zone>
+
+The DNS I<zone> in which the public keys will be listed. A key with a given
+I<id> will be listed in a B<TXT> record at I<id>B<.>I<zone>. In a simple
+system, I<zone> might be B<_domainkey.example.org>, so the B<example.org>
+outgoing mail server need only set B<s=>I<id>B<;> B<d=example.org> in its
+DKIM headers. In a more complex case, the I<zone> might be referred to using
+B<DNAME> for multiple domains.
+
+There is no default for this setting.
+
+=item B<ddns-server>
+
+The server to which DNS updates will be submitted. By default, the source
+server listed in the zone B<SOA> record will be used.
+
+=item B<ddns-key>
+
+The file containing the TKIP key to use for authenticating the DNS update.
+There is no default for this setting.
+
+=item B<ddns-ttl>
+
+The TTL to set on DKIM key records, as a duration (see below). The default
+is four hours.
+
+=item B<dns-delay>
+
+The time required for a newly published DNS record to fully propagate, as a
+duration (see below). Conservatively, this will be the sum of the zone
+refresh, expiry, and minimum-TTL times: a secondary server must have time to
+try updating, give up, and expire the zone, and a downstream recursive
+resolver must time out a previously cached negative result for the record,
+before the record can be considered fully propagated.
+
+This setting determines how long a key remains in the B<ANNOUNCE> state. The
+default is two days.
+
+=item B<active-duration>
+
+The time for which a key will be in active use signing outgoing messages, as
+a duration (see below). The default is one day.
+
+=item B<cycle-period>
+
+The maximum interval between runs of B<dkim-keys>, as a duration (see below).
+This determines the how many keys are queued up in the B<DEPLOY> state. The
+default is three days, with the expectation that the script will actually run
+daily.
+
+=item B<mail-persistence>
+
+The time before which outgoing email messages can safely be expected to have
+been delivered or abandoned, as a duration (see below). This mostly depends
+on the outgoing server configuration, but there can conceivably be additional
+delay at the receiving end.
+
+This setting determines how long a key remains in the B<RETIRE> state. The
+default is one week.
+
+=item B<dns-persistence>
+
+The time required for a withdrawn DNS record to fully propagate, as a
+duration (see below). Conservatively, this will be the sum of the zone
+refresh and expiry times, and the record TTL: a secondary server must have
+time to try updating, give up, and expire the zone, and a downstream
+recursive resolver must time out a previously cached record, before it can be
+considered fully withdrawn.
+
+This setting determines how long a key remains in the B<WITHDRAW> state. The
+default is three days.
+
+=back
+
+A duration is a (possibly fractional) decimal number, followed by an optional
+unit.
+
+=over
+
+=item *
+
+B<s>, B<sec>, B<secs>, B<second>, B<seconds>
+
+=item *
+
+B<min>, B<m>, B<mins>, B<minute>, B<minutes>
+
+=item *
+
+B<hr>, B<h>, B<hrs>, B<hour>, B<hours>
+
+=item *
+
+B<dy>, B<d>, B<dys>, B<day>, B<days>
+
+=item *
+
+B<wk>, B<w>, B<wks>, B<week>, B<weeks>
+
+=back
+
+If no unit is given, the default is seconds.
+
+=head2 Output
+
+The B<active> directory contains public and private key files, and a
+B<dkim-keys.state> file for the mail server.
+
+B<active/>I<id>B<.pub> contains the public key for the key with identifier
+I<id> (in OpenSSL PEM format), and B<active/>I<id>B<.priv> is the private key
+(a hard link to the I<state>B</>I<timestamp>B<.>I<id>B<.priv> file).
+
+The B<active/dkim-keys.state> file is formatted as follows. It contains
+blank lines and (sparse) comments beginning with C<#>. It contains a line
+
+=over
+
+B<params:> B<t0 => I<t0> B<step => I<step> B<n => I<n>
+
+=back
+
+where I<t0>, I<step>, and I<n> are integers in decimal notation. It also
+contains lines
+
+=over
+
+B<info.>I<i>B<:> B<k => I<id> B<u => I<url> B<tpub => I<tpub>
+
+=back
+
+where I<i> is an integer, I<id> is a key identifier, I<url> is a url (not
+containing spaces), and I<tpub> is an ISO8601 time stamp with explicit time
+zone offset, in double quotes. There will be exactly I<n> B<info> lines, one
+for each I<i> from 0 (inclusive) up to but not including I<n>. These lines
+may appear in any order.
+
+The B<params> line identifies one of the B<info> lines, as follows. I<t0> is
+a POSIX timestamp, counting nonleap seconds since the start of January 1970.
+I<step> is the length of time, in seconds, for which a key is active (taken
+from the B<active-duration> configuration setting). If the current POSIX
+time is I<t>, then the mail server should use the B<info.>I<i> data, where
+I<i> = floor((I<t> - I<t0>)/I<step>). If I<i>, as computed in this way, is
+less than zero or greater than or equal to I<n>, then the data is invalid:
+the mail server should report temporary failure. Specifically, if I<i> is
+less than zero then the data is apparently from the future: this is most
+likely if the system clock has been stepped, and the situation can be
+corrected by running B<dkim-keys> again. If I<i> is greater than or equal to
+I<n> then the file is out-of-date: B<dkim-keys> has not run to completion
+sufficiently recently, or is otherwise broken.
+
+The B<info> line fields are as follows. The I<id> is the identifier of the
+signing key to use, and to include in the DKIM B<s=> selector tag; the actual
+private key will be B<active/>I<id>B<.priv>. The I<url> is the URL at which
+the private key will be published (derived from the key identifier and the
+B<publish-uri> configuration setting) and I<tpub> is a time by which
+publication should have occurred; the latter two items are intended to be
+included in a message header.
+
+Exim, for example, might be configured as follows.
+
+ dkim_selector = \
+ ${lookup {params} lsearch \
+ {${lookup {${domain:$h_From:}} partial0-lsearch \
+ {/etc/mail/dkim-sign.conf} \
+ {/var/lib/dkim-keys/$value/active/dkim-keys.state}}} \
+ {${if and {{>= {$tod_epoch} {${extract {t0}{$value}}}} \
+ {< {$tod_epoch} \
+ {${eval:${extract {t0}{$value}} + \
+ ${extract {n}{$value}}*${extract {step}{$value}}}}}} \
+ {${lookup {info.${eval:($tod_epoch - ${extract {t0}{$value}})/ \
+ ${extract {step}{$value}}}}
+ lsearch \
+ {${lookup {${domain:$h_From:}} partial0-lsearch \
+ {/etc/mail/dkim-sign.conf} \
+ {/var/lib/dkim-keys/$value/active/dkim-keys.state}}} \
+ {${extract {k}{$value}}}fail}} \
+ fail}}\
+ fail}
+ dkim_private_key = \
+ ${lookup {${domain:$h_From:}} partial0-lsearch \
+ {/etc/mail/dkim-sign.conf} \
+ /var/lib/dkim-keys/$value/active/$dkim_selector.priv}
+
+=head2 Working state
+
+In the working directory, there is a subdirectory for each state. Private
+keys are stored (in OpenSSL PEM) format) in files named
+I<state>B</>I<timestamp>B<.>I<id>B<.priv> where I<state> is the key's state,
+as listed above, in uppercase, I<timestamp> is a timestamp in ISO8601 `zulu'
+format, and I<id> is the key's identifier, used as the DKIM selector. The
+meaning and value of the timestamp changes as the key advances from one state
+to the next: see the source code for details.
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+D. Crocker, T. Hansen, M. Kucherawy, RFC6376: I<DomainKeys Identified Mail
+(DKIM) Signatures>, L<https://www.rfc-editor.org/rfc/rfc6376.html>.
+
+=item *
+
+Matthew Green, I<Ok Google: Please publish your DKIM secret keys>,
+L<https://blog.cryptographyengineering.com/2020/11/16/ok-google-please-publish-your-dkim-secret-keys/>
+
+=item *
+
+L<nsupdate(1)>.
+
+=back
+
+=head1 AUTHOR
+
+Mark Wooding, <mdw@distorted.org.uk>.
+
+=cut
+
+###----- That's all, folks --------------------------------------------------
~mdw / distorted-dkim / commitdiff