Author: hhubner Date: 2006-03-17 14:20:46 -0500 (Fri, 17 Mar 2006) New Revision: 1938 Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp Log: Properly close pipes generated by the cert generator. Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 19:20:10 UTC (rev 1937) +++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 19:20:46 UTC (rev 1938) @@ -1,13 +1,15 @@ (in-package :bos.m2.cert-generator) (defun run-tool (program &optional program-args &rest args) - (let ((process (apply #'run-program program program-args :output :stream args))) + (let* ((process (apply #'run-program program program-args :output :stream args)) + (error-message (unless (zerop (process-exit-code process)) + (with-output-to-string (*standard-output*) + (with-open-stream (output-stream (process-output process)) + (princ (read-line output-stream))))))) + (process-close process) (unless (zerop (process-exit-code process)) - (let ((error-message (with-output-to-string (*standard-output*) - (with-open-stream (output-stream (process-output process)) - (princ (read-line output-stream)))))) - (error "Error executing ~A - Exit code ~D~%Error message: ~A" - (format nil "\"~A~{ ~A~}\"" program program-args) (process-exit-code process) error-message))))) + (error "Error executing ~A - Exit code ~D~%Error message: ~A" + (format nil "\"~A~{ ~A~}\"" program program-args) (process-exit-code process) error-message)))) (defun fill-form (fdf-pathname pdf-pathname output-pathname) (handler-case