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 ## The update hook function.
91 ## Called by `bin/update': might publish data to a web server, for example.
94 ## Read the user configuration.
95 if {[file exists
"$CERTROOT/etc/config.tcl"]} {
96 source "$CERTROOT/etc/config.tcl"
99 ###--------------------------------------------------------------------------
100 ### Tcl control utilities.
104 proc with-cleanup
{body
} {
105 ## Evaluate BODY, which may contain `cleanup' calls. When it finishes,
106 ## evaluate the cleanup bodies, in order.
111 set rc
[catch { uplevel 1 $body } result
]
112 foreach item
$CLEANUPS { uplevel 1 $item }
114 return -code $rc $result
117 proc cleanup
{body
} {
118 ## Arrange to perform BODY at the end of the enclosing `with-cleanup' form.
121 lappend CLEANUPS
$body
124 ###--------------------------------------------------------------------------
125 ### File system convenience functions.
127 proc make-directories
{mode args
} {
128 ## Create the directories named in the ARGS list with the given MODE, and
129 ## with the configured owner and group. Don't use Tcl's file mkdir here,
130 ## because it's potentially racy.
134 exec mkdir
-m700 $dir
135 file attributes
$dir \
136 -owner $C(ca-owner
) -group $C(ca-group
) \
141 proc make-file
{file contents
} {
142 ## Create the FILE with the specified contents.
144 set f
[open $file "w"]
145 puts -nonewline $f $contents
149 proc fresh-temp
{dir name body
} {
150 ## Find a name for a fresh temporary file in DIR; store the chosen name in
151 ## NAME, and evaluate BODY. If BODY succeeds and returns true then all is
152 ## well; if it continues or fails with POSIX EEXIST then try again with a
153 ## different name; otherwise propagate the error.
158 set file [file join $dir \
159 [format "tmp.%s.%d.%d.%06x" \
163 [expr {int
(rand
()*16777216)}]]]
164 set rc
[catch {uplevel 1 $body} result
]
168 if {[string equal
[lrange $errorCode 0 1] "POSIX EEXIST"]} {
171 return -code 1 $result
176 default { return -code $rc $result }
181 ###--------------------------------------------------------------------------
185 ## Return a named chunk of SQL.
188 set f
[open "$CERTROOT/sql/$name.sql"]
194 ###--------------------------------------------------------------------------
195 ### Date and time handling.
198 ## Return the current Unix time. Except that the magic environment
199 ## variable CA_FAKE_TIME can be set in order to convince the script that
200 ## some other time should be used instead.
202 global env TIME_DELTA
203 set now
[clock seconds
]
204 if {[info exists env
(CA_FAKE_TIME
)]} {
205 if {![info exists TIME_DELTA
]} {
206 set fake
[clock scan $env(CA_FAKE_TIME
)]
207 set TIME_DELTA
[expr {$fake - $now}]
209 return [expr {$now + $TIME_DELTA}]
216 ## Convert a Unix time into something we should store in the database.
217 ## Currently we use ISO 8601 strings giving UTC times; however, the only
218 ## guarantee made here is that lexical ordering on the time strings is the
219 ## same as the temporal ordering.
221 return [clock format $t -timezone :UTC
-format "%Y-%m-%dT%H:%M:%SZ"]
225 ## Convert a time from the database into a Unix time.
227 return [clock scan $s -timezone :UTC
-format "%Y-%m-%dT%H:%M:%SZ"]
231 ## Convert a Unix time into a string suitable for passing to OpenSSL as a
234 return [clock format $t -timezone :UTC
-format "%y%m%d%H%M%SZ"]
237 proc time-revoke
{t
} {
238 ## Convert a Unix time into a string suitable for an OpenSSL revocation
241 return [clock format $t -timezone :UTC
-format "%Y%m%d%H%M%SZ"]
244 proc split-date
{date
} {
245 ## Parse an ISO8601 date or pattern into a list of items. Numbers have
246 ## leading zeroes removed so that they don't smell like octal.
248 set list [regexp -inline -expanded {
250 (\d
+ |
\* |
\* / \d
+)
252 (\d
+ |
\* |
\* / \d
+)
254 (\d
+ |
\* |
\* / \d
+)
256 (\d
+ |
\* |
\* / \d
+)
258 (\d
+ |
\* |
\* / \d
+)
260 (\d
+ |
\* |
\* / \d
+)
263 if {![llength $list]} { error "invalid date pattern `$date'" }
265 foreach item
[lrange $list 1 end
] {
266 lappend out
[regsub {^
0*(.
)} $item "\\1"]
271 proc next-matching-date
* {pat refvar i
} {
272 ## Adjust the time in REFVAR forwards so that its components I, I + 1,
273 ## ... match the corresponding patterns in PAT: both are lists containing
274 ## year, month, day, hour, minute, second components in that order. If
275 ## this works, return `ok'. Otherwise return `step' as an indication that
276 ## the caller should step its time component and try again.
278 ## This function has hideous behaviour with nonsensical patterns. For
279 ## example, searching for `*-02-30 00:00:00' will loop forever.
281 ## If we've gone off the end, we're done.
282 if {$i >= 6} { return ok
}
284 ## Find the caller's reference time.
287 ## A useful list of minimum values.
288 set min
{ 0 1 1 0 0 0 }
290 ## Find the maximum value we're allowed in this component.
292 0 { set max
[expr {1 << 31}] }
295 switch [lindex $ref 1] {
296 1 - 3 - 5 - 7 - 8 - 10 - 12 { set max
31 }
297 4 - 6 - 9 - 11 { set max
30 }
299 set y
[lindex $ref 0]
300 if {$y%400 == 0} { set max
29 } \
301 elseif
{$y%100 == 0} { set max
28 } \
302 elseif
{$y%4 == 0} { set max
29 } \
311 ## Collect the pattern and current-value entries.
312 set p
[lindex $pat $i]
313 set n
[lindex $ref $i]
316 ## Now for the main job. We try to adjust the current component forwards
317 ## and within its bounds so as to match the pattern. If that fails, return
318 ## `step' immediately. If it succeeds, then recursively process the less
319 ## significant components. If we have to step, then advance by one and try
320 ## again: this will propagate the failure upwards if necessary.
323 ## Work out what kind of pattern this is and how to deal with it.
324 switch -regexp -matchvar m
$p {
327 ## A numeric literal. If it's within bounds then set it; otherwise
328 ## we'll have to start from the beginning.
329 if {$p < $nn ||
$p > $max} { return step
}
334 ## If this is an unqualified wildcard then accept it.
338 ## If this is a wildcard with a step amount then adjust forwards. If
339 ## we bust then fail.
341 set nn
[expr {$nn + $m - 1}]
342 set nn
[expr {$nn - $nn%$m}]
343 if {$nn > $max} { return step
}
347 ## It's something else we don't know how to handle.
348 error "bad date pattern `$p'"
352 ## If we've moved on then clear the less significant entries. This will
353 ## make it easier for them to match. It's also necessary for
354 ## correctness, of course.
356 for {set j
[expr {$i + 1}]} {$j < 6} {incr j
} {
357 lset ref
$j [lindex $min $j]
361 ## Write the value back to the reference time, and recursively fix up the
362 ## less significant components.
364 switch [next-matching-date
* $pat ref
[expr {$i + 1}]] {
367 default { error "INTERNAL: unexpected rc" }
370 ## It didn't work. Move on by one. This is just to perturb the value:
371 ## the big switch at the top will do the necessary fine tuning.
372 set n
[lindex $ref $i]
373 set nn
[expr {$n + 1}]
377 proc next-matching-date
{pat
{ref now
}} {
378 ## Return the next time (as Unix time) after REF which matches PAT.
380 if {[string equal
$ref now
]} { set ref
[now
] }
381 set reflist
[split-date
[clock format $ref -format "%Y-%m-%d %H:%M:%S"]]
382 set patlist
[split-date
$pat]
383 if {![string equal
[next-matching-date
* $patlist reflist
0] ok
]} {
384 error "failed to find matching date"
387 [eval [list format "%04d-%02d-%02d %02d:%02d:%02d"] \
389 -format "%Y-%m-%d %H:%M:%S"]
392 ###--------------------------------------------------------------------------
393 ### Setting up profiles.
395 proc sync-profiles
{} {
396 ## Synchronize the profiles in the database with the configuration file.
401 ## Delete profiles which are no longer wanted.
402 foreach {p t
} [db
eval { SELECT
label, tombstone FROM profile
; }] {
404 if {[info exists P
($p)]} {
405 ## We have a matching entry. The tombstone flag may be set, but we
406 ## will turn that off in the second pass.
408 } elseif
{![db exists
{ SELECT
1 FROM request WHERE profile
= $p; }]} {
409 ## No references, so we can delete the entry.
410 db
eval { DELETE FROM profile WHERE
label = $p; }
412 ## There are still references, and the tombstone flag isn't set yet.
414 db
eval { UPDATE profile SET tombstone
= 1 WHERE
label = $p; }
418 ## Now push each defined profile into the database. This may cause
419 ## redundant updates, but I don't really care.
420 foreach {p dict
} [array get P
] {
423 if {[info exists rec
($p)]} {
426 extensions
= $d(extensions
),
427 issue_time
= $d(issue-time
),
428 start_skew
= $d(start-skew
),
429 expire_interval
= $d(expire-interval
),
435 INSERT INTO profile
(label, extensions
, issue_time
,
436 start_skew
, expire_interval
)
437 VALUES
($p, $d(extensions
), $d(issue-time
),
438 $d(start-skew
), $d(expire-interval
));
445 ###--------------------------------------------------------------------------
446 ### Extracting information from request and certificate files.
448 proc req-key-hash
{file} {
449 ## Return the key hash from the certificate request in FILE.
451 return [lindex [exec \
452 openssl req
-in $file -noout -pubkey |
\
453 openssl rsa
2>/dev
/null
-pubin -outform der |
\
454 openssl dgst
-sha256 -hex] end
]
457 proc hack-openssl-dn
{out
} {
458 ## Convert OpenSSL's hopeless output into a DN.
460 if {[regexp {^subject
=\s
*(/.
*)$} $out -> dn
]} { return $dn }
461 if {[regexp {^subject
=(.
*)$} $out -> t
]} {
462 set t
[regsub {^
(\w
+) = } $t {/\1=}]
463 set t
[regsub -all {, (\w
+) = } $t {/\1=}]
469 ## Return the distinguished name from the certificate request in FILE.
471 return [hack-openssl-dn
[exec openssl req
-in $file -noout -subject]]
474 proc cert-key-hash
{file} {
475 ## Return the key hash from the certificate in FILE.
477 return [lindex [exec \
478 openssl x509
-in $file -noout -pubkey |
\
479 openssl rsa
2>/dev
/null
-pubin -outform der |
\
480 openssl dgst
-sha256 -hex] end
]
483 proc cert-dn
{file} {
484 ## Return the distinguished name from the certificate in FILE.
486 return [hack-openssl-dn
[exec openssl x509
-in $file -noout -subject]]
489 proc cert-seq
{file} {
490 ## Return the serial number of the certificate in FILE.
492 regexp {^serial
\s
*=\s
*([0-9a-fA-F
]+)$} \
493 [exec openssl x509
-noout -serial -in $file] \
495 return [expr 0x
$serial + 0]
498 ###--------------------------------------------------------------------------
499 ### Certificate requests.
501 proc request-match
{reqid cond
} {
502 ## Return a list of request-ids which match REQID and satisfy COND. The
503 ## REQID may be a numerical id, a SQL `LIKE' pattern matched against
504 ## request tags, or the special token `-all'. The COND is a SQL boolean
505 ## expression. The expression is /ignored/ if the REQID is an explicit
511 ## Set up the `conds' list to a bunch of SQL expressions we'll try.
512 if {[string equal
$reqid "-all"]} {
513 set conds
[list $cond]
516 if {[string is digit
$reqid]} { lappend conds
"id = :reqid" }
517 lappend conds
"tag LIKE :reqid AND $cond"
520 ## See if any of the expressions match.
522 set reqs
[db
eval "SELECT id FROM request WHERE $c;"]
523 if {[llength $reqs] > 0} { set win true
; break }
526 error "no requests match `$reqid'"
533 ###--------------------------------------------------------------------------
538 ## The archive consists of the following files.
540 ## cert.SEQ certificate storage
541 ## req.ID request storage
542 ## openssl-certs.txt OpenSSL records for the certificates
543 ## certificate.dump certificate records from the database
544 ## request.dump request records from the database
546 ## The `openssl-certs.txt' file contains lines from the `state.db' file
547 ## referring to the archived certificates. The `.dump' files contain
548 ## Tcl-format plists suitable for passing to `array set' mapping database
551 proc archive-certificates
{} {
552 ## Archive any certificates and certificate requests which need it.
559 set when
[time-db
[expr {[now
] - 86400*$C(archive-interval
)}]]
560 array unset archcerts
564 ## Prepare the archive staging area.
566 set archdir
"tmp/arch"
567 file delete
-force $archdir
568 file delete
-force "tmp/arch.tgz"
571 ## Dig out the certificates.
574 set out
[open "$archdir/certificate.dump" w
]
575 cleanup
{ close $out }
577 SELECT
* FROM certificate
578 WHERE t_expire
<= $when;
581 foreach i
$R(*) { lappend line
$i $R($i) }
584 set archcerts
($R(seq
)) 1
585 file link
-hard "$archdir/cert.$R(seq)" "cert/by-seq/$R(seq)"
586 lappend archfiles
"cert.$R(seq)"
587 lappend delfiles
"cert/by-seq/$R(seq)"
591 ## Prune the OpenSSL request file.
594 set in
[open "state/db"]
595 cleanup
{ close $in }
596 set arch
[open "$archdir/openssl-certs.txt" "w"]
597 cleanup
{ close $arch }
598 set new
[open "state/db.new" "w"]
599 cleanup
{ close $new }
601 while {[gets $in line
] >= 0} {
602 set seq
[expr 0x
[lindex [split $line "\t"] 3] + 0]
603 puts [expr {[info exists archcerts
($seq)] ?
$arch : $new}] $line
606 lappend archfiles
"openssl-certs.txt" "certificate.dump"
609 ## Delete the certificates that we archived. Here we rely on SQLite's
610 ## strong isolation guarantees to ensure that the DELETE query here
611 ## matches the same records as the SELECT did above. Also, we rely on
612 ## SQLite rolling back if anything goes wrong in the rest of the job.
613 ## This is considerably simpler than fiddling the queries below to look
614 ## at the expiry dates of matching certificates.
616 DELETE FROM certificate
617 WHERE t_expire
<= $when;
620 ## Find the orphaned requests. Don't clobber active requests even if
621 ## they look orphaned: we might just have failed to create certificates
622 ## for them for some reason.
625 set out
[open "$archdir/request.dump" w
]
626 cleanup
{ close $out }
629 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
630 WHERE c.req IS NULL AND r.st
!= 'active'
;
633 foreach i
$R(*) { lappend line
$i $R($i) }
636 file link
-hard "$archdir/req.$R(id)" "req/by-id/$R(id)"
637 lappend archfiles
"req.$R(id)"
638 lappend delfiles
"req/by-id/$R(id)"
641 if {$anyreq} { lappend archfiles
"request.dump" }
644 if {!$anycert && !$anyreq} { return }
646 eval exec tar cfz
"../arch.tgz" $archfiles
648 ## Delete the requests that we archived. Again we rely on SQLite's
649 ## strong isolation to avoid races.
654 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
655 WHERE c.req IS NULL AND r.st
!= 'active'
);
658 ## Tidy everything up.
660 set t
[time-db
[now
]]
661 file rename "tmp/arch.tgz" "archive/$t.tgz"
662 if {$anycert} { file rename -force "state/db.new" "state/db" }
664 foreach f
$delfiles { file delete
$f }
665 file delete
-force $archdir
666 file delete
-force "tmp/arch.tgz"
669 ###--------------------------------------------------------------------------
670 ### Certificate revocation.
672 ## Enormous table of revocation reasons and how to handle them.
673 array set REVOKE_REASON
{
688 affiliation-changed
{
696 cessation-of-operation
{
707 reject holdInstructionReject
708 none holdInstructionNone
709 call-issuer holdInstructionCallIssuer
715 proc revoke-reason-info
{reason infovar
} {
716 ## Write information about the revocation REASON into the array INFOVAR.
717 ## The keys defined for INFOVAR are as follows.
719 ## reason The provided reason string.
720 ## oid The OID name for the reason.
721 ## detail-type The type of the detail (for converting details).
722 ## detail-info Additional information for detail conversion
723 ## detail-arg The OpenSSL detail argument name.
728 if {![info exists REVOKE_REASON
($reason)]} {
729 error "unknown revocation reason `$reason'"
733 set R
(reason
) $reason
734 lassign
$REVOKE_REASON($reason) \
735 R
(oid
) R
(detail-type
) R
(detail-info
) R
(detail-arg
)
738 proc revoke-parse-detail
/none
{info detail
} {
739 if {[llength $detail] > 0} {
740 error "no detail permitted"
745 proc revoke-openssl-args
/none
{info arg detail
} {
749 proc revoke-parse-detail
/time {info detail
} {
750 switch [llength $detail] {
752 1 { set t
[clock scan [lindex $detail 0]] }
753 default { error "too many time arguments" }
758 proc revoke-openssl-args
/time {info arg detail
} {
759 return [list $arg [clock format [db-time
$detail] \
764 proc revoke-parse-detail
/enum
{info detail
} {
765 switch [llength $detail] {
766 0 { set r
[lindex $info 0] }
769 set r
[lindex $detail 0]
770 if {![info exists M
($r)]} { error "invalid detail value `$r'" }
772 default { error "too many symbolic arguments" }
777 proc revoke-openssl-args
/enum
{info arg detail
} {
779 return [list $arg $M($detail)]
782 proc revoke-parse-detail
{infovar detail
} {
783 ## Parse a revocation detail, as provided in a command-line argument list,
784 ## and convert it into the database format.
787 return [revoke-parse-detail
/$R(detail-type
) $R(detail-info
) $detail]
790 proc revoke-openssl-args
{infovar detail
} {
791 ## Return OpenSSL arguments for revoking certificates, given a revocation
792 ## DETAIL. You need to provide the `-revoke FILE' bit yourself: this only
793 ## provides the `-crl_reason REASON' and detail arguments.
797 [list -crl_reason $R(oid
)] \
798 [revoke-openssl-args
/$R(detail-type
) \
799 $R(detail-info
) $R(detail-arg
) $detail]]
802 proc revoke-requests
{infovar detail reqs
} {
803 ## Revoke a bunch of certificate requests, listed by id in REQS. The
804 ## INFOVAR is the name of an array set up by `revoke-reason-info'; the
805 ## DETAIL is the revocation detail in internal format, e.g., as established
806 ## by `revoke-parse-detail'.
808 ## This function establishes its own transaction, but you should wrap it in
809 ## your own one if you found the REQS list as a result of a database query,
810 ## in order to avoid race conditions.
812 ## Find some useful things.
815 set ossl_args
[revoke-openssl-args R
$detail]
818 ## Wrap a transaction around, so that we can reset the database if
819 ## something goes wrong with the file fiddling half-way through.
822 ## Make a copy of the state database. We'll work on that using some
823 ## unpleasant configuration hacking.
824 file copy
-force "state/db" "state/db.revoke"
825 set env
(db_suffix
) ".revoke"
827 ## Now work through the requests one by one, revoking each affected
831 ## Check the request state. If it was previously active, we must
832 ## remember to delete the link. Obviously we shouldn't actually delete
833 ## them yet, because this might fail catastrophically.
834 lassign
[db
eval { SELECT st
, tag FROM request WHERE id
= $req; }] \
836 if {[string equal
$reqst active
]} { lappend del
"req/active/$tag" }
838 ## Now try the certificates.
839 foreach {cert certst
} [db
eval {
840 SELECT seq
, st FROM certificate
841 WHERE req
= $req AND st
!= 'expired'
;
844 ## Check the certificate state: again, we might have to delete the
846 if {[string equal
$certst active
]} { lappend del
"cert/active/$tag" }
848 ## Update the certificate state.
849 db
eval { UPDATE certificate SET st
= 'revoked' WHERE seq
= $cert; }
851 ## Get OpenSSL to update its database.
852 eval exec openssl ca
\
853 [list -config "etc/openssl.conf"] \
854 [list -revoke "cert/by-seq/$cert"] \
859 ## Finally fiddle the request state.
863 revoke_reason
= $R(reason
),
864 revoke_detail
= $detail
869 ## Astonishingly all of that actually worked.
870 file rename -force "state/db.revoke" "state/db"
873 ## Delete the active links we made a note of earlier.
874 foreach f
$del { file delete
-force $f }
877 ###--------------------------------------------------------------------------
878 ### Managing certificates.
880 proc issue-cert
{id now
} {
881 ## Issue a certificate for the request with the given ID. This doesn't
882 ## bother to find out whethere it's a good idea.
890 ## Find a temporary file name for the output certificate.
891 fresh-temp
"$CERTROOT/tmp" tmp
{
892 set f
[open $tmp {WRONLY CREAT EXCL
}]
894 cleanup
{ file delete
$tmp }
897 ## Find stuff out about the request.
899 SELECT p.start_skew
, p.expire_interval
, p.issue_time
, p.extensions
,
901 FROM request AS r JOIN
902 profile AS p ON r.profile
= p.
label
904 }] start_skew expire_interval issue_time extensions tag cert_dn
906 ## Sign the certificate.
907 set starttime
[expr {$now - 3600*$start_skew}]
908 set endtime
[expr {$now + 3600*$expire_interval}]
909 cleanup
{ catch { eval file delete
[glob "$CERTROOT/tmp/*.pem"] } }
910 exec openssl ca
-batch \
911 -config "$CERTROOT/etc/openssl.conf" \
912 -outdir "$CERTROOT/tmp" \
913 -extensions $extensions \
914 -startdate [time-asn1
$starttime] \
915 -enddate [time-asn1
$endtime] \
916 -in "$CERTROOT/req/by-id/$id" -out $tmp \
919 ## Update the request's cert_dn field. If it's null, this is the first
920 ## certificate issued for the request, and we should fill the field in;
921 ## otherwise we should compare the actual DN to the expected one and
922 ## fail if it's wrong.
923 set dn
[cert-dn
$tmp]
924 if {[string equal
$cert_dn nil
]} {
925 db
eval { UPDATE request SET cert_dn
= $dn WHERE id
= $id; }
926 } elseif
{![string equal
$cert_dn $dn]} {
928 "DN mismatch: request $id (`$tag') has $cert_dn; "
929 "new cert has $dn"} ""]
932 ## Stash a new record in the database.
933 set expire
[time-db
$endtime]
934 set next_issue
[time-db
[next-matching-date
$issue_time $now]]
935 set now_db
[time-db
$now]
936 set seq
[cert-seq
$tmp]
939 SET st
= CASE WHEN t_expire
>= $now_db THEN 'superceded'
942 WHERE req
= $id AND st
= 'active'
;
944 INSERT INTO certificate
(seq
, req
, st
, t_expire
)
945 VALUES
($seq, $id, 'active'
, $expire);
947 UPDATE request SET t_reissue
= $next_issue
951 ## Put the file in the right place.
952 file link
-hard "$CERTROOT/cert/by-seq/$seq" $tmp
953 exec ln
-sf "../by-seq/$seq" "$CERTROOT/cert/active/$tag"
958 proc expire-certs
{now
} {
959 ## Mark certificates as having expired.
962 set now_db
[time-db
$now]
964 ## If we're unlucky, some active certificates may have expired while we
965 ## weren't looking. We'll demote these soon, but we must clear away the
967 foreach tag
[db
eval {
969 FROM request AS r JOIN certificate as c ON r.id
= c.req
970 WHERE c.st
= 'active' AND c.t_expire
< $now_db;
972 file delete
"$CERTROOT/cert/active/$tag"
975 ## Now demote the states of expired certificates. All certificates expire,
976 ## including revoked ones.
980 WHERE st
!= 'expired' AND t_expire
< $now_db;
984 ###----- That's all, folks --------------------------------------------------