certs: add a vocabulary to generate ssl certs for testing

diff --git a/extra/certs/authors.txt b/extra/certs/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/certs/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/certs/certs.factor b/extra/certs/certs.factor
new file mode 100644 (file)
index 0000000..132babb
--- /dev/null
+++ b/extra/certs/certs.factor
@@ -0,0 +1,34 @@
+! Copyright (C) 2023 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: assocs io.directories io.encodings.utf8 io.files
+io.files.unique io.launcher kernel qw ;
+IN: certs
+
+: generate-rsa-2048-key ( -- )
+    qw{ openssl genrsa 2048 -out server.key } try-process ;
+
+: generate-rsa-2048-csr ( -- )
+    qw{ openssl req -subj /C=GB/ -new -key server.key -out server.csr } try-process ;
+
+: generate-rsa-2048-crt ( -- )
+    qw{ openssl x509 -req -days 36500 -in server.csr -signkey server.key -out server.crt } try-process ;
+
+: generate-ssl-certs ( -- assoc )
+    [
+        generate-rsa-2048-key
+        generate-rsa-2048-csr
+        generate-rsa-2048-crt
+        "." directory-files [ utf8 file-contents ] zip-with
+    ] cleanup-unique-directory ;
+
+: certs>directory ( assoc path -- )
+    dup make-directories [
+        [
+            swap utf8 set-file-contents
+        ] assoc-each
+    ] with-directory ;
+
+: directory>certs ( path -- assoc )
+    [
+        "." directory-files [ utf8 file-contents ] zip-with
+    ] with-directory ;
\ No newline at end of file