hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding a local player agent

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-27 10:24:40 +02:00
parent d22a7ad529
commit 577b0aa729
8 changed files with 1321 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/player-agent-gui.rkt
+416
View File
@@ -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)