Somehow SAN does not work...
This commit is contained in:
@@ -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))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user