Index: NOTES
==================================================================
--- NOTES
+++ NOTES
@@ -1,5 +1,17 @@
+# FROM andyjpg on #chicken
+
+(let ((original-exit (exit-handler)))
+  (exit-handler (lambda (#!optional (exit-code 0))
+		  (printf "Preparing to exit...\n" exit-code)
+		  (for-each (lambda (pid)
+			      (printf "Sending signal/term to ~A\n" pid)
+			      (process-signal pid signal/term)) (children))
+		  (original-exit exit-code))))
+
+
+
 1. All run control access to db is direct.
 2. All test machines must have megatest available
 3. Tests may or may not have file system access to the originating
    run area. rsync is used to pull the test area to the home host
    if and only if the originating area can not be seen via file 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -33,10 +33,28 @@
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 (include "megatest-fossil-hash.scm")
+
+;; Overall exit handling setup immediately
+;;
+(let ((original-exit (exit-handler)))
+  (exit-handler (lambda (#!optional (exit-code 0))
+		  (printf "Preparing to exit with exit code ~A ...\n" exit-code)
+		  (children
+		   (lambda (pid)
+		     (handle-exceptions
+		      exn
+		      #t
+		      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
+				  (if (or (eq? pid-val pid)
+					  (eq? pid-val 0))
+				      (begin
+					(printf "Sending signal/term to ~A\n" pid)
+					(process-signal pid signal/term)))))))
+		  (original-exit exit-code))))
 
 (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
   (if (file-exists? debugcontrolf)
       (load debugcontrolf)))
 

Index: process.scm
==================================================================
--- process.scm
+++ process.scm
@@ -109,5 +109,21 @@
 	     (begin
 	       (thread-sleep! 2)
 	       (loop (+ i 1)))
 	     (values pid-val exit-status exit-code))))))
   
+;;======================================================================
+;; MISC PROCESS RELATED STUFF
+;;======================================================================
+
+(define (children proc)
+  (with-input-from-pipe
+   (conc "ps h --ppid " (current-process-id) " -o pid")
+   (lambda ()
+     (let loop ((inl (read-line))
+		(res '()))
+       (if (eof-object? inl)
+	   (reverse res)
+	   (let ((pid (string->number inl)))
+	     (if proc (proc pid))
+	     (loop (read-line) (cons pid res))))))))
+