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
= $(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
]
458 ## Return the distinguished name from the certificate request in FILE.
460 regexp {^subject
=\s
*(/.
*)$} \
461 [exec openssl req
-in $file -noout -subject] \
466 proc cert-key-hash
{file} {
467 ## Return the key hash from the certificate in FILE.
469 return [lindex [exec \
470 openssl x509
-in $file -noout -pubkey |
\
471 openssl rsa
2>/dev
/null
-pubin -outform der |
\
472 openssl dgst
-sha256 -hex] end
]
475 proc cert-dn
{file} {
476 ## Return the distinguished name from the certificate in FILE.
478 regexp {^subject
=\s
*(/.
*)$} \
479 [exec openssl x509
-in $file -noout -subject] \
484 proc cert-seq
{file} {
485 ## Return the serial number of the certificate in FILE.
487 regexp {^serial
\s
*=\s
*([0-9a-fA-F
]+)$} \
488 [exec openssl x509
-noout -serial -in $file] \
490 return [expr 0x
$serial + 0]
493 ###--------------------------------------------------------------------------
494 ### Certificate requests.
496 proc request-match
{reqid cond
} {
497 ## Return a list of request-ids which match REQID and satisfy COND. The
498 ## REQID may be a numerical id, a SQL `LIKE' pattern matched against
499 ## request tags, or the special token `-all'. The COND is a SQL boolean
500 ## expression. The expression is /ignored/ if the REQID is an explicit
506 ## Set up the `conds' list to a bunch of SQL expressions we'll try.
507 if {[string equal
$reqid "-all"]} {
508 set conds
[list $cond]
511 if {[string is digit
$reqid]} { lappend conds
"id = :reqid" }
512 lappend conds
"tag LIKE :reqid AND $cond"
515 ## See if any of the expressions match.
517 set reqs
[db
eval "SELECT id FROM request WHERE $c;"]
518 if {[llength $reqs] > 0} { set win true
; break }
521 error "no requests match `$reqid'"
528 ###--------------------------------------------------------------------------
533 ## The archive consists of the following files.
535 ## cert.SEQ certificate storage
536 ## req.ID request storage
537 ## openssl-certs.txt OpenSSL records for the certificates
538 ## certificate.dump certificate records from the database
539 ## request.dump request records from the database
541 ## The `openssl-certs.txt' file contains lines from the `state.db' file
542 ## referring to the archived certificates. The `.dump' files contain
543 ## Tcl-format plists suitable for passing to `array set' mapping database
546 proc archive-certificates
{} {
547 ## Archive any certificates and certificate requests which need it.
554 set when
[time-db
[expr {[now
] - 86400*$C(archive-interval
)}]]
555 array unset archcerts
559 ## Prepare the archive staging area.
561 set archdir
"tmp/arch"
562 file delete
-force $archdir
563 file delete
-force "tmp/arch.tgz"
566 ## Dig out the certificates.
569 set out
[open "$archdir/certificate.dump" w
]
570 cleanup
{ close $out }
572 SELECT
* FROM certificate
573 WHERE t_expire
<= $when;
576 foreach i
$R(*) { lappend line
$i $R($i) }
579 set archcerts
($R(seq
)) 1
580 file link
-hard "$archdir/cert.$R(seq)" "cert/by-seq/$R(seq)"
581 lappend archfiles
"cert.$R(seq)"
582 lappend delfiles
"cert/by-seq/$R(seq)"
586 ## Prune the OpenSSL request file.
589 set in
[open "state/db"]
590 cleanup
{ close $in }
591 set arch
[open "$archdir/openssl-certs.txt" "w"]
592 cleanup
{ close $arch }
593 set new
[open "state/db.new" "w"]
594 cleanup
{ close $new }
596 while {[gets $in line
] >= 0} {
597 set seq
[expr 0x
[lindex [split $line "\t"] 3] + 0]
598 puts [expr {[info exists archcerts
($seq)] ?
$arch : $new}] $line
601 lappend archfiles
"openssl-certs.txt" "certificate.dump"
604 ## Delete the certificates that we archived. Here we rely on SQLite's
605 ## strong isolation guarantees to ensure that the DELETE query here
606 ## matches the same records as the SELECT did above. Also, we rely on
607 ## SQLite rolling back if anything goes wrong in the rest of the job.
608 ## This is considerably simpler than fiddling the queries below to look
609 ## at the expiry dates of matching certificates.
611 DELETE FROM certificate
612 WHERE t_expire
<= $when;
615 ## Find the orphaned requests. Don't clobber active requests even if
616 ## they look orphaned: we might just have failed to create certificates
617 ## for them for some reason.
620 set out
[open "$archdir/request.dump" w
]
621 cleanup
{ close $out }
624 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
625 WHERE c.req IS NULL AND r.st
!= 'active'
;
628 foreach i
$R(*) { lappend line
$i $R($i) }
631 file link
-hard "$archdir/req.$R(id)" "req/by-id/$R(id)"
632 lappend archfiles
"req.$R(id)"
633 lappend delfiles
"req/by-id/$R(id)"
636 if {$anyreq} { lappend archfiles
"request.dump" }
639 if {!$anycert && !$anyreq} { return }
641 eval exec tar cfz
"../arch.tgz" $archfiles
643 ## Delete the requests that we archived. Again we rely on SQLite's
644 ## strong isolation to avoid races.
649 FROM request AS r LEFT JOIN certificate AS c ON r.id
= c.req
650 WHERE c.req IS NULL AND r.st
!= 'active'
);
653 ## Tidy everything up.
655 set t
[time-db
[now
]]
656 file rename "tmp/arch.tgz" "archive/$t.tgz"
657 if {$anycert} { file rename -force "state/db.new" "state/db" }
659 foreach f
$delfiles { file delete
$f }
660 file delete
-force $archdir
661 file delete
-force "tmp/arch.tgz"
664 ###--------------------------------------------------------------------------
665 ### Certificate revocation.
667 ## Enormous table of revocation reasons and how to handle them.
668 array set REVOKE_REASON
{
683 affiliation-changed
{
691 cessation-of-operation
{
702 reject holdInstructionReject
703 none holdInstructionNone
704 call-issuer holdInstructionCallIssuer
710 proc revoke-reason-info
{reason infovar
} {
711 ## Write information about the revocation REASON into the array INFOVAR.
712 ## The keys defined for INFOVAR are as follows.
714 ## reason The provided reason string.
715 ## oid The OID name for the reason.
716 ## detail-type The type of the detail (for converting details).
717 ## detail-info Additional information for detail conversion
718 ## detail-arg The OpenSSL detail argument name.
723 if {![info exists REVOKE_REASON
($reason)]} {
724 error "unknown revocation reason `$reason'"
728 set R
(reason
) $reason
729 lassign
$REVOKE_REASON($reason) \
730 R
(oid
) R
(detail-type
) R
(detail-info
) R
(detail-arg
)
733 proc revoke-parse-detail
/none
{info detail
} {
734 if {[llength $detail] > 0} {
735 error "no detail permitted"
740 proc revoke-openssl-args
/none
{info arg detail
} {
744 proc revoke-parse-detail
/time {info detail
} {
745 switch [llength $detail] {
747 1 { set t
[clock scan [lindex $detail 0]] }
748 default { error "too many time arguments" }
753 proc revoke-openssl-args
/time {info arg detail
} {
754 return [list $arg [clock format [db-time
$detail] \
759 proc revoke-parse-detail
/enum
{info detail
} {
760 switch [llength $detail] {
761 0 { set r
[lindex $info 0] }
764 set r
[lindex $detail 0]
765 if {![info exists M
($r)]} { error "invalid detail value `$r'" }
767 default { error "too many symbolic arguments" }
772 proc revoke-openssl-args
/enum
{info arg detail
} {
774 return [list $arg $M($detail)]
777 proc revoke-parse-detail
{infovar detail
} {
778 ## Parse a revocation detail, as provided in a command-line argument list,
779 ## and convert it into the database format.
782 return [revoke-parse-detail
/$R(detail-type
) $R(detail-info
) $detail]
785 proc revoke-openssl-args
{infovar detail
} {
786 ## Return OpenSSL arguments for revoking certificates, given a revocation
787 ## DETAIL. You need to provide the `-revoke FILE' bit yourself: this only
788 ## provides the `-crl_reason REASON' and detail arguments.
792 [list -crl_reason $R(oid
)] \
793 [revoke-openssl-args
/$R(detail-type
) \
794 $R(detail-info
) $R(detail-arg
) $detail]]
797 proc revoke-requests
{infovar detail reqs
} {
798 ## Revoke a bunch of certificate requests, listed by id in REQS. The
799 ## INFOVAR is the name of an array set up by `revoke-reason-info'; the
800 ## DETAIL is the revocation detail in internal format, e.g., as established
801 ## by `revoke-parse-detail'.
803 ## This function establishes its own transaction, but you should wrap it in
804 ## your own one if you found the REQS list as a result of a database query,
805 ## in order to avoid race conditions.
807 ## Find some useful things.
810 set ossl_args
[revoke-openssl-args R
$detail]
813 ## Wrap a transaction around, so that we can reset the database if
814 ## something goes wrong with the file fiddling half-way through.
817 ## Make a copy of the state database. We'll work on that using some
818 ## unpleasant configuration hacking.
819 file copy
-force "state/db" "state/db.revoke"
820 set env
(db_suffix
) ".revoke"
822 ## Now work through the requests one by one, revoking each affected
826 ## Check the request state. If it was previously active, we must
827 ## remember to delete the link. Obviously we shouldn't actually delete
828 ## them yet, because this might fail catastrophically.
829 lassign
[db
eval { SELECT st
, tag FROM request WHERE id
= $req; }] \
831 if {[string equal
$reqst active
]} { lappend del
"req/active/$tag" }
833 ## Now try the certificates.
834 foreach {cert certst
} [db
eval {
835 SELECT seq
, st FROM certificate
836 WHERE req
= $req AND st
!= 'expired'
;
839 ## Check the certificate state: again, we might have to delete the
841 if {[string equal
$certst active
]} { lappend del
"cert/active/$tag" }
843 ## Update the certificate state.
844 db
eval { UPDATE certificate SET st
= 'revoked' WHERE seq
= $cert; }
846 ## Get OpenSSL to update its database.
847 eval exec openssl ca
\
848 [list -config "etc/openssl.conf"] \
849 [list -revoke "cert/by-seq/$cert"] \
854 ## Finally fiddle the request state.
858 revoke_reason
= $R(reason
),
859 revoke_detail
= $detail
864 ## Astonishingly all of that actually worked.
865 file rename -force "state/db.revoke" "state/db"
868 ## Delete the active links we made a note of earlier.
869 foreach f
$del { file delete
-force $f }
872 ###--------------------------------------------------------------------------
873 ### Managing certificates.
875 proc issue-cert
{id now
} {
876 ## Issue a certificate for the request with the given ID. This doesn't
877 ## bother to find out whethere it's a good idea.
885 ## Find a temporary file name for the output certificate.
886 fresh-temp
"$CERTROOT/tmp" tmp
{
887 set f
[open $tmp {WRONLY CREAT EXCL
}]
889 cleanup
{ file delete
$tmp }
892 ## Find stuff out about the request.
894 SELECT p.start_skew
, p.expire_interval
, p.issue_time
, p.extensions
,
896 FROM request AS r JOIN
897 profile AS p ON r.profile
= p.
label
899 }] start_skew expire_interval issue_time extensions tag cert_dn
901 ## Sign the certificate.
902 set starttime
[expr {$now - 3600*$start_skew}]
903 set endtime
[expr {$now + 3600*$expire_interval}]
904 cleanup
{ catch { eval file delete
[glob "$CERTROOT/tmp/*.pem"] } }
905 exec openssl ca
-batch \
906 -config "$CERTROOT/etc/openssl.conf" \
907 -outdir "$CERTROOT/tmp" \
908 -extensions $extensions \
909 -startdate [time-asn1
$starttime] \
910 -enddate [time-asn1
$endtime] \
911 -in "$CERTROOT/req/by-id/$id" -out $tmp \
914 ## Update the request's cert_dn field. If it's null, this is the first
915 ## certificate issued for the request, and we should fill the field in;
916 ## otherwise we should compare the actual DN to the expected one and
917 ## fail if it's wrong.
918 set dn
[cert-dn
$tmp]
919 if {[string equal
$cert_dn nil
]} {
920 db
eval { UPDATE request SET cert_dn
= $dn WHERE id
= $id; }
921 } elseif
{![string equal
$cert_dn $dn]} {
923 "DN mismatch: request $id (`$tag') has $cert_dn; "
924 "new cert has $dn"} ""]
927 ## Stash a new record in the database.
928 set expire
[time-db
$endtime]
929 set next_issue
[time-db
[next-matching-date
$issue_time $now]]
930 set now_db
[time-db
$now]
931 set seq
[cert-seq
$tmp]
934 SET st
= CASE WHEN t_expire
>= $now_db THEN 'superceded'
937 WHERE req
= $id AND st
= 'active'
;
939 INSERT INTO certificate
(seq
, req
, st
, t_expire
)
940 VALUES
($seq, $id, 'active'
, $expire);
942 UPDATE request SET t_reissue
= $next_issue
946 ## Put the file in the right place.
947 file link
-hard "$CERTROOT/cert/by-seq/$seq" $tmp
948 exec ln
-sf "../by-seq/$seq" "$CERTROOT/cert/active/$tag"
953 proc expire-certs
{now
} {
954 ## Mark certificates as having expired.
957 set now_db
[time-db
$now]
959 ## If we're unlucky, some active certificates may have expired while we
960 ## weren't looking. We'll demote these soon, but we must clear away the
962 foreach tag
[db
eval {
964 FROM request AS r JOIN certificate as c ON r.id
= c.req
965 WHERE c.st
= 'active' AND c.t_expire
< $now_db;
967 file delete
"$CERTROOT/cert/active/$tag"
970 ## Now demote the states of expired certificates. All certificates expire,
971 ## including revoked ones.
975 WHERE st
!= 'expired' AND t_expire
< $now_db;
979 ###----- That's all, folks --------------------------------------------------