hans/racket-self-signed-cert
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Somehow SAN does not work...

Browse Source
This commit is contained in:
Hans Dijkema
2026-03-07 23:52:08 +01:00
parent 434c21fbbe
commit 3ded80496f
1 changed files with 42 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
private/self-signed-cert.rkt
View File

@@ -16,6 +16,7 @@
private-key private-key
certificate certificate
x509-cert x509-cert
self-signed-cert-save
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -26,11 +27,11 @@
(private-key certificate)) (private-key certificate))
(c:define/contract (private-key ssc) (c:define/contract (private-key ssc)
(c:-> self-signed-cert? string?) (c:-> self-signed-cert? bytes?)
(self-signed-cert-private-key ssc)) (self-signed-cert-private-key ssc))
(c:define/contract (certificate ssc) (c:define/contract (certificate ssc)
(c:-> self-signed-cert? string?) (c:-> self-signed-cert? bytes?)
(self-signed-cert-certificate ssc)) (self-signed-cert-certificate ssc))
(define x509-cert certificate) (define x509-cert certificate)
@@ -254,32 +255,32 @@
"CN" MBSTRING_UTF8 first-host -1 -1 0) "CN" MBSTRING_UTF8 first-host -1 -1 0)
(X509_set_issuer_name x509 x509-name) (X509_set_issuer_name x509 x509-name)
(let* ((alt-name (string-join ;(let* ((alt-name (string-join
(map make-alt-entry hosts) ", ")) ; (map make-alt-entry hosts) ", "))
(ext-san #f) ; (ext-san #f)
(subj-alt-name-asn1 #f) ; (subj-alt-name-asn1 #f)
) ; )
;
(set! subj-alt-name-asn1 (ASN1_OCTET_STRING_new)) ; (set! subj-alt-name-asn1 (ASN1_OCTET_STRING_new))
(when (eq? subj-alt-name-asn1 #f) ; (when (eq? subj-alt-name-asn1 #f)
(error "Cannot allocate Subject Alt Name ASN1 string")) ; (error "Cannot allocate Subject Alt Name ASN1 string"))
;
(ASN1_OCTET_STRING_set subj-alt-name-asn1 ; (ASN1_OCTET_STRING_set subj-alt-name-asn1
alt-name (string-length alt-name)) ; alt-name (string-length alt-name))
;
(let ((r (X509_EXTENSION_create_by_NID #f NID_subject_alt_name 0 subj-alt-name-asn1))) ; (let ((r (X509_EXTENSION_create_by_NID #f NID_subject_alt_name 0 subj-alt-name-asn1)))
(when (eq? r #f) ; (when (eq? r #f)
(error "Cannot allocate X509 Extenstion for Subject Alt Name")) ; (error "Cannot allocate X509 Extenstion for Subject Alt Name"))
;
(let* ((extension_san r) ; (let* ((extension_san r)
(re (X509_add_ext x509 extension_san -1))) ; (re (X509_add_ext x509 extension_san -1)))
(when (= re 0) ; (when (= re 0)
(error "Cannot add extension to X509")) ; (error "Cannot add extension to X509"))
;
(X509_EXTENSION_free extension_san))) ; (X509_EXTENSION_free extension_san)))
;
(ASN1_STRING_free subj-alt-name-asn1) ; (ASN1_STRING_free subj-alt-name-asn1)
) ; )
) )
(when (= (X509_sign x509 pkey (EVP_sha1)) 0) (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))