how should you kill a subprocess? pasted by klm` on Thu Feb 27 17:36:58 2014


;; count the number of cat processes
(define (count-child-processes)
  (print "\n" (with-input-from-pipe "pstree -p|egrep 'cat\\(' | wc" read)))

(count-child-processes)

(receive (pip pop pid) (process "cat" '())
  (display "hello\n" pop)
  (print "read: " (read-line pip))
  (process-signal pid signal/term)
  (print "done"))

;; cat process is incremented (process-signal didn't work), why?
(count-child-processes)

;; we can kill process with close-*-port:
(define (tiger-dance)
  (receive (pip pop pid) (process "cat" '())
    (display "hello\n" pop)
    (print "read: " (read-line pip))
    (close-input-port pip)
    (close-output-port pop)
    (print "done")))

(tiger-dance)

(count-child-processes)

;; but that causes strange 'bugs' like hangs:
(repeat 3 (thread-start! tiger-dance))

no title pasted by klm` on Thu Feb 27 18:26:26 2014

[klm@kth cube-server]$ cat process-control.scm 
(use posix srfi-18 miscmacros)

;; we can kill process with close-*-port:
(define (tiger-dance)
  (receive (pip pop pid) (process "cat" '())
    (display "hello\n" pop)
    (print "read: " (read-line pip))
    (close-input-port pip)
    (close-output-port pop)
    (print "done")))


;; but that causes strange 'bugs'?
;; this hangs:
(repeat 3 (thread-start! tiger-dance))

(thread-sleep! 0.1)
(print "we're done")
;;(print (read-line))





[klm@kth cube-server]$ csi -s process-control.scm 
read: hello

^C
Warning (#<thread: thread32>): in thread: (process) abnormal process exit
9509
2

	Call history:

	<eval>	  [tiger-dance] (process "cat" (quote ()))
	<eval>	  [tiger-dance] (display "hello\n" pop)
	<eval>	  [tiger-dance] (print "read: " (read-line pip))
	<eval>	  [tiger-dance] (read-line pip)
	<eval>	  [tiger-dance] (close-input-port pip)
	<eval>	  [tiger-dance] (close-output-port pop)	<--

*** user interrupt ***

no title pasted by klm` on Thu Feb 27 18:30:23 2014

reversing the order of close-input-port / close-output port has no effect

no title added by klm` on Thu Feb 27 19:35:41 2014


;;; this works now
;;; with csi -s process-control.scm
;;; (it no longer hangs)

(use posix srfi-18 miscmacros)

(define (process* cmd #!optional args env)
  (let*-values
      (((in-in   in-out) (create-pipe))
       ((out-in out-out) (create-pipe))
       ((err-in err-out) (create-pipe))
       ((pid) (process-fork
               (lambda ()
                 (duplicate-fileno in-in fileno/stdin)
                 (duplicate-fileno out-out fileno/stdout)
                 (duplicate-fileno err-out fileno/stderr)
                 (file-close in-out)
                 (file-close in-in)
                 (file-close out-in)
                 (file-close out-out)
                 (file-close err-in)
                 (file-close err-out)
                 (process-execute cmd args env)))))
    (file-close in-in)
    (file-close out-out)
    (file-close err-out)
    (let ((pip (open-input-file*  out-in))
          (pop (open-output-file* in-out))
          (pep (open-input-file*  err-in)))
      (set-buffering-mode! pip #:line)
      (set-buffering-mode! pop #:line)
      (set-buffering-mode! pep #:line)
      (values pip pop pid pep))))

;; we can kill process with close-*-port:
(define (tiger-dance)
  (receive (pip pop pid pep)
      (process* "cat" '())
    (print "say hello")
    (display "hello\n" pop)
    (print "reading hello")
    (print "read: " (read-line pip))
    
    (close-output-port pop)
    (close-input-port pip)
    (print "done")))

;; but that causes strange 'bugs'?
;; this hangs:
(print "running some spawn threads...")
(repeat 10 (thread-start! tiger-dance))

(thread-sleep! 0.1)
(print "we're done")
;;(print (read-line))