From 6ed566c6cddf8912ee83eac7f197f99ae16a393e Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 8 Jun 2026 15:46:27 +0200 Subject: [PATCH] Remote usage of audio-placed-player.rkt --- README.md | 91 +++++++++++++++++++ audio-placed-player.rkt | 75 ++++++++++++---- audio-player.rkt | 132 +++++++++++++++++++-------- info.rkt | 1 + private/downloader.rkt | 10 +-- private/remote-utils.rkt | 153 ++++++++++++++++++++++++++++++++ private/utils.rkt | 87 ++++++++++++++---- scrbl/audio-placed-player.scrbl | 76 ++++++++++++---- scrbl/audio-player.scrbl | 90 ++++++++++++++++++- 9 files changed, 624 insertions(+), 91 deletions(-) create mode 100644 private/remote-utils.rkt diff --git a/README.md b/README.md index 535e1e5..1642d3b 100644 --- a/README.md +++ b/README.md @@ -29,6 +29,26 @@ uses libFLAC directly. FLAC sample-rate conversion uses the existing FFmpeg swresample layer. Metadata and cover-art copying use the TagLib wrapper; the public `taglib.rkt` API also supports read-write tag editing. + +## Debian / Ubuntu + +On Debian-like systems, install the runtime and development packages for the +selected backends. A typical full setup is: + +```sh +sudo apt install \ + libao-dev \ + libflac-dev \ + libmpg123-dev \ + ffmpeg \ + libavutil-dev libavcodec-dev libavformat-dev libswresample-dev \ + libogg-dev libopus-dev libopusenc-dev libopusfile-dev \ + libtag1-dev +``` + +For Opus encoding, `libopusenc-dev` is required. For Opus decoding through +`opusfile-decoder.rkt`, install `libopusfile-dev` as well. + ## macOS Using Homebrew, install the native libraries before using the package: @@ -46,6 +66,19 @@ brew install taglib Some Homebrew installations provide FFmpeg as `ffmpeg`; older local setups may use `ffmpeg-full`. + +## Windows + +On Windows, the package downloader fetches the native DLL bundle from the +Codeberg `racket-sound-lib` release area. The current bundle URL pattern is: + +```text +https://codeberg.org/hnmdijkema/racket-sound-lib/releases/download/1-1-1/windows-x86_64.zip +``` + +The archive is installed below Racket's addon directory by +`download-soundlibs`. + ## Encoder examples Encode to Opus: @@ -78,3 +111,61 @@ A small test wrapper is available in `encoder-test.rkt`: racket encoder-test.rkt --encoder opus --input input.flac --output output.opus --bitrate-kbps 224 racket encoder-test.rkt --encoder flac --input input-96k.flac --output output-48k.flac --sample-rate 48000 ``` + +## Placed player stdio mode + +The placed player can also run as a standard-port worker. In that mode the +three existing logical channels are mapped to standard streams: + +```text +stdin command channel +stdout reply channel +stderr event channel +``` + +Because stdout and stderr are protocol streams in this mode, ordinary display +and log output is redirected. By default, `placed-player/stdio` appends such +output to a log file below Racket's standard cache directory, for example +`~/.cache/racket/racket-audio/placed-audio-player-stdio.log` on many Unix-like +systems. Pass `#:log-file #f` to discard ordinary output, or pass a path to +choose a different log file. + +## Remote placed player over SSH + +The placed player can also be started as a remote subprocess over SSH. In this +mode the existing three logical player channels are kept separate: + +```text +stdin command channel +stdout reply channel +stderr event channel +``` + +The remote worker is normally started as: + +```sh +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`. + +Example: + +```racket +(define player + (make-audio-player cb-state cb-eof + #:remote-host "nas" + #:remote-path-map + (list (list "/muziek" "/volume1/music")))) + +(audio-play! player "/muziek/klassiek/track.flac") +``` + +The remote host must be able to read the translated path. In the example above, +the remote worker receives `/volume1/music/klassiek/track.flac`. diff --git a/audio-placed-player.rkt b/audio-placed-player.rkt index 5889ae7..e1860a5 100644 --- a/audio-placed-player.rkt +++ b/audio-placed-player.rkt @@ -1,7 +1,8 @@ #lang racket/base -(require racket/place - racket/async-channel +(require racket/port + port-channel + uni-channel "libao.rkt" "audio-decoder.rkt" "private/utils.rkt" @@ -9,19 +10,43 @@ ) (provide placed-player + placed-player/stdio audio-known-exts? ) (define get-current-seconds current-seconds) +(define (placed-player/stdio #:log-file [log-file (racket-sound-log-file 'placed-audio-player-stdio)]) + (define stdin-ch + (make-uni-channel + (make-port-channel (current-input-port) #:direction 'input #:source 'stdin #:close? #f))) + (define stdout-ch + (make-uni-channel + (make-port-channel (current-output-port) #:direction 'output #:source 'stdout #:close? #f))) + (define stderr-ch + (make-uni-channel + (make-port-channel (current-error-port) #:direction 'output #:source 'stderr #:close? #f))) + (define log-port (if log-file (open-racket-sound-log-file log-file) (open-output-nowhere))) + (dynamic-wind + void + (lambda () + ;; stdout and stderr are protocol channels in this mode. Redirect ordinary + ;; output so that display/log output cannot corrupt the serialized channel + ;; streams. + (parameterize ([current-output-port log-port] + [current-error-port log-port]) + (placed-player stdin-ch stdout-ch stderr-ch))) + (lambda () + (with-handlers ([exn:fail? void]) (close-output-port log-port))))) + (define (eq-seconds? s1 s2) (let ((s1* (inexact->exact (round s1))) (s2* (inexact->exact (round s2)))) (= s1* s2*))) -(define (placed-player ch-in) - (let ((ch-evt #f) - (ch-out #f) +(define (placed-player ch-in [initial-ch-out #f] [initial-ch-evt #f]) + (let ((ch-evt initial-ch-evt) + (ch-out initial-ch-out) (ao-h #f) (ao-mutex (make-mutex)) (ao-dec #f) @@ -53,20 +78,25 @@ (begin b1 ...) r))))) + (define (->uni-channel ch) + (if (uni-channel? ch) ch (make-uni-channel ch))) + + ;; ch-in is supplied by dynamic-place or by the async/thread launcher. + ;; ch-out and ch-evt are supplied by the init command. Each logical + ;; channel is wrapped as a uni-channel on the side where it is used; raw + ;; place channels must not be wrapped before they are sent through init. + (set! ch-in (->uni-channel ch-in)) + (when ch-out (set! ch-out (->uni-channel ch-out))) + (when ch-evt (set! ch-evt (->uni-channel ch-evt))) + (define (put data) - (if (place-channel? ch-out) - (place-channel-put ch-out data) - (async-channel-put ch-out data))) + (uni-channel-put ch-out data)) (define (evt data) - (if (place-channel? ch-evt) - (place-channel-put ch-evt data) - (async-channel-put ch-evt data))) + (uni-channel-put ch-evt data)) (define (get) - (if (place-channel? ch-in) - (place-channel-get ch-in) - (async-channel-get ch-in))) + (uni-channel-get ch-in)) (define (audio-read-worker ao-dec file-id) (set! feeding-audio #t) @@ -456,8 +486,8 @@ (state "quit" evt 'force) '(quit))) ((eq? cmd 'init) (do-rpc - (set! ch-out (cadr data)) - (set! ch-evt (caddr data)) + (set! ch-out (->uni-channel (cadr data))) + (set! ch-evt (->uni-channel (caddr data))) '(initialized)) (loop)) (else @@ -536,4 +566,15 @@ ) ) ) - ) \ No newline at end of file + ) +(module+ main + (require racket/cmdline) + (define log-file 'default) + (command-line + #:once-each + [("--stdio") "Run the placed audio player over stdin/stdout/stderr." (void)] + [("--log-file") file "Write ordinary worker logging to file." (set! log-file file)] + [("--no-log-file") "Discard ordinary worker logging." (set! log-file #f)]) + (placed-player/stdio #:log-file (if (eq? log-file 'default) + (racket-sound-log-file 'placed-audio-player-stdio) + log-file))) diff --git a/audio-player.rkt b/audio-player.rkt index f7c9a0d..8b80f37 100644 --- a/audio-player.rkt +++ b/audio-player.rkt @@ -4,8 +4,10 @@ racket/contract racket/async-channel racket/runtime-path + uni-channel "audio-placed-player.rkt" "private/utils.rkt" + "private/remote-utils.rkt" (prefix-in ffi: ffi/unsafe) ) @@ -35,12 +37,22 @@ audio-known-exts? 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 ) (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) + (valid? cb-state cb-eof-stream rpc au-place evt-thread state remote-path-map) #:mutable #:transparent ) @@ -88,8 +100,24 @@ (unless cond (error (format message ...)))))) (define/contract (make-audio-player cb-state cb-eof-stream - #:use-place [use-place (place-enabled?)]) - (->* (procedure? procedure?) (#:use-place boolean?) audio-play?) + #: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]) + (->* (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?))) + audio-play?) (let ((cmd-ch #f) (ret-ch #f) (evt-ch #f) @@ -101,38 +129,69 @@ (rpc #f) (rpc-mutex (make-mutex)) ) - (if use-place - (begin - (set! cmd-ch (dynamic-place placed-player-module 'placed-player)) - (set! cmd-put (λ (data) (place-channel-put cmd-ch data))) - (set! au-pl cmd-ch) - (set! dead-guard (λ () (let ((evt (place-dead-evt au-pl))) - (sync evt)))) - (let-values (((ret-ch-in ret-ch-out) (place-channel)) - ((evt-ch-in evt-ch-out) (place-channel))) - (place-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out)) - (set! evt-ch evt-ch-in) - (set! ret-ch ret-ch-in) - (assert (is-return? (place-channel-get ret-ch-in) 'initialized) - "Unexpected: not 'initialized returnd from 'init command")) - ) - (begin - (set! cmd-ch (make-async-channel)) - (set! cmd-put (λ (data) (async-channel-put cmd-ch data))) - (set! au-pl (thread (λ () (placed-player cmd-ch)))) - (set! dead-guard (λ () (let ((evt (thread-dead-evt au-pl))) - (sync evt)))) - (set! ret-ch (make-async-channel)) - (set! evt-ch (make-async-channel)) - (async-channel-put cmd-ch (list 'init ret-ch evt-ch)) - (assert (is-return? (async-channel-get ret-ch) 'initialized) - "Unexpected: not 'initialized returnd from 'init command") - ) - ) - (set! ret-get (λ () (to-ret-value (sync ret-ch)))) - (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) evt-ch))) - (set! rpc (λ (cmd . args) (with-mutex rpc-mutex - (cmd-put (cons cmd args)) (ret-get)))) + (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*)))] + [use-place + ;; dynamic-place returns the command place-channel. The raw channel + ;; is kept for place-dead-evt, while normal traffic is sent through + ;; a uni-channel wrapper. + (let ((raw-cmd-ch (dynamic-place placed-player-module 'placed-player))) + (set! cmd-ch (make-uni-channel raw-cmd-ch)) + (set! au-pl raw-cmd-ch) + (set! dead-guard (lambda () (let ((evt (place-dead-evt au-pl))) + (sync evt)))) + (let-values (((ret-ch-in ret-ch-out) (place-channel)) + ((evt-ch-in evt-ch-out) (place-channel))) + ;; Do not send uni-channel structs through a place-channel: they + ;; contain procedures and are not place-message values. Send the + ;; raw channels and let the worker wrap them on its own side. + (set! ret-ch (make-uni-channel ret-ch-in)) + (set! evt-ch (make-uni-channel evt-ch-in)) + (uni-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out)) + (assert (is-return? (uni-channel-get ret-ch) 'initialized) + "Unexpected: not 'initialized returned from 'init command")))] + [else + (let ((raw-cmd-ch (make-async-channel))) + (set! cmd-ch (make-uni-channel raw-cmd-ch)) + (set! au-pl (thread (lambda () (placed-player raw-cmd-ch)))) + (set! dead-guard (lambda () (let ((evt (thread-dead-evt au-pl))) + (sync evt)))) + (let ((raw-ret-ch (make-async-channel)) + (raw-evt-ch (make-async-channel))) + ;; As in place mode, pass raw channels during init and keep + ;; uni-channel wrappers on each side for all subsequent traffic. + (set! ret-ch (make-uni-channel raw-ret-ch)) + (set! evt-ch (make-uni-channel raw-evt-ch)) + (uni-channel-put cmd-ch (list 'init raw-ret-ch raw-evt-ch)) + (assert (is-return? (uni-channel-get ret-ch) 'initialized) + "Unexpected: not 'initialized returned from 'init command")))]) + (set! cmd-put (λ (data) (uni-channel-put cmd-ch data))) + (set! ret-get (λ () (to-ret-value (uni-channel-get ret-ch)))) + (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) + (uni-channel-get-evt evt-ch)))) + (set! rpc (lambda (cmd . args) + (with-mutex rpc-mutex + (define args* + (if (and (eq? cmd 'open) (pair? args)) + (cons (audio-remote-path (car args) remote-path-map) (cdr args)) + args)) + (cmd-put (cons cmd args*)) + (ret-get)))) (let* ((handle #f) (cb-state* (λ (st st-hash) (cb-state handle st st-hash))) @@ -142,7 +201,8 @@ rpc au-pl #f - (make-hash))) + (make-hash) + remote-path-map)) (set-audio-play-evt-thread! handle (thread (λ () diff --git a/info.rkt b/info.rkt index d554d46..7112401 100644 --- a/info.rkt +++ b/info.rkt @@ -16,6 +16,7 @@ "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf" "early-return" "let-assert" + "uni-channel" "port-channel" "rackunit-lib" ) ) diff --git a/private/downloader.rkt b/private/downloader.rkt index 1cbc1a7..31f1449 100644 --- a/private/downloader.rkt +++ b/private/downloader.rkt @@ -26,8 +26,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define version-major 1) -(define version-minor 0) -(define version-patch 0) +(define version-minor 1) +(define version-patch 1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions @@ -40,8 +40,8 @@ version-patch )) -(define download-site "git.dijkewijk.nl") -(define base-path "hans/racket-sound-lib/releases/download") +(define download-site "codeberg.org") +(define base-path "hnmdijkema/racket-sound-lib/releases/download") (define os (system-type 'os*)) (define arch (system-type 'arch)) @@ -145,7 +145,7 @@ (let* ((file (build-path install-path "archive.zip")) (out (open-output-file file #:exists 'replace)) ) - (displayln (format "Downloading racket-webview-qt (~a)..." download-url)) + (displayln (format "Downloading racket-sound-lib (~a)..." download-url)) (do-download in out) (displayln (format "downloaded '~a'" file)) (when (directory-exists? ffi-path) diff --git a/private/remote-utils.rkt b/private/remote-utils.rkt new file mode 100644 index 0000000..a9ada15 --- /dev/null +++ b/private/remote-utils.rkt @@ -0,0 +1,153 @@ +#lang racket/base + +(require racket/list + racket/path + racket/string + racket/system + port-channel + uni-channel) + +(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 + start-remote-placed-player) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Remote path mapping +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 (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))])])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SSH / subprocess defaults +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (executable-name p) + (let ((p* (if (path? p) p (string->path p)))) + (path->string (file-name-from-path p*)))) + +(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)]) + (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 (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 (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-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)) + (define dead-guard (lambda () (subprocess-wait proc))) + (values cmd-ch ret-ch evt-ch proc dead-guard)) diff --git a/private/utils.rkt b/private/utils.rkt index e84d3b3..6700571 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -1,7 +1,9 @@ (module utils racket/base (require racket/path + racket/file racket/runtime-path + racket/system ffi/unsafe setup/dirs "downloader.rkt" @@ -19,6 +21,9 @@ warn-sound fatal-sound sync-log-sound + racket-sound-cache-directory + racket-sound-log-file + open-racket-sound-log-file integer->int-bytes int-bytes->integer valid-ffmpeg-versions @@ -34,6 +39,30 @@ (sl-def-log racket-sound sound) + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Standard cache/log paths + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (racket-sound-cache-directory) + (build-path (find-system-path 'cache-dir) "racket-audio")) + + (define (racket-sound-log-file name) + (define filename + (cond [(symbol? name) (format "~a.log" name)] + [(string? name) name] + [else (raise-argument-error 'racket-sound-log-file "(or/c symbol? string?)" name)])) + (build-path (racket-sound-cache-directory) filename)) + + (define (open-racket-sound-log-file path #:exists [exists 'append]) + (define parent (path-only (path->complete-path path))) + (when parent (make-directory* parent)) + (open-output-file path #:exists exists)) + + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mutex definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -135,16 +164,16 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define valid-ffmpeg-versions - (make-hash (list (list 'avutil 58 60 "libavcodec") - (list 'avcodec 60 62 "libavutil") - (list 'avformat 60 62 "libswresample") - (list 'swresample 4 6 "libavformat") + (make-hash (list (list 'avutil 58 60 "libavutil") + (list 'avcodec 60 62 "libavcodec") + (list 'avformat 60 62 "libavformat") + (list 'swresample 4 6 "libswresample") )) ) (define (version-str kind) (let ((v (hash-ref valid-ffmpeg-versions kind))) - (format " - ~a~a - ~a~a\n" (caddr v) (car v) (caddr v) (cadr v)) + (format " - ~a.so.~a - ~a.so.~a\n" (caddr v) (car v) (caddr v) (cadr v)) ) ) @@ -162,22 +191,50 @@ "Make sure you have installed the following libraries,\n" "e.g. on a debian based system with apt:\n" "\n" - " FLAC : sudo apt install libflac12\n" - " mpg123 : libmpg123-0\n" - " libao : libao4\n" - " ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n" - "\n" + " sudo apt install libflac12 libmpg123-0 libao4 \ +" + " libavcodec60 libavutil58 libswresample4 libavformat60 \ +" + " libogg0 libopus0 libopusenc0 libopusfile0 libtag1v5 +" + " +" + "For development from source or local FFI rebuilding, install the matching -dev packages, +" + "for example libflac-dev, libmpg123-dev, libao-dev, libavcodec-dev, +" + "libavutil-dev, libswresample-dev, libavformat-dev, libogg-dev, +" + "libopus-dev, libopusenc-dev, libopusfile-dev and libtag1-dev. +" + " +" ))) ((eq? st 'macosx) (displayln (string-append "Make sure you have the right libraries installed, using 'homebrew', see https://brew.sh/\n" "\n" - " brew install ffmpeg-full\n" - " brew install libao\n" - " brew install mpg123\n" - " brew install flac\n" - "\n" + " brew install ffmpeg +" + " brew install libao +" + " brew install mpg123 +" + " brew install flac +" + " brew install opus +" + " brew install libopusenc +" + " brew install taglib +" + " +" + "If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead. +" + " +" ))) (else (displayln diff --git a/scrbl/audio-placed-player.scrbl b/scrbl/audio-placed-player.scrbl index 5ef3c61..bc239c6 100644 --- a/scrbl/audio-placed-player.scrbl +++ b/scrbl/audio-placed-player.scrbl @@ -5,6 +5,8 @@ racket/contract racket/place racket/async-channel + uni-channel + port-channel "../audio-placed-player.rkt" "../audio-player.rkt")) @@ -30,9 +32,11 @@ The placed player is implemented as a command loop around a decoder, an asynchronous libao output handle, and a small amount of state that is reported back to the controlling side. In normal use it runs in a Racket place, so that the audio side has a separate Racket VM. The same function can also run in a -normal Racket thread with async channels. That mode is useful for debugging, -because the player then stays in the same process and can be inspected more -easily. +normal Racket thread with async channels. Both modes are mediated through +@racketmodname[uni-channel]: each of the existing logical channels is wrapped as +a uni-channel endpoint, so the worker no longer depends directly on +@racket[place-channel-put], @racket[place-channel-get], +@racket[async-channel-put], or @racket[async-channel-get]. It is normally run in a separate place so that audio decoding and feeding are isolated from scheduling delays in the main Racket VM, such as GUI activity, @@ -40,22 +44,58 @@ debugging, or interaction with DrRacket. @section{Interface} -@defproc[(placed-player [ch-in (or/c place-channel? async-channel?)]) void?]{ -Runs the placed-player command loop on @racket[ch-in]. The channel may be a -place channel or an async channel. The command loop receives list commands, +@defproc[(placed-player + [ch-in (or/c uni-channel? place-channel? async-channel? port-channel?)] + [ch-out (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f] + [ch-evt (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f]) + void?]{ +Runs the placed-player command loop on @racket[ch-in]. Each channel may already +be a @racket[uni-channel?] or may be a supported raw channel that can be wrapped +with @racket[make-uni-channel]. The command loop receives list commands, initializes its reply and event channels, and then processes playback commands until it receives @racket['quit]. -The function is designed to be started either by @racket[dynamic-place] or by -@racket[thread]. In place mode, all three channels are place channels. In -thread mode, all three channels are async channels. The implementation detects -the kind of channel and uses @racket[place-channel-put], -@racket[place-channel-get], @racket[async-channel-put], or -@racket[async-channel-get] as appropriate.} +When @racket[ch-out] and @racket[ch-evt] are @racket[#f], the command loop +expects an initial @racket['init] command containing the raw reply and event +channels. This remains the normal path for @racket[dynamic-place], because a +@racket[uni-channel] value contains procedures and must not be sent through a +place channel. In that case the controlling side sends the raw place channels +and the worker wraps them locally. + +When all three channels are supplied, the worker starts initialized. This is +used by the standard-port worker entry point and can also be used by custom +launchers.} + +@defproc[(placed-player/stdio [#:log-file log-file (or/c #f path-string?) (racket-sound-log-file 'placed-audio-player-stdio)]) + void?]{ +Runs @racket[placed-player] using the process standard streams as three logical +channels: @racket[current-input-port] is the command channel, +@racket[current-output-port] is the reply channel, and +@racket[current-error-port] is the asynchronous event channel. The streams are +wrapped through @racket[make-port-channel] and then through +@racket[make-uni-channel]. + +Because stdout and stderr are protocol streams in this mode, ordinary display +and log output is redirected while the worker is running. By default, output is +appended to a log file under Racket's standard cache directory, for example +@filepath{~/.cache/racket/racket-audio/placed-audio-player-stdio.log} on many +Unix-like systems. Pass @racket[#f] explicitly to discard ordinary output, or +pass a path to choose a different log file. + +The module also has a command-line entry point. A remote or local subprocess +worker can be started with: + +@verbatim{ +racket -l racket-audio/audio-placed-player -- --stdio +} + +This is the command used by @racket[make-audio-player] when SSH remote playback +is enabled, unless the caller supplies a custom remote command.} The public wrapper in @racketmodname[racket-audio/audio-player] creates the channels, -sends the initial @racket['init] command, starts an event thread, and exposes a -contracted API. The placed player itself only exports @racket[placed-player]. +sends the initial @racket['init] command when needed, starts an event thread, and exposes a +contracted API. The placed player exports @racket[placed-player] and the +standard-port worker entry point @racket[placed-player/stdio]. @section{Overall state model} @@ -91,7 +131,10 @@ installed. The controlling side sends commands as lists on @racket[ch-in]. The result of an RPC-style command is sent on the reply channel installed by -@racket['init]. Asynchronous events are sent on the event channel. +@racket['init] or supplied directly to @racket[placed-player]. Asynchronous +events are sent on the event channel. These are logical channels; the concrete +transport may be place channels, async channels, or port channels wrapped as +uni-channels. @itemlist[#:style 'compact @item{@racket[(list 'init ch-out ch-evt)] installs @racket[ch-out] and @@ -252,7 +295,8 @@ place or thread then terminates. @section{Running in a place or in a thread} The normal path in @racket[make-audio-player] uses @racket[dynamic-place] when -places are enabled. This gives the audio side its own Racket VM and isolates +places are enabled. The command, reply, and event channels are wrapped with +@racket[make-uni-channel] on each side. This gives the audio side its own Racket VM and isolates it from the main controller, while the command and event protocol stays the same. diff --git a/scrbl/audio-player.scrbl b/scrbl/audio-player.scrbl index d3b4b41..5a28997 100644 --- a/scrbl/audio-player.scrbl +++ b/scrbl/audio-player.scrbl @@ -28,7 +28,14 @@ through callbacks supplied when the player is created. @defproc[(make-audio-player [cb-state procedure?] [cb-eof-stream procedure?] - [#:use-place use-place boolean?]) + [#: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]) audio-play?]{ Creates an audio player and returns a player handle. The handle is passed to all other procedures in this module. @@ -108,8 +115,87 @@ a separate Racket VM, so decoding and buffer feeding are less exposed to scheduling delays caused by DrRacket, GUI event handling, debugging, logging, or other active threads in the main VM. Those delays can otherwise be heard as 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.} +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. + +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: + +@racketblock[ +(make-audio-player cb-state cb-eof + #:remote-host "nas" + #:remote-path-map + (list (list "/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]) + 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.} + + +@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.