hans/racket-audio
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remote audio player much simpler.

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-06 11:45:10 +02:00
parent 06c332474a
commit de443aad9d
6 changed files with 182 additions and 234 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+6 -8
View File
@@ -148,12 +148,10 @@ racket -l racket-audio/audio-placed-player -- --stdio
```
The worker redirects ordinary logging to a cache log file so that stdout and
stderr remain serialized protocol streams. On Unix-like systems the SSH
launcher defaults to `ssh -T -q`. On Windows it prefers PuTTY `plink.exe` or
`plink` with `-batch -T`, and falls back to OpenSSH `ssh.exe`/`ssh` when PuTTY
is not present. These defaults can be overridden with the `#:ssh-program`,
`#:ssh-options`, `#:remote-racket`, `#:remote-module`, and `#:remote-command`
arguments to `make-audio-player`.
stderr remain serialized protocol streams. SSH, the remote Racket command and
the remote module are configured in `racket-audio.ini`. The public
`make-audio-player` API only needs the remote host and, when necessary, base
path replacements.
Example:
@@ -161,8 +159,8 @@ Example:
(define player
(make-audio-player cb-state cb-eof
#:remote-host "nas"
#:remote-path-map
(list (list "/muziek" "/volume1/music"))))
#:replace-base-paths
(list (cons "/muziek" "/volume1/music"))))
(audio-play! player "/muziek/klassiek/track.flac")
```
audio-player.rkt
+16 -39
View File
@@ -39,22 +39,14 @@
audio-parameterize!
audio-param!
audio-param
audio-remote-path
racket-sound-default-ssh-program
racket-sound-default-ssh-options
racket-sound-default-remote-racket
racket-sound-default-remote-module
racket-sound-default-remote-command
current-racket-sound-ssh-program
current-racket-sound-remote-racket
current-racket-sound-remote-module
replace-base-path
)
(define-runtime-path placed-player-module "audio-placed-player.rkt")
(define-struct audio-play
(valid? cb-state cb-eof-stream rpc au-place evt-thread state remote-path-map)
(valid? cb-state cb-eof-stream rpc au-place evt-thread state replace-base-paths)
#:mutable
#:transparent
)
@@ -104,21 +96,11 @@
(define/contract (make-audio-player cb-state cb-eof-stream
#:use-place [use-place (place-enabled?)]
#:remote-host [remote-host #f]
#:remote-path-map [remote-path-map '()]
#:remote-racket [remote-racket (current-racket-sound-remote-racket)]
#:remote-module [remote-module (current-racket-sound-remote-module)]
#:remote-command [remote-command #f]
#:ssh-program [ssh-program (current-racket-sound-ssh-program)]
#:ssh-options [ssh-options #f])
#:replace-base-paths [replace-base-paths '()])
(->* (procedure? procedure?)
(#:use-place boolean?
#:remote-host (or/c #f string?)
#:remote-path-map remote-path-map?
#:remote-racket path-string?
#:remote-module string?
#:remote-command (or/c #f (listof string?))
#:ssh-program path-string?
#:ssh-options (or/c #f (listof string?)))
#:replace-base-paths replace-base-paths?)
audio-play?)
(let ((cmd-ch #f)
(ret-ch #f)
@@ -133,21 +115,16 @@
)
(cond
[remote-host
;; Remote mode starts a worker over ssh. The remote worker uses
;; placed-player/stdio, so the existing three logical channels map to
;; ssh stdin, stdout and stderr. No init command is sent in this mode:
;; the worker starts with all three channels already supplied.
(let ((cmd (or remote-command (racket-sound-default-remote-command remote-racket remote-module))))
(let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
(start-remote-placed-player remote-host
#:ssh-program ssh-program
#:ssh-options ssh-options
#:remote-command cmd)))
(set! cmd-ch cmd-ch*)
(set! ret-ch ret-ch*)
(set! evt-ch evt-ch*)
(set! au-pl proc)
(set! dead-guard dead-guard*)))]
;; Remote mode is deliberately narrow: make-audio-player only needs
;; a host and optional base-path replacements. SSH, Racket and module
;; details are encapsulated in private/remote-utils.rkt and its config.
(let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
(start-remote-placed-player remote-host)))
(set! cmd-ch cmd-ch*)
(set! ret-ch ret-ch*)
(set! evt-ch evt-ch*)
(set! au-pl proc)
(set! dead-guard dead-guard*))]
[use-place
;; dynamic-place returns the command place-channel. The raw channel
;; is kept for place-dead-evt, while normal traffic is sent through
@@ -190,7 +167,7 @@
(with-mutex rpc-mutex
(define args*
(if (and (eq? cmd 'open) (pair? args))
(cons (audio-remote-path (car args) remote-path-map) (cdr args))
(cons (replace-base-path (car args) replace-base-paths) (cdr args))
args))
(cmd-put (cons cmd args*))
(ret-get))))
@@ -204,7 +181,7 @@
au-pl
#f
(make-hash)
remote-path-map))
replace-base-paths))
(set-audio-play-evt-thread! handle
(thread
(λ ()
info.rkt
+1 -1
View File
@@ -14,7 +14,7 @@
(define deps
'("racket/gui" "racket/base" "racket"
"finalizer" "draw-lib" "net-lib"
"simple-log" "racket-sprintf"
"simple-log" "simple-ini" "racket-sprintf"
"early-return" "let-assert"
"uni-channel" "port-channel"
"rackunit-lib"
private/config.rkt
+100
View File
@@ -0,0 +1,100 @@
#lang racket/base
(provide audio-cfg-get
audio-cfg-set!
audio-remote-cfg-get
audio-remote-cfg-set!
)
(require simple-ini/class)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (build-env-path env . parts)
(let ((base (getenv env)))
(if (eq? base #f)
#f
(apply build-path (cons base parts)))))
(define (try-programs . prgs)
(letrec ((f (λ (l)
(if (null? l)
#f
(if (and (car l) (file-exists? (car l)))
(car l)
(f (cdr l)))))))
(f prgs)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define cfg (new ini% [file 'racket-audio]))
(when (eq? (send cfg get 'init 'initialized #f) #f)
(let ((s! (λ (e v)
(send cfg set! 'racket-audio e v))))
(s! 'remote-racket "racket")
(s! 'remote-module "racket-audio/audio-placed-player")
(s! 'ssh-program (cond
((eq? (system-type 'os) 'windows)
(let ((p (try-programs
(build-env-path "ProgramFiles" "PuTTY" "plink.exe")
(build-env-path "ProgramFiles" "OpenSSH" "ssh.exe")
(build-env-path "SystemRoot" "System32" "OpenSSH" "ssh.exe")
(find-executable-path "ssh.exe")
(find-executable-path "plink.exe"))))
(if (eq? p #f)
"plink.exe"
p)))
(else (let ((p (find-executable-path "ssh")))
(if (eq? p #f)
"ssh"
p))))
)
(send cfg set! 'init 'initialized #t)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (missing-cfg-value? v)
(eq? v '@racket-audio-no-value@))
(define (audio-getter section entry default-provider)
(let ((v (send cfg get section entry '@racket-audio-no-value@)))
(if (missing-cfg-value? v)
(cond ((null? default-provider)
(error (format
"audio-cfg-get: No such entry ~a in section ~a"
section entry)))
((procedure? (car default-provider))
((car default-provider) entry))
(else
(car default-provider)))
v)))
(define (audio-cfg-get entry . default-provider)
(audio-getter 'racket-audio entry default-provider))
(define (audio-cfg-set! entry val)
(send cfg set! 'racket-audio entry val))
(define (audio-remote-cfg-get host entry . default-provider)
(audio-getter (string->symbol (format "~a" host))
entry
(list (lambda (entry)
(apply audio-cfg-get (cons entry default-provider))))))
(define (audio-remote-cfg-set! host entry val)
(send cfg set! (string->symbol (format "~a" host)) entry val))
private/remote-utils.rkt
+44 -116
View File
@@ -1,80 +1,45 @@
#lang racket/base
(require racket/list
racket/path
(require racket/path
racket/string
racket/system
port-channel
uni-channel)
uni-channel
"config.rkt")
(provide remote-path-map?
audio-remote-path
racket-sound-default-ssh-program
racket-sound-default-ssh-options
racket-sound-default-remote-racket
racket-sound-default-remote-module
racket-sound-default-remote-command
racket-sound-resolve-executable
racket-sound-start-ssh-subprocess
current-racket-sound-ssh-program
current-racket-sound-remote-racket
current-racket-sound-remote-module
make-remote-port-uni-channels
(provide replace-base-paths?
replace-base-path
start-remote-placed-player)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Remote path mapping
;; Remote path replacement
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (path-string->string p)
(if (path? p) (path->string p) p))
(define (remote-path-map? v)
(or (not v)
(procedure? v)
(and (list? v)
(andmap (lambda (entry)
(cond [(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry)))
(and (path-string? (car entry)) (path-string? (cadr entry)))]
[(and (pair? entry) (path-string? (car entry)) (path-string? (cdr entry))) #t]
[(vector? entry)
(and (= (vector-length entry) 2)
(path-string? (vector-ref entry 0))
(path-string? (vector-ref entry 1)))]
[else #f]))
v))))
(define (replace-base-paths? v)
(and (list? v)
(andmap (lambda (entry)
(and (pair? entry)
(path-string? (car entry))
(path-string? (cdr entry))))
v)))
(define (path-map-entry-local entry)
(path-string->string
(cond [(vector? entry) (vector-ref entry 0)]
[(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (car entry)]
[else (car entry)])))
(define (path-map-entry-remote entry)
(path-string->string
(cond [(vector? entry) (vector-ref entry 1)]
[(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (cadr entry)]
[else (cdr entry)])))
(define (replace-prefix s from to)
(string-append to (substring s (string-length from))))
(define (audio-remote-path path map)
(define s (path-string->string path))
(cond [(not map) s]
[(procedure? map) (map s)]
[(null? map) s]
[else
(define matches
(filter (lambda (entry) (string-prefix? s (path-map-entry-local entry))) map))
(cond [(null? matches) s]
[else
(define best
(argmax (lambda (entry) (string-length (path-map-entry-local entry))) matches))
(replace-prefix s (path-map-entry-local best) (path-map-entry-remote best))])]))
(define (replace-base-path path replace-base-paths)
(let ((s (path-string->string path)))
(let loop ((entries replace-base-paths))
(cond [(null? entries) s]
[else
(let* ((entry (car entries))
(base-path-local (path-string->string (car entry)))
(base-path-remote (path-string->string (cdr entry))))
(if (string-prefix? s base-path-local)
(string-append base-path-remote
(substring s (string-length base-path-local)))
(loop (cdr entries))))]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SSH / subprocess defaults
;; Remote placed player
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (executable-name p)
@@ -84,70 +49,33 @@
(define (plink-program? p)
(regexp-match? #rx"(?i:^plink(\\.exe)?$)" (executable-name p)))
(define (racket-sound-default-ssh-program)
(cond [(eq? (system-type 'os) 'windows)
(cond [(find-executable-path "plink.exe") => values]
[(find-executable-path "plink") => values]
[(find-executable-path "ssh.exe") => values]
[(find-executable-path "ssh") => values]
[else "plink.exe"])]
[else
(cond [(find-executable-path "ssh") => values]
[else "ssh"])]))
(define (racket-sound-default-ssh-options [ssh-program (racket-sound-default-ssh-program)])
(define (ssh-options ssh-program)
(if (plink-program? ssh-program)
'("-batch" "-T")
'("-T" "-q")))
(define (racket-sound-default-remote-racket) "racket")
(define (racket-sound-default-remote-module) "racket-audio/audio-placed-player")
(define (remote-command remote-host)
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-l"
(audio-remote-cfg-get remote-host 'remote-module)
"--"
"--stdio"))
(define (racket-sound-default-remote-command
[remote-racket (racket-sound-default-remote-racket)]
[remote-module (racket-sound-default-remote-module)])
(list remote-racket "-l" remote-module "--" "--stdio"))
(define current-racket-sound-ssh-program
(make-parameter (racket-sound-default-ssh-program)))
(define current-racket-sound-remote-racket
(make-parameter (racket-sound-default-remote-racket)))
(define current-racket-sound-remote-module
(make-parameter (racket-sound-default-remote-module)))
(define (racket-sound-resolve-executable p)
(or (find-executable-path p) p))
(define (racket-sound-start-ssh-subprocess remote-host remote-command
#:ssh-program [ssh-program (current-racket-sound-ssh-program)]
#:ssh-options [ssh-options #f])
(define ssh-options* (or ssh-options (racket-sound-default-ssh-options ssh-program)))
(define args (append ssh-options* (list remote-host) remote-command))
(apply subprocess #f #f #f (racket-sound-resolve-executable ssh-program) args))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Port-channel wrapping
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (start-ssh-subprocess remote-host)
(let* ((ssh-program (audio-cfg-get 'ssh-program))
(args (append (ssh-options ssh-program)
(list remote-host)
(remote-command remote-host))))
(apply subprocess #f #f #f ssh-program args)))
(define (make-port-uc port direction source)
(make-uni-channel (make-port-channel port #:direction direction #:source source #:close? #t)))
(define (make-remote-port-uni-channels stdout stdin stderr)
(values (make-port-uc stdin 'output 'remote-stdin)
(make-port-uc stdout 'input 'remote-stdout)
(make-port-uc stderr 'input 'remote-stderr)))
(define (start-remote-placed-player remote-host
#:ssh-program [ssh-program (current-racket-sound-ssh-program)]
#:ssh-options [ssh-options #f]
#:remote-command [remote-command (racket-sound-default-remote-command)])
(define (start-remote-placed-player remote-host)
(define-values (proc stdout stdin stderr)
(racket-sound-start-ssh-subprocess remote-host remote-command
#:ssh-program ssh-program
#:ssh-options ssh-options))
(define-values (cmd-ch ret-ch evt-ch)
(make-remote-port-uni-channels stdout stdin stderr))
(start-ssh-subprocess remote-host))
(define cmd-ch (make-port-uc stdin 'output 'remote-stdin))
(define ret-ch (make-port-uc stdout 'input 'remote-stdout))
(define evt-ch (make-port-uc stderr 'input 'remote-stderr))
(define dead-guard (lambda () (subprocess-wait proc)))
(values cmd-ch ret-ch evt-ch proc dead-guard))
scrbl/audio-player.scrbl
+15 -70
View File
@@ -30,12 +30,7 @@ through callbacks supplied when the player is created.
[cb-eof-stream procedure?]
[#:use-place use-place boolean?]
[#:remote-host remote-host (or/c #f string?) #f]
[#:remote-path-map remote-path-map any/c '()]
[#:remote-racket remote-racket path-string? "racket"]
[#:remote-module remote-module string? "racket-audio/audio-placed-player"]
[#:remote-command remote-command (or/c #f (listof string?)) #f]
[#:ssh-program ssh-program path-string? (current-racket-sound-ssh-program)]
[#:ssh-options ssh-options (or/c #f (listof string?)) #f])
[#:replace-base-paths replace-base-paths any/c '()])
audio-play?]{
Creates an audio player and returns a player handle. The handle is passed to
all other procedures in this module.
@@ -118,84 +113,34 @@ clicks, gaps, or stuttering playback. Thread mode is useful for debugging the
protocol and callbacks, but it is not the preferred mode for robust playback.
When @racket[remote-host] is a string, @racket[make-audio-player] starts the
worker over SSH instead of starting a local place or thread. The remote worker
is expected to run @racket[placed-player/stdio], where stdin is the command
channel, stdout is the reply channel, and stderr is the event channel. The
client side wraps those three process ports through @racketmodname[port-channel]
and @racketmodname[uni-channel]. The default command is equivalent to:
@racketblock[
(list remote-racket "-l" remote-module "--" "--stdio")]
The remote launcher defaults are supplied by the remote utility layer. On Unix-like systems @racket[ssh] is used with @racket['("-T" "-q")]. On Windows the launcher first looks for PuTTY @tt{plink.exe} or @tt{plink}; if found, the default options are @racket['("-batch" "-T")]. If @tt{plink} is not found, the launcher falls back to OpenSSH @tt{ssh.exe}/@tt{ssh}. The default remote command is equivalent to:
@racketblock[
(racket-sound-default-remote-command remote-racket remote-module)]
When @racket[ssh-options] is @racket[#f], suitable options are derived from the selected SSH program. If the remote setup needs a different launcher command, provide @racket[remote-command] as a list of command-line words.
worker over SSH instead of starting a local place or thread. All SSH and remote
Racket details are handled by the remote utility layer and its
@tt{racket-audio.ini} configuration. The public player API only needs the host
name.
The remote player must be able to open the requested audio files. When the
local and remote file trees differ, use @racket[remote-path-map]. It may be a
procedure from path string to path string, or a list of mappings. Each mapping
may be a two-element list, a cons pair, or a two-element vector. The longest
matching local prefix is replaced by the corresponding remote prefix before the
@racket['open] command is sent. For example:
local and remote file trees differ, use @racket[replace-base-paths]. It is a
list of cons pairs. The @racket[car] is the local base path, and the
@racket[cdr] is the remote base path. The first matching local prefix is
replaced before the @racket['open] command is sent. For example:
@racketblock[
(make-audio-player cb-state cb-eof
#:remote-host "nas"
#:remote-path-map
(list (list "/muziek" "/volume1/music")))]
#:replace-base-paths
(list (cons "/muziek" "/volume1/music")))]
With that mapping, @filepath{/muziek/klassiek/x.flac} is sent to the remote
worker as @filepath{/volume1/music/klassiek/x.flac}.}
@defproc[(audio-remote-path [path path-string?]
[remote-path-map any/c])
@defproc[(replace-base-path [path path-string?]
[replace-base-paths any/c])
string?]{
Applies the same path translation used by remote playback. This is primarily a
small helper for testing SSH path-map configuration before starting playback.}
Applies the same base-path replacement used by remote playback. This is a small
helper for testing the mapping before starting playback.}
@section[#:tag "audio-player-remote-defaults"]{Remote defaults}
@defproc[(racket-sound-default-ssh-program) path-string?]{
Returns the default SSH client for remote playback. On Windows this prefers
PuTTY @tt{plink.exe}/@tt{plink}, then OpenSSH @tt{ssh.exe}/@tt{ssh}. On other
platforms it uses @tt{ssh}.}
@defproc[(racket-sound-default-ssh-options [ssh-program path-string?])
(listof string?)]{
Returns default command-line options for @racket[ssh-program]. For @tt{plink}
this is @racket['("-batch" "-T")]; for OpenSSH this is @racket['("-T" "-q")].}
@defproc[(racket-sound-default-remote-racket) string?]{
Returns the default remote Racket executable name, currently @racket["racket"].}
@defproc[(racket-sound-default-remote-module) string?]{
Returns the default remote module, currently
@racket["racket-audio/audio-placed-player"].}
@defproc[(racket-sound-default-remote-command
[remote-racket path-string? (racket-sound-default-remote-racket)]
[remote-module string? (racket-sound-default-remote-module)])
(listof string?)]{
Builds the default remote worker command:
@racketblock[
(list remote-racket "-l" remote-module "--" "--stdio")]
}
@defthing[current-racket-sound-ssh-program parameter?]{
Parameter holding the default SSH program used by @racket[make-audio-player]
when @racket[#:ssh-program] is not supplied.}
@defthing[current-racket-sound-remote-racket parameter?]{
Parameter holding the default remote Racket executable name.}
@defthing[current-racket-sound-remote-module parameter?]{
Parameter holding the default remote module name.}
@defproc[(audio-play? [v any/c]) boolean?]{
Returns @racket[#t] when @racket[v] is a currently valid audio player handle.