From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 4 May 2024 21:53:07 +0000 (+0100)
Subject: dkim-keys.in, Makefile: Rather more proper now.
X-Git-Tag: 1.0.0~5
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/distorted-dkim/commitdiff_plain/8cff7f9a25045d38666938aed0b917678ab77f0b

dkim-keys.in, Makefile: Rather more proper now.
---

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..e12da38
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+/config.mk
+/version-stamp.mk
+/dkim-keys
+/dkim-keys.1
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..6e0ee10
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,81 @@
+### -*-makefile-*-
+
+###--------------------------------------------------------------------------
+### User-serviceable parts.
+
+## Installation directories.
+prefix			 = /usr/local
+exec_prefix		 = ${prefix}
+bindir			 = ${exec_prefix}/bin
+datadir			 = ${prefix}/share
+mandir			 = ${datadir}/man
+man1dir			 = ${mandir}/man1
+
+## User configuration.
+-include config.mk
+
+###--------------------------------------------------------------------------
+### Machinery.
+
+## Preliminaries.
+all:
+clean::
+.PHONY: all clean
+.SECONDEXPANSION:
+
+force:
+.PHONY: force
+
+## Layout.
+INSTDIRS		 =
+
+INSTDIRS		+= bin
+bin_FILES		 =
+bin_INSTCMD		 = install -t$(bindir) -m755
+
+INSTDIRS		+= man1
+man1_FILES		 =
+man1_INSTCMD		 = install -t$(man1dir) -m644
+
+## Version number.
+VERSION			:= $(shell git describe --always --abbrev=4 --dirty=+)
+-include version-stamp.mk
+ifneq ($(VERSION),$(OLD_VERSION))
+  FORCE_VERSION		 = force
+else
+  FORCE_VERSION		 =
+endif
+version-stamp.mk: $(FORCE_VERSION)
+	echo "OLD_VERSION = $(VERSION)" >$@.new && mv $@.new $@
+
+## The main program.
+bin_FILES		+= dkim-keys
+dkim-keys: dkim-keys.in version-stamp.mk
+	sed 's/@VERSION@/$(VERSION)/g' $< >$@.new && \
+		chmod +x $@.new && mv $@.new $@
+
+## The manual.
+man1_FILES		+= dkim-keys.1
+dkim-keys.1: dkim-keys.in version-stamp.mk
+	pod2man -s1 -dkim-keys -r"$(VERSION)" \
+			 -c"distorted.org.uk utilities" \
+			$< >$@.new && \
+		mv $@.new $@
+
+## Building.
+TARGETS			 = $(foreach d,$(INSTDIRS), $($d_FILES))
+all: $(TARGETS)
+clean::; rm -f $(TARGETS)
+
+## Installation.
+INSTALLS		 = $(addprefix install/, $(INSTDIRS))
+install: $(INSTALLS)
+$(INSTALLS): install/%: $$($$*_FILES)
+	install -d $($*dir)
+	$($*_INSTCMD) $+
+
+UNINSTALLS		 = $(addprefix uninstall/, $(INSTDIRS))
+uninstall: $(UNINSTALLS)
+$(UNINSTALLS): uninstall/%:
+	rm -f $(addprefix $($*dir)/,$($*_FILES))
+.PHONY: install $(INSTALLS) uninstall $(UNINSTALLS)
diff --git a/dkim-keys b/dkim-keys
deleted file mode 100755
index fc459e6..0000000
--- a/dkim-keys
+++ /dev/null
@@ -1,899 +0,0 @@
-#! /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 --------------------------------------------------
diff --git a/dkim-keys.in b/dkim-keys.in
new file mode 100755
index 0000000..ef38d4d
--- /dev/null
+++ b/dkim-keys.in
@@ -0,0 +1,1378 @@
+#! /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 --------------------------------------------------