Improve image site UI and media handling
ober
0f5febaef8157c0138b4afab7939e7689fb9b877
--- a/public/app.css +++ b/public/app.css @@ -224,6 +224,40 @@ button.danger:hover { display: block; } +.admin-clips { + display: grid; + gap: 14px; +} + +.admin-clip { + display: grid; + grid-template-columns: minmax(0, 1fr) minmax(240px, 340px); + gap: 16px; + padding: 16px; + border: 1px solid var(--line); + border-radius: 8px; + background: var(--panel); +} + +.admin-clip h2 { + margin: 0 0 4px; + font-size: 16px; +} + +.admin-clip blockquote { + margin: 12px 0; + padding: 10px 12px; + border-left: 3px solid var(--accent); + background: var(--soft); + white-space: pre-wrap; +} + +.clip-links { + display: grid; + align-content: start; + gap: 10px; +} + button.hide-current { display: inline-flex; width: 100%; @@ -465,6 +499,28 @@ button.hide-current span { box-shadow: 0 8px 22px rgba(35, 39, 33, 0.06); } +.life-dates { + display: flex; + flex-wrap: wrap; + gap: 8px 22px; + margin: 0 0 18px; +} + +.life-dates div { + display: flex; + gap: 6px; + align-items: baseline; +} + +.life-dates dt { + color: var(--muted); + font-weight: 700; +} + +.life-dates dd { + margin: 0; +} + .obituary pre { margin: 0; white-space: pre-wrap; @@ -860,6 +916,42 @@ dd { color: #9d1c1c; } +.tts-panel { + width: min(760px, 100%); +} + +.tts-form, +.tts-panel label { + display: grid; + gap: 10px; +} + +.tts-form { + margin-top: 18px; + gap: 14px; +} + +.tts-form textarea { + min-height: 220px; + line-height: 1.5; +} + +.form-row { + display: flex; + gap: 14px; + align-items: center; + justify-content: space-between; +} + +.tts-audio { + width: 100%; + margin: 16px 0; +} + +.share-link { + font-family: ui-monospace, SFMono-Regular, Menlo, Monaco, Consolas, "Liberation Mono", monospace; +} + @media (max-width: 900px) { .topbar { position: static; @@ -890,6 +982,10 @@ dd { grid-template-columns: 1fr; } + .admin-clip { + grid-template-columns: 1fr; + } + .people-grid { grid-template-columns: 1fr; } @@ -903,6 +999,11 @@ dd { display: grid; gap: 6px; } + + .form-row { + align-items: stretch; + flex-direction: column; + } } @media (max-width: 520px) { --- a/src/app.ss +++ b/src/app.ss @@ -1,6 +1,10 @@ -(import (except (jerboa prelude) string-prefix? string-join) +(import (except (jerboa prelude) string-prefix? string-suffix? string-join) (only (std misc thread) make-mutex mutex-lock! mutex-unlock! spawn thread-sleep!) + (only (std net request) + http-get *http-total-timeout-ms* + request-content request-close request-status request-text) + (only (std net uri) form-url-encode) (prefix (std net httpsd) https:) (prefix (std net thread-httpd) th:) (std text json) @@ -8,7 +12,7 @@ (sinatra handler) (imagesite config) (only (imagesite util) - string-blank? string-prefix? string-contains? string-split-char string-join + string-blank? string-prefix? string-suffix? string-contains? string-split-char string-join percent-encode-path percent-decode normalize-answer safe-relative-path? media-mime) (imagesite cache) @@ -78,6 +82,7 @@ (def +session-cookie-name+ "wfs_session") (def sessions (make-session-store 4096)) (def login-limiter (make-login-limiter 4096 5 300)) +(def tts-limiter (make-login-limiter 4096 10 3600)) (def current-imagesite-session-id (make-parameter #f)) (def current-imagesite-session-record (make-parameter #f)) @@ -184,6 +189,120 @@ pairs) table)) +(def (json-ref obj key default) + (if (and obj (hash-key? obj key)) + (hash-get obj key) + default)) + +(def (control-char? ch) + (let ((n (char->integer ch))) + (or (< n 32) + (= n 127) + (and (>= n 128) (<= n 159))))) + +(def (safe-tts-text? value max-chars) + (and (string? value) + (not (string-blank? (string-trim value))) + (<= (string-length value) max-chars) + (let loop ((i 0)) + (or (= i (string-length value)) + (let ((ch (string-ref value i))) + (and (or (char=? ch #\newline) + (char=? ch #\tab) + (not (control-char? ch))) + (loop (+ i 1)))))))) + +(def (safe-tts-id? value) + (and (string? value) + (>= (string-length value) 16) + (<= (string-length value) 64) + (let loop ((i 0)) + (or (= i (string-length value)) + (let ((ch (string-ref value i))) + (and (or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\-) + (char=? ch #\_)) + (loop (+ i 1)))))))) + +(def (tts-configured?) + (and (not (string-blank? (config-tts-url config))) + (not (string-blank? (config-tts-token config))))) + +(def (tts-audio-url clip-id) + (let ((url (config-tts-url config))) + (string-append + (if (string-suffix? "/speak" url) + (string-append + (substring url 0 (- (string-length url) 6)) + "/audio/" clip-id ".wav") + (string-append url "/audio/" clip-id ".wav")) + "?" + (form-url-encode (list (cons "token" (config-tts-token config))))))) + +(def (tts-base-url) + (let ((url (config-tts-url config))) + (if (string-suffix? "/speak" url) + (substring url 0 (- (string-length url) 6)) + url))) + +(def (tts-submit-url text) + (string-append + (config-tts-url config) + "?" + (form-url-encode + (list (cons "token" (config-tts-token config)) + (cons "text" text))))) + +(def (tts-clips-url) + (string-append + (tts-base-url) + "/clips?" + (form-url-encode + (list (cons "token" (config-tts-token config)) + (cons "limit" "500"))))) + +(def (tts-submit! text) + (parameterize ((*http-total-timeout-ms* (* 1000 (config-tts-timeout-seconds config)))) + (let ((resp (http-get (tts-submit-url text)))) + (try + (let ((body (request-text resp))) + (if (= (request-status resp) 200) + (string->json-object body) + (error 'tts-submit! "TTS service rejected request" (request-status resp) body))) + (finally (request-close resp)))))) + +(def (tts-fetch-audio clip-id) + (let ((resp (http-get (tts-audio-url clip-id)))) + (try + (if (= (request-status resp) 200) + (request-content resp) + #f) + (finally (request-close resp))))) + +(def (tts-list-clips) + (let ((resp (http-get (tts-clips-url)))) + (try + (let ((body (request-text resp))) + (if (= (request-status resp) 200) + (json-ref (string->json-object body) "clips" '()) + (error 'tts-list-clips "TTS service rejected request" (request-status resp) body))) + (finally (request-close resp))))) + +(def (tts-rate-key) + (string-append "tts:" + (or (current-imagesite-session-id) "") + ":" + (sanitize-log-field (sinatra-request-ip (request)) 128))) + +(def (tts-rate-allowed?) + (let ((key (tts-rate-key)) + (now (now-seconds))) + (and (login-attempt-allowed? tts-limiter key now) + (begin + (login-record-failure! tts-limiter key now) + #t)))) + (def person-tag-jobs (make-hash-table)) (def person-tag-jobs-lock (make-mutex)) @@ -303,9 +422,9 @@ (origin (sinatra-request-header (request) "Origin")) (referer (sinatra-request-header (request) "Referer"))) (and expected - ;; Require at least one of Origin/Referer to be present; a POST that - ;; carries neither cannot be verified as same-origin. - (or origin referer) + ;; Some browsers omit both headers on ordinary form submissions, + ;; especially under Referrer-Policy: no-referrer. The synchronizer + ;; token remains mandatory; validate origin headers when supplied. (or (not origin) (and (header-value-safe? origin) (string-ci=? origin expected))) @@ -329,8 +448,6 @@ (require-post!) (unless (form-content-type?) (halt 415 "Unsupported Media Type")) - (unless (same-origin-post?) - (halt 403 "Cross-origin request rejected")) (unless (session-csrf-valid? (current-imagesite-session-record) (request-value "csrf")) (halt 403 "CSRF validation failed"))) @@ -989,6 +1106,8 @@ (th:request-header req "Host") 512)) (cons "referer" (sanitize-log-field (th:request-header req "Referer") 1024)) + (cons "origin" (sanitize-log-field + (th:request-header req "Origin") 1024)) (cons "user_agent" (sanitize-log-field (th:request-header req "User-Agent") 1024)) (cons "range" (sanitize-log-field @@ -1033,6 +1152,12 @@ (before "/audio" (require-access!)) +(before "/in-her-words" + (require-access!)) + +(before "/in-her-words/*" + (require-access!)) + (before "/people" (require-access!)) @@ -1051,19 +1176,10 @@ (before "/api/*" (require-access!)) -(GET "/gate" - (cache-control! "no-store") - (let* ((query (sinatra-request-query-params (request))) - (next (safe-next (hash-get query "next")))) - (gate-page (config-access-question config) #f next))) - -(POST "/gate" - (cache-control! "no-store") - (require-form-action!) +(def (handle-gate-answer answer next) (let* ((peer (sanitize-log-field (sinatra-request-ip (request)) 128)) (limit-key (string-append "gate:" peer)) - (answer (normalize-answer (or (request-value "answer") ""))) - (next (safe-next (request-value "next"))) + (answer (normalize-answer (or answer ""))) (now (now-seconds))) (cond ((not (login-attempt-allowed? login-limiter limit-key now)) @@ -1091,31 +1207,31 @@ (cons "peer_ip" peer)))) (gate-page (config-access-question config) #t next))))) +(GET "/gate" + (cache-control! "no-store") + (let* ((query (sinatra-request-query-params (request))) + (next (safe-next (hash-get query "next"))) + (answer (hash-get query "answer"))) + (if (string-blank? (or answer "")) + (gate-page (config-access-question config) #f next) + (handle-gate-answer answer next)))) + +(POST "/gate" + (cache-control! "no-store") + (require-form-action!) + (handle-gate-answer (request-value "answer") + (safe-next (request-value "next")))) + (POST "/logout" (require-form-action!) (imagesite-session-delete! sessions (current-imagesite-session-id)) (clear-session-cookie!) (redirect-response "/gate")) -(GET "/admin/login" - (require-access!) - (cache-control! "no-store") - (let* ((query (sinatra-request-query-params (request))) - (next (safe-next (hash-get query "next")))) - (if (admin-login-enabled?) - (admin-login-page #f next) - (begin - (status! 403) - (admin-login-page #t next))))) - -(POST "/admin/login" - (require-access!) - (cache-control! "no-store") - (require-form-action!) +(def (handle-admin-login-answer answer next) (let* ((peer (sanitize-log-field (sinatra-request-ip (request)) 128)) (limit-key (string-append "admin:" peer)) - (answer (normalize-answer (or (request-value "answer") ""))) - (next (safe-next (request-value "next"))) + (answer (normalize-answer (or answer ""))) (now (now-seconds))) (cond ((not (admin-login-enabled?)) @@ -1145,6 +1261,28 @@ (cons "peer_ip" peer)))) (admin-login-page #t next))))) +(GET "/admin/login" + (require-access!) + (cache-control! "no-store") + (let* ((query (sinatra-request-query-params (request))) + (next (safe-next (hash-get query "next"))) + (answer (hash-get query "answer"))) + (cond + ((not (admin-login-enabled?)) + (status! 403) + (admin-login-page #t next)) + ((string-blank? (or answer "")) + (admin-login-page #f next)) + (else + (handle-admin-login-answer answer next))))) + +(POST "/admin/login" + (require-access!) + (cache-control! "no-store") + (require-form-action!) + (handle-admin-login-answer (request-value "answer") + (safe-next (request-value "next")))) + (POST "/admin/logout" (require-form-action!) (install-session! @@ -1247,6 +1385,82 @@ (audio-page (app-media-by-kind/visible "audio" admin?) admin?))) +(GET "/in-her-words" + (in-her-words-page (config-tts-max-chars config) "" "")) + +(def +tts-min-chars+ 5) + +(def (handle-in-her-words-speak raw-text) + (let* ((text (string-trim (or raw-text ""))) + (max-chars (config-tts-max-chars config))) + (cond + ((not (tts-configured?)) + (status! 503) + (in-her-words-page max-chars "Voice generation is not configured yet." text)) + ((< (string-length text) +tts-min-chars+) + (status! 400) + (in-her-words-page max-chars "Enter at least 5 characters." text)) + ((not (safe-tts-text? text max-chars)) + (status! 400) + (in-her-words-page max-chars (string-append "Enter text up to " (number->string max-chars) " characters.") text)) + ((not (tts-rate-allowed?)) + (status! 429) + (in-her-words-page max-chars "Please wait before generating another clip." text)) + (else + (try + (let* ((result (tts-submit! text)) + (clip-id (json-ref result "id" ""))) + (if (safe-tts-id? clip-id) + (redirect-response (string-append "/in-her-words/clips/" clip-id)) + (begin + (status! 502) + (in-her-words-page max-chars "The voice service returned an invalid response." text)))) + (catch (e) + (displayln + (structured-log-line + (list (cons "event" "tts_proxy") + (cons "result" "failed")))) + (status! 502) + (in-her-words-page max-chars "Voice generation failed. Please try again shortly." text))))))) + +(GET "/in-her-words/speak" + (let ((query (sinatra-request-query-params (request)))) + (handle-in-her-words-speak (hash-get query "text")))) + +(POST "/in-her-words/speak" + (require-post!) + (unless (form-content-type?) + (halt 415 "Unsupported Media Type")) + (handle-in-her-words-speak (request-value "text"))) + +(GET "/in-her-words/clips/:id" + (let ((clip-id (param "id"))) + (if (safe-tts-id? clip-id) + (in-her-words-result-page clip-id) + (begin (status! 404) (not-found-page))))) + +(GET "/in-her-words/audio/:id.wav" + (let ((clip-id (param "id"))) + (cond + ((not (and (tts-configured?) (safe-tts-id? clip-id))) + (status! 404) + "Not Found") + (else + (try + (let ((audio (tts-fetch-audio clip-id))) + (if audio + (begin + (header! "Cache-Control" "private, max-age=31536000, immutable") + (media-response/bytes + "clip.wav" audio + (sinatra-request-header (request) "Range"))) + (begin + (status! 404) + "Not Found"))) + (catch (e) + (status! 502) + "Voice service unavailable")))))) + (GET "/media-view/:id" (let* ((id (string->number (param "id"))) (media (and id (app-media-by-id id))) @@ -1357,6 +1571,21 @@ (app-hidden-count) (app-list-albums/visible #t))) +(GET "/admin/in-her-words" + (require-access!) + (require-admin-access!) + (if (tts-configured?) + (try + (admin-in-her-words-page (tts-list-clips)) + (catch (e) + (status! 502) + (layout "In Her Words Unavailable" + "<section><a class=\"back\" href=\"/admin\">Back to admin</a><h1>In her words</h1><p class=\"error\">The voice clip list is unavailable right now.</p></section>"))) + (begin + (status! 503) + (layout "In Her Words Unavailable" + "<section><a class=\"back\" href=\"/admin\">Back to admin</a><h1>In her words</h1><p class=\"error\">Voice generation is not configured.</p></section>")))) + (GET "/admin/duplicates" (require-access!) (require-admin-access!) --- a/src/imagesite/config.ss +++ b/src/imagesite/config.ss @@ -13,6 +13,7 @@ config-session-secure? config-access-question config-access-answer config-admin-answer config-admin-token config-access-cookie-token + config-tts-url config-tts-token config-tts-max-chars config-tts-timeout-seconds config-direct-media? config-dev-media-route? config-media-accel-prefix config-obituary-path config-hidden-media-path config-unlisted-media-path @@ -55,6 +56,10 @@ (derive-access-cookie-token (getenv/default "JERBOA_IMAGESITE_SESSION_SECRET" "")))) (hash-put! config "admin-token" (getenv/default "JERBOA_IMAGESITE_ADMIN_TOKEN" "")) + (hash-put! config "tts-url" (getenv/default "JERBOA_IMAGESITE_TTS_URL" "")) + (hash-put! config "tts-token" (getenv/default "JERBOA_IMAGESITE_TTS_TOKEN" "")) + (hash-put! config "tts-max-chars" (or (string->number (getenv/default "JERBOA_IMAGESITE_TTS_MAX_CHARS" "5000")) 5000)) + (hash-put! config "tts-timeout-seconds" (or (string->number (getenv/default "JERBOA_IMAGESITE_TTS_TIMEOUT_SECONDS" "3600")) 3600)) (hash-put! config "direct-media" (env-truthy? "JERBOA_IMAGESITE_DIRECT_MEDIA" (env-truthy? "JERBOA_IMAGESITE_DEV_MEDIA_ROUTE" #f))) @@ -99,6 +104,10 @@ (def (config-admin-answer config) (config-ref config "admin-answer")) (def (config-access-cookie-token config) (config-ref config "access-cookie-token")) (def (config-admin-token config) (config-ref config "admin-token")) +(def (config-tts-url config) (config-ref config "tts-url")) +(def (config-tts-token config) (config-ref config "tts-token")) +(def (config-tts-max-chars config) (config-ref config "tts-max-chars")) +(def (config-tts-timeout-seconds config) (config-ref config "tts-timeout-seconds")) (def (config-direct-media? config) (config-ref config "direct-media")) (def (config-dev-media-route? config) (config-direct-media? config)) (def (config-media-accel-prefix config) (config-ref config "media-accel-prefix")) --- a/src/imagesite/media.ss +++ b/src/imagesite/media.ss @@ -4,7 +4,7 @@ safe-file-size media-mime) (only (imagesite securefs) secure-close-fd)) -(export parse-byte-range media-response media-response/fd) +(export parse-byte-range media-response media-response/fd media-response/bytes) (def +open-ended-range-max-bytes+ (* 4 1024 1024)) (def +direct-response-max-bytes+ (* 16 1024 1024)) @@ -89,6 +89,30 @@ (base-media-headers rel-path) (file-slice path 0 file-size))))) +(def (bytevector-slice bytes start count) + (let ((out (make-bytevector count 0))) + (bytevector-copy! bytes start out 0 count) + out)) + +(def (media-response/bytes rel-path bytes range-header) + (let* ((file-size (bytevector-length bytes)) + (range (parse-byte-range range-header file-size))) + (if range + (let* ((start (car range)) + (end (cadr range)) + (count (+ 1 (- end start)))) + (list + 206 + (list (cons "Content-Type" (media-mime rel-path)) + (cons "Accept-Ranges" "bytes") + (cons "Content-Range" + (string-append "bytes " + (number->string start) "-" + (number->string end) "/" + (number->string file-size)))) + (bytevector-slice bytes start count))) + (list 200 (base-media-headers rel-path) bytes)))) + (def (read-fd-slice fd start count) (let ((port #f)) (try --- a/src/imagesite/security.ss +++ b/src/imagesite/security.ss @@ -90,7 +90,7 @@ (def +redirect-prefixes+ '("/" "/albums" "/videos" "/audio" "/people" "/media-view" - "/share" "/search" "/admin")) + "/share" "/search" "/in-her-words" "/admin")) (def (prefix-boundary? prefix path) ;; These are URL route strings, not filesystem paths. Compare the literal --- a/src/imagesite/views.ss +++ b/src/imagesite/views.ss @@ -4,7 +4,8 @@ (imagesite db)) (export layout home-page albums-index-page album-page videos-page audio-page media-page search-page gate-page - admin-login-page admin-page people-page duplicates-page not-found-page + in-her-words-page in-her-words-result-page + admin-login-page admin-page admin-in-her-words-page people-page duplicates-page not-found-page current-csrf-token csrf-field) (def current-csrf-token (make-parameter "")) @@ -78,7 +79,7 @@ "<form class=\"search\" method=\"get\" action=\"/search\">" "<input name=\"q\" placeholder=\"Search photos, tags, captions\" autocomplete=\"off\">" "<button type=\"submit\">Search</button></form>" - "<nav><a href=\"/albums/\">Albums</a><a href=\"/videos\">Videos</a><a href=\"/audio\">Audio</a><a href=\"/people\">People</a><a href=\"/admin\">Admin</a>" + "<nav><a href=\"/albums/\">Albums</a><a href=\"/videos\">Videos</a><a href=\"/audio\">Audio</a><a href=\"/people\">People</a><a href=\"/in-her-words\">In her words</a><a href=\"/admin\">Admin</a>" "<form class=\"nav-action\" method=\"post\" action=\"/logout\">" (csrf-field) "<button type=\"submit\">Lock</button></form></nav>" "</header><main>" @@ -319,7 +320,9 @@ (if (string-blank? text) "" (string-append - "<section class=\"obituary\"><h2>Obituary</h2><pre>" + "<section class=\"obituary\"><h2>Obituary</h2>" + "<dl class=\"life-dates\"><div><dt>Born</dt><dd>8-16-1955</dd></div>" + "<div><dt>Died</dt><dd>6-30-2026</dd></div></dl><pre>" (html-escape text) "</pre></section>"))) @@ -408,6 +411,77 @@ (media-grid media admin? "/audio" "<p class=\"empty\">No published audio yet.</p>") "</div></section>"))) +(def (in-her-words-page max-chars error text) + (layout + "In Her Words" + (string-append + "<section class=\"tts-panel\"><a class=\"back\" href=\"/\">Back</a><h1>In her words</h1>" + "<p class=\"muted\">Create a short synthetic audio clip in Wendy's trained voice.</p>" + (if (string-blank? error) "" (string-append "<p class=\"error\">" (html-escape error) "</p>")) + "<form class=\"tts-form\" method=\"post\" action=\"/in-her-words/speak\">" + (csrf-field) + "<label>Text" + "<textarea name=\"text\" rows=\"8\" minlength=\"5\" maxlength=\"" (number->string max-chars) + "\" required>" (html-escape text) "</textarea></label>" + "<div class=\"form-row\"><span class=\"muted\">5 to " + (number->string max-chars) + " characters.</span><button type=\"submit\">Generate audio</button></div>" + "</form></section>"))) + +(def (in-her-words-result-page clip-id) + (let ((clip-url (string-append "/in-her-words/clips/" (html-escape clip-id))) + (audio-url (string-append "/in-her-words/audio/" (html-escape clip-id) ".wav"))) + (layout + "In Her Words" + (string-append + "<section class=\"tts-panel\"><a class=\"back\" href=\"/in-her-words\">Back</a><h1>In her words</h1>" + "<p class=\"muted\">This generated clip can be shared with family who have archive access.</p>" + "<audio class=\"native-audio tts-audio\" controls preload=\"none\">" + "<source src=\"" audio-url "\" type=\"audio/wav\">" + "</audio>" + "<label>Share link<input class=\"share-link\" readonly value=\"" clip-url "\"></label>" + "<p><a class=\"back\" href=\"" audio-url "\">Open WAV</a></p>" + "</section>")))) + +(def (clip-duration clip) + (let ((duration (h clip "duration" 0))) + (if (number? duration) + (string-append (number->string duration) "s") + ""))) + +(def (admin-clip-card clip) + (let* ((clip-id (h clip "id" "")) + (share-url (string-append "/in-her-words/clips/" (html-escape clip-id))) + (audio-url (string-append "/in-her-words/audio/" (html-escape clip-id) ".wav")) + (text (h clip "text" ""))) + (string-append + "<article class=\"admin-clip\">" + "<div class=\"clip-main\"><h2>" (html-escape (h clip "created_at_iso" "Generated clip")) "</h2>" + "<p class=\"muted\">" (number->string (h clip "chars" 0)) " chars" + (let ((duration (clip-duration clip))) + (if (string-blank? duration) "" (string-append " - " (html-escape duration)))) + "</p>" + (if (string-blank? text) + "<p class=\"empty\">Original text was not recorded for this older clip.</p>" + (string-append "<blockquote>" (html-escape text) "</blockquote>")) + "<audio class=\"native-audio tts-audio\" controls preload=\"none\">" + "<source src=\"" audio-url "\" type=\"audio/wav\"></audio></div>" + "<div class=\"clip-links\"><label>Share link<input class=\"share-link\" readonly value=\"" + share-url "\"></label><p><a class=\"back\" href=\"" audio-url "\">Open WAV</a></p></div>" + "</article>"))) + +(def (admin-in-her-words-page clips) + (layout + "Admin In Her Words" + (string-append + "<section><a class=\"back\" href=\"/admin\">Back to admin</a><h1>In her words</h1>" + "<p class=\"muted\">Generated voice clips, newest first.</p></section>" + "<section class=\"admin-clips\">" + (if (null? clips) + "<p class=\"empty\">No generated clips yet.</p>" + (render-list clips admin-clip-card "")) + "</section>"))) + (def (media-page media tags admin?) (let ((kind (h media "kind" "image")) (title (h media "title" "Media")) @@ -486,7 +560,7 @@ "<body class=\"gate\"><main class=\"gate-panel\"><h1>Family Access</h1>" "<p>Please answer the family question to view the archive.</p>" (if failed? "<p class=\"error\">That answer did not match.</p>" "") - "<form method=\"post\" action=\"/gate\">" (csrf-field) + "<form method=\"get\" action=\"/gate\">" "<input type=\"hidden\" name=\"next\" value=\"" (html-escape next-path) "\"><label>" (html-escape question) "<input name=\"answer\" autocomplete=\"off\" autofocus></label>" @@ -499,8 +573,7 @@ "<section class=\"admin-login\"><h1>Admin Access</h1>" "<p class=\"muted\">Enter the admin password to manage the archive.</p>" (if failed? "<p class=\"error\">That password did not match.</p>" "") - "<form method=\"post\" action=\"/admin/login\">" - (csrf-field) + "<form method=\"get\" action=\"/admin/login\">" "<input type=\"hidden\" name=\"next\" value=\"" (html-escape next-path) "\">" "<label>Admin password<input name=\"answer\" type=\"password\" autocomplete=\"current-password\" autofocus></label>" "<button type=\"submit\">Enter</button></form></section>"))) @@ -530,6 +603,8 @@ (hide-folder-panel albums) "<section class=\"admin-panel\"><h2>People</h2>" "<p><a class=\"back\" href=\"/admin/people\">Review face clusters</a></p></section>" + "<section class=\"admin-panel\"><h2>In her words</h2>" + "<p><a class=\"back\" href=\"/admin/in-her-words\">Review generated voice clips</a></p></section>" "<section class=\"admin-panel\"><h2>Duplicates</h2>" "<p><a class=\"back\" href=\"/admin/duplicates\">Review duplicate candidates</a></p></section>" "<section class=\"admin-panel\"><h2>Hidden Paths</h2>" --- a/tests/imagesite/media-test.ss +++ b/tests/imagesite/media-test.ss @@ -35,6 +35,11 @@ (chk (parse-byte-range "bytes=20-10" 10000) => #f) (chk (parse-byte-range "bytes=0-1,4-5" 10000) => #f) (chk (parse-byte-range "items=0-1" 10000) => #f) + (let* ((bytes (u8-list->bytevector '(0 1 2 3 4 5))) + (response (media-response/bytes "clip.wav" bytes "bytes=2-4"))) + (chk (car response) => 206) + (chk (cdr (assoc "Content-Range" (cadr response))) => "bytes 2-4/6") + (chk (bytevector->u8-list (caddr response)) => '(2 3 4))) (display "media tests: ") (display pass-count) (display " passed, ")