Remote usage of audio-placed-player.rkt

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`.

audio-placed-player.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
-(require racket/place
+(require racket/port
-         racket/async-channel
+         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)
+(define (placed-player ch-in [initial-ch-out #f] [initial-ch-evt #f])
-  (let ((ch-evt #f)
+  (let ((ch-evt initial-ch-evt)
-        (ch-out #f)
+        (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)
+      (uni-channel-put ch-out data))
-          (place-channel-put ch-out data)
-          (async-channel-put ch-out data)))
 
     (define (evt data)
-      (if (place-channel? ch-evt)
+      (uni-channel-put ch-evt data))
-          (place-channel-put ch-evt data)
-          (async-channel-put ch-evt data)))
 
     (define (get)
-      (if (place-channel? ch-in)
+      (uni-channel-get ch-in))
-          (place-channel-get ch-in)
-          (async-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-out (->uni-channel (cadr data)))
-                                (set! ch-evt (caddr data))
+                                (set! ch-evt (->uni-channel (caddr data)))
                                 '(initialized))
                                (loop))
              (else 
@@ -536,4 +566,15 @@
         )
       )
     )
-  )
+  )
+(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)))

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?)])
+                                    #:use-place [use-place (place-enabled?)]
-  (->* (procedure? procedure?) (#:use-place boolean?) audio-play?)
+                                    #: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
+    (cond
-        (begin
+      [remote-host
-          (set! cmd-ch (dynamic-place placed-player-module 'placed-player))
+       ;; Remote mode starts a worker over ssh.  The remote worker uses
-          (set! cmd-put (λ (data) (place-channel-put cmd-ch data)))
+       ;; placed-player/stdio, so the existing three logical channels map to
-          (set! au-pl cmd-ch)
+       ;; ssh stdin, stdout and stderr.  No init command is sent in this mode:
-          (set! dead-guard (λ () (let ((evt (place-dead-evt au-pl)))
+       ;; the worker starts with all three channels already supplied.
-                                   (sync evt))))
+       (let ((cmd (or remote-command (racket-sound-default-remote-command remote-racket remote-module))))
-          (let-values (((ret-ch-in ret-ch-out) (place-channel))
+         (let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
-                       ((evt-ch-in evt-ch-out) (place-channel)))
+                       (start-remote-placed-player remote-host
-            (place-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
+                                                   #:ssh-program ssh-program
-            (set! evt-ch evt-ch-in)
+                                                   #:ssh-options ssh-options
-            (set! ret-ch ret-ch-in)
+                                                   #:remote-command cmd)))
-            (assert (is-return? (place-channel-get ret-ch-in) 'initialized)
+           (set! cmd-ch cmd-ch*)
-                    "Unexpected: not 'initialized returnd from 'init command"))
+           (set! ret-ch ret-ch*)
-          )
+           (set! evt-ch evt-ch*)
-        (begin
+           (set! au-pl proc)
-          (set! cmd-ch (make-async-channel))
+           (set! dead-guard dead-guard*)))]
-          (set! cmd-put (λ (data) (async-channel-put cmd-ch data)))
+      [use-place
-          (set! au-pl (thread (λ () (placed-player cmd-ch))))
+       ;; dynamic-place returns the command place-channel.  The raw channel
-          (set! dead-guard (λ () (let ((evt (thread-dead-evt au-pl)))
+       ;; is kept for place-dead-evt, while normal traffic is sent through
-                                   (sync evt))))
+       ;; a uni-channel wrapper.
-          (set! ret-ch (make-async-channel))
+       (let ((raw-cmd-ch (dynamic-place placed-player-module 'placed-player)))
-          (set! evt-ch (make-async-channel))
+         (set! cmd-ch (make-uni-channel raw-cmd-ch))
-          (async-channel-put cmd-ch (list 'init ret-ch evt-ch))
+         (set! au-pl raw-cmd-ch)
-          (assert (is-return? (async-channel-get ret-ch) 'initialized)
+         (set! dead-guard (lambda () (let ((evt (place-dead-evt au-pl)))
-                  "Unexpected: not 'initialized returnd from 'init command")
+                                       (sync evt))))
-          )
+         (let-values (((ret-ch-in ret-ch-out) (place-channel))
-        )
+                      ((evt-ch-in evt-ch-out) (place-channel)))
-    (set! ret-get (λ () (to-ret-value (sync ret-ch))))
+           ;; Do not send uni-channel structs through a place-channel: they
-    (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) evt-ch)))
+           ;; contain procedures and are not place-message values.  Send the
-    (set! rpc (λ (cmd . args) (with-mutex rpc-mutex
+           ;; raw channels and let the worker wrap them on its own side.
-                                (cmd-put (cons cmd args)) (ret-get))))
+           (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
              (λ ()

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"
                  )
   )

private/downloader.rkt

@@ -26,8 +26,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define version-major 1)
-(define version-minor 0)
+(define version-minor 1)
-(define version-patch 0)
+(define version-patch 1)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions
@@ -40,8 +40,8 @@
                                  version-patch
                                  ))
 
-(define download-site "git.dijkewijk.nl")
+(define download-site "codeberg.org")
-(define base-path "hans/racket-sound-lib/releases/download")
+(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)

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))

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")
+    (make-hash (list (list 'avutil 58 60 "libavutil")
-                      (list 'avcodec 60 62 "libavutil")
+                      (list 'avcodec 60 62 "libavcodec")
-                      (list 'avformat 60 62 "libswresample")
+                      (list 'avformat 60 62 "libavformat")
-                      (list 'swresample 4 6 "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"
+                "  sudo apt install libflac12 libmpg123-0 libao4 \
-                "  mpg123 : libmpg123-0\n"
+"
-                "  libao  : libao4\n"
+                "                   libavcodec60 libavutil58 libswresample4 libavformat60 \
-                "  ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n"
+"
-                "\n"
+                "                   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 ffmpeg
-               "  brew install libao\n"
+"
-               "  brew install mpg123\n"
+               "  brew install libao
-               "  brew install flac\n"
+"
-               "\n"
+               "  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

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,
+normal Racket thread with async channels.  Both modes are mediated through
-because the player then stays in the same process and can be inspected more
+@racketmodname[uni-channel]: each of the existing logical channels is wrapped as
-easily.
+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?]{
+@defproc[(placed-player
-Runs the placed-player command loop on @racket[ch-in].  The channel may be a
+          [ch-in (or/c uni-channel? place-channel? async-channel? port-channel?)]
-place channel or an async channel.  The command loop receives list commands,
+          [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
+When @racket[ch-out] and @racket[ch-evt] are @racket[#f], the command loop
-@racket[thread].  In place mode, all three channels are place channels.  In
+expects an initial @racket['init] command containing the raw reply and event
-thread mode, all three channels are async channels.  The implementation detects
+channels.  This remains the normal path for @racket[dynamic-place], because a
-the kind of channel and uses @racket[place-channel-put],
+@racket[uni-channel] value contains procedures and must not be sent through a
-@racket[place-channel-get], @racket[async-channel-put], or
+place channel.  In that case the controlling side sends the raw place channels
-@racket[async-channel-get] as appropriate.}
+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
+sends the initial @racket['init] command when needed, starts an event thread, and exposes a
-contracted API.  The placed player itself only exports @racket[placed-player].
+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.
 

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.