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

Actually test backblaze connection in wizard.

Browse Source
This commit is contained in:
Thomas Hintz
2026-07-11 13:07:39 -07:00
parent 1019377cd8
commit 7bca829134
1 changed files with 77 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

83
src/nassella.scm
View File

@@ -14,6 +14,8 @@
;; You should have received a copy of the GNU Affero General Public License
;; along with Nassella. If not, see <https://www.gnu.org/licenses/>.
;; (import (chicken platform))
;; (register-feature! 'dev)
;; (load "src/db.scm")
;; (load "src/mocks.scm")
(include "db")
@@ -716,8 +718,63 @@ h1, h2, h3, h4, h5, h6 {
`((success . #f)
(errors ((message . ,(alist-ref 'message res)))))))))
;; (define (test-backblaze-connection key-id application-key bucket-url)
;; )
(define (test-backblaze-connection user-id instance-id key-id application-key bucket-url)
(let* ((password-path (conc "restic-password-" user-id "-" instance-id))
(restic-password
(with-db/transaction
(lambda (db)
(get-instance-restic-password db user-id instance-id)))))
(dynamic-wind
(lambda ()
(with-output-to-file password-path (lambda () (display restic-password))))
(lambda ()
;; restic retries (indefinitely?) if the connection can't be made so
;; we pass it through timeout to ensure it does not hang
(receive (in-port out-port pid err-port)
(cond-expand
(dev
(process* "timeout" `("--preserve-status" "8s" "docker" "run" "--rm" "--volume"
,(conc (current-directory) "/" password-path ":/restic-password")
"-e" ,(conc "AWS_ACCESS_KEY_ID=" key-id)
"-e" ,(conc "AWS_SECRET_ACCESS_KEY=" application-key)
"-i" "restic/restic:0.18.0" "cat" "config"
"--repo" ,(conc "s3:" bucket-url)
"--password-file" "/restic-password"
"--json")))
(else
(process* "timeout"
`("--preserve-status" "8s" "restic" "cat" "config"
"--repo" ,(conc "s3:" bucket-url)
"--password-file" password-path
"--json")
`(("AWS_ACCESS_KEY_ID" . ,key-id)
("AWS_SECRET_ACCESS_KEY" . ,application-key)))))
(let ((thread
(thread-start!
(lambda ()
(let loop ((i 0))
(thread-sleep! 1)
;; We do a non-blocking wait here so that we don't
;; block the entire web process.
(receive (wait-pid exit-normal status) (process-wait pid #t)
(if (= wait-pid 0) ;; wait-pid is 0 until the process has finished
(if (< i 12) ;; 12s timeout
(loop (+ i 1))
(error "timeout trying to connect to to backblaze"))
(if exit-normal
(let ((res (with-input-from-port in-port read-json))
(err (with-input-from-port err-port read-json)))
(if res
`((success . #t)
(result . ,res))
`((success . #f)
(errors ((message . "abnormal exit - check Key ID, Application ID, and Bucket URL"))))))
`((success . #f)
(errors ((message . "abnormal exit - check Key ID, Application ID, and Bucket URL"))))
))))))))
(thread-join! thread))))
(lambda ()
(delete-file password-path)))))
(define (deployment-directory user-id instance-id)
(string-append "deploy-" (number->string user-id) "-" (->string instance-id)))
@@ -1042,7 +1099,11 @@ chmod -R 777 /opt/keys")))
(cloudflare-result (test-cloudflare-connection (alist-ref 'cloudflare-api-token service-config)
(alist-ref 'cloudflare-zone-id service-config)
(alist-ref 'cloudflare-account-id service-config)))
(digitalocean-result (test-digitalocean-connection (alist-ref 'digitalocean-api-token service-config))))
(digitalocean-result (test-digitalocean-connection (alist-ref 'digitalocean-api-token service-config)))
(backblaze-result (test-backblaze-connection (session-user-id) instance-id
(alist-ref 'backblaze-key-id service-config)
(alist-ref 'backblaze-application-key service-config)
(alist-ref 'backblaze-bucket-url service-config))))
`(App
(Configuration-Wizard
(@ (step "Services"))
@@ -1077,11 +1138,21 @@ chmod -R 777 /opt/keys")))
"\""))))
(Fieldset
(@ (title "Backblaze"))
(h3 "Connected")
(p "Your Backblaze account was successfully connected!"))
,@(if (alist-ref 'success backblaze-result)
`((h3 "Connected")
(p "Your Backblaze account was successfully connected!"))
`((h3 "Connection Failed")
(p "Unable to make a connection via Backblaze S3 API. Message is: \""
,(string-intersperse
(map (lambda (err)
(alist-ref 'message err))
(alist-ref 'errors backblaze-result))
"\" & \"")
"\""))))
(Form-Nav (@ (back-to ,(conc "/config/wizard/services/" instance-id))
(submit-enabled ,(and (alist-ref 'success cloudflare-result)
(alist-ref 'success digitalocean-result)))))))))))
(alist-ref 'success digitalocean-result)
(alist-ref 'success backblaze-result)))))))))))
(get/widgets
("/config/wizard/apps/:id")