nassella/app
1
0
Fork 0
Code Issues 15 Pull Requests Packages Projects 1 Releases Wiki Activity

Allowing multiple instances to deploy at the same time.

Browse Source
This commit is contained in:
Thomas Hintz
2026-04-20 15:13:00 -07:00
parent e42ece86fd
commit 7ed7846536
1 changed files with 12 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src/nassella.scm
View File

@@ -697,8 +697,8 @@ h1, h2, h3, h4, h5, h6 {
;; (define (test-backblaze-connection key-id application-key bucket-url)
;; )
(define (deployment-directory user-id)
(string-append "deploy-" (number->string user-id)))
(define (deployment-directory user-id instance-id)
(string-append "deploy-" (number->string user-id) "-" (->string instance-id)))
(define (setup-deploy-files dir state state-backup)
(when (directory-exists? dir)
@@ -1020,8 +1020,6 @@ chmod -R 777 /opt/keys"))
(alist-ref 'root-domain (current-params)))))
(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
("/config/wizard/apps2/:id")
(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))
(ssh-pub-key (alist-ref 'ssh-pub-key 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))
(with-output-to-file (string-append dir "/config/apps.config")
(lambda ()
@@ -1359,7 +1357,7 @@ chmod -R 777 /opt/keys"))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(user-id (session-user-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!
(lambda ()
(change-directory dir)
@@ -1372,7 +1370,7 @@ chmod -R 777 /opt/keys"))
(if (= pid 0) ;; process is still running
(begin (let ((progress (parse-deployment-log
(with-input-from-file
(string-append (deployment-directory user-id) "/make-out")
(string-append (deployment-directory user-id instance-id) "/make-out")
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)))
@@ -1386,7 +1384,7 @@ chmod -R 777 /opt/keys"))
(loop))
(let ((progress (parse-deployment-log
(with-input-from-file
(string-append (deployment-directory user-id) "/make-out")
(string-append (deployment-directory user-id instance-id) "/make-out")
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)))
@@ -1423,7 +1421,7 @@ chmod -R 777 /opt/keys"))
(lambda (db)
`((status . ,(get-most-recent-deployment-status 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))
(status (alist-ref 'status res)))
`(App
@@ -1545,7 +1543,7 @@ chmod -R 777 /opt/keys"))
(terraform-state (alist-ref 'terraform-state results))
(ssh-pub-key (alist-ref 'ssh-pub-key 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))
(redirect (conc "/destroy/" instance-id))
(begin
@@ -1617,7 +1615,7 @@ chmod -R 777 /opt/keys"))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(user-id (session-user-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!
(lambda ()
(change-directory dir)
@@ -1630,7 +1628,7 @@ chmod -R 777 /opt/keys"))
(if (= pid 0) ;; process is still running
(begin (let ((progress (parse-deployment-log
(with-input-from-file
(string-append (deployment-directory user-id) "/make-out")
(string-append (deployment-directory user-id instance-id) "/make-out")
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)))
@@ -1644,7 +1642,7 @@ chmod -R 777 /opt/keys"))
(loop))
(let ((progress (parse-deployment-log
(with-input-from-file
(string-append (deployment-directory user-id) "/make-out")
(string-append (deployment-directory user-id instance-id) "/make-out")
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)))
@@ -1683,7 +1681,7 @@ chmod -R 777 /opt/keys"))
(lambda (db)
`((status . ,(get-most-recent-deployment-status 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))
(status (alist-ref 'status res)))
`(App