3 ### Common functions for certificate management.
5 ### (c) 2011 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
10 ### This program is free software; you can redistribute it and/or modify
11 ### it under the terms of the GNU General Public License as published by
12 ### the Free Software Foundation; either version 2 of the License, or
13 ### (at your option) any later version.
15 ### This program is distributed in the hope that it will be useful,
16 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ### GNU General Public License for more details.
20 ### You should have received a copy of the GNU General Public License
21 ### along with this program; if not, write to the Free Software Foundation,
22 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 package require sqlite3
26 ###--------------------------------------------------------------------------
27 ### Command line conventions.
29 set QUIS
[file tail
$argv0]
33 ## Report MESSAGE as a warning message.
36 puts stderr
"$QUIS: $message"
39 proc bad
{level
message} {
40 ## Report an error MESSAGE at badness LEVEL.
43 if {$level > $RC} { set RC
$level }
55 ## Report an error MESSAGE and quit.
61 ###--------------------------------------------------------------------------
62 ### Find and read configuration.
64 set CERTROOT
[file normalize
[file dirname
[file dirname
[info script
]]]]
66 ## Default user configuration.
67 set C
(ca-owner
) "root"
71 ## CA distinguished name.
74 stateOrProvinceName
"Borsetshire"
75 localityName
"Ambridge"
76 organizationName
"Archers' Omnibus Company"
77 organizationalUnitName
"Certificate Authority"
78 commonName
"Archers Omnibus Certificate Authority"
79 emailAddress
"eddie.grundy@archers.example.com"
85 ## Other random configuration.
87 set C
(archive-interval
) 32
89 ## Read the user configuration.
90 if {[file exists
"$CERTROOT/etc/config.tcl"]} {
91 source "$CERTROOT/etc/config.tcl"
94 ###--------------------------------------------------------------------------
95 ### Tcl control utilities.
99 proc with-cleanup
{body
} {
100 ## Evaluate BODY, which may contain `cleanup' calls. When it finishes,
101 ## evaluate the cleanup bodies, in order.
106 set rc
[catch { uplevel 1 $body } result
]
107 foreach item
$CLEANUPS { uplevel 1 $item }
109 return -code $rc $result
112 proc cleanup
{body
} {
113 ## Arrange to perform BODY at the end of the enclosing `with-cleanup' form.
116 lappend CLEANUPS
$body
119 ###--------------------------------------------------------------------------
120 ### File system convenience functions.
122 proc make-directories
{mode args
} {
123 ## Create the directories named in the ARGS list with the given MODE, and
124 ## with the configured owner and group. Don't use Tcl's file mkdir here,
125 ## because it's potentially racy.
129 exec mkdir
-m700 $dir
130 file attributes
$dir \
131 -owner $C(ca-owner
) -group $C(ca-group
) \
136 proc make-file
{file contents
} {
137 ## Create the FILE with the specified contents.
139 set f
[open $file "w"]
140 puts -nonewline $f $contents
144 proc fresh-temp
{dir name body
} {
145 ## Find a name for a fresh temporary file in DIR; store the chosen name in
146 ## NAME, and evaluate BODY. If BODY succeeds and returns true then all is
147 ## well; if it continues or fails with POSIX EEXIST then try again with a
148 ## different name; otherwise propagate the error.
153 set file [file join $dir \
154 [format "tmp.%s.%d.%d.%06x" \
158 [expr {int
(rand
()*16777216)}]]]
159 set rc
[catch {uplevel 1 $body} result
]
163 if {[string equal
[lrange $errorCode 0 1] "POSIX EEXIST"]} {
166 return -code 1 $result
171 default { return -code $rc $result }
176 ###--------------------------------------------------------------------------
180 ## Return a named chunk of SQL.
183 set f
[open "$CERTROOT/sql/$name.sql"]
189 ###--------------------------------------------------------------------------
190 ### Date and time handling.
193 ## Return the current Unix time. Except that the magic environment
194 ## variable CA_FAKE_TIME can be set in order to convince the script that
195 ## some other time should be used instead.
197 global env TIME_DELTA
198 set now
[clock seconds
]
199 if {[info exists env
(CA_FAKE_TIME
)]} {
200 if {![info exists TIME_DELTA
]} {
201 set fake
[clock scan $env(CA_FAKE_TIME
)]
202 set TIME_DELTA
[expr {$fake - $now}]
204 return [expr {$now + $TIME_DELTA}]
211 ## Convert a Unix time into something we should store in the database.
212 ## Currently we use ISO 8601 strings giving UTC times; however, the only
213 ## guarantee made here is that lexical ordering on the time strings is the
214 ## same as the temporal ordering.
216 return [clock format $t -timezone :UTC
-format "%Y-%m-%dT%H:%M:%SZ"]
220 ## Convert a time from the database into a Unix time.
222 return [clock scan $s -timezone :UTC
-format "%Y-%m-%dT%H:%M:%SZ"]
226 ## Convert a Unix time into a string suitable for passing to OpenSSL as a
229 return [clock format $t -timezone :UTC
-format "%y%m%d%H%M%SZ"]
232 proc time-revoke
{t
} {
233 ## Convert a Unix time into a string suitable for an OpenSSL revocation
236 return [clock format $t -timezone :UTC
-format "%Y%m%d%H%M%SZ"]
239 proc split-date
{date
} {
240 ## Parse an ISO8601 date or pattern into a list of items. Numbers have
241 ## leading zeroes removed so that they don't smell like octal.
243 set list [regexp -inline -expanded {
245 (\d
+ |
\* |
\* / \d
+)
247 (\d
+ |
\* |
\* / \d
+)
249 (\d
+ |
\* |
\* / \d
+)
251 (\d
+ |
\* |
\* / \d
+)
253 (\d
+ |
\* |
\* / \d
+)
255 (\d
+ |
\* |
\* / \d
+)
258 if {![llength $list]} { error "invalid date pattern `$date'" }
260 foreach item
[lrange $list 1 end
] {
261 lappend out
[regsub {^
0*(.
)} $item "\\1"]
266 proc next-matching-date
* {pat refvar i
} {
267 ## Adjust the time in REFVAR forwards so that its components I, I + 1,
268 ## ... match the corresponding patterns in PAT: both are lists containing
269 ## year, month, day, hour, minute, second components in that order. If
270 ## this works, return `ok'. Otherwise return `step' as an indication that
271 ## the caller should step its time component and try again.
273 ## This function has hideous behaviour with nonsensical patterns. For
274 ## example, searching for `*-02-30 00:00:00' will loop forever.
276 ## If we've gone off the end, we're done.
277 if {$i >= 6} { return ok
}
279 ## Find the caller's reference time.
282 ## A useful list of minimum values.
283 set min
{ 0 1 1 0 0 0 }
285 ## Find the maximum value we're allowed in this component.
287 0 { set max
[expr {1 << 31}] }
290 switch [lindex $ref 1] {
291 1 - 3 - 5 - 7 - 8 - 10 - 12 { set max
31 }
292 4 - 6 - 9 - 11 { set max
30 }
294 set y
[lindex $ref 0]
295 if {$y%400 == 0} { set max
29 } \
296 elseif
{$y%100 == 0} { set max
28 } \
297 elseif
{$y%4 == 0} { set max
29 } \
306 ## Collect the pattern and current-value entries.
307 set p
[lindex $pat $i]
308 set n
[lindex $ref $i]
311 ## Now for the main job. We try to adjust the current component forwards
312 ## and within its bounds so as to match the pattern. If that fails, return
313 ## `step' immediately. If it succeeds, then recursively process the less
314 ## significant components. If we have to step, then advance by one and try
315 ## again: this will propagate the failure upwards if necessary.
318 ## Work out what kind of pattern this is and how to deal with it.
319 switch -regexp -matchvar m
$p {
322 ## A numeric literal. If it's within bounds then set it; otherwise
323 ## we'll have to start from the beginning.
324 if {$p < $n ||
$p > $max} { return step
}
329 ## If this is an unqualified wildcard then accept it.
333 ## If this is a wildcard with a step amount then adjust forwards. If
334 ## we bust then fail.
336 set nn
[expr {$nn + $m - 1}]
337 set nn
[expr {$nn - $nn%$m}]
338 if {$nn > $max} { return step
}
342 ## It's something else we don't know how to handle.
343 error "bad date pattern `$p'"
347 ## If we've moved on then clear the less significant entries. This will
348 ## make it easier for them to match. It's also necessary for
349 ## correctness, of course.
351 for {set j
[expr {$i + 1}]} {$j < 6} {incr j
} {
352 lset ref
$j [lindex $min $j]
356 ## Write the value back to the reference time, and recursively fix up the
357 ## less significant components.
359 switch [next-matching-date
* $pat ref
[expr {$i + 1}]] {
362 default { error "INTERNAL: unexpected rc" }
365 ## It didn't work. Move on by one. This is just to perturb the value:
366 ## the big switch at the top will do the necessary fine tuning.
367 set n
[lindex $ref $i]
368 set nn
[expr {$n + 1}]
372 proc next-matching-date
{pat
{ref now
}} {
373 ## Return the next time (as Unix time) after REF which matches PAT.
375 if {[string equal
$ref now
]} { set ref
[now
] }
376 set reflist
[split-date
[clock format $ref -format "%Y-%m-%d %H:%M:%S"]]
377 set patlist
[split-date
$pat]
378 if {![string equal
[next-matching-date
* $patlist reflist
0] ok
]} {
379 error "failed to find matching date"
382 [eval [list format "%04d-%02d-%02d %02d:%02d:%02d"] \
384 -format "%Y-%m-%d %H:%M:%S"]
387 ###--------------------------------------------------------------------------
388 ### Setting up profiles.
390 proc sync-profiles
{} {
391 ## Synchronize the profiles in the database with the configuration file.
396 ## Delete profiles which are no longer wanted.
397 foreach {p t
} [db
eval { SELECT
label, tombstone FROM profile
; }] {
399 if {[info exists P
($p)]} {
400 ## We have a matching entry. The tombstone flag may be set, but we
401 ## will turn that off in the second pass.
403 } elseif
{![db exists
{ SELECT
1 FROM request WHERE profile
= $p; }]} {
404 ## No references, so we can delete the entry.
405 db
eval { DELETE FROM profile WHERE
label = $p; }
407 ## There are still references, and the tombstone flag isn't set yet.
409 db
eval { UPDATE profile SET tombstone
= 1 WHERE
label = $p; }
413 ## Now push each defined profile into the database. This may cause
414 ## redundant updates, but I don't really care.
415 foreach {p dict
} [array get P
] {
418 if {[info exists rec
($p)]} {
421 extensions
= $d(extensions
),
422 issue_time
= $d(issue-time
),
423 start_skew
= $(start-skew
),
424 expire_interval
= $d(expire-interval
),
430 INSERT INTO profile
(label, extensions
, issue_time
,
431 start_skew
, expire_interval
)
432 VALUES
($p, $d(extensions
), $d(issue-time
),
433 $d(start-skew
), $d(expire-interval
));
440 ###--------------------------------------------------------------------------
441 ### Extracting information from request and certificate files.
443 proc req-key-hash
{file} {
444 ## Return the key hash from the certificate request in FILE.
447 openssl req
-in $file -noout -pubkey |
\
448 openssl rsa
2>/dev
/null
-pubin -outform der |
\
449 openssl dgst
-sha256 -hex]
453 ## Return the distinguished name from the certificate request in FILE.
455 regexp {^subject
=\s
*(/.
*)$} \
456 [exec openssl req
-in $file -noout -subject] \
461 proc cert-key-hash
{file} {
462 ## Return the key hash from the certificate in FILE.
465 openssl x509
-in $file -noout -pubkey |
\
466 openssl rsa
2>/dev
/null
-pubin -outform der |
\
467 openssl dgst
-sha256 -hex]
470 proc cert-dn
{file} {
471 ## Return the distinguished name from the certificate in FILE.
473 regexp {^subject
=\s
*(/.
*)$} \
474 [exec openssl x509
-in $file -noout -subject] \
479 proc cert-seq
{file} {
480 ## Return the serial number of the certificate in FILE.
482 regexp {^serial
\s
*=\s
*([0-9a-fA-F
]+)$} \
483 [exec openssl x509
-noout -serial -in $file] \
485 return [expr 0x
$serial + 0]
488 ###--------------------------------------------------------------------------
489 ### Certificate requests.
491 proc request-match
{reqid cond
} {
492 ## Return a list of request-ids which match REQID and satisfy COND. The
493 ## REQID may be a numerical id, a SQL `LIKE' pattern matched against
494 ## request tags, or the special token `-all'. The COND is a SQL boolean
495 ## expression. The expression is /ignored/ if the REQID is an explicit
501 ## Set up the `conds' list to a bunch of SQL expressions we'll try.
502 if {[string equal
$reqid "-all"]} {
503 set conds
[list $cond]
506 if {[string is digit
$reqid]} { lappend conds
"id = :reqid" }
507 lappend conds
"tag LIKE :reqid AND $cond"
510 ## See if any of the expressions match.
512 set reqs
[db
eval "SELECT id FROM request WHERE $c;"]
513 if {[llength $reqs] > 0} { set win true
; break }
516 error "no requests match `$reqid'"
523 ###--------------------------------------------------------------------------
528 ## The archive consists of the following files.
530 ## cert.SEQ certificate storage
531 ## req.ID request storage
532 ## openssl-certs.txt OpenSSL records for the certificates
533 ## certificate.dump certificate records from the database
534 ## request.dump request records from the database
536 ## The `openssl-certs.txt' file contains lines from the `state.db' file
537 ## referring to the archived certificates. The `.dump' files contain
538 ## Tcl-format plists suitable for passing to `array set' mapping database
541 proc archive-certificates
{} {
542 ## Archive any certificates and certificate requests which need it.
549 set when
[time-db
[expr {[now
] - 86400*$C(archive-interval
)}]]
550 array unset archcerts
554 ## Prepare the archive staging area.
556 set archdir
"tmp/arch"
557 file delete
-force $archdir
558 file delete
-force "tmp/arch.tgz"
561 ## Dig out the certificates.
564 set out
[open "$archdir/certificate.dump" w
]
565 cleanup
{ close $out }
567 SELECT
* FROM certificate
568 WHERE t_expire
<= $when;
571 foreach i
$R(*) { lappend line
$i $R($i) }
574 set archcerts
($R(seq
)) 1
575 file link
-hard "$archdir/cert.$R(seq)" "cert/by-seq/$R(seq)"
576 lappend archfiles
"cert.$R(seq)"
577 lappend delfiles
"cert/by-seq/$R(seq)"
581 ## Prune the OpenSSL request file.
584 set in
[open "state/db"]
585 cleanup
{ close $in }
586 set arch
[open "$archdir/openssl-certs.txt" "w"]
587 cleanup
{ close $arch }
588 set new
[open "state/db.new" "w"]
589 cleanup
{ close $new }
591 while {[gets $in line
] >= 0} {
592 set seq
[expr 0x
[lindex [split $line "\t"] 3] + 0]
593 puts [expr {[info exists archcerts
($seq)] ?
$arch : $new}] $line
596 lappend archfiles
"openssl-certs.txt" "certificate.dump"
599 ## Delete the certificates that we archived. Here we rely on SQLite's
600 ## strong isolation guarantees to ensure that the DELETE query here
601 ## matches the same records as the SELECT did above. Also, we rely on
602 ## SQLite rolling back if anything goes wrong in the rest of the job.
603 ## This is considerably simpler than fiddling the queries below to look
604 ## at the expiry dates of matching certificates.
606 DELETE FROM certificate
607 WHERE t_expire
<= $when;
610 ## Find the orphaned requests. Don't clobber active requests even if
611 ## they look orphaned: we might just have failed to create certificates
612 ## for them for some reason.
615 set out
[open "$archdir/request.dump" w
]
616 cleanup
{ close $out }
619 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
620 WHERE c.req IS NULL AND r.st
!= 'active'
;
623 foreach i
$R(*) { lappend line
$i $R($i) }
626 file link
-hard "$archdir/req.$R(id)" "req/by-id/$R(id)"
627 lappend archfiles
"req.$R(id)"
628 lappend delfiles
"req/by-id/$R(id)"
631 if {$anyreq} { lappend archfiles
"request.dump" }
634 if {!$anycert && !$anyreq} { return }
636 eval exec tar cfz
"../arch.tgz" $archfiles
638 ## Delete the requests that we archived. Again we rely on SQLite's
639 ## strong isolation to avoid races.
644 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
645 WHERE c.req IS NULL AND r.st
!= 'active'
);
648 ## Tidy everything up.
650 set t
[time-db
[now
]]
651 file rename "tmp/arch.tgz" "archive/$t.tgz"
652 if {$anycert} { file rename -force "state/db.new" "state/db" }
654 foreach f
$delfiles { file delete
$f }
655 file delete
-force $archdir
656 file delete
-force "tmp/arch.tgz"
659 ###--------------------------------------------------------------------------
660 ### Certificate revocation.
662 ## Enormous table of revocation reasons and how to handle them.
663 array set REVOKE_REASON
{
678 affiliation-changed
{
686 cessation-of-operation
{
697 reject holdInstructionReject
698 none holdInstructionNone
699 call-issuer holdInstructionCallIssuer
705 proc revoke-reason-info
{reason infovar
} {
706 ## Write information about the revocation REASON into the array INFOVAR.
707 ## The keys defined for INFOVAR are as follows.
709 ## reason The provided reason string.
710 ## oid The OID name for the reason.
711 ## detail-type The type of the detail (for converting details).
712 ## detail-info Additional information for detail conversion
713 ## detail-arg The OpenSSL detail argument name.
718 if {![info exists REVOKE_REASON
($reason)]} {
719 error "unknown revocation reason `$reason'"
723 set R
(reason
) $reason
724 lassign
$REVOKE_REASON($reason) \
725 R
(oid
) R
(detail-type
) R
(detail-info
) R
(detail-arg
)
728 proc revoke-parse-detail
/none
{info detail
} {
729 if {[llength $detail] > 0} {
730 error "no detail permitted"
735 proc revoke-openssl-args
/none
{info arg detail
} {
739 proc revoke-parse-detail
/time {info detail
} {
740 switch [llength $detail] {
742 1 { set t
[clock scan [lindex $detail 0]] }
743 default { error "too many time arguments" }
748 proc revoke-openssl-args
/time {info arg detail
} {
749 return [list $arg [clock format [db-time
$detail] \
754 proc revoke-parse-detail
/enum
{info detail
} {
755 switch [llength $detail] {
756 0 { set r
[lindex $info 0] }
759 set r
[lindex $detail 0]
760 if {![info exists M
($r)]} { error "invalid detail value `$r'" }
762 default { error "too many symbolic arguments" }
767 proc revoke-openssl-args
/enum
{info arg detail
} {
769 return [list $arg $M($detail)]
772 proc revoke-parse-detail
{infovar detail
} {
773 ## Parse a revocation detail, as provided in a command-line argument list,
774 ## and convert it into the database format.
777 return [revoke-parse-detail
/$R(detail-type
) $R(detail-info
) $detail]
780 proc revoke-openssl-args
{infovar detail
} {
781 ## Return OpenSSL arguments for revoking certificates, given a revocation
782 ## DETAIL. You need to provide the `-revoke FILE' bit yourself: this only
783 ## provides the `-crl_reason REASON' and detail arguments.
787 [list -crl_reason $R(oid
)] \
788 [revoke-openssl-args
/$R(detail-type
) \
789 $R(detail-info
) $R(detail-arg
) $detail]]
792 proc revoke-requests
{infovar detail reqs
} {
793 ## Revoke a bunch of certificate requests, listed by id in REQS. The
794 ## INFOVAR is the name of an array set up by `revoke-reason-info'; the
795 ## DETAIL is the revocation detail in internal format, e.g., as established
796 ## by `revoke-parse-detail'.
798 ## This function establishes its own transaction, but you should wrap it in
799 ## your own one if you found the REQS list as a result of a database query,
800 ## in order to avoid race conditions.
802 ## Find some useful things.
805 set ossl_args
[revoke-openssl-args R
$detail]
808 ## Wrap a transaction around, so that we can reset the database if
809 ## something goes wrong with the file fiddling half-way through.
812 ## Make a copy of the state database. We'll work on that using some
813 ## unpleasant configuration hacking.
814 file copy
-force "state/db" "state/db.revoke"
815 set env
(db_suffix
) ".revoke"
817 ## Now work through the requests one by one, revoking each affected
821 ## Check the request state. If it was previously active, we must
822 ## remember to delete the link. Obviously we shouldn't actually delete
823 ## them yet, because this might fail catastrophically.
824 lassign
[db
eval { SELECT st
, tag FROM request WHERE id
= $req; }] \
826 if {[string equal
$reqst active
]} { lappend del
"req/active/$tag" }
828 ## Now try the certificates.
829 foreach {cert certst
} [db
eval {
830 SELECT seq
, st FROM certificate
831 WHERE req
= $req AND st
!= 'expired'
;
834 ## Check the certificate state: again, we might have to delete the
836 if {[string equal
$certst active
]} { lappend del
"cert/active/$tag" }
838 ## Update the certificate state.
839 db
eval { UPDATE certificate SET st
= 'revoked' WHERE seq
= $cert; }
841 ## Get OpenSSL to update its database.
842 eval exec openssl ca
\
843 [list -config "etc/openssl.conf"] \
844 [list -revoke "cert/by-seq/$cert"] \
849 ## Finally fiddle the request state.
853 revoke_reason
= $R(reason
),
854 revoke_detail
= $detail
859 ## Astonishingly all of that actually worked.
860 file rename -force "state/db.revoke" "state/db"
863 ## Delete the active links we made a note of earlier.
864 foreach f
$del { file delete
-force $f }
867 ###--------------------------------------------------------------------------
868 ### Managing certificates.
870 proc issue-cert
{id now
} {
871 ## Issue a certificate for the request with the given ID. This doesn't
872 ## bother to find out whethere it's a good idea.
880 ## Find a temporary file name for the output certificate.
881 fresh-temp
"$CERTROOT/tmp" tmp
{
882 set f
[open $tmp {WRONLY CREAT EXCL
}]
884 cleanup
{ file delete
$tmp }
887 ## Find stuff out about the request.
889 SELECT p.start_skew
, p.expire_interval
, p.issue_time
, p.extensions
,
891 FROM request AS r JOIN
892 profile AS p ON r.profile
= p.
label
894 }] start_skew expire_interval issue_time extensions tag cert_dn
896 ## Sign the certificate.
897 set starttime
[expr {$now - 3600*$start_skew}]
898 set endtime
[expr {$now + 3600*$expire_interval}]
899 cleanup
{ catch { eval file delete
[glob "$CERTROOT/tmp/*.pem"] } }
900 exec openssl ca
-batch \
901 -config "$CERTROOT/etc/openssl.conf" \
902 -outdir "$CERTROOT/tmp" \
903 -extensions $extensions \
904 -startdate [time-asn1
$starttime] \
905 -enddate [time-asn1
$endtime] \
906 -in "$CERTROOT/req/by-id/$id" -out $tmp \
909 ## Update the request's cert_dn field. If it's null, this is the first
910 ## certificate issued for the request, and we should fill the field in;
911 ## otherwise we should compare the actual DN to the expected one and
912 ## fail if it's wrong.
913 set dn
[cert-dn
$tmp]
914 if {[string equal
$cert_dn nil
]} {
915 db
eval { UPDATE request SET cert_dn
= $dn WHERE id
= $id; }
916 } elseif
{![string equal
$cert_dn $dn]} {
918 "DN mismatch: request $id (`$tag') has $cert_dn; "
919 "new cert has $dn"} ""]
922 ## Stash a new record in the database.
923 set expire
[time-db
$endtime]
924 set next_issue
[time-db
[next-matching-date
$issue_time $now]]
925 set now_db
[time-db
$now]
926 set seq
[cert-seq
$tmp]
929 SET st
= CASE WHEN t_expire
>= $now_db THEN 'superceded'
932 WHERE req
= $id AND st
= 'active'
;
934 INSERT INTO certificate
(seq
, req
, st
, t_expire
)
935 VALUES
($seq, $id, 'active'
, $expire);
937 UPDATE request SET t_reissue
= $next_issue
941 ## Put the file in the right place.
942 file link
-hard "$CERTROOT/cert/by-seq/$seq" $tmp
943 exec ln
-sf "../by-seq/$seq" "$CERTROOT/cert/active/$tag"
948 proc expire-certs
{now
} {
949 ## Mark certificates as having expired.
952 set now_db
[time-db
$now]
954 ## If we're unlucky, some active certificates may have expired while we
955 ## weren't looking. We'll demote these soon, but we must clear away the
957 foreach tag
[db
eval {
959 FROM request AS r JOIN certificate as c ON r.id
= c.req
960 WHERE c.st
= 'active' AND c.t_expire
< $now_db;
962 file delete
"$CERTROOT/cert/active/$tag"
965 ## Now demote the states of expired certificates. All certificates expire,
966 ## including revoked ones.
970 WHERE st
!= 'expired' AND t_expire
< $now_db;
974 ###----- That's all, folks --------------------------------------------------