Adding a local player agent
This commit is contained in:
@@ -0,0 +1,416 @@
|
||||
#lang racket/base
|
||||
|
||||
(require file/sha1
|
||||
json
|
||||
net/url
|
||||
racket-audio
|
||||
racket/class
|
||||
racket/file
|
||||
racket/gui/base
|
||||
racket/os
|
||||
racket/path
|
||||
racket/port
|
||||
racket/random
|
||||
racket/string
|
||||
simple-ini
|
||||
simple-log)
|
||||
|
||||
(provide run-player-agent-gui)
|
||||
|
||||
(sl-def-log player-agent)
|
||||
|
||||
(define config-file
|
||||
(get-ini-file 'rkt-web-player-agent))
|
||||
|
||||
(define log-file
|
||||
(build-path (find-system-path 'pref-dir)
|
||||
"rkt-web-player-agent.log"))
|
||||
|
||||
(define (fresh-app-id)
|
||||
(bytes->hex-string (crypto-random-bytes 32)))
|
||||
|
||||
(define (valid-app-id? value)
|
||||
(and (string? value)
|
||||
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
|
||||
|
||||
(define config
|
||||
(file->ini config-file))
|
||||
|
||||
(define app-id
|
||||
(let ((configured (ini-get config 'agent 'app-id #f)))
|
||||
(if (valid-app-id? configured)
|
||||
(string-downcase configured)
|
||||
(fresh-app-id))))
|
||||
|
||||
(define server-url
|
||||
(ini-get config 'server 'url "http://127.0.0.1:8080"))
|
||||
|
||||
(define assigned-name
|
||||
(ini-get config 'agent 'name
|
||||
(format "~a playback" (gethostname))))
|
||||
|
||||
(define (save-config!)
|
||||
(ini-set! config 'agent 'app-id app-id)
|
||||
(ini-set! config 'agent 'name assigned-name)
|
||||
(ini-set! config 'server 'url server-url)
|
||||
(ini->file config config-file #:private? #t))
|
||||
|
||||
(save-config!)
|
||||
|
||||
(define (base-url value)
|
||||
(string->url
|
||||
(regexp-replace #px"/+$" (string-trim value) "")))
|
||||
|
||||
(define (endpoint-url base path)
|
||||
(combine-url/relative (base-url base) path))
|
||||
|
||||
(define (post-json base path data)
|
||||
(let ((input
|
||||
(post-pure-port
|
||||
(endpoint-url base path)
|
||||
(jsexpr->bytes data)
|
||||
(list "Content-Type: application/json"
|
||||
"Cache-Control: no-store"))))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(let ((response (read-json input)))
|
||||
(when (and (hash? response)
|
||||
(string? (hash-ref response 'error #f)))
|
||||
(error 'player-agent
|
||||
(hash-ref response 'error)))
|
||||
response))
|
||||
(λ ()
|
||||
(close-input-port input)))))
|
||||
|
||||
(define (normal-state state)
|
||||
(cond
|
||||
((eq? state 'transitioning) "starting")
|
||||
((eq? state 'initialized) "stopped")
|
||||
((eq? state 'no-media) "stopped")
|
||||
(else (symbol->string state))))
|
||||
|
||||
(define (safe-delete-file file)
|
||||
(when (and file (file-exists? file))
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent
|
||||
"Could not remove temporary media file ~a: ~a"
|
||||
file
|
||||
(exn-message exception)))))
|
||||
(delete-file file))))
|
||||
|
||||
(define (run-player-agent-gui)
|
||||
(sl-log-to-file log-file)
|
||||
|
||||
(define state-lock (make-semaphore 1))
|
||||
(define worker #f)
|
||||
(define command-worker #f)
|
||||
(define executing-command-id 0)
|
||||
(define running? #f)
|
||||
(define audio #f)
|
||||
(define temporary-media #f)
|
||||
(define acknowledged-command 0)
|
||||
(define ended-counter 0)
|
||||
(define logical-volume 50)
|
||||
(define agent-state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'duration 'null
|
||||
'rate 'null
|
||||
'channels 'null
|
||||
'bits 'null
|
||||
'format ""
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
|
||||
(define (with-agent-state proc)
|
||||
(call-with-semaphore state-lock proc))
|
||||
|
||||
(define (state-value value fallback)
|
||||
(if (eq? value #f) fallback value))
|
||||
|
||||
(define (update-from-audio! state full-state)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hasheq
|
||||
'state (normal-state state)
|
||||
'position
|
||||
(state-value (hash-ref full-state 'at-second #f) 0)
|
||||
'duration
|
||||
(state-value (hash-ref full-state 'duration #f) 'null)
|
||||
'rate
|
||||
(state-value (hash-ref full-state 'rate #f) 'null)
|
||||
'channels
|
||||
(state-value (hash-ref full-state 'channels #f) 'null)
|
||||
'bits
|
||||
(state-value (hash-ref full-state 'bits #f) 'null)
|
||||
'format
|
||||
(let ((decoder (hash-ref full-state 'decoder #f)))
|
||||
(if decoder (format "~a" decoder) ""))
|
||||
'volume logical-volume
|
||||
'error 'null)))))
|
||||
|
||||
(define (set-agent-error! message)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state 'error message)))))
|
||||
|
||||
(define (clear-agent-error!)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state 'error 'null)))))
|
||||
|
||||
(define (state-snapshot)
|
||||
(with-agent-state
|
||||
(λ () agent-state)))
|
||||
|
||||
(define (ensure-audio!)
|
||||
(unless audio
|
||||
(set! audio
|
||||
(make-audio-player
|
||||
(λ (_handle state full-state)
|
||||
(update-from-audio! state full-state))
|
||||
(λ (_handle)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
(audio-ao-buf-ms! audio 500)
|
||||
(audio-buf-seconds! audio 4 10)
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! audio (* 100.0 scaled scaled))))
|
||||
audio)
|
||||
|
||||
(define (download-media! token filename)
|
||||
(let* ((extension
|
||||
(or (path-get-extension (string->path filename)) #""))
|
||||
(template
|
||||
(string-append "rkt-player-agent-~a"
|
||||
(bytes->string/utf-8 extension)))
|
||||
(target (make-temporary-file template))
|
||||
(path
|
||||
(format "/api/agent/media/~a/~a" app-id token))
|
||||
(input (get-pure-port (endpoint-url server-url path))))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(close-input-port input)
|
||||
(safe-delete-file target)
|
||||
(raise exception))))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output)
|
||||
(copy-port input output))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
target)))
|
||||
|
||||
(define (execute-command! command)
|
||||
(let* ((action (hash-ref command 'action ""))
|
||||
(data (hash-ref command 'data (hasheq))))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(let ((next-media
|
||||
(download-media!
|
||||
(hash-ref data 'mediaToken)
|
||||
(hash-ref data 'filename "track"))))
|
||||
(when audio (audio-stop! audio))
|
||||
(safe-delete-file temporary-media)
|
||||
(set! temporary-media next-media)
|
||||
(audio-play! (ensure-audio!) temporary-media)))
|
||||
((string=? action "pause")
|
||||
(audio-pause! (ensure-audio!) #t))
|
||||
((string=? action "resume")
|
||||
(audio-pause! (ensure-audio!) #f))
|
||||
((string=? action "stop")
|
||||
(when audio (audio-stop! audio)))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!)
|
||||
(hash-ref data 'percentage 0)))
|
||||
((string=? action "volume")
|
||||
(set! logical-volume
|
||||
(min 100 (max 0 (hash-ref data 'value 50))))
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! (ensure-audio!)
|
||||
(* 100.0 scaled scaled)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state
|
||||
'volume
|
||||
logical-volume)))))
|
||||
(else
|
||||
(error 'player-agent "unknown command: ~a" action)))))
|
||||
|
||||
(define frame #f)
|
||||
(define status-message #f)
|
||||
(define name-field #f)
|
||||
(define server-field #f)
|
||||
(define connect-button #f)
|
||||
|
||||
(define (show-status! message)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when status-message
|
||||
(send status-message set-label message)))
|
||||
#f))
|
||||
|
||||
(define (show-name! name)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when name-field
|
||||
(send name-field set-value name)))
|
||||
#f))
|
||||
|
||||
(define (poll-loop)
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Connection cycle failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(show-status! (format "Niet verbonden: ~a"
|
||||
(exn-message exception)))
|
||||
(when running?
|
||||
(sleep 3)
|
||||
(poll-loop)))))
|
||||
(let ((registration
|
||||
(post-json
|
||||
server-url
|
||||
"/api/agent/register"
|
||||
(hasheq 'appId app-id
|
||||
'name assigned-name))))
|
||||
(show-name! assigned-name)
|
||||
(clear-agent-error!)
|
||||
(show-status! "Verbonden")
|
||||
(info-player-agent "Registered at ~a as ~a"
|
||||
server-url assigned-name)
|
||||
(let loop ()
|
||||
(when running?
|
||||
(let* ((response
|
||||
(post-json
|
||||
server-url
|
||||
"/api/agent/poll"
|
||||
(hasheq 'appId app-id
|
||||
'name assigned-name
|
||||
'ack acknowledged-command
|
||||
'endedCounter ended-counter
|
||||
'state (state-snapshot))))
|
||||
(command
|
||||
(hash-ref response 'command 'null)))
|
||||
(when (and (hash? command)
|
||||
(> (hash-ref command 'id 0)
|
||||
acknowledged-command)
|
||||
(not (= (hash-ref command 'id 0)
|
||||
executing-command-id)))
|
||||
(set! executing-command-id
|
||||
(hash-ref command 'id))
|
||||
(set!
|
||||
command-worker
|
||||
(thread
|
||||
(λ ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error!
|
||||
(exn-message exception)))))
|
||||
(clear-agent-error!)
|
||||
(execute-command! command))
|
||||
(set! acknowledged-command
|
||||
(hash-ref command 'id))
|
||||
(set! executing-command-id 0)
|
||||
(set! command-worker #f)))))
|
||||
(sleep 1)
|
||||
(loop)))))))
|
||||
|
||||
(define (start-worker!)
|
||||
(set! running? #t)
|
||||
(set! worker (thread poll-loop))
|
||||
(send connect-button set-label "Opnieuw verbinden"))
|
||||
|
||||
(define (stop-worker!)
|
||||
(set! running? #f)
|
||||
(when (and worker (not (thread-dead? worker)))
|
||||
(kill-thread worker))
|
||||
(when (and command-worker
|
||||
(not (thread-dead? command-worker)))
|
||||
(kill-thread command-worker))
|
||||
(set! worker #f)
|
||||
(set! command-worker #f)
|
||||
(set! executing-command-id 0))
|
||||
|
||||
(define (reconnect!)
|
||||
(stop-worker!)
|
||||
(set! server-url (string-trim (send server-field get-value)))
|
||||
(let ((new-name (string-trim (send name-field get-value))))
|
||||
(set! assigned-name
|
||||
(if (string=? new-name "")
|
||||
(format "~a playback" (gethostname))
|
||||
new-name)))
|
||||
(save-config!)
|
||||
(show-status! "Verbinden…")
|
||||
(start-worker!))
|
||||
|
||||
(define agent-frame%
|
||||
(class frame%
|
||||
(super-new)
|
||||
(define/override (on-close)
|
||||
(stop-worker!)
|
||||
(when audio
|
||||
(with-handlers ((exn:fail? void))
|
||||
(audio-quit! audio)))
|
||||
(safe-delete-file temporary-media)
|
||||
(super on-close))))
|
||||
|
||||
(set! frame
|
||||
(new agent-frame%
|
||||
(label "RKT Web Player Agent")
|
||||
(width 560)
|
||||
(height 230)))
|
||||
(define panel
|
||||
(new vertical-panel%
|
||||
(parent frame)
|
||||
(alignment '(left top))
|
||||
(border 12)
|
||||
(spacing 8)))
|
||||
(set! server-field
|
||||
(new text-field%
|
||||
(parent panel)
|
||||
(label "RKT Web Player server")
|
||||
(init-value server-url)))
|
||||
(set! name-field
|
||||
(new text-field%
|
||||
(parent panel)
|
||||
(label "Naam")
|
||||
(init-value assigned-name)))
|
||||
(define id-field
|
||||
(new text-field%
|
||||
(parent panel)
|
||||
(label "Applicatie-ID")
|
||||
(init-value app-id)))
|
||||
(send id-field enable #f)
|
||||
(define controls
|
||||
(new horizontal-panel%
|
||||
(parent panel)
|
||||
(alignment '(left center))))
|
||||
(set! connect-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
(label "Opslaan en verbinden")
|
||||
(callback (λ (_button _event)
|
||||
(reconnect!)))))
|
||||
(set! status-message
|
||||
(new message%
|
||||
(parent controls)
|
||||
(label "Verbinden…")
|
||||
(auto-resize #t)))
|
||||
|
||||
(send frame show #t)
|
||||
(start-worker!)
|
||||
frame)
|
||||
+439
-35
@@ -2,8 +2,10 @@
|
||||
|
||||
(require racket-audio
|
||||
racket-audio-dlna
|
||||
file/sha1
|
||||
racket/list
|
||||
racket/path
|
||||
racket/random
|
||||
racket/string
|
||||
racket-sonos
|
||||
racket-upnp
|
||||
@@ -14,12 +16,27 @@
|
||||
player-state->jsexpr
|
||||
player-command!
|
||||
player-discover!
|
||||
player-agent-register!
|
||||
player-agent-poll!
|
||||
player-agent-media
|
||||
player-close!)
|
||||
|
||||
(sl-def-log web-player)
|
||||
|
||||
(struct renderer
|
||||
(id name kind device)
|
||||
(id [name #:mutable] kind device)
|
||||
#:transparent)
|
||||
|
||||
(struct playback-agent
|
||||
(app-id
|
||||
[name #:mutable]
|
||||
[last-seen #:mutable]
|
||||
[reported-state #:mutable]
|
||||
[commands #:mutable]
|
||||
[next-command-id #:mutable]
|
||||
[media-token #:mutable]
|
||||
[media-file #:mutable]
|
||||
[ended-counter #:mutable])
|
||||
#:transparent)
|
||||
|
||||
(struct playlist-tab
|
||||
@@ -28,6 +45,7 @@
|
||||
|
||||
(struct player
|
||||
(libraries
|
||||
[agents #:mutable]
|
||||
[current-library-id #:mutable]
|
||||
[browser-path #:mutable]
|
||||
[browser-entries #:mutable]
|
||||
@@ -68,6 +86,80 @@
|
||||
(string=? (renderer-id item) id))
|
||||
(player-renderers value)))
|
||||
|
||||
(define (agent-renderer-id app-id)
|
||||
(string-append "agent:" app-id))
|
||||
|
||||
(define (agent-by-id value app-id)
|
||||
(findf (λ (agent)
|
||||
(string=? (playback-agent-app-id agent) app-id))
|
||||
(player-agents value)))
|
||||
|
||||
(define (agent-renderer value agent)
|
||||
(renderer-by-id value
|
||||
(agent-renderer-id
|
||||
(playback-agent-app-id agent))))
|
||||
|
||||
(define (valid-agent-id? value)
|
||||
(and (string? value)
|
||||
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
|
||||
|
||||
(define (fresh-media-token)
|
||||
(bytes->hex-string (crypto-random-bytes 32)))
|
||||
|
||||
(define (enqueue-agent-command! value agent action [data (hasheq)])
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let* ((id (playback-agent-next-command-id agent))
|
||||
(command (hasheq 'id id
|
||||
'action action
|
||||
'data data)))
|
||||
(set-playback-agent-next-command-id! agent (+ id 1))
|
||||
(set-playback-agent-commands!
|
||||
agent
|
||||
(append (playback-agent-commands agent)
|
||||
(list command)))
|
||||
command))))
|
||||
|
||||
(define agent-heartbeat-timeout-seconds 10)
|
||||
|
||||
(define (prune-stale-agents! value)
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let* ((cutoff (- (current-seconds)
|
||||
agent-heartbeat-timeout-seconds))
|
||||
(stale
|
||||
(filter (λ (agent)
|
||||
(< (playback-agent-last-seen agent) cutoff))
|
||||
(player-agents value)))
|
||||
(stale-ids
|
||||
(map (λ (agent)
|
||||
(agent-renderer-id
|
||||
(playback-agent-app-id agent)))
|
||||
stale)))
|
||||
(unless (null? stale)
|
||||
(set-player-agents!
|
||||
value
|
||||
(filter (λ (agent)
|
||||
(not (member (agent-renderer-id
|
||||
(playback-agent-app-id agent))
|
||||
stale-ids)))
|
||||
(player-agents value)))
|
||||
(set-player-renderers!
|
||||
value
|
||||
(filter (λ (item)
|
||||
(not (member (renderer-id item) stale-ids)))
|
||||
(player-renderers value)))
|
||||
(when (member (player-selected-id value) stale-ids)
|
||||
(set-player-selected-id! value "local")
|
||||
(set-player-backend! value #f)
|
||||
(set-player-backend-kind! value #f)
|
||||
(set-player-state! value 'stopped)
|
||||
(set-player-position! value 0)
|
||||
(set-player-duration! value #f)
|
||||
(reset-audio-info! value)))))))
|
||||
|
||||
(define (library-by-id value id)
|
||||
(findf (λ (library)
|
||||
(string=? (music-library-id library) id))
|
||||
@@ -177,6 +269,8 @@
|
||||
(make-network-backend
|
||||
value
|
||||
(renderer-device selected)))
|
||||
((eq? kind 'agent)
|
||||
(renderer-device selected))
|
||||
(else
|
||||
(raise-arguments-error
|
||||
'player-command!
|
||||
@@ -200,9 +294,13 @@
|
||||
"Could not close ~a player: ~a"
|
||||
kind
|
||||
(exn-message exception)))))
|
||||
(if (eq? kind 'local)
|
||||
(audio-quit! backend)
|
||||
(dlna-player-close! backend))))
|
||||
(cond
|
||||
((eq? kind 'local)
|
||||
(audio-quit! backend))
|
||||
((eq? kind 'agent)
|
||||
(enqueue-agent-command! value backend "stop"))
|
||||
(else
|
||||
(dlna-player-close! backend)))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -215,9 +313,15 @@
|
||||
|
||||
(define (stop-playback! value)
|
||||
(when (player-backend value)
|
||||
(if (eq? (player-backend-kind value) 'local)
|
||||
(audio-stop! (player-backend value))
|
||||
(dlna-player-stop! (player-backend value))))
|
||||
(cond
|
||||
((eq? (player-backend-kind value) 'local)
|
||||
(audio-stop! (player-backend value)))
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command! value
|
||||
(player-backend value)
|
||||
"stop"))
|
||||
(else
|
||||
(dlna-player-stop! (player-backend value)))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -245,9 +349,27 @@
|
||||
(set-player-state! value 'starting)
|
||||
(set-player-position! value 0)
|
||||
(set-player-duration! value (track-duration item))))
|
||||
(if (eq? kind 'local)
|
||||
(audio-play! backend (track-file item))
|
||||
(dlna-player-play! backend (track-file item)))
|
||||
(cond
|
||||
((eq? kind 'local)
|
||||
(audio-play! backend (track-file item)))
|
||||
((eq? kind 'agent)
|
||||
(let ((token (fresh-media-token)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(set-playback-agent-media-token! backend token)
|
||||
(set-playback-agent-media-file! backend (track-file item))))
|
||||
(enqueue-agent-command!
|
||||
value
|
||||
backend
|
||||
"play"
|
||||
(hasheq 'mediaToken token
|
||||
'filename
|
||||
(path->string
|
||||
(or (file-name-from-path (track-file item))
|
||||
(track-file item)))))))
|
||||
(else
|
||||
(dlna-player-play! backend (track-file item))))
|
||||
(clear-error! value)))
|
||||
|
||||
(define (next-index value direction)
|
||||
@@ -274,8 +396,50 @@
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-error! value (exn-message exception)))))
|
||||
(let* ((info (dlna-player-info (player-backend value)))
|
||||
(track-info (dlna-info-track info)))
|
||||
(if (eq? (player-backend-kind value) 'agent)
|
||||
(let ((reported
|
||||
(playback-agent-reported-state
|
||||
(player-backend value))))
|
||||
;; Keep the server's optimistic command state visible until the
|
||||
;; agent acknowledges all queued work. Its report in the poll that
|
||||
;; receives a command still describes the state before execution.
|
||||
(when (and (hash? reported)
|
||||
(null? (playback-agent-commands
|
||||
(player-backend value))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let ((state (hash-ref reported 'state #f)))
|
||||
(when (string? state)
|
||||
(set-player-state!
|
||||
value
|
||||
(normalize-state (string->symbol state)))))
|
||||
(set-player-position!
|
||||
value
|
||||
(or (json-number reported 'position #f) 0))
|
||||
(set-player-duration!
|
||||
value
|
||||
(json-number reported 'duration #f))
|
||||
(set-player-rate!
|
||||
value
|
||||
(json-number reported 'rate #f))
|
||||
(set-player-channels!
|
||||
value
|
||||
(json-number reported 'channels #f))
|
||||
(set-player-bits!
|
||||
value
|
||||
(json-number reported 'bits #f))
|
||||
(let ((decoder (json-string reported 'format #f)))
|
||||
(set-player-decoder!
|
||||
value
|
||||
(and decoder (string->symbol decoder))))
|
||||
(let ((volume (json-number reported 'volume #f)))
|
||||
(when volume
|
||||
(set-player-volume! value volume)))
|
||||
(let ((error (json-string reported 'error #f)))
|
||||
(set-player-error! value error))))))
|
||||
(let* ((info (dlna-player-info (player-backend value)))
|
||||
(track-info (dlna-info-track info)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -300,7 +464,7 @@
|
||||
(set-player-decoder! value 'dlna)
|
||||
(when (number? (dlna-info-volume info))
|
||||
(set-player-volume! value
|
||||
(dlna-info-volume info)))))))))
|
||||
(dlna-info-volume info))))))))))
|
||||
|
||||
(define (entry-by-index value index)
|
||||
(and (exact-nonnegative-integer? index)
|
||||
@@ -685,14 +849,22 @@
|
||||
0)))
|
||||
((string=? command "pause")
|
||||
(let ((backend (ensure-backend! value)))
|
||||
(if (eq? (player-backend-kind value) 'local)
|
||||
(audio-pause! backend #t)
|
||||
(dlna-player-pause! backend))))
|
||||
(cond
|
||||
((eq? (player-backend-kind value) 'local)
|
||||
(audio-pause! backend #t))
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command! value backend "pause"))
|
||||
(else
|
||||
(dlna-player-pause! backend)))))
|
||||
((string=? command "resume")
|
||||
(let ((backend (ensure-backend! value)))
|
||||
(if (eq? (player-backend-kind value) 'local)
|
||||
(audio-pause! backend #f)
|
||||
(dlna-player-resume! backend))))
|
||||
(cond
|
||||
((eq? (player-backend-kind value) 'local)
|
||||
(audio-pause! backend #f))
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command! value backend "resume"))
|
||||
(else
|
||||
(dlna-player-resume! backend)))))
|
||||
((string=? command "stop")
|
||||
(stop-playback! value))
|
||||
((string=? command "next")
|
||||
@@ -711,9 +883,15 @@
|
||||
'player-command!
|
||||
"seek requires a numeric percentage"))
|
||||
(let ((backend (ensure-backend! value)))
|
||||
(if (eq? (player-backend-kind value) 'local)
|
||||
(audio-seek! backend percentage)
|
||||
(dlna-player-seek-percentage! backend percentage)))))
|
||||
(cond
|
||||
((eq? (player-backend-kind value) 'local)
|
||||
(audio-seek! backend percentage))
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command!
|
||||
value backend "seek"
|
||||
(hasheq 'percentage percentage)))
|
||||
(else
|
||||
(dlna-player-seek-percentage! backend percentage))))))
|
||||
((string=? command "volume")
|
||||
(let ((percentage (json-number data 'value #f)))
|
||||
(unless percentage
|
||||
@@ -722,12 +900,18 @@
|
||||
"volume requires a numeric value"))
|
||||
(let* ((clamped (min 100 (max 0 percentage)))
|
||||
(backend (ensure-backend! value)))
|
||||
(if (eq? (player-backend-kind value) 'local)
|
||||
(let ((logical-volume (/ clamped 100.0)))
|
||||
(audio-volume!
|
||||
backend
|
||||
(* 100.0 logical-volume logical-volume)))
|
||||
(dlna-player-volume! backend clamped))
|
||||
(cond
|
||||
((eq? (player-backend-kind value) 'local)
|
||||
(let ((logical-volume (/ clamped 100.0)))
|
||||
(audio-volume!
|
||||
backend
|
||||
(* 100.0 logical-volume logical-volume))))
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command!
|
||||
value backend "volume"
|
||||
(hasheq 'value clamped)))
|
||||
(else
|
||||
(dlna-player-volume! backend clamped)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -757,7 +941,7 @@
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(set-player-selected-id! value id))))))
|
||||
(set-player-selected-id! value id))))))
|
||||
(else
|
||||
(raise-arguments-error
|
||||
'player-command!
|
||||
@@ -782,13 +966,14 @@
|
||||
'()))
|
||||
(tab (playlist-tab "default" "Default" '())))
|
||||
(player libraries
|
||||
'()
|
||||
(and library (music-library-id library))
|
||||
'()
|
||||
browser-entries
|
||||
'()
|
||||
(list tab)
|
||||
0
|
||||
(list (renderer "local" "Dit apparaat" 'local #f))
|
||||
(list (renderer "local" "Server audio output" 'local #f))
|
||||
"local"
|
||||
#f
|
||||
#f
|
||||
@@ -816,6 +1001,7 @@
|
||||
; result : A JSON-compatible hash.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-state->jsexpr value)
|
||||
(prune-stale-agents! value)
|
||||
(refresh-network-state! value)
|
||||
(with-state-lock
|
||||
value
|
||||
@@ -922,11 +1108,15 @@
|
||||
(λ ()
|
||||
(set-player-renderers!
|
||||
value
|
||||
(cons (renderer "local"
|
||||
"Dit apparaat"
|
||||
'local
|
||||
#f)
|
||||
found))
|
||||
(append
|
||||
(list (renderer "local"
|
||||
"Server audio output"
|
||||
'local
|
||||
#f))
|
||||
found
|
||||
(filter (λ (item)
|
||||
(eq? (renderer-kind item) 'agent))
|
||||
(player-renderers value))))
|
||||
(set-player-error! value #f)))))
|
||||
(with-state-lock
|
||||
value
|
||||
@@ -934,6 +1124,145 @@
|
||||
(set-player-discovering?! value #f))))))
|
||||
can-start?))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Register or refresh one polling playback agent.
|
||||
; pre : Data contains a 256-bit hexadecimal application id.
|
||||
; post : The agent is available as a renderer under its advertised name.
|
||||
; result : Agent configuration for the polling client.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-agent-register! value data)
|
||||
(let* ((app-id (json-string data 'appId #f))
|
||||
(suggested-name
|
||||
(string-trim
|
||||
(or (json-string data 'name #f)
|
||||
"RKT playback agent"))))
|
||||
(unless (valid-agent-id? app-id)
|
||||
(raise-arguments-error
|
||||
'player-agent-register!
|
||||
"appId must contain exactly 64 hexadecimal characters"
|
||||
"appId" app-id))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let ((existing (agent-by-id value app-id)))
|
||||
(if existing
|
||||
(begin
|
||||
(set-playback-agent-name! existing suggested-name)
|
||||
(let ((agent-output (agent-renderer value existing)))
|
||||
(when agent-output
|
||||
(set-renderer-name! agent-output suggested-name)))
|
||||
(set-playback-agent-last-seen!
|
||||
existing
|
||||
(current-seconds))
|
||||
(hasheq 'name (playback-agent-name existing)
|
||||
'pollIntervalMs 1000))
|
||||
(let* ((name
|
||||
(if (string=? suggested-name "")
|
||||
"RKT playback agent"
|
||||
suggested-name))
|
||||
(agent
|
||||
(playback-agent
|
||||
app-id name (current-seconds)
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'volume 50)
|
||||
'() 1 #f #f 0)))
|
||||
(set-player-agents!
|
||||
value
|
||||
(append (player-agents value) (list agent)))
|
||||
(set-player-renderers!
|
||||
value
|
||||
(append
|
||||
(player-renderers value)
|
||||
(list (renderer (agent-renderer-id app-id)
|
||||
name
|
||||
'agent
|
||||
agent))))
|
||||
(hasheq 'name name
|
||||
'pollIntervalMs 1000))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Accept agent state and return its oldest unacknowledged command.
|
||||
; pre : The agent was registered with player-agent-register!.
|
||||
; post : State, heartbeat, acknowledgements and end-of-track are incorporated.
|
||||
; result : Poll response containing the current agent name and optional command.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-agent-poll! value data)
|
||||
(let ((app-id (json-string data 'appId #f))
|
||||
(name (json-string data 'name #f)))
|
||||
(unless (valid-agent-id? app-id)
|
||||
(raise-arguments-error
|
||||
'player-agent-poll!
|
||||
"appId must contain exactly 64 hexadecimal characters"
|
||||
"appId" app-id))
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(λ ()
|
||||
(let ((agent (agent-by-id value app-id)))
|
||||
(unless agent
|
||||
(raise-arguments-error
|
||||
'player-agent-poll!
|
||||
"playback agent is not registered"
|
||||
"appId" app-id))
|
||||
(let* ((ack (json-number data 'ack #f))
|
||||
(reported (hash-ref data 'state #f))
|
||||
(ended (json-number data 'endedCounter 0))
|
||||
(previous-ended
|
||||
(playback-agent-ended-counter agent)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(set-playback-agent-last-seen! agent (current-seconds))
|
||||
(when (and name
|
||||
(not (string=? (string-trim name) "")))
|
||||
(let ((trimmed (string-trim name))
|
||||
(agent-output (agent-renderer value agent)))
|
||||
(set-playback-agent-name! agent trimmed)
|
||||
(when agent-output
|
||||
(set-renderer-name! agent-output trimmed))))
|
||||
(when (hash? reported)
|
||||
(set-playback-agent-reported-state! agent reported))
|
||||
(when (exact-nonnegative-integer? ack)
|
||||
(set-playback-agent-commands!
|
||||
agent
|
||||
(filter
|
||||
(λ (command)
|
||||
(> (hash-ref command 'id) ack))
|
||||
(playback-agent-commands agent))))
|
||||
(when (exact-nonnegative-integer? ended)
|
||||
(set-playback-agent-ended-counter! agent ended))))
|
||||
(when (and (> ended previous-ended)
|
||||
(string=? (player-selected-id value)
|
||||
(agent-renderer-id app-id))
|
||||
(eq? (player-backend value) agent))
|
||||
(let ((index (next-index value 1)))
|
||||
(if index
|
||||
(play-index! value index)
|
||||
(stop-playback! value))))
|
||||
(hasheq
|
||||
'name (playback-agent-name agent)
|
||||
'command
|
||||
(if (null? (playback-agent-commands agent))
|
||||
'null
|
||||
(car (playback-agent-commands agent))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Resolve the current opaque media token for one playback agent.
|
||||
; pre : App id and token came from a play command returned by agent polling.
|
||||
; post : No state changes.
|
||||
; result : The local track path, or #f when the token is invalid or expired.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-agent-media value app-id token)
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let ((agent (and (valid-agent-id? app-id)
|
||||
(agent-by-id value app-id))))
|
||||
(and agent
|
||||
(string? token)
|
||||
(equal? token (playback-agent-media-token agent))
|
||||
(playback-agent-media-file agent))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Stop playback and release all player resources.
|
||||
; pre : Value was created with make-player.
|
||||
@@ -1026,6 +1355,81 @@
|
||||
(hasheq 'index 1)))
|
||||
|
||||
(check-equal? (length (hash-ref deleted-state 'tabs)) 1)
|
||||
|
||||
(define test-agent-id
|
||||
(make-string 64 #\a))
|
||||
|
||||
(define registration
|
||||
(player-agent-register!
|
||||
example-player
|
||||
(hasheq 'appId test-agent-id
|
||||
'name "Test laptop")))
|
||||
|
||||
(check-equal? (hash-ref registration 'name) "Test laptop")
|
||||
|
||||
(define agent-renderer-state
|
||||
(player-command!
|
||||
example-player
|
||||
"renderer"
|
||||
(hasheq 'id (agent-renderer-id test-agent-id))))
|
||||
|
||||
(check-equal?
|
||||
(hash-ref agent-renderer-state 'rendererId)
|
||||
(agent-renderer-id test-agent-id))
|
||||
|
||||
(player-command!
|
||||
example-player
|
||||
"volume"
|
||||
(hasheq 'value 25))
|
||||
|
||||
(define first-poll
|
||||
(player-agent-poll!
|
||||
example-player
|
||||
(hasheq 'appId test-agent-id
|
||||
'ack 0
|
||||
'endedCounter 0
|
||||
'state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'volume 25))))
|
||||
|
||||
(check-equal?
|
||||
(hash-ref (hash-ref first-poll 'command) 'action)
|
||||
"volume")
|
||||
|
||||
(define first-command-id
|
||||
(hash-ref (hash-ref first-poll 'command) 'id))
|
||||
|
||||
(define acknowledged-poll
|
||||
(player-agent-poll!
|
||||
example-player
|
||||
(hasheq 'appId test-agent-id
|
||||
'ack first-command-id
|
||||
'endedCounter 0
|
||||
'state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'volume 25))))
|
||||
|
||||
(check-eq? (hash-ref acknowledged-poll 'command) 'null)
|
||||
|
||||
(check-equal?
|
||||
(hash-ref
|
||||
(player-agent-register!
|
||||
example-player
|
||||
(hasheq 'appId test-agent-id
|
||||
'name "Office laptop"))
|
||||
'name)
|
||||
"Office laptop")
|
||||
(check-equal?
|
||||
(renderer-name
|
||||
(findf
|
||||
(λ (item)
|
||||
(string=? (renderer-id item)
|
||||
(agent-renderer-id test-agent-id)))
|
||||
(player-renderers example-player)))
|
||||
"Office laptop")
|
||||
|
||||
(check-exn exn:fail?
|
||||
(λ ()
|
||||
(player-command!
|
||||
|
||||
@@ -2,7 +2,10 @@
|
||||
|
||||
(require json
|
||||
racket/contract
|
||||
racket/file
|
||||
racket/port
|
||||
racket/runtime-path
|
||||
racket-mimetypes
|
||||
web-server/dispatch
|
||||
web-server/http
|
||||
web-server/http/json
|
||||
@@ -52,10 +55,55 @@
|
||||
command
|
||||
(request-jsexpr request)))))
|
||||
|
||||
(define (agent-register-handler request)
|
||||
(with-handlers
|
||||
((exn:fail? error-response))
|
||||
(json-response
|
||||
(player-agent-register!
|
||||
current-player
|
||||
(request-jsexpr request)))))
|
||||
|
||||
(define (agent-poll-handler request)
|
||||
(with-handlers
|
||||
((exn:fail? error-response))
|
||||
(json-response
|
||||
(player-agent-poll!
|
||||
current-player
|
||||
(request-jsexpr request)))))
|
||||
|
||||
(define (agent-media-handler _request app-id token)
|
||||
(let ((file (player-agent-media current-player app-id token)))
|
||||
(if (and file (file-exists? file))
|
||||
(response/output
|
||||
(λ (output)
|
||||
(call-with-input-file
|
||||
file
|
||||
(λ (input)
|
||||
(copy-port input output))))
|
||||
#:mime-type
|
||||
(let ((mime (mimetype-for-ext file)))
|
||||
(if (string? mime)
|
||||
(string->bytes/utf-8 mime)
|
||||
#"application/octet-stream"))
|
||||
#:headers
|
||||
(list
|
||||
(header #"Content-Length"
|
||||
(string->bytes/utf-8
|
||||
(number->string (file-size file))))
|
||||
(header #"Cache-Control" #"no-store")))
|
||||
(json-response
|
||||
(hasheq 'error "media token is invalid or expired")
|
||||
#:code 404))))
|
||||
|
||||
(define-values (dispatch _url)
|
||||
(dispatch-rules
|
||||
[("api" "state") #:method "get" state-handler]
|
||||
[("api" "discover") #:method "post" discover-handler]
|
||||
[("api" "agent" "register") #:method "post" agent-register-handler]
|
||||
[("api" "agent" "poll") #:method "post" agent-poll-handler]
|
||||
[("api" "agent" "media" (string-arg) (string-arg))
|
||||
#:method "get"
|
||||
agent-media-handler]
|
||||
[("api" "command" (string-arg))
|
||||
#:method "post"
|
||||
command-handler]))
|
||||
|
||||
Reference in New Issue
Block a user