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

Properly manage deploys via unique folders and db.

Browse Source
This commit is contained in:
Thomas Hintz
2025-11-12 07:31:23 -08:00
parent 5d256e5cf8
commit b781ddb5d7
5 changed files with 102 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
src/nassella.scm
View File

@@ -7,6 +7,7 @@
(chicken process)
(chicken process-context)
(chicken irregex)
(chicken file)
(rename srfi-1 (delete srfi1:delete))
srfi-18
@@ -757,6 +758,19 @@ h1, h2, h3, h4, h5, h6 {
(VStack
(Form-Nav (@ (back-to ,(conc "/config/wizard/machine2")) (submit-button "Launch")))))))))
(define (deployment-directory user-id)
(string-append "deploy-" (number->string user-id)))
(define (setup-deploy-files dir state state-backup)
(when (directory-exists? dir)
(delete-directory dir #t))
(create-directory dir)
(process-wait (process-run (string-append "tar -xf nassella-latest.tar -C " dir)))
(create-directory (string-append dir "/config"))
(copy-file "../config/ssh-keys" (string-append dir "/config/ssh-keys")) ;; TODO remove
(with-output-to-file (string-append dir "/terraform.tfstate") (lambda () (write-string state)))
(with-output-to-file (string-append dir "/terraform.tfstate.backup") (lambda () (write-string state-backup))))
(define (write-config-entry name value)
(display name)
(display "=\"")
@@ -772,13 +786,17 @@ h1, h2, h3, h4, h5, h6 {
(filter cdr
(get-user-selected-apps db (session-get "user-id")))))
(app-config . ,(get-user-app-config db (session-get "user-id")))
(service-config . ,(get-user-service-config db (session-get "user-id")))))))
(service-config . ,(get-user-service-config db (session-get "user-id")))
(terraform-state . ,(get-user-terraform-state db (session-get "user-id")))))))
(selected-apps (cons 'log-viewer (alist-ref 'selected-apps results)))
(app-config (alist-ref 'app-config results))
(config (alist-ref 'config app-config))
(root-domain (alist-ref 'root-domain app-config))
(service-config (alist-ref 'service-config results)))
(with-output-to-file "deploy/config/apps.config"
(service-config (alist-ref 'service-config results))
(terraform-state (alist-ref 'terraform-state results))
(dir (deployment-directory (session-get "user-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 ()
(map (lambda (e)
(write-config-entry (car e) (cdr e)))
@@ -796,13 +814,13 @@ h1, h2, h3, h4, h5, h6 {
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword")
("NEXTCLOUD_REDIS_PASSWORD" . "redispassword")
("NEXTCLOUD_POSTGRES_PASSWORD" . "dbpassword") ;; TODO generate
("NEXTCLOUD_REDIS_PASSWORD" . "redispassword") ;; TODO generate
("BACKBLAZE_KEY_ID" . ,(alist-ref 'backblaze-key-id service-config))
("BACKBLAZE_APPLICATION_KEY" . ,(alist-ref 'backblaze-application-key service-config))
("BACKBLAZE_BUCKET_URL" . ,(alist-ref 'backblaze-bucket-url service-config))
("RESTIC_PASSWORD" . "foodisgood")))))
(with-output-to-file "deploy/config/production.tfvars"
("RESTIC_PASSWORD" . "foodisgood"))))) ;; TODO generate or get from user
(with-output-to-file (string-append dir "/config/production.tfvars")
(lambda ()
(map (lambda (e)
(write-config-entry (car e) (cdr e)))
@@ -814,12 +832,13 @@ h1, h2, h3, h4, h5, h6 {
("cluster_name" . "mycluster")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
("flatcar_stable_version" . "4230.2.3")))
(display "ssh_keys=[\"") (display (with-input-from-file "deploy/config/ssh-keys" read-string)) (print "\"]"))))
(display "ssh_keys=[\"") (display (with-input-from-file (string-append dir "/config/ssh-keys") read-string)) (print "\"]"))))
(let* ((user-id (session-get "user-id"))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id)))))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id))))
(dir (deployment-directory user-id)))
(thread-start!
(lambda ()
(change-directory "deploy")
(change-directory dir)
(let ((pid (process-run "make apply > make-out")))
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
(change-directory "../")
@@ -830,15 +849,25 @@ h1, h2, h3, h4, h5, h6 {
(loop)
(with-db/transaction
(lambda (db)
;; TODO THIS DOESN'T WORK RIGHT FOR TERRAFORM OP FAILURES
;; like the random digital ocean error saying the IP can't be
;; updated because another operation is in progress.
;; it still registers as "success".
;; probably need to also write stderr to a file and read/store/parse that?
;; Should we parse make-out for string "Apply complete!" ?
(update-deployment-status
db deployment-id
(if exit-normal 'complete 'failed)))))))))))
db user-id deployment-id
(if exit-normal 'complete 'failed)
(with-input-from-file (string-append dir "/make-out") read-string))
(update-user-terraform-state db user-id
(with-input-from-file (string-append dir "/terraform.tfstate") read-string)
(with-input-from-file (string-append dir "/terraform.tfstate.backup") read-string)))))))))))
(schematra:redirect "/config/wizard/success"))
(get
("/config/wizard/success")
(let ((status (with-db/transaction (lambda (db) (get-most-recent-deployment-status db (session-get "user-id")))))
(output (with-input-from-file "deploy/make-out" (lambda () (read-string)))))
(output (with-input-from-file (string-append (deployment-directory (session-get "user-id")) "/make-out") read-string)))
`(VStack
(h1
,(case (string->symbol status)
@@ -877,16 +906,6 @@ h1, h2, h3, h4, h5, h6 {
"in progress")
(else "queued"))))
(pre ,output)
;; ,@(intersperse
;; (with-input-from-file "deploy/make-out"
;; (lambda ()
;; (letrec ((loop (lambda (out)
;; (let ((v (read-line)))
;; (if (eq? v #!eof)
;; out
;; (loop (cons v out)))))))
;; (reverse (loop '())))))
;; `(br))
)))
(schematra:schematra-install)