pipe-between.ss
#lang scheme/base

(require (prefix-in log: (planet synx/log)))

(define (wait-for-pipes pipes)
  (for ((pipe pipes))
    (let ((input (car pipe))
          (pid (cdr pipe)))
      (close-output-port input)
      (subprocess-wait pid))))

(define-syntax pipe-between
  (syntax-rules (input: pipes:)
    ((_ (process args ...) rest ...)
     (pipe-between pipes: null input: (current-output-port) (process args ...) rest ...))
    ((_ pipes: pipes input: input (process args ...))
     (let-values
         (((pid stdout stdin error) (subprocess input
                                                (current-input-port) 
                                                (current-error-port) (find-executable-path process) args ...)))
       (subprocess-wait pid)
       (wait-for-pipes pipes)))
    ((_ pipes: pipes input: input (process args ...) rest ...)
     (let-values
         (((pid nothin stdin error) (subprocess (or input (current-output-port))
                                                 #f
                                                 (current-error-port) (find-executable-path process) args ...)))
       (pipe-between pipes: (cons (cons stdin pid) pipes) input: stdin rest ...)))))

(define (main)
  (call-with-output-file
      "debug.log"
    #:exists 'replace
    (λ (output)
      (parameterize ((current-error-port output) (log:port (current-output-port)))
        (with-output-to-file
            "etc.cpio.gz"
          #:exists 'replace
          (λ ()
            (pipe-between
             ("gzip") ("cpio" "-o") ("find" "/etc" "-xdev"))))))))

(provide main pipe-between)