1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
(use gauche.threads)
(use gauche.process)
(use srfi-42)

(define (main args)
  (unless (= (length args) 3) (error "needs two arguments"))

  (let* ((ps (map (cut run-process <> :input :pipe :output :pipe) (cdr args)))
         (is (map process-output ps))
         (os (map process-input ps)))

    (define (finish sig)
      (do-ec (: p ps)
             (guard (e (else #t)) (process-send-signal p SIGTERM))) (exit 0))
    
    (do-ec (: ss (list is os)) (: p ss) (set! (port-buffering p) :none))
    (set-signal-handler! SIGCHLD finish)
    (set-signal-handler! SIGPIPE finish)
    (do-ec (:parallel (: i is) (: o (reverse os)))
           (thread-start! (make-thread (lambda () (copy-port i o)))))
    (sys-pause)))