|
|
|
|
@ -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)
|
|
|
|
|
|