Foutafhandeling
This commit is contained in:
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user