Remote audio player much simpler.

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
+stderr remain serialized protocol streams.  SSH, the remote Racket command and
-launcher defaults to `ssh -T -q`.  On Windows it prefers PuTTY `plink.exe` or
+the remote module are configured in `racket-audio.ini`.  The public
-`plink` with `-batch -T`, and falls back to OpenSSH `ssh.exe`/`ssh` when PuTTY
+`make-audio-player` API only needs the remote host and, when necessary, base
-is not present.  These defaults can be overridden with the `#:ssh-program`,
+path replacements.
-`#:ssh-options`, `#:remote-racket`, `#:remote-module`, and `#:remote-command`
-arguments to `make-audio-player`.
 
 Example:
 
@@ -161,8 +159,8 @@ Example:
 (define player
   (make-audio-player cb-state cb-eof
                      #:remote-host "nas"
-                     #:remote-path-map
+                     #:replace-base-paths
-                     (list (list "/muziek" "/volume1/music"))))
+                     (list (cons "/muziek" "/volume1/music"))))
 
 (audio-play! player "/muziek/klassiek/track.flac")
 ```

audio-player.rkt

@@ -39,22 +39,14 @@
          audio-parameterize!
          audio-param!
          audio-param
-         audio-remote-path
+         replace-base-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 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 '()]
+                                    #:replace-base-paths [replace-base-paths '()])
-                                    #: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?
+        #:replace-base-paths replace-base-paths?)
-        #: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)
@@ -133,21 +115,16 @@
         )
     (cond
       [remote-host
-       ;; Remote mode starts a worker over ssh.  The remote worker uses
+       ;; Remote mode is deliberately narrow: make-audio-player only needs
-       ;; placed-player/stdio, so the existing three logical channels map to
+       ;; a host and optional base-path replacements.  SSH, Racket and module
-       ;; ssh stdin, stdout and stderr.  No init command is sent in this mode:
+       ;; details are encapsulated in private/remote-utils.rkt and its config.
-       ;; the worker starts with all three channels already supplied.
+       (let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
-       (let ((cmd (or remote-command (racket-sound-default-remote-command remote-racket remote-module))))
+                     (start-remote-placed-player remote-host)))
-         (let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
+         (set! cmd-ch cmd-ch*)
-                       (start-remote-placed-player remote-host
+         (set! ret-ch ret-ch*)
-                                                   #:ssh-program ssh-program
+         (set! evt-ch evt-ch*)
-                                                   #:ssh-options ssh-options
+         (set! au-pl proc)
-                                                   #:remote-command cmd)))
+         (set! dead-guard dead-guard*))]
-           (set! cmd-ch cmd-ch*)
-           (set! ret-ch ret-ch*)
-           (set! evt-ch evt-ch*)
-           (set! au-pl proc)
-           (set! dead-guard dead-guard*)))]
       [use-place
        ;; dynamic-place returns the command place-channel.  The raw channel
        ;; is kept for place-dead-evt, while normal traffic is sent through
@@ -190,7 +167,7 @@
                 (with-mutex rpc-mutex
                   (define args*
                     (if (and (eq? cmd 'open) (pair? args))
-                        (cons (audio-remote-path (car args) remote-path-map) (cdr args))
+                        (cons (replace-base-path (car args) replace-base-paths) (cdr args))
                         args))
                   (cmd-put (cons cmd args*))
                   (ret-get))))
@@ -204,7 +181,7 @@
                                    au-pl
                                    #f
                                    (make-hash)
-                                   remote-path-map))
+                                   replace-base-paths))
       (set-audio-play-evt-thread! handle
             (thread
              (λ ()

info.rkt

@@ -14,7 +14,7 @@
 (define deps
   '("racket/gui" "racket/base" "racket"
                  "finalizer" "draw-lib" "net-lib"
-                 "simple-log" "racket-sprintf"
+                 "simple-log" "simple-ini" "racket-sprintf"
                  "early-return" "let-assert"
                  "uni-channel" "port-channel"
                  "rackunit-lib"

private/config.rkt

@@ -0,0 +1,100 @@
+#lang racket/base
+
+(provide audio-cfg-get
+         audio-cfg-set!
+         audio-remote-cfg-get
+         audio-remote-cfg-set!
+         )
+
+(require simple-ini/class)
+
+        
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (build-env-path env . parts)
+  (let ((base (getenv env)))
+    (if (eq? base #f)
+        #f
+        (apply build-path (cons base parts)))))
+    
+(define (try-programs . prgs)
+  (letrec ((f (λ (l)
+                (if (null? l)
+                    #f
+                    (if (and (car l) (file-exists? (car l)))
+                        (car l)
+                        (f (cdr l)))))))
+    (f prgs)))
+   
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define cfg (new ini% [file 'racket-audio]))
+
+(when (eq? (send cfg get 'init 'initialized #f) #f)
+  (let ((s! (λ (e v)
+              (send cfg set! 'racket-audio e v))))
+    (s! 'remote-racket "racket")
+    (s! 'remote-module "racket-audio/audio-placed-player")
+    (s! 'ssh-program (cond
+                       ((eq? (system-type 'os) 'windows)
+                        (let ((p (try-programs
+                                  (build-env-path "ProgramFiles" "PuTTY" "plink.exe")
+                                  (build-env-path "ProgramFiles" "OpenSSH" "ssh.exe")
+                                  (build-env-path "SystemRoot" "System32" "OpenSSH" "ssh.exe")
+                                  (find-executable-path "ssh.exe")
+                                  (find-executable-path "plink.exe"))))
+                          (if (eq? p #f)
+                              "plink.exe"
+                              p)))
+                       (else (let ((p (find-executable-path "ssh")))
+                               (if (eq? p #f)
+                                   "ssh"
+                                   p))))
+        )
+    (send cfg set! 'init 'initialized #t)
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (missing-cfg-value? v)
+  (eq? v '@racket-audio-no-value@))
+
+(define (audio-getter section entry default-provider)
+  (let ((v (send cfg get section entry '@racket-audio-no-value@)))
+    (if (missing-cfg-value? v)
+        (cond ((null? default-provider)
+               (error (format
+                       "audio-cfg-get: No such entry ~a in section ~a"
+                       section entry)))
+              ((procedure? (car default-provider))
+               ((car default-provider) entry))
+              (else
+               (car default-provider)))
+        v)))
+  
+        
+(define (audio-cfg-get entry . default-provider)
+  (audio-getter 'racket-audio entry default-provider))
+
+(define (audio-cfg-set! entry val)
+  (send cfg set! 'racket-audio entry val))
+
+(define (audio-remote-cfg-get host entry . default-provider)
+  (audio-getter (string->symbol (format "~a" host))
+                entry
+                (list (lambda (entry)
+                        (apply audio-cfg-get (cons entry default-provider))))))
+
+(define (audio-remote-cfg-set! host entry val)
+  (send cfg set! (string->symbol (format "~a" host)) entry val))
+                                    
+    
+

private/remote-utils.rkt

@@ -1,80 +1,45 @@
 #lang racket/base
 
-(require racket/list
+(require racket/path
-         racket/path
          racket/string
-         racket/system
          port-channel
-         uni-channel)
+         uni-channel
+         "config.rkt")
 
-(provide remote-path-map?
+(provide replace-base-paths?
-         audio-remote-path
+         replace-base-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
+;; Remote path replacement
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (path-string->string p)
   (if (path? p) (path->string p) p))
 
-(define (remote-path-map? v)
+(define (replace-base-paths? v)
-  (or (not v)
+  (and (list? v)
-      (procedure? v)
+       (andmap (lambda (entry)
-      (and (list? v)
+                 (and (pair? entry)
-           (andmap (lambda (entry)
+                      (path-string? (car entry))
-                     (cond [(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry)))
+                      (path-string? (cdr entry))))
-                            (and (path-string? (car entry)) (path-string? (cadr entry)))]
+               v)))
-                           [(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)
+(define (replace-base-path path replace-base-paths)
-  (path-string->string
+  (let ((s (path-string->string path)))
-   (cond [(vector? entry) (vector-ref entry 0)]
+    (let loop ((entries replace-base-paths))
-         [(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (car entry)]
+      (cond [(null? entries) s]
-         [else (car entry)])))
+            [else
-
+             (let* ((entry (car entries))
-(define (path-map-entry-remote entry)
+                    (base-path-local (path-string->string (car entry)))
-  (path-string->string
+                    (base-path-remote (path-string->string (cdr entry))))
-   (cond [(vector? entry) (vector-ref entry 1)]
+               (if (string-prefix? s base-path-local)
-         [(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (cadr entry)]
+                   (string-append base-path-remote
-         [else (cdr entry)])))
+                                  (substring s (string-length base-path-local)))
-
+                   (loop (cdr entries))))]))))
-(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
+;; 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)
+(define (ssh-options 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 (remote-command remote-host)
-(define (racket-sound-default-remote-module) "racket-audio/audio-placed-player")
+  (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
+(define (start-ssh-subprocess remote-host)
-         [remote-racket (racket-sound-default-remote-racket)]
+  (let* ((ssh-program (audio-cfg-get 'ssh-program))
-         [remote-module (racket-sound-default-remote-module)])
+         (args (append (ssh-options ssh-program)
-  (list remote-racket "-l" remote-module "--" "--stdio"))
+                       (list remote-host)
-
+                       (remote-command remote-host))))
-(define current-racket-sound-ssh-program
+    (apply subprocess #f #f #f ssh-program args)))
-  (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)
+(define (start-remote-placed-player remote-host)
-  (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
+    (start-ssh-subprocess remote-host))
-                                       #:ssh-program ssh-program
+  (define cmd-ch (make-port-uc stdin 'output 'remote-stdin))
-                                       #:ssh-options ssh-options))
+  (define ret-ch (make-port-uc stdout 'input 'remote-stdout))
-  (define-values (cmd-ch ret-ch evt-ch)
+  (define evt-ch (make-port-uc stderr 'input 'remote-stderr))
-    (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))

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 '()]
+          [#:replace-base-paths replace-base-paths 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.
@@ -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
+worker over SSH instead of starting a local place or thread.  All SSH and remote
-is expected to run @racket[placed-player/stdio], where stdin is the command
+Racket details are handled by the remote utility layer and its
-channel, stdout is the reply channel, and stderr is the event channel.  The
+@tt{racket-audio.ini} configuration.  The public player API only needs the host
-client side wraps those three process ports through @racketmodname[port-channel]
+name.
-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
+local and remote file trees differ, use @racket[replace-base-paths].  It is a
-procedure from path string to path string, or a list of mappings.  Each mapping
+list of cons pairs.  The @racket[car] is the local base path, and the
-may be a two-element list, a cons pair, or a two-element vector.  The longest
+@racket[cdr] is the remote base path.  The first matching local prefix is
-matching local prefix is replaced by the corresponding remote prefix before the
+replaced before the @racket['open] command is sent.  For example:
-@racket['open] command is sent.  For example:
 
 @racketblock[
 (make-audio-player cb-state cb-eof
                    #:remote-host "nas"
-                   #:remote-path-map
+                   #:replace-base-paths
-                   (list (list "/muziek" "/volume1/music")))]
+                   (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?]
+@defproc[(replace-base-path [path path-string?]
-                            [remote-path-map any/c])
+                            [replace-base-paths any/c])
          string?]{
-Applies the same path translation used by remote playback.  This is primarily a
+Applies the same base-path replacement used by remote playback.  This is a small
-small helper for testing SSH path-map configuration before starting playback.}
+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.