bytes to string conversion

.gitignore

@@ -17,3 +17,7 @@ compiled/
 
 /*.bak
 /private/*.bak
+/scribblings/*.css
+/scribblings/*.js
+/scribblings/*.bak
+/scribblings/*.html

private/self-signed-cert.rkt

@@ -16,6 +16,7 @@
          private-key
          certificate
          x509-cert
+         self-signed-cert-save
          )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -140,6 +141,8 @@
 (define EVP_PKEY_RSA NID_rsaEncryption)
 (define V_ASN1_OCTET_STRING   4)
 (define NID_subject_alt_name   85)
+(define NID_netscape_comment   78)
+(define X509_VERSION_3 2)  ;; See OpenSSL documentation
 
 (define _string/utf-8-pointer (_ptr o _string/utf-8))
 
@@ -166,9 +169,11 @@
   (RSA_generate_key (_fun _int _int _gen_rsa_cb _pointer -> _RSA-pointer))
   (EVP_PKEY_assign (_fun _EVP_PKEY-pointer _int _RSA-pointer -> _int))
   (EVP_sha1 (_fun -> _EVP_MD-pointer))
+  (EVP_sha256 (_fun -> _EVP_MD-pointer))
   
   (X509_new (_fun -> _X509-pointer))
   (X509_free (_fun _X509-pointer -> _void))
+  (X509_set_version (_fun _X509-pointer _int -> _int))
   (X509_get_serialNumber (_fun _X509-pointer -> _ASN1_INTEGER-pointer))
   (X509_get0_notBefore (_fun _X509-pointer -> _ASN1_TIME-pointer))
   (X509_get0_notAfter (_fun _X509-pointer -> _ASN1_TIME-pointer))
@@ -178,6 +183,7 @@
   (X509_NAME_add_entry_by_txt (_fun _X509_NAME-pointer _string/utf-8 _int _string/utf-8 _int _int _int -> _int))
   (X509_set_issuer_name (_fun _X509-pointer _X509_NAME-pointer -> _int))
   (X509_sign (_fun _X509-pointer _EVP_PKEY-pointer _EVP_MD-pointer -> _int))
+  (X509V3_EXT_conf_nid (_fun _pointer _pointer _int _string/utf-8 -> _X509_EXTENSION-pointer))
   (X509_EXTENSION_create_by_NID (_fun _pointer ; could also be, (ep : (_ptr o _X509_EXTENSION-pointer)), but works fine when #f is provided
                                       _int _int _ASN1_STRING-pointer -> (p : _X509_EXTENSION-pointer)
                                       -> p))
@@ -206,7 +212,11 @@
 (version-define 1
    (BIO_get_mem_data (λ (bio-ptr)
                        (let ((r (BIO_ctrl bio-ptr BIO_CTRL_INFO 0)))
-                         (cadr r))))
+                         (let ((r* (subbytes (cadr r) 0 (car r))))
+                           ;(write r*)(newline)
+                           (let ((r** (bytes->string/utf-8 r*)))
+                             ;(write r**)(newline)
+                             r**)))))
    (ASN1_OCTET_STRING_new (λ ()
                             (ASN1_STRING_type_new V_ASN1_OCTET_STRING)))
    )
@@ -219,6 +229,8 @@
 ;; Provided function
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define gen-san #t)
+
 (version-define 1
    (generate-key
     (λ (bits)
@@ -234,11 +246,12 @@
           pkey))))
 
    (generate-x509
-    (λ (pkey duration-in-days country company hosts)
+    (λ (pkey duration-in-days country company hosts ou)
       (let ((x509 (X509_new)))
         (when (eq? x509 #f)
             (error "Unable to create X509 structure"))
 
+        (X509_set_version x509 X509_VERSION_3)
         (ASN1_INTEGER_set (X509_get_serialNumber x509) 1)
         (X509_gmtime_adj (X509_get0_notBefore x509) 0)
         (X509_gmtime_adj (X509_get0_notAfter x509) (* duration-in-days 24 3600))
@@ -252,46 +265,38 @@
                                       "O" MBSTRING_UTF8 company -1 -1 0)
           (X509_NAME_add_entry_by_txt x509-name
                                       "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)
 
+          (when gen-san
             (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"))
+              (let ((ex (X509V3_EXT_conf_nid #f #f NID_subject_alt_name alt-name)))
+                (X509_add_ext x509 ex -1)
+                (X509_EXTENSION_free ex))
 
-            (ASN1_OCTET_STRING_set subj-alt-name-asn1
-                                   alt-name (string-length alt-name))
+              (let ((ex (X509V3_EXT_conf_nid #f #f NID_netscape_comment "Created by Racket Self Signed Certificate module, see https://pkgd.racket-lang.org/pkgn/package/racket-self-signed-cert")))
+                (X509_add_ext x509 ex -1)
+                (X509_EXTENSION_free ex))
 
-            (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)
+        (when (= (X509_sign x509 pkey (EVP_sha256)) 0)
           (X509_free x509)
           (error "Error signing certificate"))
 
         x509)))
           
    (generate-self-signed-cert*
-    (λ (bits duration-in-days hosts country company)
+    (λ (bits duration-in-days hosts country company ou)
       (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)
              (x509-data #f)
              )
@@ -317,20 +322,35 @@
         (EVP_PKEY_free pkey)
         (X509_free x509)
 
-        (make-self-signed-cert (bytes->string/utf-8 pkey-data)
-                               (bytes->string/utf-8 x509-data))
+        (make-self-signed-cert pkey-data x509-data)
         )
       )
     )
    )
 
-(c:define/contract (generate-self-signed-cert bits duration-in-days hosts country company)
-  (c:-> integer? integer? (c:or/c is-ip? is-dns? list-of-hosts?) string? string?
+(c:define/contract (generate-self-signed-cert bits duration-in-days
+                                              hosts
+                                              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)
       (error "No openssl FFI glue code available")
       (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)
         )
       )
   )
+
+
+
+(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))
+                   

scribblings/self-signed-cert.scrbl

@@ -121,7 +121,8 @@ term “X.509 certificate”.
           [duration-in-days integer?]
           [hosts (or/c  is-ip? is-dns? list-of-hosts?)]
           [country string?]
-          [company string?])
+          [company string?]
+          [#:ou ou (or/c string? #f)])
          self-signed-cert?]{
 
 Generates a new self-signed RSA certificate and private key.
@@ -132,28 +133,18 @@ Racket's @racketmodname[openssl] library.
 @subsection{Arguments}
 
 @itemlist[
-@item{@racket[bits] — size of the RSA key in bits (for example
-@racket[2048] or @racket[4096]).}
-
-@item{@racket[duration-in-days] — number of days for which the
-certificate remains valid.}
-
-@item{@racket[hosts] — a host name, IP address, or a list of such
-values. These values are written into the certificate's
+@item{@racket[bits] — size of the RSA key in bits (for example @racket[2048] or @racket[4096]).}
+@item{@racket[duration-in-days] — number of days for which the certificate remains valid.}
+@item{@racket[hosts] — a host name, IP address, or a list of such values. These values are written into the certificate's
 @italic{Subject Alternative Name} extension.}
-
-@item{@racket[country] — value for the certificate subject's
-@tt{C} (country) attribute.}
-
-@item{@racket[company] — value for the certificate subject's
-@tt{O} (organization) attribute.}
+@item{@racket[country] — value for the certificate subject's @tt{C} (country) attribute.}
+@item{@racket[company] — value for the certificate subject's @tt{O} (organization) attribute.}
+@item{@racket[ou] - value for the certificate subject's @tt{OU} (organization unit) attribute.}
 ]
 
 The first host in the list is used as the certificate's
 Common Name (CN).
 
-@subsection{Result}
-
 Returns a @racket[self-signed-cert] structure containing:
 
 @itemlist[
@@ -161,7 +152,24 @@ Returns a @racket[self-signed-cert] structure containing:
 @item{the corresponding self-signed X.509 certificate}
 ]
 
-Both values are returned as PEM encoded strings.
+Both values are returned as PEM encoded byte-arrays.
+}
+
+@section{Store Certificates}
+
+@defproc[(self-signed-cert-save
+          [ssc self-signed-cert?]
+          [cert-file (or/c string? path?)]
+          [privkey-file (or/c string/ path?)])
+          boolean?]{
+Saves the certificate and private key of the self signed certificate to
+files with the given filenames. The contents of the files will be replaced
+if they already exist.
+
+
+Returns @tt{#t} if succesful. If the filenames cannot be written,
+an exception will be raised.
+}
                    
 @subsection{Example}
 
@@ -173,7 +181,7 @@ Both values are returned as PEM encoded strings.
     365
     '("localhost" "127.0.0.1" "*.local.lan")
     "NL"
-    "Example Company"))
+    "Example Company" #:ou "Example Department"))
 
 (private-key cert)
 (certificate cert)