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

Fixing create-instance in prod, not showing nassella in prod.

Browse Source
This commit is contained in:
Thomas Hintz
2026-04-22 11:19:05 -07:00
parent 24b9477f24
commit 9eb260f399
1 changed files with 36 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
src/nassella.scm
View File

@@ -312,9 +312,10 @@ h1, h2, h3, h4, h5, h6 {
(username . ,remote-user)) (username . ,remote-user))
(current-params))) (current-params)))
(next)) (next))
(if (string-prefix-ci? "/unsecured/" path) (if (and (cdr path) (cadr path) (string=? "unsecured" (cadr path)))
(next) (next)
'(unauthorized "no valid auth header"))))))) (begin (log-to (debug-log) "no valid auth header | ~S | ~A" path headers)
'(unauthorized "no valid auth header"))))))))
(with-schematra-app app (with-schematra-app app
(lambda () (lambda ()
@@ -706,7 +707,11 @@ h1, h2, h3, h4, h5, h6 {
(create-directory dir) (create-directory dir)
(process-wait (process-run (string-append "tar -xf nassella-latest.tar -C " dir))) (process-wait (process-run (string-append "tar -xf nassella-latest.tar -C " dir)))
(create-directory (string-append dir "/config")) (create-directory (string-append dir "/config"))
(copy-file "../config/ssh-keys" (string-append dir "/config/ssh-keys")) ;; TODO remove (cond-expand
(dev
;; in dev copy personal ssh key
(copy-file "../config/ssh-keys" (string-append dir "/config/ssh-keys")))
(else '()))
(with-output-to-file (string-append dir "/terraform.tfstate") (lambda () (write-string state))) (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)))) (with-output-to-file (string-append dir "/terraform.tfstate.backup") (lambda () (write-string state-backup))))
@@ -772,12 +777,17 @@ h1, h2, h3, h4, h5, h6 {
;; and uses that to store the generated ssh keys. ;; and uses that to store the generated ssh keys.
;; Later on this directory gets deleted after we read the keys into ;; Later on this directory gets deleted after we read the keys into
;; strings to return from this function. ;; strings to return from this function.
(process* "docker" `("run" "--rm" "--volume" (cond-expand
,(conc (current-directory) "/" key-path ":/opt/keys") (dev
"debian:12-slim" "bash" "-c" "apt update (create-directory key-path)
(process* "docker" `("run" "--rm" "--volume"
,(conc (current-directory) "/" key-path ":/opt/keys")
"debian:12-slim" "bash" "-c" "apt update
apt install -y openssh-client apt install -y openssh-client
ssh-keygen -t ed25519 -f /opt/keys/key -N \"\" ssh-keygen -t ed25519 -f /opt/keys/key -N \"\"
chmod -R 777 /opt/keys")) chmod -R 777 /opt/keys")))
(else
(process* "ssh-keygen" `("-t" "ed25519" "-f" ,(conc (current-directory) "/" key-path "/key") "-N" "\"\""))))
(let ((thread (let ((thread
(thread-start! (thread-start!
(lambda () (lambda ()
@@ -791,12 +801,14 @@ chmod -R 777 /opt/keys"))
(if exit-normal (if exit-normal
(begin (begin
(with-input-from-port in-port read-string) ;; left here for debugging and to clear ports (with-input-from-port in-port read-string) ;; left here for debugging and to clear ports
(with-input-from-port err-port read-string) ;; left here for debugging and to clear ports (with-input-from-port err-port read-string)
;; left here for debugging and to clear ports
(let ((priv-key (with-input-from-file (conc key-path "/key") read-string)) (let ((priv-key (with-input-from-file (conc key-path "/key") read-string))
(pub-key (with-input-from-file (conc key-path "/key.pub") read-string))) (pub-key (with-input-from-file (conc key-path "/key.pub") read-string)))
(delete-directory key-path #t) (delete-directory key-path #t)
(list priv-key pub-key))) (list priv-key pub-key)))
(error "Generating ssh key docker command had abnormal exit"))))))))) (begin (log-to (debug-log) "generate-ssh-key: docker command error")
(error "Generating ssh key docker command had abnormal exit"))))))))))
(thread-join! thread))))) (thread-join! thread)))))
(define (generate-restic-password) (define (generate-restic-password)
@@ -854,12 +866,12 @@ chmod -R 777 /opt/keys"))
;;; REQUIRES AUTHED USER ;;; REQUIRES AUTHED USER
(post "/config/wizard/create-instance" (post "/config/wizard/create-instance"
(let* ((ssh-keys (generate-ssh-key (session-user-id))) (let* ((ssh-keys (generate-ssh-key (session-user-id)))
(instance-id (with-db/transaction (instance-id (with-db/transaction
(lambda (db) (lambda (db)
(create-instance db (session-user-id) (first ssh-keys) (second ssh-keys) (create-instance db (session-user-id) (first ssh-keys) (second ssh-keys)
(generate-restic-password)))))) (generate-restic-password))))))
(redirect (conc "/config/wizard/services/" instance-id)))) (redirect (conc "/config/wizard/services/" instance-id))))
;; TODO should all these key related form fields be of type password ;; TODO should all these key related form fields be of type password
;; so the browser doesn't save them??? ;; so the browser doesn't save them???
@@ -996,7 +1008,11 @@ chmod -R 777 /opt/keys"))
(Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps results))))) (Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps results)))))
(Field (@ (name "nextcloud") (type "checkbox") (label ("NextCloud")) (checked ,(member 'nextcloud (alist-ref 'selected-apps results))))) (Field (@ (name "nextcloud") (type "checkbox") (label ("NextCloud")) (checked ,(member 'nextcloud (alist-ref 'selected-apps results)))))
(Field (@ (name "ghost") (type "checkbox") (label ("Ghost")) (checked ,(member 'ghost (alist-ref 'selected-apps results))))) (Field (@ (name "ghost") (type "checkbox") (label ("Ghost")) (checked ,(member 'ghost (alist-ref 'selected-apps results)))))
(Field (@ (name "nassella") (type "checkbox") (label ("Nassella")) (checked ,(member 'nassella (alist-ref 'selected-apps results))))) ,@(cond-expand
(dev
`((Field (@ (name "nassella") (type "checkbox") (label ("Nassella")) (checked ,(member 'nassella (alist-ref 'selected-apps results)))))))
(else
'()))
(Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled")))) (Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))))
;; TODO add config for when automatic upgrades are scheduled for? ;; TODO add config for when automatic upgrades are scheduled for?
;; TODO add config for server timezone? ;; TODO add config for server timezone?
@@ -1270,9 +1286,10 @@ chmod -R 777 /opt/keys"))
(post "/config/wizard/review-submit/:id" (post "/config/wizard/review-submit/:id"
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(status (string->symbol (status (string->symbol
(with-db/transaction (->string
(lambda (db) (with-db/transaction
(get-most-recent-deployment-status db (session-user-id) instance-id)))))) (lambda (db)
(get-most-recent-deployment-status db (session-user-id) instance-id)))))))
(when (not (or (eq? status 'queued) (eq? status 'in-progress))) (when (not (or (eq? status 'queued) (eq? status 'in-progress)))
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(results (results