111 lines
4.4 KiB
Racket
111 lines
4.4 KiB
Racket
#lang racket/base
|
|
|
|
(require file/sha1
|
|
racket/contract
|
|
racket/os
|
|
racket/path
|
|
racket/random
|
|
racket/string
|
|
simple-ini)
|
|
|
|
(provide (struct-out player-agent-config)
|
|
load-player-agent-config
|
|
save-player-agent-config!
|
|
valid-app-id?)
|
|
|
|
(struct player-agent-config (file ini app-id server-url name) #:transparent)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Supporting functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (fresh-app-id)
|
|
(bytes->hex-string (crypto-random-bytes 32)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Recognize a playback-agent application identifier.
|
|
; pre : value is any Racket value.
|
|
; post : No state is changed.
|
|
; result : #t only for a 256-bit identifier encoded as 64 hexadecimal digits.
|
|
; internals:
|
|
; Identifiers are accepted case-insensitively and normalized while
|
|
; loading configuration.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define/contract (valid-app-id? value)
|
|
(-> any/c boolean?)
|
|
(and (string? value)
|
|
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)
|
|
#t))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Load the playback-agent INI configuration.
|
|
; pre : file is a writable path-string understood by simple-ini.
|
|
; post : Missing defaults and a generated application ID are persisted.
|
|
; result : A player-agent-config value containing normalized settings.
|
|
; internals:
|
|
; Reusing the stored application ID preserves the server allowlist;
|
|
; only a missing or malformed identifier is replaced.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define/contract (load-player-agent-config
|
|
[file (get-ini-file 'rkt-web-player-agent)])
|
|
(->* () (path-string?) player-agent-config?)
|
|
(let* ((ini (file->ini file))
|
|
(configured-id (ini-get ini 'agent 'app-id #f))
|
|
(value
|
|
(player-agent-config
|
|
file
|
|
ini
|
|
(if (valid-app-id? configured-id)
|
|
(string-downcase configured-id)
|
|
(fresh-app-id))
|
|
(ini-get ini 'server 'url "http://127.0.0.1:8080")
|
|
(ini-get ini 'agent 'name
|
|
(format "~a playback" (gethostname))))))
|
|
(save-player-agent-config! value)
|
|
value))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Persist a playback-agent configuration.
|
|
; pre : value is a player-agent-config with a writable file path.
|
|
; post : Its ID, name and server URL are stored in a private INI file.
|
|
; result : The result returned by simple-ini's ini->file procedure.
|
|
; internals:
|
|
; The existing parsed INI value is updated directly so unrelated
|
|
; settings remain intact.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define/contract (save-player-agent-config! value)
|
|
(-> player-agent-config? void?)
|
|
(let ((ini (player-agent-config-ini value)))
|
|
(ini-set! ini 'agent 'app-id (player-agent-config-app-id value))
|
|
(ini-set! ini 'agent 'name (player-agent-config-name value))
|
|
(ini-set! ini 'server 'url (player-agent-config-server-url value))
|
|
(ini->file ini (player-agent-config-file value) #:private? #t)))
|
|
|
|
(module+ test
|
|
(require rackunit
|
|
racket/file)
|
|
|
|
(define test-directory (make-temporary-file "rkt-agent-config-~a" 'directory))
|
|
(define test-file (build-path test-directory "agent.ini"))
|
|
(dynamic-wind
|
|
void
|
|
(λ ()
|
|
(let* ((first (load-player-agent-config test-file))
|
|
(changed
|
|
(struct-copy player-agent-config first
|
|
(server-url "https://music.example.test")
|
|
(name "Test output"))))
|
|
(check-true (valid-app-id? (player-agent-config-app-id first)))
|
|
(save-player-agent-config! changed)
|
|
(let ((second (load-player-agent-config test-file)))
|
|
(check-equal? (player-agent-config-app-id second)
|
|
(player-agent-config-app-id first))
|
|
(check-equal? (player-agent-config-server-url second)
|
|
"https://music.example.test")
|
|
(check-equal? (player-agent-config-name second) "Test output"))))
|
|
(λ () (delete-directory/files test-directory))))
|