Luca Pisati <wingededge.com at pisati> writes:

> Clemens Heitzinger wrote:
> > 
> > Raimondas Kiveris <ldis.com at rai> writes:
> > 
> > > I have following problem:
> > >
> > > I have to use run-shell-command in a multithreaded application.
> > > Run-shell-command with :wait t apparently suspends all other
> > > threads and if external process takes significant time to complete
> > > the whole application practically hangs.
> > 
> > Try running RUN-SHELL-COMMAND in a separate thread, or new lisp
> > listener.  It seems as if the whole ACL unix process only hangs if you
> > use RUN-SHELL-COMMAND in the first (main?) lisp process.  This should
> > really be submitted as a bug report (at least, documentation bug
> > report).
> 
> Well, on unix the *common-lisp* buffer is definitively "different".
> But, even if you run in another thread, the :wait t will block the
> entire Lisp. Therefore the timeout will not work. As I said in the previous
> email, I believe that the only way is to implement your own waiting loop.
> Also, the timeout action could be to sigkill the process, so, you need
> access to the pid of the process.

I misremembered a problem I had several months ago.  -- The
*common-lisp* buffer feels "differently" (Linux, ACL 5.0.1) in mp
applications, although I can't come up with a test case right now.

Maybe this piece of code is useful.

(defun shell-output-lines-with-timeout (timeout &rest format-args)
  (let ((command-line (apply #'format nil format-args)))
    (multiple-value-bind (output-stream stream-b pid)
	(excl:run-shell-command command-line :output :stream :wait nil :error-output :output)
      (declare (ignore stream-b))
      (unwind-protect
	  (mp:with-timeout (timeout
			    (warn "Killing process ~D for command ~S because it timed out after ~S seconds."
				  pid command-line timeout)
			    (excl:run-shell-command (format nil "kill -9 ~D >/dev/null" pid))
			    (values))
	    (loop for line = (read-line output-stream nil nil)
		while line
		collect line))
	(when output-stream (close output-stream :abort t))
	(system:reap-os-subprocess :pid pid)))))

Yours,
Clemens