Allowing multiple instances to deploy at the same time.

This commit is contained in:
2026-04-20 15:13:00 -07:00
parent e42ece86fd
commit 7ed7846536

View File

@@ -697,8 +697,8 @@ h1, h2, h3, h4, h5, h6 {
;; (define (test-backblaze-connection key-id application-key bucket-url) ;; (define (test-backblaze-connection key-id application-key bucket-url)
;; ) ;; )
(define (deployment-directory user-id) (define (deployment-directory user-id instance-id)
(string-append "deploy-" (number->string user-id))) (string-append "deploy-" (number->string user-id) "-" (->string instance-id)))
(define (setup-deploy-files dir state state-backup) (define (setup-deploy-files dir state state-backup)
(when (directory-exists? dir) (when (directory-exists? dir)
@@ -1020,8 +1020,6 @@ chmod -R 777 /opt/keys"))
(alist-ref 'root-domain (current-params))))) (alist-ref 'root-domain (current-params)))))
(redirect (conc "/config/wizard/apps2/" instance-id)))) (redirect (conc "/config/wizard/apps2/" instance-id))))
;; TODO should this even allow changing existing username/passwords like for db?
;; wouldn't that break the db connection and you would lose data?
(get/widgets (get/widgets
("/config/wizard/apps2/:id") ("/config/wizard/apps2/:id")
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1293,7 +1291,7 @@ chmod -R 777 /opt/keys"))
(terraform-state (alist-ref 'terraform-state results)) (terraform-state (alist-ref 'terraform-state results))
(ssh-pub-key (alist-ref 'ssh-pub-key results)) (ssh-pub-key (alist-ref 'ssh-pub-key results))
(restic-password (alist-ref 'restic-password results)) (restic-password (alist-ref 'restic-password results))
(dir (deployment-directory (session-user-id)))) (dir (deployment-directory (session-user-id) instance-id)))
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state)) (setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
(with-output-to-file (string-append dir "/config/apps.config") (with-output-to-file (string-append dir "/config/apps.config")
(lambda () (lambda ()
@@ -1359,7 +1357,7 @@ chmod -R 777 /opt/keys"))
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(user-id (session-user-id)) (user-id (session-user-id))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id)))) (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
(dir (deployment-directory user-id))) (dir (deployment-directory user-id instance-id)))
(thread-start! (thread-start!
(lambda () (lambda ()
(change-directory dir) (change-directory dir)
@@ -1372,7 +1370,7 @@ chmod -R 777 /opt/keys"))
(if (= pid 0) ;; process is still running (if (= pid 0) ;; process is still running
(begin (let ((progress (parse-deployment-log (begin (let ((progress (parse-deployment-log
(with-input-from-file (with-input-from-file
(string-append (deployment-directory user-id) "/make-out") (string-append (deployment-directory user-id instance-id) "/make-out")
read-string))) read-string)))
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string)) (tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))) (tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
@@ -1386,7 +1384,7 @@ chmod -R 777 /opt/keys"))
(loop)) (loop))
(let ((progress (parse-deployment-log (let ((progress (parse-deployment-log
(with-input-from-file (with-input-from-file
(string-append (deployment-directory user-id) "/make-out") (string-append (deployment-directory user-id instance-id) "/make-out")
read-string))) read-string)))
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string)) (tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))) (tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
@@ -1423,7 +1421,7 @@ chmod -R 777 /opt/keys"))
(lambda (db) (lambda (db)
`((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id)) `((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id))
(progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id)))))) (progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id))))))
(output (with-input-from-file (string-append (deployment-directory (session-user-id)) "/make-out") read-string)) (output (with-input-from-file (string-append (deployment-directory (session-user-id) instance-id) "/make-out") read-string))
(progress (alist-ref 'progress res)) (progress (alist-ref 'progress res))
(status (alist-ref 'status res))) (status (alist-ref 'status res)))
`(App `(App
@@ -1545,7 +1543,7 @@ chmod -R 777 /opt/keys"))
(terraform-state (alist-ref 'terraform-state results)) (terraform-state (alist-ref 'terraform-state results))
(ssh-pub-key (alist-ref 'ssh-pub-key results)) (ssh-pub-key (alist-ref 'ssh-pub-key results))
(restic-password (alist-ref 'restic-password results)) (restic-password (alist-ref 'restic-password results))
(dir (deployment-directory (session-user-id)))) (dir (deployment-directory (session-user-id) instance-id)))
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain)) (if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
(redirect (conc "/destroy/" instance-id)) (redirect (conc "/destroy/" instance-id))
(begin (begin
@@ -1617,7 +1615,7 @@ chmod -R 777 /opt/keys"))
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(user-id (session-user-id)) (user-id (session-user-id))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id)))) (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
(dir (deployment-directory user-id))) (dir (deployment-directory user-id instance-id)))
(thread-start! (thread-start!
(lambda () (lambda ()
(change-directory dir) (change-directory dir)
@@ -1630,7 +1628,7 @@ chmod -R 777 /opt/keys"))
(if (= pid 0) ;; process is still running (if (= pid 0) ;; process is still running
(begin (let ((progress (parse-deployment-log (begin (let ((progress (parse-deployment-log
(with-input-from-file (with-input-from-file
(string-append (deployment-directory user-id) "/make-out") (string-append (deployment-directory user-id instance-id) "/make-out")
read-string))) read-string)))
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string)) (tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))) (tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
@@ -1644,7 +1642,7 @@ chmod -R 777 /opt/keys"))
(loop)) (loop))
(let ((progress (parse-deployment-log (let ((progress (parse-deployment-log
(with-input-from-file (with-input-from-file
(string-append (deployment-directory user-id) "/make-out") (string-append (deployment-directory user-id instance-id) "/make-out")
read-string))) read-string)))
(tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string)) (tf-state (with-input-from-file (string-append dir "/terraform.tfstate") read-string))
(tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string))) (tf-state-backup (with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))
@@ -1683,7 +1681,7 @@ chmod -R 777 /opt/keys"))
(lambda (db) (lambda (db)
`((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id)) `((status . ,(get-most-recent-deployment-status db (session-user-id) instance-id))
(progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id)))))) (progress . ,(get-most-recent-deployment-progress db (session-user-id) instance-id))))))
(output (with-input-from-file (string-append (deployment-directory (session-user-id)) "/make-out") read-string)) (output (with-input-from-file (string-append (deployment-directory (session-user-id) instance-id) "/make-out") read-string))
(progress (alist-ref 'progress res)) (progress (alist-ref 'progress res))
(status (alist-ref 'status res))) (status (alist-ref 'status res)))
`(App `(App