Somehow SAN does not work...

This commit is contained in:
2026-03-07 23:52:08 +01:00
parent 434c21fbbe
commit 3ded80496f

View File

@@ -16,6 +16,7 @@
private-key
certificate
x509-cert
self-signed-cert-save
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -26,11 +27,11 @@
(private-key certificate))
(c:define/contract (private-key ssc)
(c:-> self-signed-cert? string?)
(c:-> self-signed-cert? bytes?)
(self-signed-cert-private-key ssc))
(c:define/contract (certificate ssc)
(c:-> self-signed-cert? string?)
(c:-> self-signed-cert? bytes?)
(self-signed-cert-certificate ssc))
(define x509-cert certificate)
@@ -254,32 +255,32 @@
"CN" MBSTRING_UTF8 first-host -1 -1 0)
(X509_set_issuer_name x509 x509-name)
(let* ((alt-name (string-join
(map make-alt-entry hosts) ", "))
(ext-san #f)
(subj-alt-name-asn1 #f)
)
(set! subj-alt-name-asn1 (ASN1_OCTET_STRING_new))
(when (eq? subj-alt-name-asn1 #f)
(error "Cannot allocate Subject Alt Name ASN1 string"))
(ASN1_OCTET_STRING_set subj-alt-name-asn1
alt-name (string-length alt-name))
(let ((r (X509_EXTENSION_create_by_NID #f NID_subject_alt_name 0 subj-alt-name-asn1)))
(when (eq? r #f)
(error "Cannot allocate X509 Extenstion for Subject Alt Name"))
(let* ((extension_san r)
(re (X509_add_ext x509 extension_san -1)))
(when (= re 0)
(error "Cannot add extension to X509"))
(X509_EXTENSION_free extension_san)))
(ASN1_STRING_free subj-alt-name-asn1)
)
;(let* ((alt-name (string-join
; (map make-alt-entry hosts) ", "))
; (ext-san #f)
; (subj-alt-name-asn1 #f)
; )
;
; (set! subj-alt-name-asn1 (ASN1_OCTET_STRING_new))
; (when (eq? subj-alt-name-asn1 #f)
; (error "Cannot allocate Subject Alt Name ASN1 string"))
;
; (ASN1_OCTET_STRING_set subj-alt-name-asn1
; alt-name (string-length alt-name))
;
; (let ((r (X509_EXTENSION_create_by_NID #f NID_subject_alt_name 0 subj-alt-name-asn1)))
; (when (eq? r #f)
; (error "Cannot allocate X509 Extenstion for Subject Alt Name"))
;
; (let* ((extension_san r)
; (re (X509_add_ext x509 extension_san -1)))
; (when (= re 0)
; (error "Cannot add extension to X509"))
;
; (X509_EXTENSION_free extension_san)))
;
; (ASN1_STRING_free subj-alt-name-asn1)
; )
)
(when (= (X509_sign x509 pkey (EVP_sha1)) 0)
@@ -340,3 +341,16 @@
)
)
)
(c:define/contract (self-signed-cert-save ssc cert-file privkey-file)
(c:-> self-signed-cert? path-string? path-string? boolean?)
(let ((f1 (open-output-file cert-file #:exists 'replace))
(f2 (open-output-file privkey-file #:exists 'replace)))
(display (format "~a" (certificate ssc)) f1)
(close-output-port f1)
(display (format "~a" (private-key ssc)) f2)
(close-output-port f2)
#t))