From e751e1e17c0215747e5087cb674a8bfcd7ab702b Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 21 Oct 2026 23:21:37 +0200 Subject: [PATCH] Download timeouts --- private-player-agent/player-agent-core.rkt | 84 ++++++++++++++++--- private-player-agent/player-agent-gui.rkt | 46 ++++++++++ .../player-agent-translate.rkt | 10 +++ private/server.rkt | 5 ++ scribblings/rkt-web-player.scrbl | 6 ++ 5 files changed, 141 insertions(+), 10 deletions(-) diff --git a/private-player-agent/player-agent-core.rkt b/private-player-agent/player-agent-core.rkt index d43ef10..c054cd1 100644 --- a/private-player-agent/player-agent-core.rkt +++ b/private-player-agent/player-agent-core.rkt @@ -84,6 +84,17 @@ (exn-message exception))))) (delete-file file)))) +;;; Copies media in bounded chunks, reporting bytes written without waiting +;;; for a full buffer; slow network streams therefore still show progress. +(define (copy-media-port input output progress!) + (let ((buffer (make-bytes 65536))) + (let loop ((received 0)) + (let ((count (read-bytes-avail! buffer input))) + (unless (eof-object? count) + (write-bytes buffer output 0 count) + (progress! (+ received count)) + (loop (+ received count))))))) + ;;; Evicts least recently used files until the cache fits its byte budget. ;;; Entries contain path, byte size and last use; active files remain protected. (define (trim-media-cache! cache protected [limit 1000000000]) @@ -151,6 +162,7 @@ (pending-auto-music-id #f) (music-tracks (make-hash)) (current-track-value #f) + (download-progress 'null) (acknowledged-command 0) (ended-counter 0) (logical-volume 50) @@ -173,9 +185,11 @@ (define (state-value value fallback) (if (eq? value #f) fallback value)) - ;;; Returns the latest audio state while holding the state semaphore. + ;;; Combines audio and download state under the semaphore so audio callbacks + ;;; cannot erase progress while the next track is being prefetched. (define (snapshot) - (with-agent-state (λ () agent-state))) + (with-agent-state + (λ () (hash-set agent-state 'download download-progress)))) ;;; Returns the currently audible track while holding the state semaphore. (define (current-track) @@ -243,7 +257,7 @@ ;;; Downloads one protected media resource to a temporary local file. ;;; A failed download closes its port and removes its partial file. - (define (download-media! token filename) + (define (download-media! token filename size) (let* ((started (current-inexact-monotonic-milliseconds)) (extension (or (path-get-extension (string->path filename)) #"")) @@ -257,14 +271,35 @@ (λ (exception) (when input (close-input-port input)) (safe-delete-file target) + (with-agent-state + (λ () (set! download-progress 'null))) (raise exception)))) (info-player-agent "Downloading ~a" filename) + (with-agent-state + (λ () + (set! download-progress + (hasheq 'filename filename 'received 0 + 'total (if (exact-nonnegative-integer? size) + size 'null))))) (set! input (get-pure-port (endpoint-url server-url path))) (call-with-output-file target - (λ (output) (copy-port input output)) + (λ (output) + (copy-media-port + input output + (λ (received) + (with-agent-state + (λ () + (set! download-progress + (hash-set download-progress 'received received))))))) #:exists 'truncate/replace) (close-input-port input) + (when (and (exact-nonnegative-integer? size) + (not (= (file-size target) size))) + (error 'player-agent + "Incomplete media download: received ~a of ~a bytes" + (file-size target) size)) + (with-agent-state (λ () (set! download-progress 'null))) (info-player-agent "Downloaded ~a: ~a bytes in ~a ms" filename (file-size target) (round (- (current-inexact-monotonic-milliseconds) @@ -299,12 +334,8 @@ (let ((downloaded (download-media! (hash-ref data 'mediaToken) - (hash-ref data 'filename "track")))) - (when (and (hash-has-key? data 'mediaSize) - (not (= (file-size downloaded) - (hash-ref data 'mediaSize)))) - (safe-delete-file downloaded) - (error 'player-agent "Downloaded media size does not match the server")) + (hash-ref data 'filename "track") + (hash-ref data 'mediaSize #f)))) (with-agent-state (λ () (when found (safe-delete-file (car found))) @@ -541,6 +572,7 @@ (kill-thread command-worker)) (set! worker #f) (set! command-worker #f) + (with-agent-state (λ () (set! download-progress 'null))) (set! executing-command-id 0)) ;;; Restarts the runtime with a new normalized server address and name. @@ -579,6 +611,35 @@ (module+ test (require rackunit) + ;; Progress must arrive before EOF, even when a slow server has sent much + ;; less than one buffer. Binary data must reach the output unchanged. + (let-values (((input writer) (make-pipe))) + (let* ((output (open-output-bytes)) + (updates (make-channel)) + (worker + (thread + (λ () + (copy-media-port input output + (λ (received) + (channel-put updates received))))))) + (dynamic-wind + void + (λ () + (write-bytes #"\0\1\377" writer) + (flush-output writer) + (check-equal? (sync/timeout 5 updates) 3) + (check-equal? (get-output-bytes output) #"\0\1\377") + (write-bytes #"next" writer) + (close-output-port writer) + (check-equal? (sync/timeout 5 updates) 7) + (check-not-false (sync/timeout 5 worker)) + (check-equal? (get-output-bytes output) #"\0\1\377next")) + (λ () + (kill-thread worker) + (close-input-port input) + (close-output-port writer) + (close-output-port output))))) + (check-equal? (normal-state 'initialized) "stopped") (check-equal? (normal-state 'transitioning) "starting") (check-equal? (normal-state 'playing) "playing") @@ -620,6 +681,9 @@ app-id))) (check-false ((player-agent-runtime-running? runtime))) (check-false ((player-agent-runtime-current-track runtime))) + (check-equal? + (hash-ref ((player-agent-runtime-snapshot runtime)) 'download) + 'null) (check-equal? (hash-ref ((player-agent-runtime-snapshot runtime)) 'state) "stopped") diff --git a/private-player-agent/player-agent-gui.rkt b/private-player-agent/player-agent-gui.rkt index dc6af93..24b8930 100644 --- a/private-player-agent/player-agent-gui.rkt +++ b/private-player-agent/player-agent-gui.rkt @@ -95,6 +95,9 @@ (playback-message #f) (playback-details #f) (playback-filename #f) + (download-panel #f) + (download-message #f) + (download-gauge #f) (name-field #f) (server-field #f) (connect-button #f) @@ -163,6 +166,7 @@ (when (and playback-message playback-details playback-filename) (let* ((snapshot ((player-agent-runtime-snapshot runtime))) (track ((player-agent-runtime-current-track runtime))) + (download (hash-ref snapshot 'download 'null)) (state (hash-ref snapshot 'state "stopped")) (title (and track (hash-ref track 'title #f))) (artist (and track (hash-ref track 'artist #f))) @@ -210,6 +214,31 @@ (not (string=? format-name ""))) format-name ""))))) + (when download-panel + (send download-panel show (hash? download)) + (when (hash? download) + (let* ((received (hash-ref download 'received)) + (total (hash-ref download 'total)) + (known-size? (and (number? total) (> total 0))) + (percent (if known-size? + (min 100 (quotient (* received 100) total)) + 0)) + (megabytes + (~r (/ received 1000000.0) #:precision '(= 1)))) + (send download-gauge show known-size?) + (send download-gauge set-value percent) + (send download-message set-label + (cap200 + (format "~a: ~a~a — ~a" + (tr 'downloading) + megabytes + (if known-size? + (format " / ~a MB (~a%)" + (~r (/ total 1000000.0) + #:precision '(= 1)) + percent) + " MB") + (hash-ref download 'filename))))))) (send playback-message set-label (cap200 @@ -385,6 +414,23 @@ (parent playback-panel) (label "—") [ellipsis 'right] [auto-resize #t] [stretchable-width #t])) + (set! download-panel + (new vertical-panel% + (parent playback-panel) + (alignment '(left top)) + (stretchable-height #f))) + (set! download-message + (new ellipsis-msg% + (parent download-panel) + (label "") + [ellipsis 'right] [auto-resize #t] [stretchable-width #t])) + (set! download-gauge + (new gauge% + (parent download-panel) + (label #f) + (range 100) + (stretchable-width #t))) + (send download-panel show #f) (set! quit-button (new button% (parent controls) diff --git a/private-player-agent/player-agent-translate.rkt b/private-player-agent/player-agent-translate.rkt index 705163d..16f8eb3 100644 --- a/private-player-agent/player-agent-translate.rkt +++ b/private-player-agent/player-agent-translate.rkt @@ -31,6 +31,7 @@ 'playing "Playing" 'paused "Paused" 'loading "Loading" + 'downloading "Downloading" 'stopped "Stopped" 'channel "channel" 'channels "channels" @@ -56,6 +57,7 @@ 'playing "Speelt" 'paused "Gepauzeerd" 'loading "Laden" + 'downloading "Downloaden" 'stopped "Gestopt" 'channel "kanaal" 'channels "kanalen" @@ -82,6 +84,7 @@ 'paused "Pausiert" 'loading "Laden" 'stopped "Gestoppt" + 'downloading "Herunterladen" 'channel "Kanal" 'channels "Kanäle" 'tray-open "RKT Web Player Agent öffnen" @@ -106,6 +109,7 @@ 'playing "Lecture" 'paused "En pause" 'loading "Chargement" + 'downloading "Téléchargement" 'stopped "Arrêté" 'channel "canal" 'channels "canaux" @@ -131,6 +135,7 @@ 'playing "Reproduciendo" 'paused "En pausa" 'loading "Cargando" + 'downloading "Descargando" 'stopped "Detenido" 'channel "canal" 'channels "canales" @@ -156,6 +161,7 @@ 'playing "In riproduzione" 'paused "In pausa" 'loading "Caricamento" + 'downloading "Download" 'stopped "Arrestato" 'channel "canale" 'channels "canali" @@ -181,6 +187,7 @@ 'playing "Spelar" 'paused "Pausad" 'loading "Läser in" + 'downloading "Laddar ned" 'stopped "Stoppad" 'channel "kanal" 'channels "kanaler" @@ -206,6 +213,7 @@ 'playing "Spiller" 'paused "På pause" 'loading "Laster" + 'downloading "Laster ned" 'stopped "Stoppet" 'channel "kanal" 'channels "kanaler" @@ -231,6 +239,7 @@ 'playing "Toistetaan" 'paused "Keskeytetty" 'loading "Ladataan" + 'downloading "Ladataan tiedostoa" 'stopped "Pysäytetty" 'channel "kanava" 'channels "kanavaa" @@ -256,6 +265,7 @@ 'playing "Spilar" 'paused "Í bið" 'loading "Hleður" + 'downloading "Sæki" 'stopped "Stöðvað" 'channel "rás" 'channels "rásir" diff --git a/private/server.rkt b/private/server.rkt index 69821f2..60403e0 100644 --- a/private/server.rkt +++ b/private/server.rkt @@ -11,6 +11,7 @@ web-server/dispatch web-server/http web-server/http/json + web-server/safety-limits web-server/servlet-env "library.rkt" "player.rkt" @@ -377,6 +378,10 @@ #:listen-ip listen-ip #:port port #:connection-close? #t + ;; Content-Length responses use one timeout for the entire copy-port. + ;; Large lossless tracks can take several minutes over a healthy link. + #:safety-limits (make-safety-limits #:response-timeout 3600 + #:response-send-timeout 3600) #:launch-browser? launch-browser? #:quit? #f #:banner? #t diff --git a/scribblings/rkt-web-player.scrbl b/scribblings/rkt-web-player.scrbl index da8fba3..3e1bc30 100644 --- a/scribblings/rkt-web-player.scrbl +++ b/scribblings/rkt-web-player.scrbl @@ -141,6 +141,8 @@ in-progress download can temporarily exceed the budget. The cache lasts until the agent exits; it is not retained across restarts. A track that is not cached is still downloaded completely before playback. +The HTTP server allows up to one hour for a response, including media +transfers, so large lossless tracks can finish over slower connections. The next track is fetched after the play command completes. Commands are processed in server order, so a pending prefetch can still delay a later manual track selection. @@ -345,6 +347,10 @@ configured RKT Web Player server, downloads assigned tracks over HTTP, and plays them with @tt{racket-audio}. Its configured display name is authoritative and is followed by the server. Importing the module does not start the GUI; the function must be called explicitly. +During downloads, including prefetching the next track, the GUI shows the +filename and received megabytes. When the server supplies the file size, +it also shows the total size, percentage and a progress bar. The display +updates every half second and disappears when the download finishes or fails. The GUI and its @tt{racket-tray} system tray support the same ten languages based on the operating-system language, with English as fallback. Closing or minimizing the window hides it in the tray. The tray menu restores the window