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

Compare commits

base: nassella:main
Branches Tags
nassella:main nassella:create-instance-full
..
compare: nassella:create-instance-full
Branches Tags
nassella:create-instance-full nassella:main

1 Commits
main ... create-ins

Author SHA1 Message Date
Thomas Hintz
863d839563 wip 2026-08-23 12:06:15 -07:00
3 changed files with 371 additions and 230 deletions
Expand all files Collapse all files

2
src/Makefile
View File

@@ -15,7 +15,7 @@
# along with Nassella. If not, see <https://www.gnu.org/licenses/>. # along with Nassella. If not, see <https://www.gnu.org/licenses/>.
dockerall: dockerall:
docker buildx build --platform linux/amd64,linux/arm64 -t nassella/b0.0.1 . docker buildx build --platform linux/arm64 -t nassella/b0.0.1 . # linux/amd64,
dockerlocal: dockerlocal:
docker buildx build -t nassella/b0.0.1 . docker buildx build -t nassella/b0.0.1 .

10
src/db.scm
View File

@@ -23,7 +23,7 @@
db-init db-clean db-init db-clean
create-user delete-user create-user delete-user
get-user-id-by-username get-user-id-by-username get-user-email-by-id
create-instance destroy-instance get-user-instances create-instance destroy-instance get-user-instances
get-instance-ssh-pub-key get-instance-ssh-priv-key get-instance-ssh-pub-key get-instance-ssh-priv-key
update-instance-ssh-pub-key update-instance-ssh-pub-key
@@ -181,6 +181,12 @@ returning users.user_id;"
(value-at res) (value-at res)
#f))) #f)))
(define (get-user-email-by-id conn id)
(let ((res (query conn "select email from users where user_id=$1;" id)))
(if (> (row-count res) 0)
(value-at res)
#f)))
;; We also encrypt the ssh pub key not to hide it but to make it ;; We also encrypt the ssh pub key not to hide it but to make it
;; more difficult for someone to tamper with it which could allow ;; more difficult for someone to tamper with it which could allow
;; an attacker to poison an instance with an ssh key that they have ;; an attacker to poison an instance with an ssh key that they have
@@ -701,7 +707,7 @@ where user_id=$1;"
(string-split (with-input-from-file "db-init.sql" read-string) ";")) (string-split (with-input-from-file "db-init.sql" read-string) ";"))
(log-to (debug-log) "table creation finished") (log-to (debug-log) "table creation finished")
(log-to (debug-log) "creating test user") (log-to (debug-log) "creating test user")
(create-user db "me@example.com" "username") (create-user db "me@example.com" "username") ;; TODO should this be removed?
(log-to (debug-log) "test user creation finished"))) (log-to (debug-log) "test user creation finished")))
;; originally there was no migrations table, so first add it if it doesn't exist ;; originally there was no migrations table, so first add it if it doesn't exist
(if (value-at (query db "SELECT EXISTS (SELECT FROM pg_tables WHERE schemaname = 'public' AND tablename = 'migrations');")) (if (value-at (query db "SELECT EXISTS (SELECT FROM pg_tables WHERE schemaname = 'public' AND tablename = 'migrations');"))

589
src/nassella.scm
View File

@@ -350,6 +350,9 @@ h1, h2, h3, h4, h5, h6 {
(define (session-user-id) (define (session-user-id)
(alist-ref 'user-id (current-params))) (alist-ref 'user-id (current-params)))
(define (session-username)
(alist-ref 'username (current-params)))
(define-syntax get/widgets (define-syntax get/widgets
(syntax-rules () (syntax-rules ()
((_ (path) body ...) ((_ (path) body ...)
@@ -670,6 +673,21 @@ h1, h2, h3, h4, h5, h6 {
#f #f
read-json)) read-json))
(define (b2-create-bucket api-url account-token account-id bucket-name)
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference (string-append api-url "/b2api/v4/b2_create_bucket"))
headers: (headers `((authorization #(,account-token raw))
(content-type application/json))))
(lambda ()
(write-json
`((accountId . ,account-id)
(bucketName . ,bucket-name)
(bucketType . "allPrivate")
(lifecycleRules . #(((daysFromHidingToDeleting . 1)
(fileNamePrefix . "")))))))
read-json))
;; request response looks like ;; request response looks like
;; (((accountId . "xxx") (bucketId . "xxx") (bucketInfo) (bucketName . "xxx") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3)) ((accountId . "yyy") (bucketId . "yyy") (bucketInfo) (bucketName . "yyy") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3))) ;; (((accountId . "xxx") (bucketId . "xxx") (bucketInfo) (bucketName . "xxx") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3)) ((accountId . "yyy") (bucketId . "yyy") (bucketInfo) (bucketName . "yyy") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3)))
(define (b2-list-buckets api-url account-token account-id) (define (b2-list-buckets api-url account-token account-id)
@@ -1186,6 +1204,231 @@ chmod -R 777 /opt/keys")))
(write-json data)) (write-json data))
read-json))) read-json)))
(define (perform-review-submit instance-id)
(let* ((status (string->symbol
(->string
(with-db/transaction
(lambda (db)
(get-most-recent-deployment-status db (session-user-id) instance-id)))))))
(when (or (not (or (eq? status 'queued) (eq? status 'in-progress)))
(equal? (alist-ref 'force (current-params)) "true"))
(let* ((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)))
(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))
","
(or (alist-ref 'subdomain (alist-ref (car app-version) config))
"nassella-ignore") ;; a hack to get authelia to work for now
","
(cdr app-version)))
selected-apps)
" "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
("HOST_ADMIN_PASSWORD" . ,(create-authelia-password-hash (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* ((user-id (session-user-id))
(app-config
(with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))
(first-deployment? (not (with-db/transaction (lambda (db) (get-most-recent-deployment-status db 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))
(backup-request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000))))
(if first-deployment?
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . ignored)
(machine-destroy . ignored)
(ip-destroy . ignored)
(volume-destroy . ignored)))))
(begin
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . in-progress)))))
(handle-exceptions
exn
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . failed)))))
(send-instance-control-command
(alist-ref 'root-domain app-config)
(alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
"queue-restic-snapshot-no-restart"
(alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
`((path . "/")
(tag . "automated_pre_instance_update")
;; effectively a guid, we just want something unique
(request_id . ,backup-request-id)
(version . 0))))))
(thread-start!
(lambda ()
(when (not first-deployment?)
(let ((start-time (time->seconds (current-time))))
(let loop ()
(thread-sleep! 1)
(let* ((status-result
(handle-exceptions
exn
'((status . "error"))
(send-instance-control-command
(alist-ref 'root-domain app-config)
(alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
"restic-snapshot-status"
(alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
`((request_id . ,backup-request-id)
(version . 0)))))
(complete (string=? (alist-ref 'status status-result) "complete")))
(if (or complete (> (- (time->seconds (current-time)) start-time) 120))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed))))))
(loop))))))
(change-directory dir)
(let ((pid (process-run "make preapply && make apply > 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-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup))
(if (= status 0)
(update-deployment-progress db deployment-id `((instance-up . in-progress)))
(update-deployment-status
db user-id deployment-id
'failed
(with-input-from-file (string-append dir "/make-out") read-string)))))
(when (= status 0)
(let ((instance-up (instance-up? (string-append "https://"
(alist-ref 'subdomain (alist-ref 'log-viewer (alist-ref 'config app-config)))
"."
(alist-ref 'root-domain app-config)))))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id `((instance-up . ,(if instance-up 'complete 'failed))))
(update-deployment-status
db user-id deployment-id
(if instance-up
'complete
'failed)
(with-input-from-file (string-append dir "/make-out") read-string))))))))))))))))
(redirect (conc "/config/wizard/success/" instance-id)))
(with-schematra-app app (with-schematra-app app
(lambda () (lambda ()
@@ -1219,6 +1462,122 @@ chmod -R 777 /opt/keys")))
(generate-restic-password)))))) (generate-restic-password))))))
(redirect (conc "/config/wizard/services/" instance-id)))) (redirect (conc "/config/wizard/services/" instance-id))))
;; TODOs
;; backblaze: create bucket then generate a new key restricted to that bucket and only use that key
;; postmark:
;; - use API to create an email server for instance
;; - use API to generate SMTP settings for instance
;; nassella:
;; - generate instance name and verify it does not already exist
;; - store that instance name in a new db column
;; - update dashboard to use instance name
;; - (later) detect closest digitalocean region to user
;; - (later) ensure can select the correct digitalocean size
'x
(post "/config/wizard/create-instance-full"
(let* ((ssh-keys (generate-ssh-key (session-user-id)))
(instance-id (with-db/transaction
(lambda (db)
(create-instance db (session-user-id) (first ssh-keys) (second ssh-keys)
(generate-restic-password)))))
(instance-name "red1")
(root-domain "nassellatest.com")
(backblaze-bucket-name (string-append "nassella-instance-" instance-name))
(backblaze-application-key "K004v8YQPbm/MdmyoffQBH8Cof9Wt7M") ;; TODO need to generate a restricted key with access to only the new bucket and use that one so we don't leak our key
(backblaze-key-id "004da8e20ea1d5e000000000f")
(backblaze-auth (b2-authorize-account backblaze-key-id backblaze-application-key))
(backblaze-bucket-response
(b2-create-bucket (alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo backblaze-auth)))
(alist-ref 'authorizationToken backblaze-auth)
(alist-ref 'accountId backblaze-auth)
backblaze-bucket-name))
(backblaze-s3-url (alist-ref 's3ApiUrl (alist-ref 'storageApi (alist-ref 'apiInfo backblaze-auth)))))
(with-db/transaction
(lambda (db)
(update-user-service-config
db
(session-user-id)
instance-id
`((cloudflare-api-token . "cfut_ykuHdXr5P8Nm3SFCM2uQTErxKZ24pZzb98wZ7cUC76189f76")
(cloudflare-account-id . "f6542e441e20c201803398433cb923a8")
(cloudflare-zone-id . "e126d94dc5cdd32503749b55a9d64faf")
(digitalocean-api-token . "dop_v1_44a6f12f1bab78c9c3a4ba4edc7d91c3c98b4ddd0e08f3c80e0689431feb88d0")
(backblaze-application-key . ,backblaze-application-key)
(backblaze-key-id . ,backblaze-key-id)
(backblaze-bucket-name . ,backblaze-bucket-name)
(backblaze-bucket-id . ,(alist-ref 'bucketId backblaze-bucket-response))
(backblaze-bucket-url . ,(string-append backblaze-s3-url "/" backblaze-bucket-name))
(digitalocean-region . "sfo3") ;; TODO detect closest region to user
(digitalocean-size . "s-2vcpu-2gb") ;; TODO make sure size is available, align to nassella plan?
(digitalocean-volume-size . "60") ;; TODO align to plan?
))
(update-root-domain db (session-user-id) instance-id root-domain)
(update-user-selected-apps
db
(session-user-id)
instance-id
(filter (lambda (app/version) (cdr app/version)) ;; filter out unused apps
`((wg-easy . #f)
(nextcloud . "34")
(ghost . #f)
(nassella . #f)
(wordpress . #f)
(lldap . #f)
(authelia . "4")
(instance-control . "b0.0.1")
(log-viewer . "20"))))
(update-user-app-config
db
(session-user-id)
instance-id
`((nextcloud . ((subdomain . ,(string-append "nextcloud." instance-name))
(admin-user . ,(session-username))
(admin-password . "Foodisgood4!") ;; TODO
(postgres-password . ,(generate-postgres-password))
(redis-password . ,(generate-redis-password))))
(authelia . ((subdomain . #f)
(db-password . ,(generate-postgres-password))
(jwt-secret . ,(generate-jwt-secret))
(session-secret . ,(generate-authelia-key-seed))
(encryption-key . ,(generate-authelia-key-seed))))
(log-viewer . ((subdomain . ,(string-append "logs." instance-name))
(user . ,(session-username))
(password . "Foodisgood4!"))) ;; TODO
(all-apps . ((smtp-host . "smtp.postmarkapp.com")
(smtp-port . "587")
(smtp-auth-user . "PM-T-outbound-L0Ps1dQBMdx2u20RZ9-BsF") ;; TODO
(smtp-auth-password . "alb0YXkEOmp0htTm4-kV_OGLjQbjb7NRwLN2") ;; TODO
(smtp-from . ,(string-append "admin@" root-domain))))
(instance-control . ((subdomain . ,(string-append "nassella-instance-control." instance-name))
(webhooks-secret . ,(generate-jwt-secret))))
;; unused but rest of system expects to be set
(ghost . ((subdomain . #f)
(postgres-root-password . ,(generate-postgres-password))
(postgres-password . ,(generate-postgres-password))))
(wg-easy . ((subdomain . #f)))
(nassella . ((subdomain . #f)
(postgres-password . ,(generate-postgres-password))
(authelia-postgres-password . ,(generate-postgres-password))
(lldap-postgres-password . ,(generate-postgres-password))
(lldap-jwt-secret . ,(generate-jwt-secret))
(lldap-key-seed . ,(generate-key-seed))
(lldap-subdomain . #f)
(lldap-admin-password . "")
(stripe-api-key . "")
(authelia-jwt-secret . ,(generate-jwt-secret))
(authelia-key-seed . ,(generate-authelia-key-seed))))
(wordpress . ((subdomain . #f)
(db-password . ,(generate-postgres-password))
(db-root-password . ,(generate-postgres-password))))
(lldap . ((subdomain . #f)
(db-password . ,(generate-postgres-password))
(jwt-secret . ,(generate-jwt-secret))
(key-seed . ,(generate-key-seed))
(admin-password . "")
(user-email . "")))))))
(perform-review-submit instance-id)))
(get/widgets (get/widgets
("/config/wizard/services/:id") ("/config/wizard/services/:id")
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
@@ -1796,232 +2155,7 @@ chmod -R 777 /opt/keys")))
(Form-Nav (@ (back-to ,(conc "/config/wizard/machine2/" instance-id)) (submit-button "Launch"))))))))) (Form-Nav (@ (back-to ,(conc "/config/wizard/machine2/" instance-id)) (submit-button "Launch")))))))))
(post "/config/wizard/review-submit/:id" (post "/config/wizard/review-submit/:id"
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (perform-review-submit (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)))))))
(when (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)))
(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))
","
(or (alist-ref 'subdomain (alist-ref (car app-version) config))
"nassella-ignore") ;; a hack to get authelia to work for now
","
(cdr app-version)))
selected-apps)
" "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
("HOST_ADMIN_PASSWORD" . ,(create-authelia-password-hash (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?))
(user-id (session-user-id))
(app-config
(with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))
(first-deployment? (not (with-db/transaction (lambda (db) (get-most-recent-deployment-status db 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))
(backup-request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000))))
(if first-deployment?
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . ignored)
(machine-destroy . ignored)
(ip-destroy . ignored)
(volume-destroy . ignored)))))
(begin
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . in-progress)))))
(handle-exceptions
exn
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . failed)))))
(send-instance-control-command
(alist-ref 'root-domain app-config)
(alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
"queue-restic-snapshot-no-restart"
(alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
`((path . "/")
(tag . "automated_pre_instance_update")
;; effectively a guid, we just want something unique
(request_id . ,backup-request-id)
(version . 0))))))
(thread-start!
(lambda ()
(when (not first-deployment?)
(let ((start-time (time->seconds (current-time))))
(let loop ()
(thread-sleep! 1)
(let* ((status-result
(handle-exceptions
exn
'((status . "error"))
(send-instance-control-command
(alist-ref 'root-domain app-config)
(alist-ref 'subdomain (alist-ref 'instance-control (alist-ref 'config app-config)))
"restic-snapshot-status"
(alist-ref 'webhooks-secret (alist-ref 'instance-control (alist-ref 'config app-config)))
`((request_id . ,backup-request-id)
(version . 0)))))
(complete (string=? (alist-ref 'status status-result) "complete")))
(if (or complete (> (- (time->seconds (current-time)) start-time) 120))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed))))))
(loop))))))
(change-directory dir)
(let ((pid (process-run "make preapply && make apply > 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-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup))
(if (= status 0)
(update-deployment-progress db deployment-id `((instance-up . in-progress)))
(update-deployment-status
db user-id deployment-id
'failed
(with-input-from-file (string-append dir "/make-out") read-string)))))
(when (= status 0)
(let ((instance-up (instance-up? (string-append "https://"
(alist-ref 'subdomain (alist-ref 'log-viewer (alist-ref 'config app-config)))
"."
(alist-ref 'root-domain app-config)))))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id `((instance-up . ,(if instance-up 'complete 'failed))))
(update-deployment-status
db user-id deployment-id
(if instance-up
'complete
'failed)
(with-input-from-file (string-append dir "/make-out") read-string))))))))))))))))
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))
(get/widgets (get/widgets
("/config/wizard/success/:id" ("/config/wizard/success/:id"
@@ -2115,7 +2249,8 @@ chmod -R 777 /opt/keys")))
(@ (element main)) (@ (element main))
(h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances") (h1 (@ (style ((font-size ,($ 'font.size.xxl))))) "Nassella - Instances")
(form (form
(@ (action "/config/wizard/create-instance") (@ ;; (action "/config/wizard/create-instance")
(action "/config/wizard/create-instance-full")
(method POST)) (method POST))
(Button "Setup New Instance")) (Button "Setup New Instance"))
(ul (@ (style ((list-style "none") (ul (@ (style ((list-style "none")