--- /dev/null
+#! /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 --------------------------------------------------
~mdw / ca / blobdiff