342 lines
14 KiB
Racket
342 lines
14 KiB
Racket
#lang racket/base
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; First-run setup state and web setup processing.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(require crypto
|
|
net/uri-codec
|
|
racket/path
|
|
racket/string
|
|
web-server/http
|
|
"auth.rkt"
|
|
"config.rkt"
|
|
"database.rkt"
|
|
"http-util.rkt"
|
|
"vendor.rkt"
|
|
"../translate.rkt")
|
|
|
|
(provide setup-complete?
|
|
setup-handler)
|
|
|
|
(define setup-lock (make-semaphore 1))
|
|
|
|
(define (bytes->hex value)
|
|
(apply string-append
|
|
(for/list ((byte (in-bytes value)))
|
|
(define hex (number->string byte 16))
|
|
(if (= (string-length hex) 1)
|
|
(string-append "0" hex)
|
|
hex))))
|
|
|
|
(define setup-form-token
|
|
(bytes->hex (crypto-random-bytes 32)))
|
|
|
|
(define (admin-ready? config)
|
|
(and (database-ready? config)
|
|
(with-handlers ((exn:fail? (λ (_e) #f)))
|
|
(administrator-exists? config))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Check whether the wiki has everything required for normal use.
|
|
; pre : The data directory is accessible.
|
|
; post : PostgreSQL configuration/schema and vendor files have only been inspected.
|
|
; result : #t when PostgreSQL, an administrator and browser libraries are ready.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (setup-complete? config)
|
|
(and (database-ready? config)
|
|
(admin-ready? config)
|
|
(vendor-files-ready? config)))
|
|
|
|
(define (request-form req)
|
|
(define body (request-post-data/raw req))
|
|
(if body
|
|
(form-urlencoded->alist (bytes->string/utf-8 body))
|
|
'()))
|
|
|
|
(define (form-value form key [default ""])
|
|
(define found (assoc key form))
|
|
(if (and found (cdr found))
|
|
(cdr found)
|
|
default))
|
|
|
|
(define setup-style
|
|
#<<CSS
|
|
html { box-sizing: border-box; font-family: system-ui, -apple-system, BlinkMacSystemFont, "Segoe UI", sans-serif; color: #172033; background: #f4f6f8; }
|
|
*, *::before, *::after { box-sizing: inherit; }
|
|
body { margin: 0; min-height: 100vh; display: grid; place-items: center; padding: 32px; }
|
|
.setup { width: min(700px, 100%); background: white; border: 1px solid #d7dde5; border-radius: 14px; padding: 34px; box-shadow: 0 12px 40px rgba(22, 32, 51, 0.08); }
|
|
h1 { margin: 0 0 10px; font-size: 2rem; }
|
|
h2 { margin: 28px 0 8px; font-size: 1.15rem; }
|
|
p { line-height: 1.55; }
|
|
.status { margin: 24px 0; padding: 0; list-style: none; border-top: 1px solid #e3e7ed; }
|
|
.status li { display: flex; justify-content: space-between; gap: 20px; padding: 12px 0; border-bottom: 1px solid #e3e7ed; }
|
|
.ready { color: #286b3d; font-weight: 600; }
|
|
.pending { color: #8b5d00; font-weight: 600; }
|
|
.fields { display: grid; grid-template-columns: 1fr 140px; gap: 0 14px; }
|
|
.fields .wide { grid-column: 1 / -1; }
|
|
label { display: block; margin: 12px 0; font-weight: 600; }
|
|
input, select { display: block; width: 100%; margin-top: 6px; padding: 10px 12px; font: inherit; border: 1px solid #aeb7c4; border-radius: 6px; background: white; }
|
|
button { margin-top: 18px; padding: 10px 18px; font: inherit; font-weight: 600; cursor: pointer; }
|
|
.error { margin: 18px 0; padding: 12px 14px; background: #fff1f1; border: 1px solid #e8b7b7; border-radius: 6px; color: #8b1f1f; white-space: pre-wrap; }
|
|
.note { color: #5b6472; font-size: 0.94rem; }
|
|
code { background: #f2f4f7; padding: 2px 5px; border-radius: 4px; }
|
|
@media (max-width: 620px) { .fields { grid-template-columns: 1fr; } .fields .wide { grid-column: auto; } }
|
|
CSS
|
|
)
|
|
|
|
(define (status-row label ready? ready-text pending-text)
|
|
`(li
|
|
(span ,label)
|
|
(span ((class ,(if ready? "ready" "pending")))
|
|
,(if ready? ready-text pending-text))))
|
|
|
|
(define (setting-value settings getter default)
|
|
(if settings (getter settings) default))
|
|
|
|
|
|
(define (language-field config [form '()])
|
|
(define language (form-value form 'language (current-language config)))
|
|
`((label
|
|
,(tr config 'language)
|
|
(select ((name "language"))
|
|
(option ((value "en") ,@(if (string-ci=? language "en") '((selected "selected")) '())) ,(tr config 'language-en))
|
|
(option ((value "nl") ,@(if (string-ci=? language "nl") '((selected "selected")) '())) ,(tr config 'language-nl))))))
|
|
|
|
(define (database-fields config [form '()])
|
|
(define settings (read-database-settings config))
|
|
(define ssl-text
|
|
(form-value form
|
|
'db-ssl
|
|
(symbol->string (setting-value settings database-settings-ssl 'no))))
|
|
(define ssl (string->symbol ssl-text))
|
|
`((h2 ,(tr config 'postgresql))
|
|
(div ((class "fields"))
|
|
(label
|
|
,(tr config 'server)
|
|
(input ((name "db-server")
|
|
(value ,(form-value form 'db-server (setting-value settings database-settings-server "localhost")))
|
|
(required "required"))))
|
|
(label
|
|
,(tr config 'port)
|
|
(input ((name "db-port")
|
|
(type "number")
|
|
(min "1")
|
|
(max "65535")
|
|
(value ,(form-value form 'db-port (number->string (setting-value settings database-settings-port 5432))))
|
|
(required "required"))))
|
|
(label ((class "wide"))
|
|
,(tr config 'database)
|
|
(input ((name "db-database")
|
|
(value ,(form-value form 'db-database (setting-value settings database-settings-database "racket_wiki")))
|
|
(required "required"))))
|
|
(label ((class "wide"))
|
|
,(tr config 'user)
|
|
(input ((name "db-user")
|
|
(autocomplete "username")
|
|
(value ,(form-value form 'db-user (setting-value settings database-settings-user "")))
|
|
(required "required"))))
|
|
(label ((class "wide"))
|
|
,(tr config 'password)
|
|
(input ((name "db-password")
|
|
(type "password")
|
|
(autocomplete "current-password")
|
|
(value ""))))
|
|
(label ((class "wide"))
|
|
,(tr config 'tls-ssl)
|
|
(select ((name "db-ssl"))
|
|
(option ((value "no") ,@(if (eq? ssl 'no) '((selected "selected")) '())) ,(tr config 'ssl-no))
|
|
(option ((value "optional") ,@(if (eq? ssl 'optional) '((selected "selected")) '())) ,(tr config 'ssl-optional))
|
|
(option ((value "yes") ,@(if (eq? ssl 'yes) '((selected "selected")) '())) ,(tr config 'ssl-required)))))))
|
|
|
|
(define (admin-fields config [form '()])
|
|
`((h2 ,(tr config 'administrator))
|
|
(label
|
|
,(tr config 'administrator-username)
|
|
(input ((name "username")
|
|
(autocomplete "username")
|
|
(value ,(form-value form 'username ""))
|
|
(required "required"))))
|
|
(label
|
|
,(tr config 'display-name)
|
|
(input ((name "display-name")
|
|
(autocomplete "name")
|
|
(value ,(form-value form 'display-name ""))
|
|
(placeholder "Optional; defaults to username"))))
|
|
(label
|
|
,(tr config 'administrator-password)
|
|
(input ((name "password")
|
|
(type "password")
|
|
(autocomplete "new-password")
|
|
(required "required"))))
|
|
(label
|
|
,(tr config 'repeat-password)
|
|
(input ((name "password-confirm")
|
|
(type "password")
|
|
(autocomplete "new-password")
|
|
(required "required"))))))
|
|
|
|
(define (setup-page config [message #f] [form '()])
|
|
(define db-ready? (database-ready? config))
|
|
(define administrator-ready? (admin-ready? config))
|
|
(define vendor-ready? (vendor-files-ready? config))
|
|
`(html
|
|
(head
|
|
(meta ((charset "utf-8")))
|
|
(meta ((name "viewport") (content "width=device-width, initial-scale=1")))
|
|
(title ,(string-append "Setup - " (wiki-config-site-title config)))
|
|
(style ,setup-style))
|
|
(body
|
|
(main ((class "setup"))
|
|
(h1 ,(tr config 'setup-title))
|
|
(p ,(tr config 'setup-description))
|
|
(ul ((class "status"))
|
|
,(status-row (tr config 'postgresql) db-ready? (tr config 'ready) (tr config 'required))
|
|
,(status-row (tr config 'administrator-account) administrator-ready? (tr config 'ready) (tr config 'required))
|
|
,(status-row (tr config 'frontend-libraries) vendor-ready? (tr config 'ready) (tr config 'will-download)))
|
|
,@(if message
|
|
`((div ((class "error")) ,message))
|
|
'())
|
|
(form ((method "post") (action "/setup"))
|
|
(input ((type "hidden") (name "setup-token") (value ,setup-form-token)))
|
|
,@(language-field config form)
|
|
,@(if db-ready? '() (database-fields config form))
|
|
,@(if administrator-ready? '() (admin-fields config form))
|
|
(button ((type "submit")) ,(tr config 'complete-setup)))
|
|
(p ((class "note"))
|
|
"PostgreSQL connection settings are stored in "
|
|
(code ,(path->string (database-config-path config)))
|
|
". Protect the wiki data directory as you would any other file containing database credentials.")
|
|
(p ((class "note"))
|
|
"Frontend libraries are stored below "
|
|
(code ,(path->string (vendor-directory config)))
|
|
" and are served locally after setup.")))))
|
|
|
|
(define (setup-page-response config [message #f] [form '()])
|
|
(html-response
|
|
(setup-page config message form)
|
|
#:headers (list (make-header #"Cache-Control" #"no-store"))))
|
|
|
|
(define (validate-admin-form form)
|
|
(define username (string-trim (form-value form 'username)))
|
|
(define display-name (string-trim (form-value form 'display-name)))
|
|
(define password (form-value form 'password))
|
|
(define password-confirm (form-value form 'password-confirm))
|
|
(cond
|
|
((string=? username "") "Administrator username is required.")
|
|
((string=? password "") "Administrator password is required.")
|
|
((< (string-length password) 8) "Administrator password must contain at least 8 characters.")
|
|
((not (string=? password password-confirm)) "The two passwords do not match.")
|
|
(else
|
|
(list username
|
|
(if (string=? display-name "") username display-name)
|
|
password))))
|
|
|
|
(define (form->database-settings form)
|
|
(define port (string->number (form-value form 'db-port "5432")))
|
|
(define ssl-text (form-value form 'db-ssl "no"))
|
|
(define ssl
|
|
(cond
|
|
((string=? ssl-text "yes") 'yes)
|
|
((string=? ssl-text "optional") 'optional)
|
|
(else 'no)))
|
|
(cond
|
|
((string=? (string-trim (form-value form 'db-server)) "") "PostgreSQL server is required.")
|
|
((or (not port) (not (exact-integer? port)) (< port 1) (> port 65535)) "PostgreSQL port is invalid.")
|
|
((string=? (string-trim (form-value form 'db-database)) "") "PostgreSQL database is required.")
|
|
((string=? (string-trim (form-value form 'db-user)) "") "PostgreSQL user is required.")
|
|
(else
|
|
(database-settings (string-trim (form-value form 'db-server))
|
|
port
|
|
(string-trim (form-value form 'db-database))
|
|
(string-trim (form-value form 'db-user))
|
|
(form-value form 'db-password)
|
|
ssl))))
|
|
|
|
|
|
(define (configure-language! config form)
|
|
(define language (string-downcase (form-value form 'language (current-language config))))
|
|
(unless (member language '("en" "nl"))
|
|
(error 'setup "Unsupported UI language: ~a" language))
|
|
(write-language! config language))
|
|
|
|
(define (configure-database! config form)
|
|
(unless (database-ready? config)
|
|
(define settings (form->database-settings form))
|
|
(when (string? settings)
|
|
(error 'setup settings))
|
|
(test-database-settings! settings)
|
|
(initialize-database-with-settings! settings config)
|
|
(write-database-settings! config settings)))
|
|
|
|
(define (configure-administrator! config form)
|
|
(unless (admin-ready? config)
|
|
(define admin-values (validate-admin-form form))
|
|
(when (string? admin-values)
|
|
(error 'setup admin-values))
|
|
(create-user! config
|
|
(list-ref admin-values 0)
|
|
(list-ref admin-values 1)
|
|
(list-ref admin-values 2)
|
|
'admin
|
|
'enabled)))
|
|
|
|
(define (cleartext-password-error? message)
|
|
(and (string? message)
|
|
(regexp-match? #rx"refusing to send cleartext password" message)))
|
|
|
|
(define (setup-error-message e)
|
|
(define message (exn-message e))
|
|
(if (cleartext-password-error? message)
|
|
(string-append
|
|
"PostgreSQL requests cleartext password authentication. "
|
|
"Configure the matching pg_hba.conf rule for this database/user to use "
|
|
"scram-sha-256 (recommended), then reload PostgreSQL and try again. "
|
|
"If more than one pg_hba.conf rule could match, remember that PostgreSQL "
|
|
"uses the first matching rule. "
|
|
"The entered non-password fields have been preserved below.\n\n"
|
|
"Technical detail: " message)
|
|
message))
|
|
|
|
(define (complete-setup! config req)
|
|
(call-with-semaphore
|
|
setup-lock
|
|
(λ ()
|
|
(if (setup-complete? config)
|
|
(redirect-response "/login")
|
|
(let ((form (request-form req)))
|
|
(cond
|
|
((not (string=? (form-value form 'setup-token) setup-form-token))
|
|
(setup-page-response
|
|
config
|
|
"Invalid setup form token. Reload the setup page and try again."
|
|
form))
|
|
(else
|
|
(with-handlers ((exn:fail?
|
|
(λ (e)
|
|
(setup-page-response
|
|
config
|
|
(setup-error-message e)
|
|
form))))
|
|
(configure-language! config form)
|
|
(configure-database! config form)
|
|
(configure-administrator! config form)
|
|
(download-vendor-files! config)
|
|
(redirect-response "/login")))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Handle the web-based initial setup page.
|
|
; pre : req is a GET or POST request for /setup.
|
|
; post : POST can configure PostgreSQL, create the first administrator and
|
|
; download frontend libraries.
|
|
; result : An HTML setup response or a redirect to /login.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (setup-handler config req)
|
|
(cond
|
|
((setup-complete? config)
|
|
(redirect-response "/login"))
|
|
((string-ci=? (bytes->string/latin-1 (request-method req)) "POST")
|
|
(complete-setup! config req))
|
|
(else
|
|
(setup-page-response config))))
|