Migrations infra & working instance-control + commands
This commit is contained in:
@@ -32,7 +32,10 @@
|
||||
nassella-db
|
||||
sql-null
|
||||
openssl
|
||||
spiffy)
|
||||
spiffy
|
||||
hmac
|
||||
sha256-primitive
|
||||
string-hexadecimal)
|
||||
|
||||
(define app (schematra/make-app))
|
||||
|
||||
@@ -902,6 +905,23 @@ chmod -R 777 /opt/keys")))
|
||||
(lambda ()
|
||||
(delete-file password-path)))))
|
||||
|
||||
;; TODO is this actually needed?
|
||||
(single-headers (cons 'X-Nassella-Signature (single-headers)))
|
||||
(header-parsers (cons `(X-Nassella-Signature . ,(single identity)) (header-parsers)))
|
||||
|
||||
(define (send-instance-control-command domain subdomain command secret-key data)
|
||||
(let ((json (json->string data)))
|
||||
(with-input-from-request
|
||||
(make-request method: 'POST
|
||||
uri: (uri-reference (conc "https://" subdomain "." domain "/hooks/" command))
|
||||
headers: (headers `((content-type application/json)
|
||||
(X-Nassella-Signature
|
||||
#(,(string->hex ((hmac secret-key (sha256-primitive)) json))
|
||||
())))))
|
||||
(lambda ()
|
||||
(write-json data))
|
||||
read-json)))
|
||||
|
||||
(with-schematra-app app
|
||||
(lambda ()
|
||||
|
||||
@@ -1098,7 +1118,8 @@ chmod -R 777 /opt/keys")))
|
||||
`((wg-easy . ,(or (and (alist-ref 'wg-easy (current-params)) "15.1.0") (sql-null)))
|
||||
(nextcloud . ,(or (and (alist-ref 'nextcloud (current-params)) "31.0.8") (sql-null)))
|
||||
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6.10.0") (sql-null)))
|
||||
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") (sql-null)))))
|
||||
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") (sql-null)))
|
||||
(instance-control . "b0.0.1")))
|
||||
(update-root-domain db
|
||||
(session-user-id)
|
||||
instance-id
|
||||
@@ -1238,7 +1259,8 @@ chmod -R 777 /opt/keys")))
|
||||
(smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params)))
|
||||
(smtp-auth-password . ,(alist-ref 'smtp-auth-password (current-params)))
|
||||
(smtp-from . ,(alist-ref 'smtp-from (current-params)))))
|
||||
(instance-control . ((webhooks-secret . ,(or (alist-ref 'webhooks-secret
|
||||
(instance-control . ((subdomain . "nassella-instance-control")
|
||||
(webhooks-secret . ,(or (alist-ref 'webhooks-secret
|
||||
(alist-ref 'instance-control config eq? '()))
|
||||
(generate-jwt-secret))))))))))
|
||||
(redirect (conc "/config/wizard/machine/" instance-id))))
|
||||
@@ -1449,7 +1471,7 @@ chmod -R 777 /opt/keys")))
|
||||
("cluster_name" . "nassella")
|
||||
("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.0")))
|
||||
("flatcar_stable_version" . "4593.2.1")))
|
||||
;; 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?))
|
||||
@@ -1580,11 +1602,14 @@ chmod -R 777 /opt/keys")))
|
||||
,(alist-ref 'subdomain (alist-ref app config))
|
||||
"." ,root-domain)))
|
||||
#f)))
|
||||
;; TODO update links
|
||||
'((wg-easy . "https://wg-easy.github.io/wg-easy/Pre-release/")
|
||||
(nextcloud . "https://nextcloud.com/support/")
|
||||
(ghost . "https://nextcloud.com/support/")
|
||||
(nassella . "https://nextcloud.com/support/")
|
||||
(log-viewer . "https://nextcloud.com/support/")))))
|
||||
(log-viewer . "https://nextcloud.com/support/")
|
||||
;; (instance-control . "https://nextcloud.com/support/")
|
||||
))))
|
||||
(h3 "Actions")
|
||||
(ul (li (a (@ (href "/config/wizard/services/"
|
||||
,(alist-ref 'instance-id instance)))
|
||||
@@ -1707,7 +1732,7 @@ chmod -R 777 /opt/keys")))
|
||||
("cluster_name" . "nassella")
|
||||
("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.0")))
|
||||
("flatcar_stable_version" . "4593.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?
|
||||
@@ -1826,10 +1851,10 @@ chmod -R 777 /opt/keys")))
|
||||
(Main-Container
|
||||
(VStack
|
||||
(h1 "Backups")
|
||||
(a (@ (href "/")) "Create Snapshot") ;; TODO
|
||||
(a (@ (href ,(conc "/backups/" instance-id "/create"))) "Create Snapshot")
|
||||
(table
|
||||
(thead
|
||||
(tr (th "Time") (th "Data Added (MiB)") (th "Total Size (MiB)") (th "Tag") (th "*")))
|
||||
(tr (th "Time") (th "Total Size (MiB)") (th "Tag") (th "*")))
|
||||
(tbody
|
||||
,@(map (lambda (snapshot)
|
||||
`(tr
|
||||
@@ -1837,7 +1862,7 @@ chmod -R 777 /opt/keys")))
|
||||
(td ,(roundx
|
||||
(/ (or (alist-ref 'total_bytes_processed (alist-ref 'summary snapshot)) 0) bytes-in-mib)))
|
||||
(td ,(or (alist-ref 'tags snapshot) ""))
|
||||
(td (a (@ (href ,(conc "/backups/" instance-id "/"
|
||||
(td (a (@ (href ,(conc "/backups/" instance-id "/restore/"
|
||||
(alist-ref 'short_id snapshot))))
|
||||
"Restore"))))
|
||||
(sort
|
||||
@@ -1846,7 +1871,7 @@ chmod -R 777 /opt/keys")))
|
||||
(restic-date-string->date (alist-ref 'time b)))))))))))))
|
||||
|
||||
(get/widgets
|
||||
("/backups/:instance_id/:restic_id")
|
||||
("/backups/:instance_id/restore/:restic_id")
|
||||
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
|
||||
(restic-id (alist-ref "restic_id" (current-params) equal?))
|
||||
(snapshot-info (find (lambda (snapshot)
|
||||
@@ -1889,6 +1914,40 @@ chmod -R 777 /opt/keys")))
|
||||
(VStack
|
||||
(Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Restore"))))))))))
|
||||
|
||||
(get/widgets
|
||||
("/backups/:instance_id/create")
|
||||
(let* ((instance-id (alist-ref "instance_id" (current-params) equal?))
|
||||
(root-domain (alist-ref 'root-domain
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(get-user-app-config db (session-user-id) instance-id))))))
|
||||
`(App
|
||||
(Main-Container
|
||||
(VStack
|
||||
(h1 "Create Snapshot")
|
||||
(h2 "Root Domain")
|
||||
,root-domain
|
||||
(form
|
||||
(@ (action ,(conc "/backups/" instance-id "/create-submit")) (method POST))
|
||||
(Fieldset (@ (title "Snapshot Properties"))
|
||||
(Field (@ (name "tag") (label ("Tag")))))
|
||||
(VStack
|
||||
(Form-Nav (@ (back-to ,(conc "/backups/" instance-id)) (submit-button "Create"))))))))))
|
||||
|
||||
(post "/backups/:instance_id/create-submit"
|
||||
(let ((instance-id (alist-ref "instance_id" (current-params) equal?))
|
||||
(app-config (with-db/transaction
|
||||
(lambda (db)
|
||||
(get-user-app-config db (session-user-id) instance-id)))))
|
||||
;; TODO make requests to instance control
|
||||
;; get the root domain and subdomain for instance control
|
||||
;; then call subdomain.rootdomain/hooks/queue-restic-snapshot
|
||||
;; content-type application/json
|
||||
;; data: 'path "/" 'tag tag 'request_id (generate-one?) 'version 0
|
||||
;; then run through hmac ((hmac "instance-control-secret-key" sha256-primitive) data)
|
||||
;; then make a new page to redirect the user to that polls for status page using the request id
|
||||
(redirect (conc "/config/wizard/review/" instance-id))))
|
||||
|
||||
(schematra-install)
|
||||
|
||||
))
|
||||
|
||||
Reference in New Issue
Block a user