#lang racket/base

(require racket/path
         racket/string
         port-channel
         uni-channel
         "config.rkt")

(provide replace-base-paths?
         replace-base-path
         start-remote-placed-player)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Remote path replacement
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (path-string->string p)
  (if (path? p) (path->string p) p))

(define (replace-base-paths? v)
  (and (list? v)
       (andmap (lambda (entry)
                 (and (pair? entry)
                      (path-string? (car entry))
                      (path-string? (cdr entry))))
               v)))

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Remote placed player
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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 (ssh-options ssh-program)
  (if (plink-program? ssh-program)
      '("-batch" "-T")
      '("-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 (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 (start-remote-placed-player remote-host)
  (define-values (proc 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))