diff --git a/README.md b/README.md index 003e1af..8cec71c 100644 --- a/README.md +++ b/README.md @@ -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") ``` diff --git a/audio-player.rkt b/audio-player.rkt index 7c89454..df4b6bf 100644 --- a/audio-player.rkt +++ b/audio-player.rkt @@ -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 (λ () diff --git a/info.rkt b/info.rkt index 7112401..29e446d 100644 --- a/info.rkt +++ b/info.rkt @@ -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" diff --git a/private/config.rkt b/private/config.rkt new file mode 100644 index 0000000..96e8a32 --- /dev/null +++ b/private/config.rkt @@ -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)) + + + diff --git a/private/remote-utils.rkt b/private/remote-utils.rkt index a9ada15..da6a795 100644 --- a/private/remote-utils.rkt +++ b/private/remote-utils.rkt @@ -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)) diff --git a/scrbl/audio-player.scrbl b/scrbl/audio-player.scrbl index 5a28997..67d18e0 100644 --- a/scrbl/audio-player.scrbl +++ b/scrbl/audio-player.scrbl @@ -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.