Download timeouts

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")

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)

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"

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

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