fix ca and package commands and some bugz

src/std/actor-v18/admin.ss

@@ -7,27 +7,27 @@
         :std/misc/ports
         ./path
         ./server-identifier)
-(export default-admin-pubkey-path
-        default-admin-privkey-path
+(export ensemble-admin-pubkey-path
+        ensemble-admin-privkey-path
         get-admin-pubkey
         get-admin-privkey
         generate-admin-keypair!
         admin-auth-challenge-sign
         admin-auth-challenge-verify)
 
-(def (default-admin-pubkey-path)
+(def (ensemble-admin-pubkey-path)
   (path-expand "admin.pub" (ensemble-base-path)))
 
-(def (default-admin-privkey-path)
+(def (ensemble-admin-privkey-path)
   (path-expand "admin.priv" (ensemble-base-path)))
 
-(def (get-admin-pubkey (path (default-admin-pubkey-path)))
+(def (get-admin-pubkey (path (ensemble-admin-pubkey-path)))
   (let (path (path-expand path))
     (if (file-exists? path)
       (bytes->public-key EVP_PKEY_ED25519 (read-file-u8vector path))
       #f)))
 
-(def (get-admin-privkey passphrase (path (default-admin-privkey-path)))
+(def (get-admin-privkey passphrase (path (ensemble-admin-privkey-path)))
   (let (path (path-expand path))
     (if (file-exists? path)
       (let* ((blob (read-file-u8vector path))
@@ -49,8 +49,8 @@
       #f)))
 
 (def (generate-admin-keypair! passphrase
-                              (pubk-path  (default-admin-pubkey-path))
-                              (privk-path (default-admin-privkey-path))
+                              (pubk-path  (ensemble-admin-pubkey-path))
+                              (privk-path (ensemble-admin-privkey-path))
                               force: (force? #f))
   (let ((pubk-path (path-expand pubk-path))
         (privk-path (path-expand privk-path)))

src/std/actor-v18/cookie.ss

@@ -7,20 +7,17 @@
         ./path)
 (export #t)
 
-(def (default-cookie-path)
-  (ensemble-cookie-path))
-
 (def (ensemble-cookie-path (base (ensemble-base-path)))
   (path-expand "cookie" base))
 
-(def (get-actor-server-cookie (path (default-cookie-path)))
+(def (get-actor-server-cookie (path (ensemble-cookie-path)))
   (let (path (path-expand path))
     (if (file-exists? path)
       (read-file-u8vector path)
       (error "cookie file doesn't exist" path))))
 
-(def (generate-actor-server-cookie! (path (default-cookie-path))
-                                    force: (force? #f))
+(def (generate-ensemble-cookie! (path (ensemble-cookie-path))
+                                force: (force? #f))
   (let (path (path-expand path))
     (if (file-exists? path)
       (if force?

src/std/actor-v18/ensemble-supervisor.ss

@@ -25,6 +25,8 @@
 ;;; cfg: <ensemble-config>
 (def (become-ensemble-supervisor! cfg (thunk void))
   (check-ensemble-config! cfg)
+  (unless (file-exists? (ensemble-cookie-path))
+    (generate-ensemble-cookie!))
   (let* ((root (config-get cfg root:))
          (root (and root (path-normalize root)))
          (root/log (and root (path-expand "log" root))))
@@ -68,8 +70,8 @@
                domain: domain
                identifier: supervisor-id
                registry: registry-id
-               cookie: (default-cookie-path)
-               admin:  (default-admin-pubkey-path)
+               cookie: (ensemble-cookie-path)
+               admin:  (ensemble-admin-pubkey-path)
                role: 'supervisor
                exe: "gerbil"
                args: '("ensemble" "supervisor")

src/std/actor-v18/server-identifier.ss

@@ -33,6 +33,16 @@
    (else
     (raise-bad-argument server-identifier "symbol or pair of symbols" id))))
 
+(def (server-identifier-id server-id)
+  (if (symbol? server-id)
+    server-id
+    (car server-id)))
+
+(def (server-identifier-domain server-id)
+  (if (pair? server-id)
+    (cdr server-id)
+    (ensemble-domain)))
+
 (def (server-identifier-at-domain server-id global-domain)
   (cond
    ((symbol? server-id)

src/std/actor-v18/supervisor.ss

@@ -86,8 +86,8 @@
                  domain: (cdr server-id)
                  identifier: server-id
                  supervisor: (actor-server-identifier)
-                 cookie: (default-cookie-path)
-                 admin:  (default-admin-pubkey-path)
+                 cookie: (ensemble-cookie-path)
+                 admin:  (ensemble-admin-pubkey-path)
                  ;; execution
                  role: 'registry
                  ;; logging
@@ -114,8 +114,8 @@
                    identifier: server-id
                    supervisor: self
                    registry: (registry-server-id)
-                   cookie: (default-cookie-path)
-                   admin:  (default-admin-pubkey-path)
+                   cookie: (ensemble-cookie-path)
+                   admin:  (ensemble-admin-pubkey-path)
                    policy: 'restart
                    ;; logging
                    log-level: 'INFO

src/std/actor-v18/tls.ss

@@ -8,7 +8,8 @@
         :std/misc/template
         :std/misc/process
         :std/misc/ports
-        ./path)
+        ./path
+        ./server-identifier)
 (export ensemble-tls-base-path
         ensemble-tls-server-path
         ensemble-tls-cafile
@@ -278,87 +279,90 @@
                                country-name: (country-name "UN")
                                organization-name: (organization-name "Mighty Gerbils")
                                location: (location "Internet"))
-
-  (let* ((base-path (ensemble-tls-base-path))
-         (root-ca-path (path-expand "root-ca" base-path))
-         (sub-ca-path  (path-expand "sub-ca" base-path))
-         (sub-ca.conf  (path-expand "sub-ca.conf" sub-ca-path))
-         (server-path  (parameterize ((ensemble-domain ~ensemble-domain))
-                         (ensemble-tls-server-path server-id)))
-         (server.conf  (path-expand "server.conf" server-path))
-         (server.key   (path-expand "server.key" server-path))
-         (server.csr   (path-expand "server.csr" server-path))
-         (server.crt   (path-expand "server.crt" server-path))
-         (chain.pem    (path-expand "chain.pem" server-path)))
-
-    ;; sanity check: must have a sub-ca
-    (unless (file-exists? sub-ca-path)
-      (error "sub-ca does not exist" sub-ca-path))
-
-    (unless (file-exists? server-path)
-      (create-directory* server-path))
-
-    ;; server.conf
-    (displayln "... generate " server.conf)
-    (call-with-output-file server.conf
-      (cut write-template server.conf-template <>
-           server:
-           (string-append "URI.0 = srv:" (symbol->string server-id) "\n")
-           ensemble-domain:
-           (string-append "URI.1 = dom:" (symbol->string ~ensemble-domain) "\n")
-           capabilities:
-           (string-join
-            (map (lambda (i x)
-                   (string-append "URI." (number->string i) " = cap:" x))
-                 (iota (length capabilities) 2)
-                 (map symbol->string capabilities))
-            "\n")
-           server-host: (actor-tls-host server-id ~ensemble-domain tls-domain)
-           country-name: country-name
-           organization-name: organization-name
-           location: location))
-
-    ;; server.key
-    (unless (file-exists? server.key)
-      (displayln "... generate " server.key)
+  (parameterize ((ensemble-domain ~ensemble-domain))
+    (let* ((base-path (ensemble-tls-base-path))
+           (root-ca-path (path-expand "root-ca" base-path))
+           (sub-ca-path  (path-expand "sub-ca" base-path))
+           (sub-ca.conf  (path-expand "sub-ca.conf" sub-ca-path))
+           (server-path  (ensemble-tls-server-path server-id))
+           (server.conf  (path-expand "server.conf" server-path))
+           (server.key   (path-expand "server.key" server-path))
+           (server.csr   (path-expand "server.csr" server-path))
+           (server.crt   (path-expand "server.crt" server-path))
+           (chain.pem    (path-expand "chain.pem" server-path)))
+
+      ;; sanity check: must have a sub-ca
+      (unless (file-exists? sub-ca-path)
+        (error "sub-ca does not exist" sub-ca-path))
+
+      (unless (file-exists? server-path)
+        (create-directory* server-path))
+
+      ;; server.conf
+      (displayln "... generate " server.conf)
+      (call-with-output-file server.conf
+        (cut write-template server.conf-template <>
+             server:
+             (string-append "URI.0 = srv:"
+                            (symbol->string (server-identifier-id server-id))
+                            "\n")
+             ensemble-domain:
+             (string-append "URI.1 = dom:"
+                            (symbol->string (server-identifier-domain server-id))
+                            "\n")
+             capabilities:
+             (string-join
+              (map (lambda (i x)
+                     (string-append "URI." (number->string i) " = cap:" x))
+                   (iota (length capabilities) 2)
+                   (map symbol->string capabilities))
+              "\n")
+             server-host: (actor-tls-host server-id ~ensemble-domain tls-domain)
+             country-name: country-name
+             organization-name: organization-name
+             location: location))
+
+      ;; server.key
+      (unless (file-exists? server.key)
+        (displayln "... generate " server.key)
+        (invoke "openssl"
+                ["genpkey"
+                 "-quiet"
+                 "-algorithm" "RSA"
+                 "-pkeyopt" "rsa_keygen_bits:4096"
+                 "-out" server.key]))
+
+      ;; server.csr
+      (when (file-exists? server.csr)
+        (rename-file server.csr
+                     (string-append server.csr ".bak." (number->string (current-time-seconds)))))
+      (displayln "... generate " server.csr)
       (invoke "openssl"
-              ["genpkey"
-               "-quiet"
-               "-algorithm" "RSA"
-               "-pkeyopt" "rsa_keygen_bits:4096"
-               "-out" server.key]))
-
-    ;; server.csr
-    (when (file-exists? server.csr)
-      (rename-file server.csr
-                   (string-append server.csr ".bak." (number->string (current-time-seconds)))))
-    (displayln "... generate " server.csr)
-    (invoke "openssl"
-            ["req" "-new"
-             "-config" server.conf
-             "-key" server.key
-             "-out" server.csr])
-
-    ;; server.cert
-    (when (file-exists? server.crt)
-      (rename-file server.crt
-                   (string-append server.crt ".bak." (number->string (current-time-seconds)))))
-    (displayln "... generate " server.crt)
-    (invoke "openssl"
-            ["ca" "-batch" "-notext"
-             "-config" sub-ca.conf
-             "-in" server.csr
-             "-out" server.crt
-             "-extensions" "actor_ext"
-             ;; TODO see above
-             "-passin" (string-append "pass:" sub-ca-passphrase)])
-
-    (displayln "... generate " chain.pem)
-    (call-with-output-file chain.pem
-      (lambda(output)
-        (for (f [server.crt (ensemble-tls-cafile)])
-          (let (blob (read-file-u8vector f))
-            (write-subu8vector blob 0 (u8vector-length blob) output)))))))
+              ["req" "-new"
+               "-config" server.conf
+               "-key" server.key
+               "-out" server.csr])
+
+      ;; server.cert
+      (when (file-exists? server.crt)
+        (rename-file server.crt
+                     (string-append server.crt ".bak." (number->string (current-time-seconds)))))
+      (displayln "... generate " server.crt)
+      (invoke "openssl"
+              ["ca" "-batch" "-notext"
+               "-config" sub-ca.conf
+               "-in" server.csr
+               "-out" server.crt
+               "-extensions" "actor_ext"
+               ;; TODO see above
+               "-passin" (string-append "pass:" sub-ca-passphrase)])
+
+      (displayln "... generate " chain.pem)
+      (call-with-output-file chain.pem
+        (lambda(output)
+          (for (f [server.crt (ensemble-tls-cafile)])
+            (let (blob (read-file-u8vector f))
+              (write-subu8vector blob 0 (u8vector-length blob) output))))))))
 
 (def root-ca.conf-template #<<END
 [default]

src/tools/gxensemble/admin.ss

@@ -12,11 +12,11 @@
   (if (hash-get opt 'view)
     (let (cookie (get-actor-server-cookie))
       (displayln (hex-encode cookie)))
-    (generate-actor-server-cookie! force: (hash-get opt 'force))))
+    (generate-ensemble-cookie! force: (hash-get opt 'force))))
 
 (def (do-admin-creds opt)
   (if (hash-get opt 'view)
-    (let* ((pubk-path (default-admin-pubkey-path))
+    (let* ((pubk-path (ensemble-admin-pubkey-path))
            (pubk-raw (read-file-u8vector pubk-path)))
       (displayln (hex-encode pubk-raw)))
     (let* ((passphrase (read-password prompt: "Enter passphrase: "))

src/tools/gxensemble/misc.ss

@@ -18,32 +18,45 @@
   (stop-actor-server!))
 
 (def (do-package opt)
-  (let* ((server-id (hash-ref opt 'server-id))
-         (output    (hash-ref opt 'output))
-         (output    (path-expand output (current-directory)))
-         (ensemble-base "ensemble/")
-         (ensemble-rebase
-          (lambda files
-            (map (cut string-append ensemble-base <>) files)))
-         (server-base
-          (string-append ensemble-base
-                         "server/"
-                         (symbol->string server-id) "/"))
-         (server-rebase
-          (lambda files
-            (map (cut string-append server-base <>) files))))
-
-    (current-directory (gerbil-path))
-    (invoke "tar"
-            ["cavf" output
-             (ensemble-rebase
-              "cookie"
-              "admin.pub"
-              "tls/ca-certificates"
-              "tls/ca.pem"
-              "tls/caroot.pem"
-              "tls/domain") ...
-              (server-rebase "tls/chain.pem" "tls/server.key") ...])))
+  (parameterize ((ensemble-domain (or (hash-get opt 'ensemble-domain) (ensemble-domain))))
+    (let* ((server-id   (hash-ref opt 'server-id))
+           (output      (hash-ref opt 'output))
+           (output      (path-expand output (path-normalize (current-directory))))
+           (base-path   (ensemble-base-path))
+           (server-path (ensemble-server-path server-id))
+           (rebase-path
+            (lambda (path)
+              (if (string-prefix? base-path path)
+                (path-expand (substring path (1+ (string-length base-path)) (string-length path))
+                  "ensemble")
+                (error "unexpected path: not a base subpath" base-path path))))
+           (ensemble-rebase
+            (lambda files
+              (filter-map
+               (lambda (file)
+                 (and (file-exists? file)
+                      (rebase-path file)))
+               files)))
+           (ensemble-file
+            (lambda (file)
+              (path-expand file base-path)))
+           (server-file
+            (lambda (file)
+              (path-expand file server-path))))
+      (current-directory (gerbil-path))
+      (invoke "tar"
+              ["cavf" output
+               (ensemble-rebase
+                (ensemble-file "cookie")
+                (ensemble-file "admin.pub")
+                (ensemble-file "tls/ca-certificates")
+                (ensemble-file "tls/ca.pem")
+                (ensemble-file "tls/caroot.pem")
+                (ensemble-file "tls/domain")
+                (server-file "tls/chain.pem")
+                (server-file "tls/server.key"))
+               ...]
+              directory: (gerbil-path)))))
 
 (def (do-shutdown opt)
   (start-actor-server-with-options! opt)