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

Made remote playing possible.

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-06 14:28:28 +02:00
parent de443aad9d
commit c8494e289e
2 changed files with 63 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/remote-utils.rkt
+40 -12
View File
@@ -4,7 +4,9 @@
racket/string
port-channel
uni-channel
"config.rkt")
"config.rkt"
"utils.rkt"
)
(provide replace-base-paths?
replace-base-path
@@ -25,6 +27,14 @@
(path-string? (cdr entry))))
v)))
(define (get-path-separator s)
(let ((m (regexp-match #rx"[\\\\/]" s)))
(if (eq? m #f)
(begin
(warn-sound "No delimiter found in ~a, assuming unix: '/'" s)
"/")
(car m))))
(define (replace-base-path path replace-base-paths)
(let ((s (path-string->string path)))
(let loop ((entries replace-base-paths))
@@ -34,8 +44,13 @@
(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)))
(let* ((new-path* (string-append base-path-remote
(substring s (string-length base-path-local))))
(delim (get-path-separator new-path*))
(new-path (string-replace (string-replace new-path* "/" delim) "\\" delim))
)
new-path
)
(loop (cdr entries))))]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -51,21 +66,34 @@
(define (ssh-options ssh-program)
(if (plink-program? ssh-program)
'("-batch" "-T")
'("-batch" "-T" "-load")
'("-T" "-q")))
(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 (shell-quote s)
(string-append "'"
(regexp-replace* #rx"'" s "'\"'\"'")
"'"))
(define (start-ssh-subprocess remote-host)
(define (remote-command remote-host #:cmd [cmd #f])
(if (eq? cmd #f)
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-l"
(audio-remote-cfg-get remote-host 'remote-module)
"--"
"--stdio")
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-e"
(shell-quote cmd)
"--"
"--stdio")
)
)
(define (start-ssh-subprocess remote-host #:cmd [cmd #f])
(let* ((ssh-program (audio-cfg-get 'ssh-program))
(args (append (ssh-options ssh-program)
(list remote-host)
(remote-command remote-host))))
(remote-command remote-host #:cmd cmd))))
(apply subprocess #f #f #f ssh-program args)))
(define (make-port-uc port direction source)