[Gnucash-changes] r13849 - gnucash/trunk - Handle the failure to fork a child process and print an error message,

[David Hampton]

Author: hampton
Date: 2006-04-25 01:13:33 -0400 (Tue, 25 Apr 2006)
New Revision: 13849
Trac: http://svn.gnucash.org/trac/changeset/13849

Modified:
   gnucash/trunk/ChangeLog
   gnucash/trunk/src/scm/process.scm
Log:
Handle the failure to fork a child process and print an error message,
instead of just ignoring the error. Fixes #127241.


Modified: gnucash/trunk/ChangeLog
===================================================================
--- gnucash/trunk/ChangeLog	2006-04-25 04:20:49 UTC (rev 13848)
+++ gnucash/trunk/ChangeLog	2006-04-25 05:13:33 UTC (rev 13849)
@@ -1,5 +1,9 @@
 2006-04-25  David Hampton  <hampton at employees.org>
 
+	* src/scm/process.scm: Handle the failure to fork a child process
+	and print an error message, instead of just ignoring the
+	error. Fixes #127241.
+
 	* src/gnome-utils/gnc-currency-edit.[ch]: Add completion support to
 	the currency edit widget.  Fixes #339412.
 

Modified: gnucash/trunk/src/scm/process.scm
===================================================================
--- gnucash/trunk/src/scm/process.scm	2006-04-25 04:20:49 UTC (rev 13848)
+++ gnucash/trunk/src/scm/process.scm	2006-04-25 05:13:33 UTC (rev 13849)
@@ -22,6 +22,7 @@
 
 (define-module (gnucash process))
 
+(use-modules (gnucash main))
 (export gnc:run-sub-process)
 (export gnc:cleanup-sub-process)
 
@@ -52,35 +53,41 @@
                (parent-write-pipe (cdr parent-to-child-pipe))
                (child-read-pipe (car parent-to-child-pipe))
                (child-write-pipe (cdr child-to-parent-pipe))
-               (pid (false-if-exception (primitive-fork))))
-          
-          (setvbuf parent-write-pipe _IONBF)
-          (setvbuf child-write-pipe _IONBF)
+               (pid (false-if-exception (primitive-fork)))
+	       )
 
-          (if (not (zero? pid))
-              ;; we're the parent
-              (begin
-                (close-input-port child-read-pipe)
-                (close-output-port child-write-pipe)
-                (list pid parent-read-pipe parent-write-pipe #f))
-              ;; else we're the child
-              (begin
-                ;; set standard-input and standard-output at the fd
-                ;; level -- which is really all that matters since
-                ;; we're about to exec...
-                (set-batch-mode?! #t)
-                (close-all-ports-except child-read-pipe child-write-pipe)
-                ;;(close-input-port parent-read-pipe)
-                ;;(close-output-port parent-write-pipe)
-                (dup->fdes child-read-pipe 0)
-                (dup->fdes child-write-pipe 1)
-                ;; now launch the child process.
-                (or (false-if-exception
-                     (if envt
-                         (apply execle path envt args)
-                         (apply execl path args)))
-                    (exit 1))))))))
+          (if (not pid)
+	      (begin
+		(gnc:error "Failed to fork child process.")
+		#f)
+	      (begin
+		(setvbuf parent-write-pipe _IONBF)
+		(setvbuf child-write-pipe _IONBF)
 
+		(if (not (zero? pid))
+		    ;; we're the parent
+		    (begin
+		      (close-input-port child-read-pipe)
+		      (close-output-port child-write-pipe)
+		      (list pid parent-read-pipe parent-write-pipe #f))
+		    ;; else we're the child
+		    (begin
+		      ;; set standard-input and standard-output at the fd
+		      ;; level -- which is really all that matters since
+		      ;; we're about to exec...
+		      (set-batch-mode?! #t)
+		      (close-all-ports-except child-read-pipe child-write-pipe)
+		      ;;(close-input-port parent-read-pipe)
+		      ;;(close-output-port parent-write-pipe)
+		      (dup->fdes child-read-pipe 0)
+		      (dup->fdes child-write-pipe 1)
+		      ;; now launch the child process.
+		      (or (false-if-exception
+			   (if envt
+			       (apply execle path envt args)
+			       (apply execl path args)))
+			  (exit 1))))))))))
+
 (define (gnc:cleanup-sub-process pid clean-secs)
   ;; Try to be nice, until it's time not to be nice.  If this function
   ;; returns, child is dead dead dead.  Returns child result status