Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -8,12 +8,12 @@
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 ;;======================================================================
 
 (use srfi-1 data-structures posix regex-case base64 format dot-locking csv-xml z3 sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack
-     matchable regex posix srfi-18 extras
-     pkts (prefix dbi dbi:))
+     matchable pkts (prefix dbi dbi:)
+     regex)
 
 (import (prefix sqlite3 sqlite3:))
 (import (prefix base64 base64:))
 
 (declare (unit common))
@@ -100,10 +100,11 @@
 ;;
 (define *user-hash-data* (make-hash-table))
 
 (define *db-keys* #f)
 
+(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
 (define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
 (define *runconfigdat* #f)   ;; run configs data
 (define *configdat*    #f)   ;; megatest.config data
 (define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
 (define *toppath*      #f)
@@ -2321,34 +2322,67 @@
 ;;======================================================================
 ;; Manage pkts, used in servers, tests and likely other contexts so put
 ;; in common
 ;;======================================================================
 
-(define common:pkt-spec
-  '((server . ((action    . a)
-	       (pid       . d)
-	       (ipaddr    . i)
-	       (port      . p)))
-    			  
-    (test   . ((cpuuse    . c)
-	       (diskuse   . d)
-	       (item-path . i)
-	       (runname   . r)
-	       (state     . s)
-	       (target    . t)
-	       (status    . u)))))
+(define common:pkts-spec
+  '((default . ((parent    . P)
+                (action    . a)
+                (filename  . f)))
+    (configf . ((parent    . P)
+                (action    . a)
+                (filename  . f)))
+    (server  . ((action    . a)
+		(pid       . d)
+		(ipaddr    . i)
+		(port      . p)
+		(parent    . P)))
+    			  
+    (test    . ((cpuuse    . c)
+		(diskuse   . d)
+		(item-path . i)
+		(runname   . r)
+		(state     . s)
+		(target    . t)
+		(status    . u)
+		(parent    . P)))))
 
 (define (common:get-pkts-dirs mtconf use-lt)
   (let* ((pktsdirs-str (or (configf:lookup mtconf "setup"  "pktsdirs")
 			   (and use-lt
-				(conc *toppath* "/lt/.pkts"))))
+				(conc (or *toppath*
+					  (current-directory))
+				      "/lt/.pkts"))))
 	 (pktsdirs  (if pktsdirs-str
 			(string-split pktsdirs-str " ")
 			#f)))
     pktsdirs))
 
 ;; use-lt is use linktree "lt" link to find pkts dir
+(define (common:save-pkt pktalist-in mtconf use-lt #!key (add-only #f)) ;; add-only saves the pkt only if there is a parent already
+  (if (or add-only
+	  (hash-table-exists? *pkts-info* 'last-parent))
+      (let* ((parent   (hash-table-ref/default *pkts-info* 'last-parent #f))
+	     (pktalist (if parent
+			   (cons `(parent . ,parent)
+				 pktalist-in)
+			   pktalist-in)))
+	(let-values (((uuid pkt)
+		      (alist->pkt pktalist common:pkts-spec)))
+	  (hash-table-set! *pkts-info* 'last-parent uuid)
+	  (let ((pktsdir (or (hash-table-ref/default *pkts-info* 'pkts-dir #f)
+			     (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
+				    (pktsdir   (car pktsdirs))) ;; assume it is there
+			       (hash-table-set! *pkts-info* 'pkts-dir pktsdir)
+			       pktsdir))))
+	    (if (not (file-exists? pktsdir))
+		(create-directory pktsdir #t))
+	    (with-output-to-file
+		(conc pktsdir "/" uuid ".pkt")
+	      (lambda ()
+		(print pkt))))))))
+	
 (define (common:with-queue-db mtconf proc #!key (use-lt #f)(toppath-in #f))
   (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
 	 (pktsdir  (if pktsdirs (car pktsdirs) #f))
 	 (toppath  (or (configf:lookup mtconf "scratchdat" "toppath")
 		       toppath-in))
@@ -2365,11 +2399,11 @@
 	(let* ((pdb  (open-queue-db pdbpath "pkts.db"
 				    schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
 	  (proc pktsdirs pktsdir pdb)
 	  (dbi:close pdb))))))
 
-(define (common:load-pkts-to-db mtconf)
+(define (common:load-pkts-to-db mtconf #!key (use-lt #f))
   (common:with-queue-db
    mtconf
    (lambda (pktsdirs pktsdir pdb)
      (for-each
       (lambda (pktsdir) ;; look at all
@@ -2396,11 +2430,12 @@
 		       (add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0)
 		       (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
 		     (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
 		     )))
 	     pkts)))))
-      pktsdirs))))
+      pktsdirs))
+   use-lt: use-lt))
 
 (define (common:get-pkt-alists pkts)
   (map (lambda (x)
 	 (alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
        pkts))

Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -252,10 +252,17 @@
 ;;
 (define (read-config path ht allow-system #!key (environ-patt #f)            (curr-section #f)   
 		     (sections #f)              (settings (make-hash-table)) (keep-filenames #f)
 		     (post-section-procs '())   (apply-wildcards #t) )
   (debug:print 9 *default-log-port* "START: " path)
+  (if *configdat*
+      (common:save-pkt `((action . read-config)
+			 (f      . ,(cond ((string? path) path)
+					  ((port?   path) "port")
+					  (else (conc path))))
+                         (T      . configf))
+		       *configdat* #t add-only: #t))
   (if (and (not (port? path))
 	   (not (common:file-exists? path))) ;; for case where we are handed a port
       (begin 
 	(debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory))
 	;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -385,17 +385,30 @@
                           (if (and sdat
 				   (not changed)
 				   (> (- (current-seconds) start-time) 2))
 			      (begin
 				(debug:print-info 0 *default-log-port* "Received server alive signature")
+                                (common:save-pkt `((action . alive)
+                                                   (T      . server)
+                                                   (pid    . ,(current-process-id))
+                                                   (ipaddr . ,(car sdat))
+                                                   (port   . ,(cadr sdat)))
+                                                 *configdat* #t)
 				sdat)
                               (begin
 				(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
                                 (sleep 4)
 				(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
 				    (begin
 				      (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
+                                      (common:save-pkt `((action . died)
+                                                         (T      . server)
+                                                         (pid    . ,(current-process-id))
+                                                         (ipaddr . ,(car sdat))
+                                                         (port   . ,(cadr sdat))
+                                                         (msg    . "Transport died?"))
+                                                 *configdat* #t)
 				      (exit))
 				    (loop start-time
 					  (equal? sdat last-sdat)
 					  sdat)))))))
          (iface       (car server-info))
@@ -502,11 +515,14 @@
     ;; 			  (/ *total-non-write-delay* 
     ;; 			     *number-non-write-queries*))
     ;; 		      " ms")
     
     (db:print-current-query-stats)
-    
+    (common:save-pkt `((action . exit)
+                       (T      . server)
+                       (pid    . ,(current-process-id)))
+                     *configdat* #t)
     (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
     (exit)))
 
 ;; all routes though here end in exit ...
 ;;
@@ -539,10 +555,14 @@
     (let* ((num-alive   (server:get-num-alive (server:get-list *toppath*))))
       (if (> num-alive 3)
           (begin
             (cleanup-proc (conc "ERROR: Aborting server start because there are already " num-alive " possible servers either running or starting up"))
             (exit))))
+  (common:save-pkt `((action . start)
+		     (T      . server)
+		     (pid    . ,(current-process-id)))
+		   *configdat* #t)
     (let* ((th2 (make-thread (lambda ()
                                (debug:print-info 0 *default-log-port* "Server run thread started")
                                (http-transport:run 
                                 (if (args:get-arg "-server")
                                     (args:get-arg "-server")

Index: megatest.config
==================================================================
--- megatest.config
+++ megatest.config
@@ -52,5 +52,7 @@
 script nbfake echo
 
 
 [server]
 timeout 1
+
+[include local.config]

Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -115,10 +115,11 @@
    set-ss                    : set state/status
    archive                   : compress and move test data to archive disk
    kill                      : stop tests or entire runs
    db                        : database utilities
    areas, contours, setup    : show areas, contours or setup section from megatest.config
+   gendot                    : generate a graphviz dot file from pkts.
 
 Contour actions:
    process                   : runs import, rungen and dispatch 
 			     
 Trigger propagation actions:
@@ -1165,10 +1166,11 @@
 		 (print "No section \"" (car remargs) "\" found")))
 	   (print "ERROR: list requires section parameter; areas, setup or contours")))
       ((gendot)
        (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
 	      (mtconf    (car mtconfdat)))
+	 (common:load-pkts-to-db mtconf use-lt: #t) ;; need to NOT do this by default ...
 	 (common:with-queue-db
 	  mtconf
 	  (lambda (pktsdirs pktsdir conn)
 	    ;;                       pktspec display-fields 
 	    (make-report "out.dot" conn
@@ -1259,8 +1261,8 @@
 	  (repl)
 	  (load (args:get-arg "-load")))))
 
 #|
 (define mtconf (car (simple-setup #f)))
-(define dat (with-queue-db mtconf (lambda (conn)(get-pkts conn '()))))
+(define dat (common:with-queue-db mtconf (lambda (conn)(get-pkts conn '()))))
 (pp (pkts#flatten-all dat '((cmd . ((parent . P)(url . M)))(runtype . ((parent . P)))) 'id 'group-id 'uuid 'parent 'pkt-type 'pkt 'processed))
 |#

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -144,10 +144,11 @@
       (rmt:send-receive cmd rid params attemptnum: attemptnum))
      
      ;;DOT CASE5 [label="local\nread"];
      ;;DOT MUTEXLOCK -> CASE5 [label="server not required,\non homehost,\nread-only query"]; {rank=same "case 5" CASE5};
      ;;DOT CASE5 -> "rmt:open-qry-close-locally";
+
      ;; on homehost and this is a read
      ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
 	   (cdr (remote-hh-dat runremote))       ;; on homehost
            (member cmd api:read-only-queries))   ;; this is a read
       (mutex-unlock! *rmt-mutex*)

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -8,12 +8,12 @@
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 
 (require-extension (srfi 18) extras tcp s11n)
 
-(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest directory-utils posix-extras matchable
-     )
+(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
+     directory-utils posix-extras matchable)
 
 (use spiffy uri-common intarweb http-client spiffy-request-vars)
 
 (declare (unit server))
 
@@ -33,10 +33,16 @@
   (if (not hostport)
       #f
       (conc "http://" (car hostport) ":" (cadr hostport))))
 
 (define  *server-loop-heart-beat* (current-seconds))
+
+;;======================================================================
+;; P K T S   S T U F F 
+;;======================================================================
+
+;; ???
 
 ;;======================================================================
 ;; P K T S   S T U F F 
 ;;======================================================================