From 595dbd34bb0b5f0a7adc9912d39198cf407974f4 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Fri, 25 Feb 2022 15:50:49 -0600
Subject: added start-from-config function and salt-from-file functions

---
 src/main.lisp    | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/package.lisp |  3 ++-
 2 files changed, 50 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/main.lisp b/src/main.lisp
index 26df348..2ddb845 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -182,6 +182,9 @@
 (defvar *instance-salt* "change me"
   "This is salt used for password hashing and login recovery")
 
+(defparameter +default-config-file+
+  #+linux "/etc/oneliners/oneliners-conf.lisp")
+
 (defparameter +data-store-directory-name+
   "oneliners-api-datastore")
 
@@ -213,6 +216,46 @@
   (lzb:set-canned-response *server* 404 "Not Found" "text/plain")
   (lzb:set-canned-response *server* 500 "Server Error" "text/plain"))
 
+(defvar *swank-thread* nil)
+
+(defun salt-from-file (path)
+  "Get server salt from a file, making one if not already extant. It
+is recommended to keep this file somewhere other than the host where
+you are running this instance.. You will need it to allow people to
+obtain new tokens or to change their passwords for their contributor
+accounts. So keep it secret, keep it safe."
+  (unless (uiop:file-exists-p path)
+    (a:write-string-into-file
+         (uuid)
+         path))
+  (a:read-file-into-string file))
+
+(defun start-from-config (&optional (config-file +default-config-file+))
+  (assert (uiop:file-exists-p config-file))
+  (let ((config 
+          (with-open-file (input config-file)
+            (read input))))
+    (with-plist
+        (port address salt-file domain store-dir admins swank-port) config
+        ;; start the server with options in the config.
+        (apply 'start
+               (nconc  
+                (when port (list :port port))
+                (when salt-file
+                  (list :salt (salt-from-file salt-file)))
+                (when address (list :address address))
+                (when domain (list :domain domain))
+                (when store-dir (list :store-dir store-dir))))
+        ;; make any admins listed.
+        (when admins
+          (loop for (name pass) in admins
+                unless (contributor-by-handle name)
+                  do (make-new-admin-user name pass)))
+        (when swank-port
+          (setf *swank-thread*
+                (bt:make-thread
+                 (lambda () (swank:create-server :port swank-port :dont-close t))))))))
+
 (defun start
     (&key
        (port 8888)
@@ -315,6 +358,11 @@
     ;; finally, delete the invite.
     (db:delete-object invite)))
 
+(defun make-new-admin-user (handle password)
+  (db:with-transaction ()
+    (with-slots (salt hashed-pw adminp) (make-instance 'contributor :handle handle)
+      (setf hashed-pw (pw-hash password salt)
+            adminp t))))
 
 (defun make-api-access (contributor)
   (db:with-transaction ()
diff --git a/src/package.lisp b/src/package.lisp
index 9575d3e..62a31ad 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -6,4 +6,5 @@
                     (#:json #:jonathan))
   (:import-from #:lazybones
                 #:defendpoint*
-                #:http-err))
+                #:http-err)
+  (:export #:start-from-config))
-- 
cgit v1.2.3