laten zien hoe downloads en zo gaan

private/dlna-playback.rkt

@@ -359,7 +359,10 @@
                          (make-semaphore 1))))
     (set-dlna-playback-monitor!
      playback
-     (thread (λ () (monitor-loop playback poll-seconds))))
+     (thread (λ ()
+               (with-handlers ((exn:break? void))
+                 (parameterize-break #t
+                   (monitor-loop playback poll-seconds))))))
     playback))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -483,7 +486,9 @@
     (set-dlna-playback-running?! playback #f)
     (let ((monitor (dlna-playback-monitor playback)))
       (when (and monitor (not (thread-dead? monitor)))
-        (kill-thread monitor))
+        ;; A break unwinds call-with-semaphore; kill-thread leaves its lock held.
+        (break-thread monitor)
+        (thread-wait monitor))
       (set-dlna-playback-monitor! playback #f)
       (with-lock
        playback

private/player.rkt

@@ -1461,6 +1461,11 @@
                         (player-renderers value))
         'rendererId (or (playback-session-selected-id session) 'null)
         'currentIndex (or (playback-session-current-index session) 'null)
+        'download
+        (let ((backend (playback-session-backend session)))
+          (if (and backend (eq? (playback-session-backend-kind session) 'agent))
+              (hash-ref (playback-agent-reported-state backend) 'download 'null)
+              'null))
         'state (symbol->string (playback-session-state session))
         'position (playback-session-position session)
         'duration (or (playback-session-duration session) 'null)
@@ -2154,7 +2159,13 @@
                    'state
                    (hasheq 'state "stopped"
                            'position 0
-                           'volume 25))))
+                           'volume 25
+                           'download (hasheq 'filename "Large.flac"
+                                             'received 65536 'total 100000000)))))
+
+        (check-equal?
+         (hash-ref (player-state->jsexpr example-player) 'download)
+         (hasheq 'filename "Large.flac" 'received 65536 'total 100000000))
 
         (check-equal?
          (hash-ref (hash-ref first-poll 'command) 'action)

private/server.rkt

@@ -7,6 +7,8 @@
          racket/runtime-path
          racket-mimetypes
          racket/string
+         racket/path
+         simple-log
          net/url
          web-server/dispatch
          web-server/http
@@ -19,6 +21,8 @@
 
 (provide serve-player)
 
+(sl-def-log web-player-http)
+
 (define-runtime-path public-directory "../public")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -176,16 +180,47 @@
       player
       (request-jsexpr request)))))
 
+;;; Streams an agent download without holding player locks and reports its
+;;; start, progress and outcome, including the client and actual bytes sent.
+(define (stream-agent-media! file output client app-id)
+  (let ((received 0)
+        (total (file-size file))
+        (started (current-inexact-monotonic-milliseconds))
+        (reported (current-inexact-monotonic-milliseconds))
+        (completed? #f)
+        (name (file-name-from-path file)))
+    (dynamic-wind
+      (λ () (info-web-player-http "Agent download started: client=~a agent=~a file=~a bytes=~a"
+                                  client (substring app-id 0 8) name total))
+      (λ ()
+        (call-with-input-file
+         file
+         (λ (input)
+           (let ((buffer (make-bytes 65536)))
+             (let loop ()
+               (let ((count (read-bytes-avail! buffer input)))
+                 (unless (eof-object? count)
+                   (write-bytes buffer output 0 count)
+                   (set! received (+ received count))
+                   (when (>= (- (current-inexact-monotonic-milliseconds) reported) 5000)
+                     (set! reported (current-inexact-monotonic-milliseconds))
+                     (info-web-player-http "Agent download progress: client=~a file=~a bytes=~a/~a"
+                                           client name received total))
+                   (loop)))))))
+        (flush-output output)
+        (set! completed? #t))
+      (λ ()
+        (info-web-player-http "Agent download ~a: client=~a file=~a bytes=~a/~a elapsed-ms=~a"
+                              (if completed? "sent" "interrupted") client name received total
+                              (round (- (current-inexact-monotonic-milliseconds) started)))))))
+
 ;;; Streams the media file identified by an agent's opaque token.
-(define (agent-media-handler player _request app-id token)
+(define (agent-media-handler player request app-id token)
   (let ((file (player-agent-media player app-id token)))
     (if (and file (file-exists? file))
         (response/output
          (λ (output)
-           (call-with-input-file
-            file
-            (λ (input)
-              (copy-port input output))))
+           (stream-agent-media! file output (request-client-ip request) app-id))
          #:mime-type
          (let ((mime (mimetype-for-ext file)))
            (if (string? mime)