This commit is contained in:
2026-03-08 01:41:01 +01:00
parent 7b1f044279
commit 0aa971e34d

View File

@@ -241,7 +241,7 @@
pkey)))) pkey))))
(generate-x509 (generate-x509
(λ (pkey duration-in-days country company hosts) (λ (pkey duration-in-days country company hosts ou)
(let ((x509 (X509_new))) (let ((x509 (X509_new)))
(when (eq? x509 #f) (when (eq? x509 #f)
(error "Unable to create X509 structure")) (error "Unable to create X509 structure"))
@@ -260,6 +260,9 @@
"O" MBSTRING_UTF8 company -1 -1 0) "O" MBSTRING_UTF8 company -1 -1 0)
(X509_NAME_add_entry_by_txt x509-name (X509_NAME_add_entry_by_txt x509-name
"CN" MBSTRING_UTF8 first-host -1 -1 0) "CN" MBSTRING_UTF8 first-host -1 -1 0)
(when (not (eq? ou #f))
(X509_NAME_add_entry_by_txt x509-name
"OU" MBSTRING_UTF8 ou -1 -1 0))
(X509_set_issuer_name x509 x509-name) (X509_set_issuer_name x509 x509-name)
(when gen-san (when gen-san
@@ -277,7 +280,7 @@
) )
) )
)
(when (= (X509_sign x509 pkey (EVP_sha1)) 0) (when (= (X509_sign x509 pkey (EVP_sha1)) 0)
(X509_free x509) (X509_free x509)
@@ -286,9 +289,9 @@
x509))) x509)))
(generate-self-signed-cert* (generate-self-signed-cert*
(λ (bits duration-in-days hosts country company) (λ (bits duration-in-days hosts country company ou)
(let* ((pkey (generate-key bits)) (let* ((pkey (generate-key bits))
(x509 (generate-x509 pkey duration-in-days country company hosts)) (x509 (generate-x509 pkey duration-in-days country company hosts ou))
(pkey-data #f) (pkey-data #f)
(x509-data #f) (x509-data #f)
) )
@@ -320,13 +323,16 @@
) )
) )
(c:define/contract (generate-self-signed-cert bits duration-in-days hosts country company) (c:define/contract (generate-self-signed-cert bits duration-in-days
(c:-> integer? integer? (c:or/c is-ip? is-dns? list-of-hosts?) string? string? hosts
self-signed-cert?) country company #:ou [ou #f])
(c:->* (integer? integer? (c:or/c is-ip? is-dns? list-of-hosts?) string? string?)
(#:ou string?)
self-signed-cert?)
(if (eq? generate-self-signed-cert* #f) (if (eq? generate-self-signed-cert* #f)
(error "No openssl FFI glue code available") (error "No openssl FFI glue code available")
(let ((h (if (list-of-hosts? hosts) hosts (list hosts)))) (let ((h (if (list-of-hosts? hosts) hosts (list hosts))))
(generate-self-signed-cert* bits duration-in-days h country company) (generate-self-signed-cert* bits duration-in-days h country company ou)
) )
) )
) )