Foutafhandeling

private-player-agent/player-agent-core.rkt

@@ -86,9 +86,13 @@
 
 ;;; 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!)
+(define (copy-media-port input output progress! #:idle-timeout [idle-timeout 60])
   (let ((buffer (make-bytes 65536)))
     (let loop ((received 0))
+      (unless (sync/timeout idle-timeout input)
+        (error 'player-agent
+               "Download timeout: no data received for ~a seconds (~a bytes received)"
+               idle-timeout received))
       (let ((count (read-bytes-avail! buffer input)))
         (unless (eof-object? count)
           (write-bytes buffer output 0 count)
@@ -224,7 +228,7 @@
                 'format (let ((decoder (hash-ref full-state 'decoder #f)))
                           (if decoder (format "~a" decoder) ""))
                 'volume logical-volume
-                'error 'null))
+                'error (hash-ref agent-state 'error 'null)))
          (when (and pending-auto-music-id
                     (number? audible-music-id)
                     (= pending-auto-music-id audible-music-id))
@@ -257,7 +261,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 size)
+  (define (download-media-once! token filename size)
     (let* ((started (current-inexact-monotonic-milliseconds))
            (extension
             (or (path-get-extension (string->path filename)) #""))
@@ -306,6 +310,22 @@
                                      started)))
         target)))
 
+  ;;; Retries interrupted downloads twice before reporting a final failure.
+  ;;; Each attempt removes its partial file; the media token stays unacknowledged.
+  (define (download-media! token filename size)
+    (let loop ((attempt 1))
+      (with-handlers
+          ((exn:fail?
+            (λ (exception)
+              (if (< attempt 3)
+                  (begin
+                    (warn-player-agent "Download attempt ~a failed for ~a: ~a; retrying"
+                                       attempt filename (exn-message exception))
+                    (sleep 1)
+                    (loop (+ attempt 1)))
+                  (raise exception)))))
+        (download-media-once! token filename size))))
+
   ;;; Scopes media identity to its server, source path, size and modification time.
   ;;; Older servers without version metadata only reuse the same media token.
   (define (command-cache-key data)
@@ -543,12 +563,28 @@
                              (λ (exception)
                                (warn-player-agent "Command failed: ~a"
                                                   (exn-message exception))
+                               (when (and audio
+                                          (equal? (hash-ref command 'action) "play"))
+                                 (with-handlers
+                                     ((exn:fail?
+                                       (λ (stop-exception)
+                                         (warn-player-agent
+                                          "Could not stop audio after failed play: ~a"
+                                          (exn-message stop-exception)))))
+                                   (audio-stop! audio)))
                                (with-agent-state
                                 (λ ()
                                   (set! loading-media-key #f)
+                                  (when (equal? (hash-ref command 'action) "play")
+                                    (set! agent-state
+                                          (hash-set* agent-state
+                                                     'state "stopped"
+                                                     'position 0)))
                                   (trim-cache!)))
                                (set-agent-error! (exn-message exception)))))
-                         (clear-agent-error!)
+                         ;; A queued prefetch must not erase a failed play's error.
+                         (unless (equal? (hash-ref command 'action) "prefetch")
+                           (clear-agent-error!))
                          (execute-command! command))
                        (set! acknowledged-command (hash-ref command 'id))
                        (set! executing-command-id 0)
@@ -609,7 +645,102 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module+ test
-  (require rackunit)
+  (require rackunit
+           racket/async-channel
+           web-server/http
+           web-server/http/json
+           web-server/web-server
+           (prefix-in lift: web-server/dispatchers/dispatch-lift))
+
+  ;; Exercise real polling after three truncated downloads. A queued prefetch
+  ;; must preserve the error, and a subsequent Stop must still be processed.
+  (test-case "failed download reports stopped and accepts subsequent commands"
+    (let* ((ready (make-async-channel))
+           (done (make-semaphore 0))
+           (attempts 0)
+           (prefetch-attempts 0)
+           (reports (make-hash))
+           (runtime #f)
+           (stop-server
+            (serve
+             #:port 0 #:listen-ip "127.0.0.1"
+             #:confirmation-channel ready #:connection-close? #t
+             #:dispatch
+             (lift:make
+              (λ (request)
+                (let ((path (url->string (request-uri request))))
+                  (cond
+                    ((equal? path "/api/agent/register")
+                     (response/jsexpr (hasheq)))
+                    ((equal? path "/api/agent/poll")
+                     (let* ((data (bytes->jsexpr (request-post-data/raw request)))
+                            (ack (hash-ref data 'ack))
+                            (command
+                             (case ack
+                               ((0) (hasheq 'id 1 'action "play"
+                                            'data (hasheq 'mediaToken "broken"
+                                                          'filename "broken.flac"
+                                                          'mediaSize 8)))
+                               ((1) (hasheq 'id 2 'action "prefetch"
+                                            'data (hasheq 'mediaToken "next"
+                                                          'filename "next.flac"
+                                                          'mediaSize 4)))
+                               ((2) (hasheq 'id 3 'action "stop"))
+                               (else 'null))))
+                       (hash-set! reports ack (hash-ref data 'state))
+                       (when (= ack 3) (semaphore-post done))
+                       (response/jsexpr (hasheq 'command command))))
+                    (else
+                     (when (regexp-match? #rx"broken$" path)
+                       (set! attempts (+ attempts 1)))
+                     (when (regexp-match? #rx"next$" path)
+                       (set! prefetch-attempts (+ prefetch-attempts 1)))
+                     (let ((body (if (and (regexp-match? #rx"next$" path)
+                                          (= prefetch-attempts 1))
+                                     #"12" #"1234")))
+                       (response/output
+                        (λ (output) (write-bytes body output))
+                        #:headers
+                        (list (header #"Content-Length"
+                                      (string->bytes/utf-8
+                                       (number->string (bytes-length body)))))))))))))))
+      (dynamic-wind
+        void
+        (λ ()
+          (let ((port (async-channel-get ready)))
+            (when (exn? port) (raise port))
+            (set! runtime
+                  (make-player-agent-runtime
+                   (format "http://127.0.0.1:~a" port) "Test" (make-string 64 #\a)))
+            ((player-agent-runtime-start! runtime))
+            (check-not-false (sync/timeout 15 done))
+            (check-equal? attempts 3)
+            (check-equal? prefetch-attempts 2)
+            (let ((failed (hash-ref reports 1 (hasheq)))
+                  (prefetched (hash-ref reports 2 (hasheq)))
+                  (stopped (hash-ref reports 3 (hasheq))))
+              (check-equal? (hash-ref failed 'state #f) "stopped")
+              (check-regexp-match #rx"received 4 of 8 bytes"
+                                  (hash-ref failed 'error ""))
+              (check-equal? (hash-ref failed 'download #f) 'null)
+              (check-equal? (hash-ref prefetched 'error #f)
+                            (hash-ref failed 'error ""))
+              (check-equal? (hash-ref stopped 'error #f) 'null)
+              (check-true ((player-agent-runtime-running? runtime))))))
+        (λ ()
+          (when runtime ((player-agent-runtime-shutdown! runtime)))
+          (stop-server)))))
+
+  ;; An open stream that stops delivering bytes must not occupy the worker forever.
+  (let-values (((input writer) (make-pipe)))
+    (dynamic-wind
+      void
+      (λ ()
+        (check-exn #rx"Download timeout: no data received"
+                   (λ ()
+                     (copy-media-port input (open-output-bytes) void
+                                      #:idle-timeout 0.02))))
+      (λ () (close-input-port input) (close-output-port writer))))
 
   ;; Progress must arrive before EOF, even when a slow server has sent much
   ;; less than one buffer. Binary data must reach the output unchanged.

private-player-agent/player-agent-gui.rkt

@@ -98,6 +98,7 @@
         (download-panel #f)
         (download-message #f)
         (download-gauge #f)
+        (error-message #f)
         (name-field #f)
         (server-field #f)
         (connect-button #f)
@@ -214,6 +215,11 @@
                            (not (string=? format-name "")))
                       format-name
                       "")))))
+          (when error-message
+            (let ((message (hash-ref snapshot 'error 'null)))
+              (send error-message show (string? message))
+              (send error-message set-label
+                    (if (string? message) (cap200 message) ""))))
           (when download-panel
             (send download-panel show (hash? download))
             (when (hash? download)
@@ -431,6 +437,12 @@
                  (range 100)
                  (stretchable-width #t)))
       (send download-panel show #f)
+      (set! error-message
+            (new ellipsis-msg%
+                 (parent playback-panel)
+                 (label "")
+                 [ellipsis 'right] [auto-resize #t] [stretchable-width #t]))
+      (send error-message show #f)
       (set! quit-button
             (new button%
                  (parent controls)

scribblings/rkt-web-player.scrbl

@@ -351,6 +351,13 @@ 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.
+Interrupted downloads are retried twice, starting again from the beginning.
+After 60 seconds without incoming media data, the agent aborts the attempt
+instead of waiting indefinitely. If all three attempts fail, a failed play
+returns to the stopped state and the GUI displays the error, including byte
+counts for an incomplete file. Background prefetching and audio status updates
+preserve this message; a new playback command clears it. Polling continues,
+so subsequent commands can still be processed.
 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