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

wip instance "destroy" action

Browse Source
This commit is contained in:
Thomas Hintz
2026-02-09 08:30:39 -08:00
parent 78f509d946
commit 83f68db2d7
2 changed files with 150 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@@ -86,7 +86,7 @@ apply: announce-start ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generat
bash -c "terraform apply -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)"
destroy: ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars
bash -c "terraform destroy -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)"
bash -c "terraform destroy -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)"
.PHONY: restic-init
restic-init: $(apps_config) restic-password

150
src/nassella.scm
View File

@@ -1329,11 +1329,159 @@ chmod -R 777 /opt/keys"))
"Modify Setup"))
(li "Upgrade Now (pending automatic upgrades scheduled for: )")
(li "Manage Backups")
(li "Destroy"))))))
(li (a (@ (href "/destroy/" ,(alist-ref 'instance-id instance)))
"Destroy (confirmation required)")))))))
(with-db/transaction
(lambda (db)
(get-dashboard db (session-user-id))))))))))
(get/widgets
("/destroy/:id")
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(root-domain
(with-db/transaction
(lambda (db)
(alist-ref 'root-domain (get-user-app-config db (session-user-id) instance-id))))))
`(App
(h2 "Destroy Instance")
,root-domain
(h2 "This action is NOT reversible")
(form
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
(VStack
(Fieldset
(@ (title "Type the domain name of the instance to confirm."))
(Field (@ (name "instance-domain") (label ("Domain")) (value ""))))
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
;; TODO This is mostly a copy of the deployment POST action
(post "/destroy-submit/:id"
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(results
(with-db/transaction
(lambda (db)
`((selected-apps . ,(map
car
(filter cdr
(get-user-selected-apps db (session-user-id) instance-id))))
(app-config . ,(get-user-app-config db (session-user-id) instance-id))
(service-config . ,(get-user-service-config db (session-user-id) instance-id))
(terraform-state . ,(get-user-terraform-state db (session-user-id) instance-id))
(ssh-pub-key . ,(get-instance-ssh-pub-key db (session-user-id) instance-id))
(restic-password . ,(get-instance-restic-password db (session-user-id) instance-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))
(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))))
(if (not (string=? (alist-ref 'instance-domain (current-params)) root-domain))
(redirect (conc "/destroy/" instance-id))
(begin
(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)))
`(("ROOT_DOMAIN" . ,root-domain)
("APP_CONFIGS" . ,(string-intersperse
(map (lambda (app)
(conc (if (eq? app 'log-viewer) 'dozzle app)
","
(alist-ref 'subdomain (alist-ref app config))))
selected-apps)
" "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config)))
("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
("NEXTCLOUD_POSTGRES_USER" . "nextcloud")
("NEXTCLOUD_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_REDIS_PASSWORD" . ,(alist-ref 'redis-password (alist-ref 'nextcloud config)))
("GHOST_DATABASE_ROOT_PASSWORD" . ,(alist-ref 'postgres-root-password (alist-ref 'ghost config)))
("GHOST_DATABASE_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'ghost config)))
("SMTP_HOST" . ,(alist-ref 'smtp-host (alist-ref 'all-apps config)))
("SMTP_PORT" . ,(alist-ref 'smtp-port (alist-ref 'all-apps config)))
("SMTP_AUTH_USER" . ,(alist-ref 'smtp-auth-user (alist-ref 'all-apps config)))
("SMTP_AUTH_PASSWORD" . ,(alist-ref 'smtp-auth-password (alist-ref 'all-apps config)))
("SMTP_FROM" . ,(alist-ref 'smtp-from (alist-ref 'all-apps config)))
("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" . ,restic-password)))))
(with-output-to-file (string-append dir "/config/production.tfvars")
(lambda ()
(map (lambda (e)
(write-config-entry (car e) (cdr e)))
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
("cloudflare_api_token" . ,(alist-ref 'cloudflare-api-token service-config))
("cloudflare_zone_id" . ,(alist-ref 'cloudflare-zone-id service-config))
("cloudflare_account_id" . ,(alist-ref 'cloudflare-account-id service-config))
("cluster_name" . "mycluster")
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
("flatcar_stable_version" . "4459.2.1")))
;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
;; TODO need a new table to track destroying?
;; as this is creating a new "deployment"
;; to attach state to
(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)))
(thread-start!
(lambda ()
(change-directory dir)
(let ((pid (process-run "make destroy > make-out 2>&1")))
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
(change-directory "../")
(let loop ()
(thread-sleep! 5)
(receive (pid exit-normal status) (process-wait pid #t)
(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")
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)))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id progress)
(when (file-exists? (string-append dir "/terraform.tfstate"))
(update-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup))))))
(loop))
(let ((progress (parse-deployment-log
(with-input-from-file
(string-append (deployment-directory user-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)))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id progress)
;; 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 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 instance-id
(if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup))))))))))))
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
(schematra-install)
))