Refactor authelia for logs to use file backed users.
This commit is contained in:
206
src/nassella.scm
206
src/nassella.scm
@@ -869,67 +869,37 @@ h1, h2, h3, h4, h5, h6 {
|
||||
`((success . #f)
|
||||
(result ,data))))))
|
||||
|
||||
;; (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* "/bin/timeout"
|
||||
;; `("--preserve-status" "8s" "/bin/restic" "cat" "config"
|
||||
;; "--repo" ,(conc "s3:" bucket-url)
|
||||
;; "--password-file" ,(conc (current-directory) "/" 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))
|
||||
;; `((success . #f)
|
||||
;; (errors ((message . "timeout trying to connect to backblaze")))))
|
||||
;; (if exit-normal
|
||||
;; (let ((res (with-input-from-port in-port read-json))
|
||||
;; (err (with-input-from-port err-port read-json)))
|
||||
;; ;; status 10 is what is returned if we can connect but the repo
|
||||
;; ;; is not initialized yet
|
||||
;; (if (or res (and err (= status 10)))
|
||||
;; `((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 ()
|
||||
;; (handle-exceptions exn 'ignore
|
||||
;; (delete-file password-path))))))
|
||||
(define *instance-up-timeout* 1) ;; seconds
|
||||
(define *instance-up-retry-time* 120) ;; 120s, 2 minutes
|
||||
(define *instance-up-retries* (/ *instance-up-retry-time* *instance-up-timeout*))
|
||||
(define (instance-up? path)
|
||||
(let loop ((i 0))
|
||||
(let ((thread
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(condition-case
|
||||
(receive (data uri response) (with-input-from-request path #f read-string)
|
||||
(if (eq? (response-code response) 401)
|
||||
#t
|
||||
(begin (thread-sleep! *instance-up-timeout*) ;; we depend on this taking at least as long as the timeout if the instance is still booting
|
||||
#f)))
|
||||
(e (exn client-error)
|
||||
(if (eq? (response-code (get-condition-property e 'client-error 'response)) 401)
|
||||
#t
|
||||
(begin (thread-sleep! *instance-up-timeout*) ;; we depend on this taking at least as long as the timeout if the instance is still booting
|
||||
#f)))
|
||||
(e (exn net)
|
||||
(thread-sleep! *instance-up-timeout*)
|
||||
#f)
|
||||
(e ()
|
||||
(thread-sleep! *instance-up-timeout*)
|
||||
#f))))))
|
||||
(if (thread-join! thread *instance-up-timeout* #f)
|
||||
#t
|
||||
(if (< i *instance-up-retries*)
|
||||
(loop (+ i 1))
|
||||
#f)))))
|
||||
|
||||
|
||||
(define (deployment-directory user-id instance-id)
|
||||
(string-append "deploy-" (number->string user-id) "-" (->string instance-id)))
|
||||
@@ -1077,6 +1047,34 @@ chmod -R 777 /opt/keys")))
|
||||
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
|
||||
64)))
|
||||
|
||||
(define (create-authelia-password-hash password)
|
||||
;; docker run --rm -it authelia/authelia:latest authelia crypto hash generate argon2
|
||||
(receive (in-port out-port pid err-port)
|
||||
(cond-expand
|
||||
(dev
|
||||
(process* "docker" `("run" "--rm" "authelia/authelia:latest" "authelia" "crypto" "hash" "generate" "argon2" "--password" ,password)))
|
||||
(else
|
||||
(process* "/usr/local/bin/authelia" `("crypto" "hash" "generate" "argon2" "--password" ,password))))
|
||||
(let ((thread
|
||||
(thread-start!
|
||||
(lambda ()
|
||||
(let loop ()
|
||||
(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
|
||||
(loop)
|
||||
(if exit-normal
|
||||
(begin
|
||||
(with-input-from-port err-port read-string) ;; left here for debugging and to clear ports
|
||||
;; the output is prefixed with "Digest: " and suffixed with a newline
|
||||
;; so we clean it up
|
||||
(string-drop (string-trim-right (with-input-from-port in-port read-string)) 8))
|
||||
(begin (log-to (debug-log) "authelia: docker command error")
|
||||
(error "Authelia for generating password hash had abnormal exit"))))))))))
|
||||
(thread-join! thread))))
|
||||
|
||||
(define (generate-postgres-password)
|
||||
(generator->string (gtake (make-random-char-generator
|
||||
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
|
||||
@@ -1401,8 +1399,9 @@ chmod -R 777 /opt/keys")))
|
||||
'()))
|
||||
(Field (@ (name "wordpress") (type "checkbox") (label ("Wordpress")) (checked ,(member 'wordpress (alist-ref 'selected-apps results)))))
|
||||
(Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled")))
|
||||
(Field (@ (name "lldap") (type "checkbox") (label ("Admin LLDAP")) (checked #t) (disabled "disabled")))
|
||||
(Field (@ (name "authelia") (type "checkbox") (label ("Admin Authelia")) (checked #t) (disabled "disabled"))))
|
||||
;; (Field (@ (name "lldap") (type "checkbox") (label ("Admin LLDAP")) (checked #t) (disabled "disabled")))
|
||||
;; (Field (@ (name "authelia") (type "checkbox") (label ("Admin Authelia")) (checked #t) (disabled "disabled")))
|
||||
)
|
||||
;; TODO add config for when automatic upgrades are scheduled for?
|
||||
;; TODO add config for server timezone?
|
||||
(Form-Nav (@ (back-to ,(conc "/config/wizard/services-success/" instance-id))))))))))
|
||||
@@ -1424,7 +1423,7 @@ chmod -R 777 /opt/keys")))
|
||||
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6") #f))
|
||||
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") #f))
|
||||
(wordpress . ,(or (and (alist-ref 'wordpress (current-params)) "8.4") #f))
|
||||
(lldap . "0.6.3")
|
||||
(lldap . #f) ;; "0.6.3"
|
||||
(authelia . "4")
|
||||
(instance-control . "b0.0.1")
|
||||
(log-viewer . "20"))))
|
||||
@@ -1500,31 +1499,30 @@ chmod -R 777 /opt/keys")))
|
||||
(Field (@ (name "wordpress-subdomain") (label ("Subdomain")) (required #t)
|
||||
(value ,(alist-ref 'subdomain (alist-ref 'wordpress app-config eq? '()) eq? "wordpress"))))))
|
||||
'())
|
||||
,@(if (member 'lldap selected-apps)
|
||||
`((Fieldset
|
||||
(@ (title "Admin LLDAP"))
|
||||
(Field (@ (name "lldap-subdomain") (label ("Subdomain")) (required #t)
|
||||
(value ,(alist-ref 'subdomain (alist-ref 'lldap app-config eq? '()) eq? "lldap"))))
|
||||
(Field (@ (name "lldap-user-email") (label ("Admin Email Address")) (type "email") (required #t)
|
||||
(value ,(alist-ref 'user-email (alist-ref 'lldap app-config eq? '()) eq? ""))))
|
||||
(Field (@ (name "lldap-admin-password") (label ("Admin Password")) (type "password") (required #t)
|
||||
(value ,(alist-ref 'admin-password (alist-ref 'lldap app-config eq? '()) eq? ""))))))
|
||||
'())
|
||||
,@(if (member 'authelia selected-apps)
|
||||
`((Fieldset
|
||||
(@ (title "Admin Authelia"))
|
||||
(Field (@ (name "authelia-subdomain") (label ("Subdomain")) (required #t)
|
||||
(value ,(alist-ref 'subdomain (alist-ref 'authelia app-config eq? '()) eq? "authelia"))))))
|
||||
'())
|
||||
;; ,@(if (member 'lldap selected-apps)
|
||||
;; `((Fieldset
|
||||
;; (@ (title "Admin LLDAP"))
|
||||
;; (Field (@ (name "lldap-subdomain") (label ("Subdomain")) (required #t)
|
||||
;; (value ,(alist-ref 'subdomain (alist-ref 'lldap app-config eq? '()) eq? "lldap"))))
|
||||
;; (Field (@ (name "lldap-user-email") (label ("Admin Email Address")) (type "email") (required #t)
|
||||
;; (value ,(alist-ref 'user-email (alist-ref 'lldap app-config eq? '()) eq? ""))))
|
||||
;; (Field (@ (name "lldap-admin-password") (label ("Admin Password")) (type "password") (required #t)
|
||||
;; (value ,(alist-ref 'admin-password (alist-ref 'lldap app-config eq? '()) eq? ""))))))
|
||||
;; '())
|
||||
;; ,@(if (member 'authelia selected-apps)
|
||||
;; `((Fieldset
|
||||
;; (@ (title "Admin Authelia"))
|
||||
;; (Field (@ (name "authelia-subdomain") (label ("Subdomain")) (required #t)
|
||||
;; (value ,(alist-ref 'subdomain (alist-ref 'authelia app-config eq? '()) eq? "authelia"))))))
|
||||
;; '())
|
||||
(Fieldset
|
||||
(@ (title "Log Viewer"))
|
||||
(Field (@ (name "log-viewer-subdomain") (label ("Subdomain")) (required #t)
|
||||
(value ,(alist-ref 'subdomain (alist-ref 'log-viewer app-config eq? '()) eq? "logs"))))
|
||||
;; (Field (@ (name "log-viewer-user") (label ("Username")) (required #t)
|
||||
;; (value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
|
||||
;; (Field (@ (name "log-viewer-password") (label ("Password")) (type "password") (required #t)
|
||||
;; (value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
|
||||
)
|
||||
(Field (@ (name "log-viewer-user") (label ("Admin Email")) (required #t)
|
||||
(value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
|
||||
(Field (@ (name "log-viewer-password") (label ("Admin Password")) (type "password") (required #t)
|
||||
(value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? "")))))
|
||||
,@(if (or (member 'nextcloud selected-apps) (member 'ghost selected-apps) (member 'nassella selected-apps) (member 'authelia selected-apps))
|
||||
`((Fieldset
|
||||
(@ (title "All Apps - Email - SMTP"))
|
||||
@@ -1662,8 +1660,8 @@ chmod -R 777 /opt/keys")))
|
||||
(alist-ref 'authelia config eq? '()))
|
||||
(generate-authelia-key-seed)))))
|
||||
(log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (current-params)))
|
||||
(user . "unused") ;; TODO can we remove?
|
||||
(password . "unused"))) ;; TODO can we remove?
|
||||
(user . ,(alist-ref 'log-viewer-user (current-params)))
|
||||
(password . ,(alist-ref 'log-viewer-password (current-params)))))
|
||||
(all-apps . ((smtp-host . ,(alist-ref 'smtp-host (current-params)))
|
||||
(smtp-port . ,(alist-ref 'smtp-port (current-params)))
|
||||
(smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params)))
|
||||
@@ -1836,13 +1834,14 @@ chmod -R 777 /opt/keys")))
|
||||
(map (lambda (app-version)
|
||||
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
|
||||
","
|
||||
(alist-ref 'subdomain (alist-ref (car app-version) config))
|
||||
(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" . ,(alist-ref 'password (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")
|
||||
@@ -1999,13 +1998,29 @@ chmod -R 777 /opt/keys")))
|
||||
(with-db/transaction
|
||||
(lambda (db)
|
||||
(update-deployment-progress db deployment-id progress)
|
||||
(update-deployment-status
|
||||
db user-id deployment-id
|
||||
(if (= status 0) 'complete 'failed)
|
||||
(with-input-from-file (string-append dir "/make-out") read-string))
|
||||
(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 (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
|
||||
@@ -2057,7 +2072,8 @@ chmod -R 777 /opt/keys")))
|
||||
(ip-destroy . "Instance Mapped IP Disconnect")
|
||||
(ip-create . "Instance Mapped IP Connect")
|
||||
(volume-create . "App Volume Connect")
|
||||
(machine-destroy . "Cleanup Previous Instance"))))
|
||||
(machine-destroy . "Cleanup Previous Instance")
|
||||
(instance-up . "Instance Starting Up"))))
|
||||
(form
|
||||
(@ (action "/dashboard") (method GET))
|
||||
,@(if (or (eq? (string->symbol status) 'complete) (eq? (string->symbol status) 'failed))
|
||||
|
||||
Reference in New Issue
Block a user