Working delete instance for all cases.
This commit is contained in:
@@ -30,7 +30,7 @@ RUN chicken-install srfi-1 srfi-13 srfi-18 srfi-19 srfi-158 srfi-194 \
|
||||
sxml-transforms schematra \
|
||||
uri-common http-client medea intarweb \
|
||||
sql-null openssl postgresql crypto-tools \
|
||||
hmac sha2 string-utils
|
||||
hmac sha2 string-utils base64
|
||||
|
||||
WORKDIR /var
|
||||
RUN mkdir nassella
|
||||
|
||||
406
src/nassella.scm
406
src/nassella.scm
@@ -54,7 +54,8 @@
|
||||
spiffy
|
||||
hmac
|
||||
sha256-primitive
|
||||
string-hexadecimal)
|
||||
string-hexadecimal
|
||||
base64)
|
||||
|
||||
(define app (schematra/make-app))
|
||||
|
||||
@@ -656,6 +657,66 @@ h1, h2, h3, h4, h5, h6 {
|
||||
(email . ,email))))))))
|
||||
read-json)))
|
||||
|
||||
;; returns something like:
|
||||
;; ((accountId . "xxx") (apiInfo (storageApi (absoluteMinimumPartSize . 5000000) (allowed (buckets . #(((id . "yyy") (name . "aaa")))) (capabilities . #("readBucketEncryption" "listFiles" "shareFiles" "listBuckets" "readBucketLifecycleRules" "readBuckets" "readFiles" "writeBucketReplications" "writeBucketNotifications" "listAllBucketNames" "writeFiles" "writeBuckets" "writeBucketEncryption" "deleteFiles" "writeBucketLogging" "readBucketLogging" "readBucketReplications" "writeBucketLifecycleRules" "readBucketNotifications")) (namePrefix . null)) (apiUrl . "https://api004.backblazeb2.com") (downloadUrl . "https://f004.backblazeb2.com") (recommendedPartSize . 100000000) (s3ApiUrl . "https://s3.us-west-004.backblazeb2.com"))) (applicationKeyExpirationTimestamp . null) (authorizationToken . "abc"))
|
||||
;; #<URI-common: scheme=https port=443 host="api.backblazeb2.com" path=(/ "b2api" "v4" "b2_authorize_account") query=() fragment=#f>
|
||||
;; #<intarweb#response>
|
||||
;; ; 3 values
|
||||
(define (b2-authorize-account key-id key)
|
||||
(with-input-from-request
|
||||
(make-request method: 'GET
|
||||
uri: (uri-reference "https://api.backblazeb2.com/b2api/v4/b2_authorize_account")
|
||||
headers: (headers `((authorization #(,(string-append "Basic " (base64-encode (string-append key-id ":" key))) raw)))))
|
||||
#f
|
||||
read-json))
|
||||
|
||||
(define (b2-authorization-details key-id key)
|
||||
(let* ((auth (b2-authorize-account key-id key))
|
||||
(buckets (alist-ref 'buckets (alist-ref 'allowed (alist-ref 'storageApi (alist-ref 'apiInfo auth))))))
|
||||
(values (alist-ref 'authorizationToken auth)
|
||||
(alist-ref 'accountId auth)
|
||||
(alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo auth)))
|
||||
(alist-ref 'id (car buckets)) ;; assume at least one bucket and the one we want for now
|
||||
(alist-ref 'name (car buckets))
|
||||
buckets)))
|
||||
|
||||
(define (b2-list-file-versions api-url account-token bucket-id)
|
||||
(with-input-from-request
|
||||
(make-request method: 'GET
|
||||
uri: (uri-reference (string-append api-url "/b2api/v4/b2_list_file_versions?bucketId=" bucket-id))
|
||||
headers: (headers `((authorization #(,account-token raw))
|
||||
(content-type application/json))))
|
||||
#f
|
||||
read-json))
|
||||
|
||||
(define (b2-list-file-versions-only-name-id api-url account-token bucket-id)
|
||||
(map (lambda (x)
|
||||
(cons (alist-ref 'fileName x)
|
||||
(alist-ref 'fileId x)))
|
||||
(alist-ref 'files (b2-list-file-versions api-url account-token bucket-id))))
|
||||
|
||||
(define (b2-delete-file-version api-url account-token file-name file-id)
|
||||
(with-input-from-request
|
||||
(make-request method: 'POST
|
||||
uri: (uri-reference (string-append api-url "/b2api/v4/b2_delete_file_version"))
|
||||
headers: (headers `((authorization #(,account-token raw))
|
||||
(content-type application/json))))
|
||||
(lambda ()
|
||||
(write-json
|
||||
`((fileName . ,file-name)
|
||||
(fileId . ,file-id))))
|
||||
read-json))
|
||||
|
||||
(define (b2-delete-bucket-files key-id app-key)
|
||||
(receive (token account-id api-url bucket-id _ _)
|
||||
(b2-authorization-details key-id app-key)
|
||||
(let loop ((files (b2-list-file-versions-only-name-id api-url token bucket-id)))
|
||||
(when (not (null? files))
|
||||
(for-each (lambda (file)
|
||||
(b2-delete-file-version api-url token (car file) (cdr file)))
|
||||
files)
|
||||
(loop (b2-list-file-versions-only-name-id api-url token bucket-id))))))
|
||||
|
||||
(define (get-digital-ocean-regions api-token)
|
||||
(filter
|
||||
(lambda (r)
|
||||
@@ -1685,7 +1746,6 @@ chmod -R 777 /opt/keys")))
|
||||
(restic-password (alist-ref 'restic-password results))
|
||||
(dir (deployment-directory (session-user-id) instance-id)))
|
||||
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
|
||||
(log-to (debug-log) "writing configs")
|
||||
(with-output-to-file (string-append dir "/config/apps.config")
|
||||
(lambda ()
|
||||
(map (lambda (e)
|
||||
@@ -2058,170 +2118,190 @@ chmod -R 777 /opt/keys")))
|
||||
(@ (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 ""))))
|
||||
(@ (title "Delete Instance"))
|
||||
(Field (@ (name "instance-domain") (label ("Type the domain name of the instance to confirm.")) (value "")))
|
||||
(Field (@ (name "delete-backups") (label ("Delete backups for this instance")) (type "checkbox"))))
|
||||
(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 (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) instance-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-version)
|
||||
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
|
||||
","
|
||||
(alist-ref 'subdomain (alist-ref (car app-version) config))
|
||||
","
|
||||
(cdr app-version)))
|
||||
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)))
|
||||
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
|
||||
("NASSELLA_POSTGRES_DB" . "nassella")
|
||||
("NASSELLA_POSTGRES_USER" . "nassella")
|
||||
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
|
||||
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
|
||||
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
|
||||
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
|
||||
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_STRIPE_API_KEY" . ,(alist-ref 'stripe-api-key (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
|
||||
("WORDPRESS_DB_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'wordpress config)))
|
||||
("WORDPRESS_DB_ROOT_PASSWORD" . ,(alist-ref 'db-root-password (alist-ref 'wordpress config)))
|
||||
("LLDAP_POSTGRES_DB" . "lldap")
|
||||
("LLDAP_POSTGRES_USER" . "lldap")
|
||||
("LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'lldap config)))
|
||||
("LLDAP_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'lldap config)))
|
||||
("LLDAP_KEY_SEED" . ,(alist-ref 'key-seed (alist-ref 'lldap config)))
|
||||
("LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'lldap config)))
|
||||
("LLDAP_USER_EMAIL" . ,(alist-ref 'user-email (alist-ref 'lldap config)))
|
||||
("AUTHELIA_POSTGRES_DB" . "authelia")
|
||||
("AUTHELIA_POSTGRES_USER" . "authelia")
|
||||
("AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'authelia config)))
|
||||
("AUTHELIA_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_SESSION_SECRET" . ,(alist-ref 'session-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_ENCRYPTION_KEY" . ,(alist-ref 'encryption-key (alist-ref 'authelia 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)
|
||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))
|
||||
,@(if (and restic-snapshot-id (not (string=? restic-snapshot-id ""))) `(("RESTIC_SNAPSHOT_ID" . ,restic-snapshot-id)) '())))))
|
||||
(with-output-to-file (string-append dir "/config/production.tfvars")
|
||||
(lambda ()
|
||||
(map (lambda (e)
|
||||
(write-terraform-config-entry (car e) (cdr e)))
|
||||
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
|
||||
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
|
||||
("digitalocean_volume_size" . ,(alist-ref 'digitalocean-volume-size 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" . ,(string-append "nassella" (string-delete #\. root-domain))) ;; TODO update to: (import srfi-14) (string-filter char-set:letter+digit root-domain)
|
||||
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
|
||||
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
|
||||
("flatcar_stable_version" . "4593.2.4")))
|
||||
;; 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 instance-id)))
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(change-directory dir)
|
||||
(let ((pid (process-run "make preapply && 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 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)))
|
||||
(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 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)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(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))
|
||||
(when exit-normal
|
||||
(destroy-instance db instance-id))))))))))))
|
||||
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?)))))))
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(status (string->symbol
|
||||
(->string
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(get-most-recent-deployment-status db (session-user-id) instance-id)))))))
|
||||
(if (or (not (or (eq? status 'queued) (eq? status 'in-progress)))
|
||||
(equal? (alist-ref 'force (current-params)) "true"))
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(restic-snapshot-id (alist-ref 'restic-snapshot-id (current-params)))
|
||||
(results
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
`((selected-apps . ,(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 (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) instance-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-version)
|
||||
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
|
||||
","
|
||||
(alist-ref 'subdomain (alist-ref (car app-version) config))
|
||||
","
|
||||
(cdr app-version)))
|
||||
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)))
|
||||
("NASSELLA_LLDAP_SUBDOMAIN" . ,(alist-ref 'lldap-subdomain (alist-ref 'nassella config)))
|
||||
("NASSELLA_POSTGRES_DB" . "nassella")
|
||||
("NASSELLA_POSTGRES_USER" . "nassella")
|
||||
("NASSELLA_POSTGRES_PASSWORD" . ,(alist-ref 'postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_POSTGRES_DB" . "authelia")
|
||||
("NASSELLA_AUTHELIA_POSTGRES_USER" . "authelia")
|
||||
("NASSELLA_AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'authelia-postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_POSTGRES_DB" . "lldap")
|
||||
("NASSELLA_LLDAP_POSTGRES_USER" . "lldap")
|
||||
("NASSELLA_LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'lldap-postgres-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_JWT_SECRET" . ,(alist-ref 'lldap-jwt-secret (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_KEY_SEED" . ,(alist-ref 'lldap-key-seed (alist-ref 'nassella config)))
|
||||
("NASSELLA_LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'lldap-admin-password (alist-ref 'nassella config)))
|
||||
("NASSELLA_STRIPE_API_KEY" . ,(alist-ref 'stripe-api-key (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_JWT_SECRET" . ,(alist-ref 'authelia-jwt-secret (alist-ref 'nassella config)))
|
||||
("NASSELLA_AUTHELIA_KEY_SEED" . ,(alist-ref 'authelia-key-seed (alist-ref 'nassella config)))
|
||||
("WORDPRESS_DB_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'wordpress config)))
|
||||
("WORDPRESS_DB_ROOT_PASSWORD" . ,(alist-ref 'db-root-password (alist-ref 'wordpress config)))
|
||||
("LLDAP_POSTGRES_DB" . "lldap")
|
||||
("LLDAP_POSTGRES_USER" . "lldap")
|
||||
("LLDAP_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'lldap config)))
|
||||
("LLDAP_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'lldap config)))
|
||||
("LLDAP_KEY_SEED" . ,(alist-ref 'key-seed (alist-ref 'lldap config)))
|
||||
("LLDAP_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'lldap config)))
|
||||
("LLDAP_USER_EMAIL" . ,(alist-ref 'user-email (alist-ref 'lldap config)))
|
||||
("AUTHELIA_POSTGRES_DB" . "authelia")
|
||||
("AUTHELIA_POSTGRES_USER" . "authelia")
|
||||
("AUTHELIA_POSTGRES_PASSWORD" . ,(alist-ref 'db-password (alist-ref 'authelia config)))
|
||||
("AUTHELIA_JWT_SECRET" . ,(alist-ref 'jwt-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_SESSION_SECRET" . ,(alist-ref 'session-secret (alist-ref 'authelia config)))
|
||||
("AUTHELIA_ENCRYPTION_KEY" . ,(alist-ref 'encryption-key (alist-ref 'authelia 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)
|
||||
("INSTANCE_CONTROL_WEBHOOKS_SECRET" . ,(alist-ref 'webhooks-secret (alist-ref 'instance-control config)))
|
||||
,@(if (and restic-snapshot-id (not (string=? restic-snapshot-id ""))) `(("RESTIC_SNAPSHOT_ID" . ,restic-snapshot-id)) '())))))
|
||||
(with-output-to-file (string-append dir "/config/production.tfvars")
|
||||
(lambda ()
|
||||
(map (lambda (e)
|
||||
(write-terraform-config-entry (car e) (cdr e)))
|
||||
`(("server_type" . ,(alist-ref 'digitalocean-size service-config))
|
||||
("do_token" . ,(alist-ref 'digitalocean-api-token service-config))
|
||||
("digitalocean_volume_size" . ,(alist-ref 'digitalocean-volume-size 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" . ,(string-append "nassella" (string-delete #\. root-domain))) ;; TODO update to: (import srfi-14) (string-filter char-set:letter+digit root-domain)
|
||||
("datacenter" . ,(alist-ref 'digitalocean-region service-config))
|
||||
;; (source <(curl -sSfL https://stable.release.flatcar-linux.net/amd64-usr/current/version.txt); echo "${FLATCAR_VERSION_ID}")
|
||||
("flatcar_stable_version" . "4593.2.4")))
|
||||
;; remove the newline that generating the ssh key adds
|
||||
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
|
||||
(let* ((instance-id (alist-ref "id" (current-params) equal?))
|
||||
(delete-backups (alist-ref 'delete-backups (current-params) equal?))
|
||||
(user-id (session-user-id))
|
||||
(app-config
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(get-user-app-config db (session-user-id) instance-id))))
|
||||
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
|
||||
(dir (deployment-directory user-id instance-id)))
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(change-directory dir)
|
||||
(let ((pid (process-run "make preapply && 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 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)))
|
||||
(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 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)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(when (= status 0)
|
||||
(update-deployment-status
|
||||
db user-id deployment-id
|
||||
'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))))
|
||||
;; todo handle errors here
|
||||
(when delete-backups
|
||||
(b2-delete-bucket-files (alist-ref 'backblaze-key-id service-config) (alist-ref 'backblaze-application-key service-config)))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-status
|
||||
db user-id deployment-id
|
||||
'complete
|
||||
(with-input-from-file (string-append dir "/make-out") read-string))))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(destroy-instance db instance-id)))))))))))
|
||||
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))))
|
||||
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))))
|
||||
|
||||
(get/widgets
|
||||
("/destroy-success/:id"
|
||||
|
||||
Reference in New Issue
Block a user