From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 1 Dec 2012 13:03:41 +0000 (+0000)
Subject: Almost a complete rewrite.
X-Git-Url: https://git.distorted.org.uk/~mdw/ca/commitdiff_plain/69ab55f79b5b6109be503ff8d61fba82b1468360

Almost a complete rewrite.

The scripts are now written in Tcl, using Sqlite3 to store information
about the certificates.  There's a comprehensive library for hacking the
database, and fiddling with certificates.  There are even tests, which
seem to work properly.
---

diff --git a/.gitignore b/.gitignore
index aa429de..dd8d9b5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,11 @@
 ca.cert
+crl
 certs
 index
 private
 state
 tmp
 etc/config
+cert
+req
+archive
diff --git a/bin/add b/bin/add
new file mode 100755
index 0000000..1c2ae81
--- /dev/null
+++ b/bin/add
@@ -0,0 +1,111 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Insert a certificate request into the database.
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+
+## Parse the command line.
+set O(replace) false
+set usage "usage: $argv0 \[-replace\] PROFILE TAG FILE"
+for {set i 0} {$i < [llength $argv]} {incr i} {
+  switch -glob -- [lindex $argv $i] {
+    "-replace" {
+      set O(replace) true
+    }
+    "--" {
+      incr i
+      break
+    }
+    "-*" {
+      puts stderr $usage
+      exit 1
+    }
+    default {
+      break
+    }
+  }
+}
+set args [lrange $argv $i end]
+if {[llength $args] != 3} {
+  puts stderr $usage
+  exit 1
+}
+lassign $args profile tag file
+
+## Open the database.
+sqlite3 db "$CERTROOT/state/ca.db"
+
+## Do most of the work in a transaction.
+db transaction {
+  with-cleanup {
+
+    ## Check whether this tag is already taken.
+    if {!$O(replace) && [db exists {
+      SELECT 1 FROM request
+      WHERE tag = $tag AND st = 'active';
+    }]} {
+      error "request `$tag' already active"
+    }
+
+    ## Check whether the profile exists.
+    if {![db exists {
+      SELECT 1 FROM profile WHERE label = $profile;
+    }]} {
+      error "unknown profile `$profile'"
+    }
+
+    ## Copy the file away.
+    fresh-temp "$CERTROOT/tmp" tmp {
+      file copy $file $tmp
+    }
+    cleanup { file delete $tmp }
+
+    ## Get lots of information about the request.
+    set dn [req-dn $tmp]
+    set hash [req-key-hash $tmp]
+
+    ## Get an id number for the new request.
+    db eval {
+      UPDATE meta
+      SET request_seq = request_seq + 1;
+    }
+    set id [db eval {
+      SELECT request_seq FROM meta;
+    }]
+
+    ## Insert the new record into the request table.
+    db eval {
+      UPDATE request SET st = 'withdrawn' WHERE tag = $tag AND st = 'active';
+      INSERT INTO request(id, tag, dn, hash, st, profile)
+      VALUES ($id, $tag, $dn, @hash, 'active', $profile);
+    }
+
+    ## Link the file into the right place.
+    file link -hard "$CERTROOT/req/by-id/$id" $tmp
+    exec ln -sf "../by-id/$id" "$CERTROOT/req/active/$tag"
+  }
+
+  ## Issue a shiny new certificate.
+  issue-cert $id [now]
+}
diff --git a/bin/check b/bin/check
new file mode 100755
index 0000000..bf276f0
--- /dev/null
+++ b/bin/check
@@ -0,0 +1,227 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Check that the certificate authority database and files are consistent.
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+
+## Open the database
+sqlite3 db "$CERTROOT/state/ca.db"
+db nullvalue nil
+
+## Build a map of the active requests.  Verify that active requests have
+## distinct tags.
+array unset actreq
+array unset complain
+foreach {tag id} [db eval {
+  SELECT tag, id FROM request WHERE st = 'active';
+}] {
+  if {[info exists actreq($tag)] && ![info exists complain(dup-req-$tag)]} {
+    bad 4 "multiple active requests with tag `$tag' ($id and $actreq($tag))"
+    set complain(dup-req-$tag) 1
+  } else {
+    set actreq($tag) $id
+  }
+}
+
+## Go through the active certificates.  Each one should tie up to an active
+## request.  We don't check here that the request exists at all: that gets
+## done later.
+array unset actcert
+foreach {seq tag st} [db eval {
+  SELECT c.seq, r.tag, r.st
+  FROM certificate AS c JOIN request AS r ON c.req = r.id
+  WHERE c.st = 'active';
+}] {
+  if {[info exists actcert($tag)] &&
+      ![info exists complain(dup-cert-$tag)]} {
+    bad 4 [join {
+      "multiple active certificates with "
+      "tag `$tag' ($seq and $actcert($tag))"} ""]
+    continue
+  }
+  set actcert($tag) $seq
+  if {![string equal $st active]} {
+    bad 2 [join {
+      "active cert $seq associated with "
+      "request $id (`$tag') which is $st not active"} ""]
+  }
+}
+
+## Check that the certificates for a revoked request are revoked or
+## expired.
+foreach {seq id tag st} [db eval {
+  SELECT c.seq, r.id, r.tag, c.st
+  FROM certificate AS c JOIN request AS r ON c.req = r.id
+  WHERE r.st = 'revoked' AND c.st != 'revoked' AND c.st != 'expired';
+}] {
+  bad 4 "cert $seq for revoked request $id (`$tag') is $st not revoked"
+}
+
+## Similarly, check that revoked certificates match up with revoked
+## requests.
+foreach {seq id tag st} [db eval {
+  SELECT c.seq, r.id, r.tag, c.st
+  FROM certificate AS c JOIN request AS r ON c.req = r.id
+  WHERE c.st = 'revoked' AND r.st != 'revoked';
+}] {
+  bad 2 [join {
+    "revoked cert $seq associated with "
+    "request $id (`$tag') which is $st not revoked"} ""]
+}
+
+## Check that the active symlinks are correct.
+foreach {what key dir actvar} {
+  "request" "id" "req" actreq
+  "certificate" "seq" "cert" actcert
+} {
+  upvar 0 $actvar act
+
+  ## Check that there's a symlink DIR/active/TAG for each active item, and
+  ## that it points to the correct item.
+  foreach tag [array names act] {
+    set link "$CERTROOT/$dir/active/$tag"
+    set id $act($tag)
+    if {![file exists $link]} {
+      bad 1 "missing symlink for active $what `$tag' ($key = $id)"
+    } elseif {![string equal [file type $link] link]} {
+      bad 1 "entry for active $what `$tag' ($key = $id) isn't a link"
+    } elseif {![string equal [file readlink $link] "../by-$key/$id"]} {
+      bad 1 "link for active $what `$tag' ($key = $id) is wrong"
+      moan "\t(actually `[file readlink $link]'; should be `../by-$key/$id')"
+    }
+  }
+
+  ## Check that there aren't any other stray things.
+  foreach tag \
+      [glob -tails -directory "$CERTROOT/$dir/active" -nocomplain *] {
+    if {![info exists act($tag)]} {
+      bad 1 "bogus file `$dir/active/$tag'"
+    }
+  }
+}
+
+## Now run through all of the requests and check that they match the
+## corresponding request files.
+array unset reqmap
+foreach {id tag st dn hash} [db eval {
+  SELECT id, tag, st, dn, hash FROM request;
+}] {
+  if {[info exists reqmap($id)]} {
+    bad 4 "duplicate request id $id"
+    continue
+  }
+  set reqmap($id) 1
+
+  switch -exact -- $st {
+    active - withdrawn - revoked { }
+    default {
+      bad 2 "request $id (`$tag') has unknown state `$st'"
+    }
+  }
+
+  set reqfile "$CERTROOT/req/by-id/$id"
+  if {![file exists $reqfile]} {
+    bad 4 "missing file for request $id (`$tag')"
+    continue
+  }
+
+  set req_dn [req-dn $reqfile]
+  if {![string equal $req_dn $dn]} {
+    bad 2 "request $id (`$tag') has DN mismatch"
+    moan "\t(db has dn = $dn)"
+    moan "\t(file has dn = $req_dn)"
+  }
+
+  set req_hash [req-key-hash $reqfile]
+  if {![string equal $req_hash $hash]} {
+    bad 2 "request $id (`$tag') has key hash mismatch"
+    moan "\t(db has hash = $hash)"
+    moan "\t(file has hash = $req_hash)"
+  }
+}
+
+## Run through all of the certificates and check that they match the
+## correspoding certificate files.  This is a good opportunity to verify that
+## the certificates match up with requests.
+array unset certmap
+foreach {seq req tag st dn hash} [db eval {
+  SELECT c.seq, r.id, r.tag, c.st, r.cert_dn, r.hash
+  FROM certificate AS c LEFT OUTER JOIN request AS r ON c.req = r.id;
+}] {
+  if {[info exists certmap($seq)]} {
+    bad 4 "duplicate certificate serial number $seq"
+    continue
+  }
+  set certmap($seq) 1
+
+  if {[string equal $req nil]} {
+    bad 2 "certificate $seq has no certificate request"
+  }
+
+  switch -exact -- $st {
+    active - withdrawn - superceded - revoked - expired { }
+    default {
+      bad 2 "certificate $id (`$tag') has unknown state `$st'"
+    }
+  }
+
+  set certfile "$CERTROOT/cert/by-seq/$seq"
+  if {![file exists $certfile]} {
+    bad 4 "missing file for certficate $seq (`$tag')"
+    continue
+  }
+  if {[string equal $req nil]} { continue }
+
+  set cert_dn [cert-dn $certfile]
+  if {![string equal $dn $cert_dn]} {
+    bad 2 "certificate $seq (`$tag') has DN mismatch"
+    moan "\t(db has dn = $dn)"
+    moan "\t(file has dn = $cert_dn)"
+  }
+
+  set cert_hash [cert-key-hash $certfile]
+  if {![string equal $cert_hash $hash]} {
+    bad 2 "certificate $seq (`$tag') has key hash mismatch"
+    moan "\t(db has hash = $hash)"
+    moan "\t(file has hash = $cert_hash)"
+  }
+}
+
+## Finally, make sure that there aren't any stray files in those directories.
+foreach {dir mapvar} {
+  "req/by-id" reqmap
+  "cert/by-seq" certmap
+} {
+  upvar 0 $mapvar map
+  foreach file [glob -tails -directory "$CERTROOT/$dir" -nocomplain *] {
+    if {![info exists map($file)]} {
+      bad 1 "bogus file `$dir/$file'"
+    }
+  }
+}
+
+## Done!
+quit
+
+###----- That's all, folks --------------------------------------------------
diff --git a/bin/clean b/bin/clean
deleted file mode 100755
index 539e068..0000000
--- a/bin/clean
+++ /dev/null
@@ -1,8 +0,0 @@
-#! /bin/sh
-
-set -e
-certroot=$(cd ${0%/*}/..; pwd)
-cd "$certroot"
-umask 022
-
-rm -rf ca.cert archive certs crls index private state tmp
diff --git a/bin/issue-crl b/bin/issue-crl
deleted file mode 100755
index 600e22a..0000000
--- a/bin/issue-crl
+++ /dev/null
@@ -1,17 +0,0 @@
-#! /bin/sh
-
-set -e
-certroot=$(cd ${0%/*}/..; pwd)
-cd "$certroot"
-. lib/func.sh
-runas_ca
-
-now=$(date +%Y-%m-%d)
-n=0
-while t=$now#$n.crl; [ -f crls/$t ]; do
-  n=$(expr $n + 1)
-done
-openssl ca -config openssl.conf -gencrl -out crls/$t
-rm -f crls/new
-ln -s $t crls/new
-mv crls/new crls/current
diff --git a/bin/make-ca-key b/bin/make-ca-key
deleted file mode 100755
index d24a902..0000000
--- a/bin/make-ca-key
+++ /dev/null
@@ -1,46 +0,0 @@
-#! /bin/sh
-
-set -e
-certroot=$(cd ${0%/*}/..; pwd)
-cd "$certroot"
-. lib/func.sh
-umask 022
-
-## Archive any existing CA.
-if [ -f ca.cert ]; then
-  mkdir -p archive
-  if [ -f archive/state/serial ]; then
-    next=$(cat archive/state/serial)
-  else
-    mkdir -p archive/state
-    next=1
-  fi
-  mkdir archive/"$next"
-  mv ca.cert certs crls index private state archive/"$next"/
-  expr "$next" + 1 >archive/state/serial.new
-  mv archive/state/serial.new archive/state/serial
-fi
-
-## Clear out the old CA completely.
-rm -rf certs index private tmp state
-rm -f ca.cert distorted.crl
-
-## Build a new one.
-mkdir -m750 private
-mkdir -m775 certs crls index index/byhash index/byserial state tmp
-chown $ca_owner:$ca_group certs crls index index/byhash index/byserial private state tmp
-touch state/db
-echo 01 >state/serial
-echo 01 >state/crlnumber
-
-## Set the CA subject name.  It won't fit on one line, and there's no
-## good way of continuing it.  Have fun parsing the sed.
-subject=$(sed -n 's:^:/:;1h;2,$H;${x;s/\n//g;p;}' <etc/issuer)
-
-## Build the new CA key and certificate.
-umask 027
-openssl req -new -config openssl.conf -x509 -days 3650 \
-	-out ca.cert -keyout private/ca.key \
-	-subj "$subject"
-chown $ca_owner:$ca_group private/ca.key
-chmod 644 ca.cert
diff --git a/bin/make-cert b/bin/make-cert
deleted file mode 100755
index 825f115..0000000
--- a/bin/make-cert
+++ /dev/null
@@ -1,40 +0,0 @@
-#! /bin/sh
-
-set -e
-certroot=$(cd ${0%/*}/..; pwd)
-. "$certroot"/lib/func.sh
-runas_ca "$@"
-
-## Parse the command line.
-case "$#" in
-  3) ;;
-  *) echo >&2 "Usage: $0 TAG PROFILE FILE"; exit 1 ;;
-esac
-tag=$1 profile=$2 file=$3
-
-## Make sure we're not overwriting anything.  Put sequence numbers
-## into labels to prevent bad things from happening.
-if [ -f "$certroot"/certs/"$tag".cert ]; then
-  echo >&2 "$0: certificate $tag already exists"
-  exit 1
-fi
-
-## Make a temporary copy of the certificate.  This prevents a race, and
-## more importantly lets us change directory.
-cp "$file" "$certroot"/tmp/"$tag".req
-cd "$certroot"
-
-## Make the certificate.
-openssl ca -config openssl.conf -extensions $profile-extensions \
-	-in tmp/"$tag".req -out tmp/"$tag".cert
-
-## Install a hash link the benefit of OpenSSL's `verify' command and
-## similar, and install the completed request and certificate in the
-## archive.
-mv tmp/"$tag".req tmp/"$tag".cert certs/
-linkserial certs/"$tag".cert
-linkhash certs/"$tag".cert
-rm tmp/*.pem
-
-## Output the certificate.
-openssl x509 -in certs/"$tag".cert
diff --git a/bin/refresh b/bin/refresh
deleted file mode 100755
index 22c444d..0000000
--- a/bin/refresh
+++ /dev/null
@@ -1,23 +0,0 @@
-#! /bin/sh
-
-set -e
-certroot=$(cd ${0%/*}/..; pwd)
-cd "$certroot"
-. lib/func.sh
-runas_ca
-
-badness=0
-indices="byhash byserial"
-for i in $indices; do rm -rf index/$i; done
-for i in $indices; do mkdir index/$i.new; done
-
-for i in certs/*.cert; do
-  linkserial "$i" .new
-  linkhash "$i" .new
-done
-
-for i in $indices; do
-  if [ -d index/$i ]; then mv index/$i index/$i.old; fi;
-done
-for i in $indices; do mv index/$i.new index/$i; done
-for i in $indices; do rm -rf index/$i.old; done
diff --git a/bin/revoke b/bin/revoke
new file mode 100755
index 0000000..15ae900
--- /dev/null
+++ b/bin/revoke
@@ -0,0 +1,48 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Revoke a certificate request
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+
+## Open the database
+sqlite3 db "$CERTROOT/state/ca.db"
+db nullvalue nil
+cd "$CERTROOT"
+
+## Establish the right parameters to store.
+set usage "usage: $argv0 REQUEST REASON \[DETAIL ...\]"
+if {$argc < 2} {
+  puts stderr $usage
+  exit 1
+}
+lassign $argv reqid reason
+revoke-reason-info $reason R
+set detail [revoke-parse-detail R [lrange $argv 2 end]]
+
+## Do the revocation.
+db transaction {
+  revoke-requests R $detail [request-match $reqid "st != 'expired'"]
+}
+
+###----- That's all, folks --------------------------------------------------
diff --git a/bin/setup b/bin/setup
new file mode 100755
index 0000000..ab3d0b2
--- /dev/null
+++ b/bin/setup
@@ -0,0 +1,83 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Initialize a new certificate authority.
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+cd $CERTROOT
+
+## If there's already a database here, then give up.
+if {[file exists "state/ca.db"]} {
+  puts stderr \
+      "$argv0: It looks like there's already a certificate authority here.
+
+	If you want to clobber it, delete state/ca.db and run this
+	program again."
+  exit 1
+}
+
+## Otherwise, clear any existing stuff away.  Either we failed part way
+## through a previous setup attempt, or the user has explicitly deleted the
+## database in order to persuade us to do this.
+file delete -force \
+    "archive" "cert" "req" "state" "private" "crl" "tmp" "ca.cert"
+
+## Set up the state directory.
+make-directories 0775 "state" "archive"
+make-file "state/serial" "01\n"
+make-file "state/crlnumber" "01\n"
+make-file "state/db" ""
+
+## Initialize the database in a temporary file: we'll rename it into place as
+## our last action.  This involves installing the tables and indices, and
+## setting up the configured profiles.
+sqlite db "state/ca.db.new"
+db eval [sql create]
+sync-profiles
+db close
+file attributes "state/ca.db.new" \
+    -owner $C(ca-owner) -group $C(ca-group) \
+    -permissions 0664
+
+## Generate the private CA key.
+make-directories 0750 "private"
+set subject ""
+foreach {attr value} $C(ca-name) { append subject "/$attr=$value" }
+exec >@stdout 2>@stderr openssl req -config "etc/openssl.conf"  \
+    -out "ca.cert" -keyout "private/ca.key" \
+    -new -x509 -days $C(ca-period) \
+    -subj $subject
+file attributes "ca.cert" \
+    -owner $C(ca-owner) -group $C(ca-group) \
+    -permissions 0640
+
+## Set up the directories for the actual certificates.  These are published
+## by the web server.
+make-directories 0775 "cert" "cert/by-seq" "cert/active"
+make-directories 0775 "req" "req/by-id" "req/active"
+
+## Make other directories.
+make-directories 0775 "tmp"
+
+## Finally, put the database in the right place.
+file rename "state/ca.db.new" "state/ca.db"
diff --git a/bin/update b/bin/update
new file mode 100755
index 0000000..7031c25
--- /dev/null
+++ b/bin/update
@@ -0,0 +1,55 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Run periodic maintenance on the certificate database
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+
+## Open the database
+sqlite3 db "$CERTROOT/state/ca.db"
+db nullvalue nil
+cd "$CERTROOT"
+
+## Reissue certificates for requests which need it.
+set now [now]
+set now_db [time-db $now]
+foreach id [db eval {
+  SELECT id FROM request
+  WHERE st = 'active' AND t_reissue <= $now_db;
+}] {
+  issue-cert $id $now
+}
+
+## Mark certificates as having expired.
+expire-certs $now
+
+## Archive certificates and requests which are very old.
+archive-certificates
+
+## Update OpenSSL's database of things.
+exec openssl ca -config "etc/openssl.conf" -updatedb 2>@1
+
+## Generate a CRL.
+exec openssl ca -config "etc/openssl.conf" -gencrl -out "crl" 2>@1
+
+###----- That's all, folks --------------------------------------------------
diff --git a/bin/withdraw b/bin/withdraw
new file mode 100755
index 0000000..ed6e740
--- /dev/null
+++ b/bin/withdraw
@@ -0,0 +1,63 @@
+#! /usr/bin/tclsh8.5
+### -*-tcl-*-
+###
+### Revoke a certificate request
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## Find the common utilities.
+source [file join [file dirname $argv0] "../lib/func.tcl"]
+
+## Get the list of requests.
+if {[llength $argv] != 1} {
+  puts stderr "Usage: $QUIS REQID"
+  exit 1
+}
+lassign $argv reqid
+
+## Set the request state.  Don't try to revoke the certificates: they'll
+## expire soon enough, and there isn't really anything wrong with them
+## anyway.  (If there were anything wrong, the request would have been
+## revoked.)
+db transaction {
+  set del {}
+  foreach req [request-match $reqid "st = 'active'"] {
+    lassign [db eval { SELECT st, tag FROM request WHERE id = $req; }] \
+	reqst tag
+    if {[string equal $reqst active]} { lappend del "req/active/$tag" }
+    foreach {cert certst} [db eval {
+      SELECT seq, st FROM certificate
+      WHERE req = $req AND st = 'active';
+    }] {
+      db eval {
+	UPDATE certificate
+	SET st = 'withdrawn'
+	WHERE seq = $cert;
+      }
+      lappend del "cert/active/$tag"
+    }
+    db eval {
+      UPDATE request
+      SET st = 'withdrawn'
+      WHERE id = $req;
+    }
+  }
+}
+foreach f $del { file delete -force "$CERTROOT/$f" }
diff --git a/etc/config.tcl b/etc/config.tcl
new file mode 100644
index 0000000..8192461
--- /dev/null
+++ b/etc/config.tcl
@@ -0,0 +1,19 @@
+### -*-tcl-*-
+
+set C(ca-owner) "mdw"
+set C(ca-group) "mdw"
+set C(ca-user) "mdw"
+
+set P(tls-client) {
+  extensions tls-client-extensions
+  issue-time "*-*-* 03:00:00"
+  start-skew 1
+  expire-interval 28
+}
+
+set P(tls-server) {
+  extensions tls-server-extensions
+  issue-time "*-*-* 03:00:00"
+  start-skew 1
+  expire-interval 28
+}
diff --git a/etc/issuer b/etc/issuer
deleted file mode 100644
index bd38de8..0000000
--- a/etc/issuer
+++ /dev/null
@@ -1,6 +0,0 @@
-C=GB
-ST=Cambridgeshire
-O=distorted.org.uk
-OU=Certificate Authority
-CN=distorted.org.uk top-level CA
-emailAddress=ca@distorted.org.uk
diff --git a/openssl.conf b/etc/openssl.conf
similarity index 86%
rename from openssl.conf
rename to etc/openssl.conf
index 4ff681e..4fa74a5 100644
--- a/openssl.conf
+++ b/etc/openssl.conf
@@ -6,6 +6,7 @@
 ### Defaults.
 
 RANDFILE = /dev/urandom
+db_suffix =
 
 ###--------------------------------------------------------------------------
 ### Certificate request configuration.
@@ -13,7 +14,7 @@ RANDFILE = /dev/urandom
 [req]
 default_bits = 3072
 encrypt_key = no
-default_md = sha1
+default_md = sha256
 utf8 = yes
 x509_extensions = ca-extensions
 distinguished_name = req-dn
@@ -55,16 +56,15 @@ preserve = yes
 
 [distorted-ca]
 default_days = 1825
-default_md = sha1
+default_md = sha256
 unique_subject = no
 email_in_dn = no
 private_key = private/ca.key
 certificate = ca.cert
-database = state/db
+database = state/db$ENV::db_suffix
 serial = state/serial
 crlnumber = state/crlnumber
-default_crl_days = 7
-new_certs_dir = tmp
+default_crl_hours = 28
 x509_extensions = tls-server-extensions
 crl_extensions = crl-extensions
 policy = distorted-policy
@@ -76,21 +76,21 @@ copy_extensions = copy
 countryName = supplied
 stateOrProvinceName = optional
 localityName = optional
-organizationName = match
+organizationName = supplied
 organizationalUnitName = optional
 commonName = supplied
 emailAddress = optional
 
 [crl-extensions]
 issuerAltName = email:ca@distorted.org.uk
-crlDistributionPoints=URI:http://www.distorted.org.uk/ca/distorted.crl
+crlDistributionPoints = URI:http://www.distorted.org.uk/ca/crl
 
 [ca-extensions]
 basicConstraints = critical, CA:TRUE
 keyUsage = critical, keyCertSign
 subjectKeyIdentifier = hash
 subjectAltName = email:ca@distorted.org.uk
-crlDistributionPoints=URI:http://www.distorted.org.uk/ca/distorted.crl
+crlDistributionPoints = URI:http://www.distorted.org.uk/ca/crl
 
 [tls-server-extensions]
 basicConstraints = critical, CA:FALSE
@@ -99,7 +99,7 @@ extendedKeyUsage = serverAuth
 subjectKeyIdentifier = hash
 authorityKeyIdentifier = keyid:always, issuer:always
 issuerAltName = issuer:copy
-crlDistributionPoints=URI:http://www.distorted.org.uk/ca/distorted.crl
+crlDistributionPoints = URI:http://www.distorted.org.uk/ca/crl
 
 [tls-client-extensions]
 basicConstraints = critical, CA:FALSE
@@ -109,6 +109,6 @@ subjectKeyIdentifier = hash
 authorityKeyIdentifier = keyid:always,issuer:always
 issuerAltName = issuer:copy
 subjectAltName = email:copy
-crlDistributionPoints=URI:http://www.distorted.org.uk/ca/distorted.crl
+crlDistributionPoints = URI:http://www.distorted.org.uk/ca/crl
 
 ###----- That's all, folks --------------------------------------------------
diff --git a/lib/func.sh b/lib/func.sh
deleted file mode 100644
index 90e643c..0000000
--- a/lib/func.sh
+++ /dev/null
@@ -1,62 +0,0 @@
-### -*-sh-*-
-
-## Set up configuration.
-ca_user=ca ca_group=ca ca_owner=root
-if [ -f etc/config ]; then . etc/config; fi
-
-runas_ca () {
-  ## runas_ca
-  ##
-  ## Make sure we're running as the CA user.  I don't trust ASN.1 parsers
-  ## to run as root against untrusted input -- especially OpenSSL's one.
-
-  case $(id -un) in
-    $ca_user) ;;
-    *) exec sudo -u $ca_user "$0" "$@" ;;
-  esac
-}
-
-linkserial () {
-  ## linkserial CERT [SERIAL]
-  ##
-  ## Make a link for the certificate according to its serial number.
-
-  cert=$1 suffix=$2
-  serial=$(openssl x509 -serial -noout -in "$cert")
-  serial=${serial##*=}
-  t=index/byserial$suffix/$serial.pem
-  if [ -L "$t" ]; then
-    other=$(readlink "$t")
-    echo "Duplicate serial numbers: ${other##*/}, ${cert##*/}"
-    badness=1
-    return
-  fi
-  lns "$cert" "$t"
-}
-
-linkhash () {
-  ## linkhash CERT [SUFFIX]
-  ##
-  ## Make links for the certificate according to its hash.
-
-  cert=$1 suffix=$2
-  fpr=$(openssl x509 -fingerprint -noout -in "$cert")
-  for opt in subject_hash subject_hash_old; do
-    n=0
-    hash=$(openssl x509 -$opt -noout -in "$cert")
-    while t=index/byhash$suffix/$hash.$n; [ -L "$t" ]; do
-      ofpr=$(openssl x509 -fingerprint -noout -in "$t")
-      other=$(readlink "$t")
-      case "${cert##*/}" in "${other##*/}") continue ;; esac
-      case "$ofpr" in
-	"$fpr")
-	  echo "Duplicate certificates: ${other##*/}, ${cert##*/}"
-	  badness=1
-	  return
-	  ;;
-      esac
-      n=$(expr $n + 1)
-    done
-    lns "$cert" "$t"
-  done
-}
diff --git a/lib/func.tcl b/lib/func.tcl
new file mode 100644
index 0000000..ece7e5b
--- /dev/null
+++ b/lib/func.tcl
@@ -0,0 +1,974 @@
+### -*-tcl-*-
+###
+### Common functions for certificate management.
+###
+### (c) 2011 Mark Wooding
+###
+
+###----- 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 Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+package require sqlite3
+
+###--------------------------------------------------------------------------
+### Command line conventions.
+
+set QUIS [file tail $argv0]
+set RC 0
+
+proc moan {message} {
+  ## Report MESSAGE as a warning message.
+
+  global QUIS
+  puts stderr "$QUIS: $message"
+}
+
+proc bad {level message} {
+  ## Report an error MESSAGE at badness LEVEL.
+
+  global RC
+  if {$level > $RC} { set RC $level }
+  moan $message
+}
+
+proc quit {} {
+  ## Exit the program.
+
+  global RC
+  exit $RC
+}
+
+proc die {message} {
+  ## Report an error MESSAGE and quit.
+
+  bad 1 $message
+  quit
+}
+
+###--------------------------------------------------------------------------
+### Find and read configuration.
+
+set CERTROOT [file normalize [file dirname [file dirname [info script]]]]
+
+## Default user configuration.
+set C(ca-owner) "root"
+set C(ca-user) "ca"
+set C(ca-group) "ca"
+
+## CA distinguished name.
+set C(ca-name) {
+  countryName "GB"
+  stateOrProvinceName "Borsetshire"
+  localityName "Ambridge"
+  organizationName "Archers' Omnibus Company"
+  organizationalUnitName "Certificate Authority"
+  commonName "Archers Omnibus Certificate Authority"
+  emailAddress "eddie.grundy@archers.example.com"
+}
+
+## Profiles.
+array unset P
+
+## Other random configuration.
+set C(ca-period) 3650
+set C(archive-interval) 32
+
+## Read the user configuration.
+if {[file exists "$CERTROOT/etc/config.tcl"]} {
+  source "$CERTROOT/etc/config.tcl"
+}
+
+###--------------------------------------------------------------------------
+### Tcl control utilities.
+
+set CLEANUPS {}
+
+proc with-cleanup {body} {
+  ## Evaluate BODY, which may contain `cleanup' calls.  When it finishes,
+  ## evaluate the cleanup bodies, in order.
+
+  global CLEANUPS
+  set save $CLEANUPS
+  set CLEANUPS {}
+  set rc [catch { uplevel 1 $body } result]
+  foreach item $CLEANUPS { uplevel 1 $item }
+  set CLEANUPS $save
+  return -code $rc $result
+}
+
+proc cleanup {body} {
+  ## Arrange to perform BODY at the end of the enclosing `with-cleanup' form.
+
+  global CLEANUPS
+  lappend CLEANUPS $body
+}
+
+###--------------------------------------------------------------------------
+### File system convenience functions.
+
+proc make-directories {mode args} {
+  ## Create the directories named in the ARGS list with the given MODE, and
+  ## with the configured owner and group.  Don't use Tcl's file mkdir here,
+  ## because it's potentially racy.
+
+  global C
+  foreach dir $args {
+    exec mkdir -m700 $dir
+    file attributes $dir \
+	-owner $C(ca-owner) -group $C(ca-group) \
+	-permissions $mode
+  }
+}
+
+proc make-file {file contents} {
+  ## Create the FILE with the specified contents.
+
+  set f [open $file "w"]
+  puts -nonewline $f $contents
+  close $f
+}
+
+proc fresh-temp {dir name body} {
+  ## Find a name for a fresh temporary file in DIR; store the chosen name in
+  ## NAME, and evaluate BODY.  If BODY succeeds and returns true then all is
+  ## well; if it continues or fails with POSIX EEXIST then try again with a
+  ## different name; otherwise propagate the error.
+
+  global errorCode
+  upvar 1 $name file
+  while 1 {
+    set file [file join $dir \
+		  [format "tmp.%s.%d.%d.%06x" \
+		       [info hostname] \
+		       [pid] \
+		       [clock seconds] \
+		       [expr {int(rand()*16777216)}]]]
+    set rc [catch {uplevel 1 $body} result]
+    switch $rc {
+      0 { return $file }
+      1 {
+	if {[string equal [lrange $errorCode 0 1] "POSIX EEXIST"]} {
+	  continue
+	} else {
+	  return -code 1 $result
+	}
+      }
+      2 { return $result }
+      4 { continue }
+      default { return -code $rc $result }
+    }
+  }
+}
+
+###--------------------------------------------------------------------------
+### SQL chunks.
+
+proc sql {name} {
+  ## Return a named chunk of SQL.
+
+  global CERTROOT
+  set f [open "$CERTROOT/sql/$name.sql"]
+  set sql [read $f]
+  close $f
+  return $sql
+}
+
+###--------------------------------------------------------------------------
+### Date and time handling.
+
+proc now {} {
+  ## Return the current Unix time.  Except that the magic environment
+  ## variable CA_FAKE_TIME can be set in order to convince the script that
+  ## some other time should be used instead.
+
+  global env TIME_DELTA
+  set now [clock seconds]
+  if {[info exists env(CA_FAKE_TIME)]} {
+    if {![info exists TIME_DELTA]} {
+      set fake [clock scan $env(CA_FAKE_TIME)]
+      set TIME_DELTA [expr {$fake - $now}]
+    }
+    return [expr {$now + $TIME_DELTA}]
+  } else {
+    return $now
+  }
+}
+
+proc time-db {t} {
+  ## Convert a Unix time into something we should store in the database.
+  ## Currently we use ISO 8601 strings giving UTC times; however, the only
+  ## guarantee made here is that lexical ordering on the time strings is the
+  ## same as the temporal ordering.
+
+  return [clock format $t -timezone :UTC -format "%Y-%m-%dT%H:%M:%SZ"]
+}
+
+proc db-time {s} {
+  ## Convert a time from the database into a Unix time.
+
+  return [clock scan $s -timezone :UTC -format "%Y-%m-%dT%H:%M:%SZ"]
+}
+
+proc time-asn1 {t} {
+  ## Convert a Unix time into a string suitable for passing to OpenSSL as a
+  ## validity time.
+
+  return [clock format $t -timezone :UTC -format "%y%m%d%H%M%SZ"]
+}
+
+proc time-revoke {t} {
+  ## Convert a Unix time into a string suitable for an OpenSSL revocation
+  ## time.
+
+  return [clock format $t -timezone :UTC -format "%Y%m%d%H%M%SZ"]
+}
+
+proc split-date {date} {
+  ## Parse an ISO8601 date or pattern into a list of items.  Numbers have
+  ## leading zeroes removed so that they don't smell like octal.
+
+  set list [regexp -inline -expanded {
+    ^ \s*
+    (\d+ | \* | \* / \d+)
+    -
+    (\d+ | \* | \* / \d+)
+    -
+    (\d+ | \* | \* / \d+)
+    (?: \s* T \s* | \s+)
+    (\d+ | \* | \* / \d+)
+    :
+    (\d+ | \* | \* / \d+)
+    :
+    (\d+ | \* | \* / \d+)
+    $
+  } $date]
+  if {![llength $list]} { error "invalid date pattern `$date'" }
+  set out {}
+  foreach item [lrange $list 1 end] {
+    lappend out [regsub {^0*(.)} $item "\\1"]
+  }
+  return $out
+}
+
+proc next-matching-date* {pat refvar i} {
+  ## Adjust the time in REFVAR forwards so that its components I, I + 1,
+  ## ... match the corresponding patterns in PAT: both are lists containing
+  ## year, month, day, hour, minute, second components in that order.  If
+  ## this works, return `ok'.  Otherwise return `step' as an indication that
+  ## the caller should step its time component and try again.
+  ##
+  ## This function has hideous behaviour with nonsensical patterns.  For
+  ## example, searching for `*-02-30 00:00:00' will loop forever.
+
+  ## If we've gone off the end, we're done.
+  if {$i >= 6} { return ok }
+
+  ## Find the caller's reference time.
+  upvar $refvar ref
+
+  ## A useful list of minimum values.
+  set min { 0 1 1 0 0 0 }
+
+  ## Find the maximum value we're allowed in this component.
+  switch $i {
+    0 { set max [expr {1 << 31}] }
+    1 { set max 12 }
+    2 {
+      switch [lindex $ref 1] {
+	1 - 3 - 5 - 7 - 8 - 10 - 12 { set max 31 }
+	4 - 6 - 9 - 11 { set max 30 }
+	2 {
+	  set y [lindex $ref 0]
+	  if {$y%400 == 0} { set max 29 } \
+	  elseif {$y%100 == 0} { set max 28 } \
+	  elseif {$y%4 == 0} { set max 29 } \
+	  else { set max 28 }
+	}
+      }
+    }
+    3 { set max 23 }
+    4 - 5 { set max 59 }
+  }
+
+  ## Collect the pattern and current-value entries.
+  set p [lindex $pat $i]
+  set n [lindex $ref $i]
+  set nn $n
+
+  ## Now for the main job.  We try to adjust the current component forwards
+  ## and within its bounds so as to match the pattern.  If that fails, return
+  ## `step' immediately.  If it succeeds, then recursively process the less
+  ## significant components.  If we have to step, then advance by one and try
+  ## again: this will propagate the failure upwards if necessary.
+  while 1 {
+
+    ## Work out what kind of pattern this is and how to deal with it.
+    switch -regexp -matchvar m $p {
+
+      {^\d+$} {
+	## A numeric literal.  If it's within bounds then set it; otherwise
+	## we'll have to start from the beginning.
+	if {$p < $n || $p > $max} { return step }
+	set nn $p
+      }
+
+      {^\*$} {
+	## If this is an unqualified wildcard then accept it.
+      }
+
+      {^\*/(\d+)$} {
+	## If this is a wildcard with a step amount then adjust forwards.  If
+	## we bust then fail.
+	set m [lindex $m 1]
+	set nn [expr {$nn + $m - 1}]
+	set nn [expr {$nn - $nn%$m}]
+	if {$nn > $max} { return step }
+      }
+
+      default {
+	## It's something else we don't know how to handle.
+	error "bad date pattern `$p'"
+      }
+    }
+
+    ## If we've moved on then clear the less significant entries.  This will
+    ## make it easier for them to match.  It's also necessary for
+    ## correctness, of course.
+    if {$nn > $n} {
+      for {set j [expr {$i + 1}]} {$j < 6} {incr j} {
+	lset ref $j [lindex $min $j]
+      }
+    }
+
+    ## Write the value back to the reference time, and recursively fix up the
+    ## less significant components.
+    lset ref $i $nn
+    switch [next-matching-date* $pat ref [expr {$i + 1}]] {
+      ok { return ok }
+      step { }
+      default { error "INTERNAL: unexpected rc" }
+    }
+
+    ## It didn't work.  Move on by one.  This is just to perturb the value:
+    ## the big switch at the top will do the necessary fine tuning.
+    set n [lindex $ref $i]
+    set nn [expr {$n + 1}]
+  }
+}
+
+proc next-matching-date {pat {ref now}} {
+  ## Return the next time (as Unix time) after REF which matches PAT.
+
+  if {[string equal $ref now]} { set ref [now] }
+  set reflist [split-date [clock format $ref -format "%Y-%m-%d %H:%M:%S"]]
+  set patlist [split-date $pat]
+  if {![string equal [next-matching-date* $patlist reflist 0] ok]} {
+    error "failed to find matching date"
+  }
+  return [clock scan \
+	      [eval [list format "%04d-%02d-%02d %02d:%02d:%02d"] \
+		   $reflist] \
+	      -format "%Y-%m-%d %H:%M:%S"]
+}
+
+###--------------------------------------------------------------------------
+### Setting up profiles.
+
+proc sync-profiles {} {
+  ## Synchronize the profiles in the database with the configuration file.
+
+  global P
+  db transaction {
+
+    ## Delete profiles which are no longer wanted.
+    foreach {p t} [db eval { SELECT label, tombstone FROM profile; }] {
+      set rec($p) t
+      if {[info exists P($p)]} {
+	## We have a matching entry.  The tombstone flag may be set, but we
+	## will turn that off in the second pass.
+	continue
+      } elseif {![db exists { SELECT 1 FROM request WHERE profile = $p; }]} {
+	## No references, so we can delete the entry.
+	db eval { DELETE FROM profile WHERE label = $p; }
+      } elseif {!$t} {
+	## There are still references, and the tombstone flag isn't set yet.
+	## Set it.
+	db eval { UPDATE profile SET tombstone = 1 WHERE label = $p; }
+      }
+    }
+
+    ## Now push each defined profile into the database.  This may cause
+    ## redundant updates, but I don't really care.
+    foreach {p dict} [array get P] {
+      array unset d
+      array set d $dict
+      if {[info exists rec($p)]} {
+	db eval {
+	  UPDATE profile SET
+		  extensions = $d(extensions),
+		  issue_time = $d(issue-time),
+		  start_skew = $(start-skew),
+		  expire_interval = $d(expire-interval),
+		  tombstone = 0
+	  WHERE label = $p;
+	}
+      } else {
+	db eval {
+	  INSERT INTO profile(label, extensions, issue_time,
+			      start_skew, expire_interval)
+	  VALUES ($p, $d(extensions), $d(issue-time),
+		  $d(start-skew), $d(expire-interval));
+	}
+      }
+    }
+  }
+}
+
+###--------------------------------------------------------------------------
+### Extracting information from request and certificate files.
+
+proc req-key-hash {file} {
+  ## Return the key hash from the certificate request in FILE.
+
+  return [exec \
+	      openssl req -in $file -noout -pubkey | \
+	      openssl rsa 2>/dev/null -pubin -outform der | \
+	      openssl dgst -sha256 -hex]
+}
+
+proc req-dn {file} {
+  ## Return the distinguished name from the certificate request in FILE.
+
+  regexp {^subject=\s*(/.*)$} \
+      [exec openssl req -in $file -noout -subject] \
+      -> dn
+  return $dn
+}
+
+proc cert-key-hash {file} {
+  ## Return the key hash from the certificate in FILE.
+
+  return [exec \
+	      openssl x509 -in $file -noout -pubkey | \
+	      openssl rsa 2>/dev/null -pubin -outform der | \
+	      openssl dgst -sha256 -hex]
+}
+
+proc cert-dn {file} {
+  ## Return the distinguished name from the certificate in FILE.
+
+  regexp {^subject=\s*(/.*)$} \
+      [exec openssl x509 -in $file -noout -subject] \
+      -> dn
+  return $dn
+}
+
+proc cert-seq {file} {
+  ## Return the serial number of the certificate in FILE.
+
+  regexp {^serial\s*=\s*([0-9a-fA-F]+)$} \
+      [exec openssl x509 -noout -serial -in $file] \
+      -> serial
+  return [expr 0x$serial + 0]
+}
+
+###--------------------------------------------------------------------------
+### Certificate requests.
+
+proc request-match {reqid cond} {
+  ## Return a list of request-ids which match REQID and satisfy COND.  The
+  ## REQID may be a numerical id, a SQL `LIKE' pattern matched against
+  ## request tags, or the special token `-all'.  The COND is a SQL boolean
+  ## expression.  The expression is /ignored/ if the REQID is an explicit
+  ## request id.
+
+  set conds {}
+  set win false
+
+  ## Set up the `conds' list to a bunch of SQL expressions we'll try.
+  if {[string equal $reqid "-all"]} {
+    set conds [list $cond]
+    set win true
+  } else {
+    if {[string is digit $reqid]} { lappend conds "id = :reqid" }
+    lappend conds "tag LIKE :reqid AND $cond"
+  }
+
+  ## See if any of the expressions match.
+  foreach c $conds {
+    set reqs [db eval "SELECT id FROM request WHERE $c;"]
+    if {[llength $reqs] > 0} { set win true; break }
+  }
+  if {!$win} {
+    error "no requests match `$reqid'"
+  }
+
+  ## Done.
+  return $reqs
+}
+
+###--------------------------------------------------------------------------
+### Archival.
+
+## Archive format.
+##
+## The archive consists of the following files.
+##
+## cert.SEQ		certificate storage
+## req.ID		request storage
+## openssl-certs.txt	OpenSSL records for the certificates
+## certificate.dump	certificate records from the database
+## request.dump		request records from the database
+##
+## The `openssl-certs.txt' file contains lines from the `state.db' file
+## referring to the archived certificates.  The `.dump' files contain
+## Tcl-format plists suitable for passing to `array set' mapping database
+## fields to values.
+
+proc archive-certificates {} {
+  ## Archive any certificates and certificate requests which need it.
+
+  global CERTROOT C
+
+  db transaction {
+
+    ## Initial setup.
+    set when [time-db [expr {[now] - 86400*$C(archive-interval)}]]
+    array unset archcerts
+    set archfiles {}
+    set delfiles {}
+
+    ## Prepare the archive staging area.
+    cd $CERTROOT
+    set archdir "tmp/arch"
+    file delete -force $archdir
+    file delete -force "tmp/arch.tgz"
+    file mkdir $archdir
+
+    ## Dig out the certificates.
+    set anycert false
+    with-cleanup {
+      set out [open "$archdir/certificate.dump" w]
+      cleanup { close $out }
+      db eval {
+	SELECT * FROM certificate
+	WHERE t_expire <= $when;
+      } R {
+	set line {}
+	foreach i $R(*) { lappend line $i $R($i) }
+	puts $out $line
+	set anycert true
+	set archcerts($R(seq)) 1
+	file link -hard "$archdir/cert.$R(seq)" "cert/by-seq/$R(seq)"
+	lappend archfiles "cert.$R(seq)"
+	lappend delfiles "cert/by-seq/$R(seq)"
+      }
+    }
+
+    ## Prune the OpenSSL request file.
+    if {$anycert} {
+      with-cleanup {
+	set in [open "state/db"]
+	cleanup { close $in }
+	set arch [open "$archdir/openssl-certs.txt" "w"]
+	cleanup { close $arch }
+	set new [open "state/db.new" "w"]
+	cleanup { close $new }
+
+	while {[gets $in line] >= 0} {
+	  set seq [expr 0x[lindex [split $line "\t"] 3] + 0]
+	  puts [expr {[info exists archcerts($seq)] ? $arch : $new}] $line
+	}
+      }
+      lappend archfiles "openssl-certs.txt" "certificate.dump"
+    }
+
+    ## Delete the certificates that we archived.  Here we rely on SQLite's
+    ## strong isolation guarantees to ensure that the DELETE query here
+    ## matches the same records as the SELECT did above.  Also, we rely on
+    ## SQLite rolling back if anything goes wrong in the rest of the job.
+    ## This is considerably simpler than fiddling the queries below to look
+    ## at the expiry dates of matching certificates.
+    db eval {
+      DELETE FROM certificate
+      WHERE t_expire <= $when;
+    }
+
+    ## Find the orphaned requests.  Don't clobber active requests even if
+    ## they look orphaned: we might just have failed to create certificates
+    ## for them for some reason.
+    set anyreq false
+    with-cleanup {
+      set out [open "$archdir/request.dump" w]
+      cleanup { close $out }
+      db eval {
+	SELECT r.*
+	FROM request AS r LEFT JOIN certificate AS c ON r.id = c.req
+	WHERE c.req IS NULL AND r.st != 'active';
+      } R {
+	set line {}
+	foreach i $R(*) { lappend line $i $R($i) }
+	puts $out $line
+	set anyreq true
+	file link -hard "$archdir/req.$R(id)" "req/by-id/$R(id)"
+	lappend archfiles "req.$R(id)"
+	lappend delfiles "req/by-id/$R(id)"
+      }
+    }
+    if {$anyreq} { lappend archfiles "request.dump" }
+
+    ## Make the archive.
+    if {!$anycert && !$anyreq} { return }
+    cd $archdir
+    eval exec tar cfz "../arch.tgz" $archfiles
+
+    ## Delete the requests that we archived.  Again we rely on SQLite's
+    ## strong isolation to avoid races.
+    db eval {
+      DELETE FROM request
+      WHERE id IN (
+	      SELECT r.id
+	      FROM request AS r LEFT JOIN certificate AS c ON r.id = c.req
+	      WHERE c.req IS NULL AND r.st != 'active');
+    }
+
+    ## Tidy everything up.
+    cd $CERTROOT
+    set t [time-db [now]]
+    file rename "tmp/arch.tgz" "archive/$t.tgz"
+    if {$anycert} { file rename -force "state/db.new" "state/db" }
+  }
+  foreach f $delfiles { file delete $f }
+  file delete -force $archdir
+  file delete -force "tmp/arch.tgz"
+}
+
+###--------------------------------------------------------------------------
+### Certificate revocation.
+
+## Enormous table of revocation reasons and how to handle them.
+array set REVOKE_REASON {
+  unspecified {
+    unspecified
+    none
+  }
+  key-compromise {
+    keyCompromise
+    time "%Y%m%d%H%M%SZ"
+    -crl_compromise
+  }
+  ca-compromise {
+    CACompromise
+    time "%Y%m%d%H%M%SZ"
+    -crl_CA_compromise
+  }
+  affiliation-changed {
+    affiliationChanged
+    none
+  }
+  superceded {
+    superseded
+    none
+  }
+  cessation-of-operation {
+    cessationOfOperation
+    none
+  }
+  remove-from-crl {
+    removeFromCrl
+    none
+  }
+  certificate-hold {
+    certificateHold
+    enum {
+      reject holdInstructionReject
+      none holdInstructionNone
+      call-issuer holdInstructionCallIssuer
+    }
+    -crl_hold
+  }
+}
+
+proc revoke-reason-info {reason infovar} {
+  ## Write information about the revocation REASON into the array INFOVAR.
+  ## The keys defined for INFOVAR are as follows.
+  ##
+  ##	reason		The provided reason string.
+  ##	oid		The OID name for the reason.
+  ##	detail-type	The type of the detail (for converting details).
+  ##	detail-info	Additional information for detail conversion
+  ##	detail-arg	The OpenSSL detail argument name.
+
+  global REVOKE_REASON
+  upvar 1 $infovar R
+
+  if {![info exists REVOKE_REASON($reason)]} {
+    error "unknown revocation reason `$reason'"
+  }
+
+  array unset R
+  set R(reason) $reason
+  lassign $REVOKE_REASON($reason) \
+      R(oid) R(detail-type) R(detail-info) R(detail-arg)
+}
+
+proc revoke-parse-detail/none {info detail} {
+  if {[llength $detail] > 0} {
+    error "no detail permitted"
+  }
+  return nil
+}
+
+proc revoke-openssl-args/none {info arg detail} {
+  return {}
+}
+
+proc revoke-parse-detail/time {info detail} {
+  switch [llength $detail] {
+    0 { set t [now] }
+    1 { set t [clock scan [lindex $detail 0]] }
+    default { error "too many time arguments" }
+  }
+  return [time-db $t]
+}
+
+proc revoke-openssl-args/time {info arg detail} {
+  return [list $arg [clock format [db-time $detail] \
+			 -timezone :UTC \
+			 -format $info]]
+}
+
+proc revoke-parse-detail/enum {info detail} {
+  switch [llength $detail] {
+    0 { set r [lindex $info 0] }
+    1 {
+      array set M $info
+      set r [lindex $detail 0]
+      if {![info exists M($r)]} { error "invalid detail value `$r'" }
+    }
+    default { error "too many symbolic arguments" }
+  }
+  return $r
+}
+
+proc revoke-openssl-args/enum {info arg detail} {
+  array set M $info
+  return [list $arg $M($detail)]
+}
+
+proc revoke-parse-detail {infovar detail} {
+  ## Parse a revocation detail, as provided in a command-line argument list,
+  ## and convert it into the database format.
+
+  upvar 1 $infovar R
+  return [revoke-parse-detail/$R(detail-type) $R(detail-info) $detail]
+}
+
+proc revoke-openssl-args {infovar detail} {
+  ## Return OpenSSL arguments for revoking certificates, given a revocation
+  ## DETAIL.  You need to provide the `-revoke FILE' bit yourself: this only
+  ## provides the `-crl_reason REASON' and detail arguments.
+
+  upvar 1 $infovar R
+  return [concat \
+	      [list -crl_reason $R(oid)] \
+	      [revoke-openssl-args/$R(detail-type) \
+		   $R(detail-info) $R(detail-arg) $detail]]
+}
+
+proc revoke-requests {infovar detail reqs} {
+  ## Revoke a bunch of certificate requests, listed by id in REQS.  The
+  ## INFOVAR is the name of an array set up by `revoke-reason-info'; the
+  ## DETAIL is the revocation detail in internal format, e.g., as established
+  ## by `revoke-parse-detail'.
+  ##
+  ## This function establishes its own transaction, but you should wrap it in
+  ## your own one if you found the REQS list as a result of a database query,
+  ## in order to avoid race conditions.
+
+  ## Find some useful things.
+  global env
+  upvar 1 $infovar R
+  set ossl_args [revoke-openssl-args R $detail]
+  set del {}
+
+  ## Wrap a transaction around, so that we can reset the database if
+  ## something goes wrong with the file fiddling half-way through.
+  db transaction {
+
+    ## Make a copy of the state database.  We'll work on that using some
+    ## unpleasant configuration hacking.
+    file copy -force "state/db" "state/db.revoke"
+    set env(db_suffix) ".revoke"
+
+    ## Now work through the requests one by one, revoking each affected
+    ## certificate.
+    foreach req $reqs {
+
+      ## Check the request state.  If it was previously active, we must
+      ## remember to delete the link.  Obviously we shouldn't actually delete
+      ## them yet, because this might fail catastrophically.
+      lassign [db eval { SELECT st, tag FROM request WHERE id = $req; }] \
+	  reqst tag
+      if {[string equal $reqst active]} { lappend del "req/active/$tag" }
+
+      ## Now try the certificates.
+      foreach {cert certst} [db eval {
+	SELECT seq, st FROM certificate
+	WHERE req = $req AND st != 'expired';
+      }] {
+
+	## Check the certificate state: again, we might have to delete the
+	## active link.
+	if {[string equal $certst active]} { lappend del "cert/active/$tag" }
+
+	## Update the certificate state.
+	db eval { UPDATE certificate SET st = 'revoked' WHERE seq = $cert; }
+
+	## Get OpenSSL to update its database.
+	eval exec openssl ca \
+	    [list -config "etc/openssl.conf"] \
+	    [list -revoke "cert/by-seq/$cert"] \
+	    $ossl_args \
+	    2>@1
+      }
+
+      ## Finally fiddle the request state.
+      db eval {
+	UPDATE request
+	SET st = 'revoked',
+	revoke_reason = $R(reason),
+	revoke_detail = $detail
+	WHERE id = $req;
+      }
+    }
+
+    ## Astonishingly all of that actually worked.
+    file rename -force "state/db.revoke" "state/db"
+  }
+
+  ## Delete the active links we made a note of earlier.
+  foreach f $del { file delete -force $f }
+}
+
+###--------------------------------------------------------------------------
+### Managing certificates.
+
+proc issue-cert {id now} {
+  ## Issue a certificate for the request with the given ID.  This doesn't
+  ## bother to find out whethere it's a good idea.
+
+  global CERTROOT
+  db nullvalue nil
+
+  with-cleanup {
+    db transaction {
+
+      ## Find a temporary file name for the output certificate.
+      fresh-temp "$CERTROOT/tmp" tmp {
+	set f [open $tmp {WRONLY CREAT EXCL}]
+      }
+      cleanup { file delete $tmp }
+      close $f
+
+      ## Find stuff out about the request.
+      lassign [db eval {
+	SELECT	p.start_skew, p.expire_interval, p.issue_time, p.extensions,
+		r.tag, r.cert_dn
+	FROM	request AS r JOIN
+		profile AS p ON r.profile = p.label
+	WHERE	r.id = $id;
+      }] start_skew expire_interval issue_time extensions tag cert_dn
+
+      ## Sign the certificate.
+      set starttime [expr {$now - 3600*$start_skew}]
+      set endtime [expr {$now + 3600*$expire_interval}]
+      cleanup { catch { eval file delete [glob "$CERTROOT/tmp/*.pem"] } }
+      exec openssl ca -batch \
+	  -config "$CERTROOT/etc/openssl.conf" \
+	  -outdir "$CERTROOT/tmp" \
+	  -extensions $extensions \
+	  -startdate [time-asn1 $starttime] \
+	  -enddate [time-asn1 $endtime] \
+	  -in "$CERTROOT/req/by-id/$id" -out $tmp \
+	  2>@1
+
+      ## Update the request's cert_dn field.  If it's null, this is the first
+      ## certificate issued for the request, and we should fill the field in;
+      ## otherwise we should compare the actual DN to the expected one and
+      ## fail if it's wrong.
+      set dn [cert-dn $tmp]
+      if {[string equal $cert_dn nil]} {
+	db eval { UPDATE request SET cert_dn = $dn WHERE id = $id; }
+      } elseif {![string equal $cert_dn $dn]} {
+	error [join {
+	  "DN mismatch: request $id (`$tag') has $cert_dn; "
+	  "new cert has $dn"} ""]
+      }
+
+      ## Stash a new record in the database.
+      set expire [time-db $endtime]
+      set next_issue [time-db [next-matching-date $issue_time $now]]
+      set now_db [time-db $now]
+      set seq [cert-seq $tmp]
+      db eval {
+	UPDATE certificate
+	SET st = CASE WHEN t_expire >= $now_db THEN 'superceded'
+	ELSE 'expired'
+	END
+	WHERE req = $id AND st = 'active';
+
+	INSERT INTO certificate(seq, req, st, t_expire)
+	VALUES ($seq, $id, 'active', $expire);
+
+	UPDATE request SET t_reissue = $next_issue
+	WHERE id = $id;
+      }
+
+      ## Put the file in the right place.
+      file link -hard "$CERTROOT/cert/by-seq/$seq" $tmp
+      exec ln -sf "../by-seq/$seq" "$CERTROOT/cert/active/$tag"
+    }
+  }
+}
+
+proc expire-certs {now} {
+  ## Mark certificates as having expired.
+
+  global CERTROOT
+  set now_db [time-db $now]
+
+  ## If we're unlucky, some active certificates may have expired while we
+  ## weren't looking.  We'll demote these soon, but we must clear away the
+  ## old links.
+  foreach tag [db eval {
+    SELECT r.tag
+    FROM request AS r JOIN certificate as c ON r.id = c.req
+    WHERE c.st = 'active' AND c.t_expire < $now_db;
+  }] {
+    file delete "$CERTROOT/cert/active/$tag"
+  }
+
+  ## Now demote the states of expired certificates.  All certificates expire,
+  ## including revoked ones.
+  db eval {
+    UPDATE certificate
+    SET st = 'expired'
+    WHERE st != 'expired' AND t_expire < $now_db;
+  }
+}
+
+###----- That's all, folks --------------------------------------------------
diff --git a/sql/create.sql b/sql/create.sql
new file mode 100644
index 0000000..978adcb
--- /dev/null
+++ b/sql/create.sql
@@ -0,0 +1,142 @@
+/* -*-sql-*-
+ *
+ * Set up the database for tracking certificates and requests
+ */
+
+/*----- Metadata table ----------------------------------------------------*/
+
+create table meta (
+	version integer,
+	request_seq integer
+);
+
+insert into meta values (1, 0);
+
+/*----- Profiles ----------------------------------------------------------*/
+
+create table profile (
+
+	-- A label by which this profile is known.
+	label varchar(16) primary key,
+
+	-- The name of the extensions section in OpenSSL's configuration
+	-- file.
+	extensions varchar(32) not null,
+
+	-- The time at which to issue the next certificate.  This has the
+	-- form of an ISO8601 date (YYYY-MM-DD HH:MM:SS), though the
+	-- components can be wildcards.  Specifically, * means any value, and
+	-- */n means any value which is a multiple of n.  Sorry: there isn't
+	-- currently a way of saying `next Thursday'.
+	issue_time varchar(64) not null,
+
+	-- The time, in hours, that a certificate should appear to have been
+	-- valid /before/ it was issued.  This is useful to prevent
+	-- unnecessary problems with reliers whose clocks are broken.
+	start_skew integer not null,
+
+	-- The time, in hours, that a certificate remains valid after issue.
+	expire_interval integer not null,
+
+	-- A marker that this profile shouldn't be used any more.
+	tombstone boolean default 0
+);
+
+/*----- Certificate requests ----------------------------------------------*/
+
+create table request (
+
+	-- We need a stable way to talk about requests.  Unfortunately, we
+	-- don't have an exernally stable name, so we'll get the database to
+	-- make one up for us.
+	id integer primary key,
+
+	-- The tag is a vaguely human-readable name for this certificate
+	-- request.  THere should only be one active request with a given
+	-- tag, though there may be several withdrawn or revoked requests.
+	tag varchar(128) not null,
+
+	-- The distinguished name for the request.  Again, there should only
+	-- be one active request with a given DN, but there may be several
+	-- withdrawn or revoked requests.  The DN is given in OpenSSL's terse
+	-- form, as written by `openssl req -subject -noout'.
+	dn text not null,
+
+	-- The distinguished name as it will appear in certificates.  We
+	-- expect all certificates to have the same DN, though OpenSSL's
+	-- certificate construction will mangle the DN (in particular, it
+	-- moves email addresses to the `subjectAltName').  If this field is
+	-- null then no certificate has been issued for the request;
+	-- otherwise we fill it in with the certificate's DN.
+	cert_dn text,
+
+	-- The key hash from the request.  This is simply the SHA256 hash of
+	-- the DER-encoded public key, in lowercase hex.
+	hash varchar(64) not null,
+
+	-- The state can be one of `active', `withdrawn', or `revoked'.
+	-- Requests in the `archived' state aren't stored in the database.
+	st varchar(12) not null,
+
+	-- The profile tells us how we should generate certificates.  It
+	-- refers to a chunk of the OpenSSL configuration file.
+	profile varchar(16) not null,
+
+	-- If the state is `revoked' then we should have the reason and maybe
+	-- a detail here.  The reason is one of the names: `unspecified',
+	-- `key-compromise', `ca-compromise', `affiliation-changed',
+	-- `superceded', `cessation-of-operation', `certificate-hold', or
+	-- `remove-from-crl'.  The detail's contents depends on the reason.
+	-- If the reason is `certificate-hold' then the reason is the hold
+	-- instruction, probably `none', `call-issuer', or `reject'; if the
+	-- reason is `key-compromise' or `ca-compromise' then the detail is
+	-- the compromise time; other reasons don't carry details.
+	revoke_reason varchar(32),
+	revoke_detail text,
+
+	-- The time at which we should issue the next certificate for this
+	-- request.
+	t_reissue timestamp default 0,
+
+	-- Ensure that we have a revocation reason if the state is
+	-- `revoked'.
+	check (st != 'revoked' or revoke_reason is not null),
+
+	-- Check that the profile matches one that's already known.
+	foreign key (profile) references profile(label)
+);
+
+create index request_tag on request(tag);
+create index request_dn on request(dn);
+create index request_hash on request(hash);
+create index request_reissue on request(t_reissue asc);
+create index request_prifile on request(profile);
+
+/*----- Certificates ------------------------------------------------------*/
+
+create table certificate (
+
+	-- The sequence number of the certificate, as issued by OpenSSL's
+	-- `ca' program.
+	seq integer primary key,
+
+	-- The associated certificate request.
+	req integer not null,
+
+	-- The state can be one of `active', `superceded', `withdrawn',
+	-- `revoked', or `expired'.  Certificates in the `archived' state
+	-- aren't stored in the database.
+	st varchar(12) not null,
+
+	-- The expiry time for the certificate.  This may be in the past.
+	t_expire timestamp not null,
+
+	-- Match the certificate up with its request.
+	foreign key (req) references request(id)
+);
+
+create index cert_st on certificate(st);
+create index cert_req on certificate(req);
+create index cert_expire on certificate(t_expire asc);
+
+/*----- That's all, folks -------------------------------------------------*/
diff --git a/test/.gitignore b/test/.gitignore
new file mode 100644
index 0000000..0c1819c
--- /dev/null
+++ b/test/.gitignore
@@ -0,0 +1,3 @@
+stage-*.tar.gz
+fake-reqs
+fake-keys
diff --git a/test/init b/test/init
new file mode 100755
index 0000000..8d89942
--- /dev/null
+++ b/test/init
@@ -0,0 +1,53 @@
+#! /bin/sh
+
+set -ex
+dirs="state archive req cert"
+rm -rf $dirs tmp
+mkdir -m775 tmp
+export CA_FAKE_TIME
+
+donep=t stage=0
+while :; do
+  stage=$(( $stage + 1 ))
+  if [ -e test/stage-$stage.tar.gz ]; then continue; fi
+  case $donep,$stage in
+    t,1) ;;
+    t,*) tar xf test/stage-$(( $stage - 1 )).tar.gz ;;
+  esac
+  donep=nil
+  case $stage in
+    1)
+      CA_FAKE_TIME="2011-08-23 18:32:45"
+      bin/setup
+      for i in $(seq 1 50); do
+	bin/add tls-client fake#$i test/fake-reqs/$i.req
+      done
+      bin/check
+      ;;
+    2)
+      CA_FAKE_TIME="2011-08-24 18:32:45"
+      bin/update
+      bin/check
+      ;;
+    3)
+      CA_FAKE_TIME="2011-08-30 18:32:45"
+      bin/update
+      bin/check
+      ;;
+    4)
+      CA_FAKE_TIME="2011-09-03 18:32:45"
+      bin/update
+      bin/revoke fake#13 key-compromise
+      bin/check
+      ;;
+    5)
+      CA_FAKE_TIME="2011-09-05 18:32:45"
+      bin/update
+      bin/check
+      ;;
+    *)
+      break
+      ;;
+  esac
+  tar cfz test/stage-$stage.tar.gz $dirs
+done
diff --git a/test/make-fake-reqs b/test/make-fake-reqs
new file mode 100755
index 0000000..0586a05
--- /dev/null
+++ b/test/make-fake-reqs
@@ -0,0 +1,29 @@
+#! /bin/sh
+
+set -e
+rm -rf test/fake-reqs.new
+mkdir test/fake-reqs.new
+ncert=50
+
+if [ ! -d test/fake-keys ]; then
+  rm -rf test/fake-keys.new
+  mkdir test/fake-keys.new
+  pexec -r $(seq 50) -R -c -e i \
+    'openssl genrsa -out test/fake-keys.new/$i.key 3072'
+  mv test/fake-keys.new test/fake-keys
+fi
+
+dnbase="/C=GB/ST=Cambridgeshire/L=Cambridge/O=distorted.org.uk/OU=Testing"
+for i in $(seq 50); do
+  openssl req -batch \
+    -new -out test/fake-reqs.new/$i.req -sha1 \
+    -key test/fake-keys/$i.key \
+    -subj "$dnbase/CN=Test certificate #$i"
+done
+
+if [ -d test/fake-reqs ]; then
+  rm -rf test/fake-reqs.old
+  mv test/fake-reqs test/fake-reqs.old
+fi
+mv test/fake-reqs.new test/fake-reqs
+rm -rf test/fake-reqs.old