laten zien hoe downloads en zo gaan

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)