add config file that controls server behavior

crossfire/server.rkt

@@ -30,13 +30,23 @@
 
 ;; configuration
 
-(define PRODUCTION? #f)
+(define *production?* #f)
+
+(define *config-root* (if *production?* "/etc/" "etc/"))
+(define *state-root* (if *production?* "/var/lib/crossfire/" "lib/"))
+(define *lib-root* (if *production?* "/usr/lib/" "lib/"))
+
+(define (get-binary-path-for-arch arch)
+  (build-path *lib-root* (string-append "arch_" arch) "crossfire-agent"))
+
+(define *server-config-path* (build-path *config-root* "crossfire.rktd"))
+(define *server-db-path* (build-path *state-root* "crossfire.sqlite"))
+(define *server-files-path* (build-path *state-root* "projects/"))
+(define *server-seckey-path* (build-path *state-root* "server.key"))
+
+(define (get-project-file-path projid)
+  (build-path *server-files-path* (number->string projid)))
 
-(define SERVER-DATA-DIR (if PRODUCTION? "/var/lib/crossfire/" "lib/"))
-(define SERVER-DB-PATH (build-path SERVER-DATA-DIR "crossfire.sqlite"))
-(define SERVER-FILES-PATH (build-path SERVER-DATA-DIR "projects/"))
-(define AGENT-ARCH-PREFIX "arch_")
-(define AGENT-BINARY "crossfire-agent")
 
 ;; comms node for server (without secret key)
 (define current-server-public-node (make-parameter #f))
@@ -49,7 +59,7 @@
 (define current-db (make-parameter #f))
 
 (define (open-server-db [mode 'read/write])
-  (let ([db (sqlite3-connect #:database SERVER-DB-PATH #:mode mode)])
+  (let ([db (sqlite3-connect #:database *server-db-path* #:mode mode)])
     (query-exec db "pragma foreign_keys=1;")
     db))
 
@@ -128,7 +138,7 @@
       (query-exec (current-db) q-delete-task id))
     (for ([(id committed) (in-query (current-db) q-get-task-id-commit)])
       (set-add! existing-ids (number->string id))
-      (define path (build-path SERVER-FILES-PATH (number->string id)))
+      (define path (get-project-file-path id))
       (define exists? (file-exists? path))
       (define committed? (= 1 committed))
       (cond
@@ -138,7 +148,7 @@
         [(not committed?) (cleanup id exists? path)]
         [else (void)]))))
   ;; delete any unaffiliated files
-  (for ([subpath (in-directory SERVER-FILES-PATH)])
+  (for ([subpath (in-directory *server-files-path*)])
     (define name (path->string (file-name-from-path subpath)))
     (unless (set-member? existing-ids name)
       (delete-file subpath)))
@@ -146,7 +156,7 @@
 
 ;; commits a file corresponding to the task
 (define (server-commit-file taskid data)
-  (define path (build-path SERVER-FILES-PATH (number->string taskid)))
+  (define path (get-project-file-path taskid))
   (call-with-output-file path
     (lambda (out)
       (write-bytes data out)
@@ -158,7 +168,7 @@
 ;; computes a hash of the file identifying its current contents for agents
 ;; (in case we reuse taskids)
 (define (server-hash-file taskid)
-  (define path (build-path SERVER-FILES-PATH (number->string taskid)))
+  (define path (get-project-file-path taskid))
   (define *read-size* 8192)
   (call-with-input-file path (lambda (in)
     (define ctx (crypto-blake2b-init))
@@ -170,7 +180,7 @@
     (crypto-blake2b-final ctx))))
 
 (define (server-get-file taskid)
-  (define path (build-path SERVER-FILES-PATH (number->string taskid)))
+  (define path (get-project-file-path taskid))
   (file->bytes path))
 
 
@@ -198,7 +208,7 @@
 (define (configure-agent-binary agent-node agent-arch server-node)
   (define binary
     (file->bytes
-      (build-path SERVER-DATA-DIR (string-append AGENT-ARCH-PREFIX agent-arch) AGENT-BINARY)))
+      (get-binary-path-for-arch agent-arch)))
 
   (define (configure.linux-gnu)
     (define trailing-data (s-exp->fasl (list agent-node server-node)))
@@ -694,17 +704,50 @@
 (module+ main
   (require racket/cmdline)
 
-  ;; TODO : read cmdline and config file
+  ;; TODO : read cmdline
+
+  (define server-config (call-with-input-file *server-config-path* read))
+  (unless (list? server-config)
+    (error "corrupted config file, expected a list of config entries"))
+  (define (config-get key pred)
+    (define (make-err-fmt actual)
+      (format "invalid config!\n expected: (~a <value satisfying ~a>)\n got: ~a" key
+              (if (contract? pred) (format "~v" pred) (object-name pred))
+              actual))
+    (match (assoc key server-config)
+      [#f (error (make-err-fmt "<nothing>"))]
+      [(list _ (? pred data)) data]
+      [x (error (make-err-fmt x))]))
 
   ;; initialize server
   (install-logging!)
   (log-server-info "initializing server")
   (current-db (open-server-db 'create))
   (migrate-server-db)
-  ;; temp key
+
-  (define seckey (crypto-sign-make-key))
+  ;; load or create secret key
+  (unless (file-exists? *server-seckey-path*)
+    (log-server-info "generating new secret key")
+    (call-with-output-file *server-seckey-path*
+      (lambda (out)
+        (write-bytes (crypto-sign-make-key) out)
+        (port-fsync out))))
+
+  (define seckey (file->bytes *server-seckey-path*))
   (define pubkey (crypto-sign-public-key seckey))
-  (define server (node 0 "server" 'server pubkey seckey "0.0.0.0" 1337))
+  (define server (node 0 (config-get 'name string?) 'server pubkey seckey
+                       (config-get 'listen-addr string?) (config-get 'listen-port integer?)))
+  (define public-addr
+    (match (config-get 'public-addr (or/c 'auto string?))
+      ['auto (error "TODO auto public-addr unimplemented")]
+      [addr addr]))
+  (define public-port
+    (match (config-get 'public-port (or/c 'auto integer?))
+      ['auto (node-port server)]
+      [port port]))
+  (current-server-public-node
+    (struct-copy node server [seckey #f] [host public-addr] [port public-port]))
+
   (current-comms (make-comms server))
   (current-tm (make-transaction-manager server (current-comms)))
   (current-agent-handler (make-agent-handler))

etc/crossfire.rktd

@@ -0,0 +1,10 @@
+(;; name of this server
+ (name "a crossfire server")
+ ;; the ip address and port to listen on
+ (listen-addr "0.0.0.0")
+ (listen-port 25446)
+ ;; the "public" ip (or domain name) and port of this node
+ ;; - auto for addr selects the first interface addr (linux only)
+ ;; - auto for port uses the same as listen-port
+ (public-addr "127.0.0.1")
+ (public-port auto))