Megatest

Changes On Branch 01fd2fa26b9a206e
Login

Changes In Branch v1.62-no-rpc Through [01fd2fa26b] Excluding Merge-Ins

This is equivalent to a diff from 3e767a9aad to 01fd2fa26b

2016-11-30
17:01
Filter working check-in: d9859999af user: ritikaag tags: db-new
2016-11-22
07:33
Merged in v1.62-side changes to get the efficient db sync check-in: ff1d02545b user: matt tags: v1.62-no-rpc
2016-11-21
22:18
Mostly working after stripping even more junk out ... check-in: 01fd2fa26b user: matt tags: v1.62-no-rpc
20:06
Stripped server stuff out to get db access down to bare metal check-in: de910838a1 user: matt tags: v1.62-no-rpc
2016-11-18
20:46
Try tmp db without rpc check-in: d06a3ab427 user: matt tags: v1.62-no-rpc
2016-11-17
16:27
Beginnings of fix for testconfig disks issue Closed-Leaf check-in: 7e67a7638f user: mrwellan tags: testconfig-disks-fix
2016-11-16
16:57
moved rpc-transport updates into mainline v1.62 branch check-in: f736d3db6e user: bjbarcla tags: v1.62
16:08
Merged v1.62 into rpc-transport Closed-Leaf check-in: 534875ccf1 user: mrwellan tags: rpc-transport-merge-v1.62
13:48
Try using md5sum instead of sha1. Much faster but what is the collison risk? check-in: 3e767a9aad user: mrwellan tags: v1.62, v1.6208
10:12
Fixed remotediff example. Broken by unknown goof up. check-in: 9833288949 user: mrwellan tags: v1.62

Modified common.scm from [41eb86f112] to [c51e104a50].

94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
(define *megatest-db*         #f)
(define *last-db-access*      (current-seconds))  ;; update when db is accessed via server
(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))


;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>
(define *max-cache-size*    0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id*         #f)
(define *server-info*       #f)
(define *time-to-exit*      #f)
(define *received-response* #f)
(define *default-numtries*  10)
(define *server-run*        #t)
(define *run-id*            #f)
(define *server-kind-run*   (make-hash-table))


(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys*              (make-hash-table)) ;; cache the keys here
(define *keyvals*           (make-hash-table))
(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id







>

















>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
(define *megatest-db*         #f)
(define *last-db-access*      (current-seconds))  ;; update when db is accessed via server
(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))
(define *db-cache-path*       #f)

;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>
(define *max-cache-size*    0)
(define *logged-in-clients* (make-hash-table))
(define *client-non-blocking-mode* #f)
(define *server-id*         #f)
(define *server-info*       #f)
(define *time-to-exit*      #f)
(define *received-response* #f)
(define *default-numtries*  10)
(define *server-run*        #t)
(define *run-id*            #f)
(define *server-kind-run*   (make-hash-table))
(define *home-host*         #f)

(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
(define *keys*              (make-hash-table)) ;; cache the keys here
(define *keyvals*           (make-hash-table))
(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
389
390
391
392
393
394
395










396
397
398
399
400
401


402
403
404
405
406
407
408
409
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
      (if *toppath* 
          (pathname-file *toppath*)
          (pathname-file (current-directory)))))











;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:legacy-sync-recommended)


  (or (args:get-arg "-runtests")
      (args:get-arg "-run")
      (args:get-arg "-server")
      ;; (args:get-arg "-set-run-status")
      (args:get-arg "-remove-runs")
      ;; (args:get-arg "-get-run-status")
      ))








>
>
>
>
>
>
>
>
>
>






>
>
|







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
      (if *toppath* 
          (pathname-file *toppath*)
          (pathname-file (current-directory)))))

(define (common:get-db-tmp-area)
  (if *db-cache-path*
      *db-cache-path*
      (let ((dbpath (create-directory (conc "/tmp/" (current-user-name)
					    "/megatest_cachedb/"
					    (common:get-testsuite-name) "/"
					    (string-translate *toppath* "/" ".")) #t)))
	(set! *db-cache-path* dbpath)
	dbpath)))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:legacy-sync-recommended)
  (or (and (common:get-homehost)
	   (cdr (common:get-homehost)))
      (args:get-arg "-runtests")
      (args:get-arg "-run")
      (args:get-arg "-server")
      ;; (args:get-arg "-set-run-status")
      (args:get-arg "-remove-runs")
      ;; (args:get-arg "-get-run-status")
      ))

611
612
613
614
615
616
617


























618
619
620
621
622
623
624
	    tlist
	    target)
	(if target
	    (begin
	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
	      #f)
	    #f))))



























;;======================================================================
;; M I S C   L I S T S
;;======================================================================

;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	    tlist
	    target)
	(if target
	    (begin
	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
	      #f)
	    #f))))

;; logic for getting homehost. Returns (host . at-home)
;;
(define (common:get-homehost)
  (cond
   (*home-host*     *home-host*)
   ((not *toppath*) #f)            ;; don't know toppath yet? return #f
   (else
    (let* ((currhost (get-host-name))
	   (bestadrs (server:get-best-guess-address currhost))
	   ;; first look in config, then look in file .homehost, create it if not found
	   (homehost (or (configf:lookup *configdat* "server" "homehost" )
			 (let ((hhf (conc *toppath* "/.homehost")))
			   (if (file-exists? hhf)
			       (with-input-from-file hhf read-line)
			       (if (file-write-access? *toppath*)
				   (begin
				     (with-output-to-file hhf
				       (lambda ()
					 (print bestadrs)))
				     (common:get-homehost))
				   #f)))))
	   (at-home  (or (equal? homehost currhost)
			 (equal? homehost bestadrs))))
      (set! *home-host* (cons homehost at-home))
      *home-host*))))

;;======================================================================
;; M I S C   L I S T S
;;======================================================================

;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943













944
945
946
947
948
949
950
951
952
953
954
		  (if match 
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! freespc newval))))))
	      (car df-results))
    freespc))

;; check space in dbdir
;; returns: ok/not dbspace required-space
;;
(define (common:check-db-dir-space)
  (let* ((dbdir    (db:get-dbdir))
	 (dbspace  (if (directory? dbdir)
		       (get-df dbdir)
		       0))
	 (required (string->number 
		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
			"100000"))))
    (list (> dbspace required)
	  dbspace
	  required
	  dbdir)))














;; check available space in dbdir, exit if insufficient
;;
(define (common:check-db-dir-and-exit-if-insufficient)
  (let* ((spacedat (common:check-db-dir-space))
	 (is-ok    (car spacedat))
	 (dbspace  (cadr spacedat))
	 (required (caddr spacedat))
	 (dbdir    (cadddr spacedat)))
    (if (not is-ok)
	(begin
	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")







<
<
<
|
<
|
|
|
<
<
<



|

>
>
>
>
>
>
>
>
>
>
>
>
>



|







961
962
963
964
965
966
967



968

969
970
971



972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
		  (if match 
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! freespc newval))))))
	      (car df-results))
    freespc))




(define (common:check-space-in-dir dirpath required)

  (let* ((dbspace  (if (directory? dirpath)
		       (get-df dirpath)
		       0)))



    (list (> dbspace required)
	  dbspace
	  required
	  dirpath)))

;; check space in dbdir and in megatest dir
;; returns: ok/not dbspace required-space
;;
(define (common:check-db-dir-space)
  (let* ((required (string->number 
		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
			"100000")))
	 (dbdir    (common:get-db-tmp-area)) ;; (db:get-dbdir))
	 (tdbspace (common:check-space-in-dir dbdir required))
	 (mdbspace (common:check-space-in-dir *toppath* required)))
    (sort (list tdbspace mdbspace) (lambda (a b)
				     (< (cadr a)(cadr b))))))
    
;; check available space in dbdir, exit if insufficient
;;
(define (common:check-db-dir-and-exit-if-insufficient)
  (let* ((spacedat (car (common:check-db-dir-space))) ;; look only at worst for now
	 (is-ok    (car spacedat))
	 (dbspace  (cadr spacedat))
	 (required (caddr spacedat))
	 (dbdir    (cadddr spacedat)))
    (if (not is-ok)
	(begin
	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")

Modified dashboard-tests.scm from [2a1074e05f] to [5fc35a4338].

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170


;;======================================================================
;; Run info panel
;;======================================================================
(define (run-info-panel db keydat testdat runname)
  (let* ((run-id     (db:test-get-run_id testdat))
	 (rundat     (db:get-run-info db run-id))
	 (header     (db:get-header rundat))
	 (event_time (db:get-value-by-header (db:get-rows rundat)
					     (db:get-header rundat)
					     "event_time")))
    (iup:frame 
     #:title "Megatest Run Info" ; #:expand "YES"
     (iup:hbox ; #:expand "YES"







|







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170


;;======================================================================
;; Run info panel
;;======================================================================
(define (run-info-panel db keydat testdat runname)
  (let* ((run-id     (db:test-get-run_id testdat))
	 (rundat     (rmt:get-run-info run-id))
	 (header     (db:get-header rundat))
	 (event_time (db:get-value-by-header (db:get-rows rundat)
					     (db:get-header rundat)
					     "event_time")))
    (iup:frame 
     #:title "Megatest Run Info" ; #:expand "YES"
     (iup:hbox ; #:expand "YES"
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
    dlog))


;;======================================================================
;;
;;======================================================================
(define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest)
  (let* ((db-path       (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
	 (dbstruct      (make-dbr:dbstruct path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
					   local: #t))
	 (testdat        (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id))
	 (db-mod-time   0) ;; (file-modification-time db-path))
	 (last-update   0) ;; (current-seconds))
	 (request-update #t))
    (if (not testdat)
	(begin
	  (debug:print 2 *default-log-port* "ERROR: No test data found for test " test-id ", exiting")







|
|
|







413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
    dlog))


;;======================================================================
;;
;;======================================================================
(define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest)
  (let* ((db-path       (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
	 (dbstruct      #f) ;; NOT ACTUALLY USED (db:setup)) ;; (make-dbr:dbstruct path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
			    ;;		   local: #t))
	 (testdat        (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id))
	 (db-mod-time   0) ;; (file-modification-time db-path))
	 (last-update   0) ;; (current-seconds))
	 (request-update #t))
    (if (not testdat)
	(begin
	  (debug:print 2 *default-log-port* "ERROR: No test data found for test " test-id ", exiting")

Modified dashboard.scm from [ef1ffd321d] to [df1301b5c8].

81
82
83
84
85
86
87

88
89
90
91
92
93
94
			"-use-server"
			"-guimonitor"
			"-main"
			"-v"
			"-q"
			"-use-local"
			"-skip-version-check"

			)
		 args:arg-hash
		 0))

(if (not (null? remargs))
    (begin
      (print "Unrecognised arguments: " (string-intersperse remargs " "))







>







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
			"-use-server"
			"-guimonitor"
			"-main"
			"-v"
			"-q"
			"-use-local"
			"-skip-version-check"
			"-repl"
			)
		 args:arg-hash
		 0))

(if (not (null? remargs))
    (begin
      (print "Unrecognised arguments: " (string-intersperse remargs " "))
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
  tabdats
  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  )


(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
   please-update:        #t
   update-mutex:         (make-mutex)







<







115
116
117
118
119
120
121

122
123
124
125
126
127
128
  tabdats
  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  )


(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
   please-update:        #t
   update-mutex:         (make-mutex)
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
(define (dboard:tabdat-make-data)
  (let ((dat (make-dboard:tabdat)))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))

(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path 0))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))

  ;; HACK ALERT: this is a hack, please fix.
  (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
  
  (dboard:tabdat-keys-set! tabdat (rmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))







|
|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
(define (dboard:tabdat-make-data)
  (let ((dat (make-dboard:tabdat)))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))

(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))

  ;; HACK ALERT: this is a hack, please fix.
  (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
  
  (dboard:tabdat-keys-set! tabdat (rmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
				 (debug:catch-and-dump
				  (lambda ()
				    (mark-for-update tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)
					     ;; (if (dboard:tabdat-dblocal tabdat) (db:close-all (dboard:tabdat-dblocal tabdat)))
					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
					     (mark-for-update tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump 







<







2032
2033
2034
2035
2036
2037
2038

2039
2040
2041
2042
2043
2044
2045
				 (debug:catch-and-dump
				  (lambda ()
				    (mark-for-update tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)

					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
					     (mark-for-update tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump 
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (common:max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))







|







2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (common:max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db*"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
	      (dashboard-tests:examine-test run-id test-id)
	      (begin
		(debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
		(exit 1)))))
       ;; ((args:get-arg "-guimonitor")
       ;;  (gui-monitor (dboard:tabdat-dblocal tabdat)))
       (else
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(iup:callback-set! *tim*







|







3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
	      (dashboard-tests:examine-test run-id test-id)
	      (begin
		(debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
		(exit 1)))))
       ;; ((args:get-arg "-guimonitor")
       ;;  (gui-monitor (dboard:tabdat-dblocal tabdat)))
       (else
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(iup:callback-set! *tim*
3355
3356
3357
3358
3359
3360
3361


3362
3363
	(thread-join! th2)))))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))



(main)








>
>
|

3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
	(thread-join! th2)))))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(if (args:get-arg "-repl")
    (repl)
    (main))

Modified db.scm from [bd53297b84] to [12276ed6d7].

36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

;;======================================================================
;;  R E C O R D S
;;======================================================================


(defstruct dbr:dbstruct 
  main
  strdb
  ((path #f)  : string)
  ((local #f) : boolean)
  rundb
  inmem
  mtime
  rtime 
  stime
  inuse
  refdb
  ((locdbs (make-hash-table)) : hash-table)
  olddb)

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================

(define (db:general-sqlite-error-dump exn stmt . params)
  (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?







>

<
|
|
<
<
<
<
<
<
<
<
<
<







36
37
38
39
40
41
42
43
44

45
46










47
48
49
50
51
52
53
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

;;======================================================================
;;  R E C O R D S
;;======================================================================

;; each db entry is a pair ( db . dbfilepath )
(defstruct dbr:dbstruct 

  (tmpdb  #f)
  (mtdb   #f))











;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================

(define (db:general-sqlite-error-dump exn stmt . params)
  (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct run-id) 
  (if (sqlite3:database? dbstruct) ;; pass sqlite3 databases on through
      dbstruct
      (begin
	(let ((dbdat (if (or (not run-id)
			     (eq? run-id 0))
			 (db:open-main dbstruct)
			 (db:open-rundb dbstruct run-id)
			 )))
	  dbdat))))

;; legacy handling of structure for managing db's. Refactor this into dbr:?
(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))

(define (db:dbdat-get-path dbdat)
  (if (pair? dbdat)
      (cdr dbdat)
      #f))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
(define (db:done-with dbstruct run-id mod-read)
  (if (not (sqlite3:database? dbstruct))
      (begin
	(mutex-lock! *rundb-mutex*)
	(if (eq? mod-read 'mod)
	    (dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
	    (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
	(dbr:dbstruct-inuse-set! dbstruct #f)
	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((dbdat (if (dbr:dbstruct? dbstruct)
		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat))) 
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain (current-error-port)))
     (let ((res (apply proc db params)))
       (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
       res))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

;; (define (db:get-filedb dbstruct run-id)







|
<
|
<
<
<
|
<
<
<

|















|
|
|
|
|
|
|
|
|





|
|
|







|







74
75
76
77
78
79
80
81

82



83



84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct . blah) ;;  run-id) 

  (or (dbr:dbstruct-tmpdb dbstruct)



      (db:open-db dbstruct)))




;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))

(define (db:dbdat-get-path dbdat)
  (if (pair? dbdat)
      (cdr dbdat)
      #f))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
;; (define (db:done-with dbstruct run-id mod-read)
;;   (if (not (sqlite3:database? dbstruct))
;;       (begin
;; 	(mutex-lock! *rundb-mutex*)
;; 	(if (eq? mod-read 'mod)
;; 	    (dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
;; 	    (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
;; 	(dbr:dbstruct-inuse-set! dbstruct #f)
;; 	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((dbdat ;; (if (dbr:dbstruct? dbstruct)
		    (db:get-db dbstruct run-id))
;;		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat))) 
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain (current-error-port)))
     (let ((res (apply proc db params)))
       ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
       res))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

;; (define (db:get-filedb dbstruct run-id)
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
;;     (filedb:get-path db id)))

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;; 
;; If run-id is #f return to create and retrieve the path where the db will live.
;;
(define (db:dbfile-path run-id)
  (let* ((dbdir           (db:get-dbdir))
	 (fname           (if run-id
			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
			      #f)))
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
       (exit 1))
     (if (not (directory? dbdir))(create-directory dbdir #t)))
    (if fname
	(conc dbdir "/" fname) 
	dbdir)))

;; Returns the database location as specified in config file
;;
(define (db:get-dbdir)
  (or (configf:lookup *configdat* "setup" "dbdir")
      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
	       
(define (db:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";")))) 

;; open an sql database inside a file lock
;; returns: db existed-prior-to-opening
;; RA => Returns a db handler; sets the lock if opened in writable mode
;;
(define (db:lock-create-open fname initproc)
  ;; (if (file-exists? fname)
  ;;     (let ((db (sqlite3:open-database fname)))
  ;;       (sqlite3:set-busy-handler! db (make-busy-timeout 136000))
  ;;       (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
  ;;       db)
  (let* ((parent-dir   (pathname-directory fname))
	 (dir-writable (file-write-access? parent-dir))
	 (file-exists  (file-exists? fname))
	 (file-write   (if file-exists
			   (file-write-access? fname)
			   dir-writable )))
    (if file-write ;; dir-writable







|
|
|
|
|






|
|
|



|
|
|










<
<
<
<
<







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186





187
188
189
190
191
192
193
;;     (filedb:get-path db id)))

;; NB// #f => return dbdir only
;;      (was planned to be;  zeroth db with name=main.db)
;; 
;; If run-id is #f return to create and retrieve the path where the db will live.
;;
(define (db:dbfile-path) ;;  run-id)
  (let* ((dbdir           (common:get-db-tmp-area))) ;; (db:get-dbdir))
;; 	 (fname           (if run-id
;; 			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
;; 			      #f)))
    (handle-exceptions
     exn
     (begin
       (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
       (exit 1))
     (if (not (directory? dbdir))(create-directory dbdir #t)))
    dbdir)) ;; (if fname
;;	(conc dbdir "/" fname) 
;;	dbdir)))

;; Returns the database location as specified in config file
;;
;; (define db:get-dbdir common:get-db-tmp-area)
;;  (or (configf:lookup *configdat* "setup" "dbdir")
;;      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
	       
(define (db:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";")))) 

;; open an sql database inside a file lock
;; returns: db existed-prior-to-opening
;; RA => Returns a db handler; sets the lock if opened in writable mode
;;
(define (db:lock-create-open fname initproc)





  (let* ((parent-dir   (pathname-directory fname))
	 (dir-writable (file-write-access? parent-dir))
	 (file-exists  (file-exists? fname))
	 (file-write   (if file-exists
			   (file-write-access? fname)
			   dir-writable )))
    (if file-write ;; dir-writable
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362

363
364
365
366
367

368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421

422
423
424
425
426
427


428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
		(initproc db)))
	  ;; (release-dot-lock fname)
	  db)
	(begin
	  (debug:print 2 *default-log-port* "WARNING: opening db in non-writable dir " fname)
	  (sqlite3:open-database fname))))) ;; )

;; This routine creates the db. It is only called if the db is not already opened
;; 
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((local  (dbr:dbstruct-local dbstruct))
	 (rdb    (if local
		     (dbr:dbstruct-localdb dbstruct run-id)
		     (dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-runrec dbstruct run-id 'inmem)))
    (if (or rdb
	    do-not-open)
	rdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
		 (dbexists     (file-exists? dbpath))
		 (inmem        (if local #f (db:open-inmem-db)))
		 (refdb        (if local #f (db:open-inmem-db)))
		 (db           (db:lock-create-open dbpath ;; this is the database physically on disk
						    (lambda (db)
						      (handle-exceptions
						       exn
						       (begin
							 ;; (release-dot-lock dbpath)
							 (if (> attemptnum 2)
							     (debug:print-error 0 *default-log-port* "tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
							     (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
						       (db:initialize-run-id-db db)
						       (sqlite3:execute 
							db
							"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
							(* run-id 30000) ;; allow for up to 30k tests per run
							run-id)
						       ;; do a dummy query to test that the table exists and the db is truly readable
						       (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
						       )))) ;; add strings db to rundb, not in use yet
		 ;;   )) ;; (sqlite3:open-database dbpath))
		 (olddb        (if *megatest-db*
				   *megatest-db* 
				   (let ((db (db:open-megatest-db)))
				     (set! *megatest-db* db)
				     db)))
		 (write-access (file-write-access? dbpath))
		 ;; (handler      (make-busy-timeout 136000))
		 )
	    (if (and dbexists (not write-access))
		(set! *db-write-access* #f)) ;; only unset so other db's also can use this control
	    (dbr:dbstruct-rundb-set!  dbstruct (cons db dbpath))
	    (dbr:dbstruct-inuse-set!  dbstruct #t)
	    (dbr:dbstruct-olddb-set!  dbstruct olddb)
	    ;; (dbr:dbstruct-run-id-set! dbstruct run-id)
	    (mutex-unlock! *rundb-mutex*)
	    (if local
		(begin
		  (dbr:dbstruct-localdb-set! dbstruct run-id db) ;; (dbr:dbstruct-inmem-set! dbstruct db) ;; direct access ...
		  db)
		(begin
		  (dbr:dbstruct-inmem-set!  dbstruct inmem)
		  ;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
		  ;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
		  (db:sync-tables db:sync-tests-only db inmem)
		  (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? 
		  (dbr:dbstruct-refdb-set!  dbstruct refdb)
		  (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
		  ;; sync once more to deal with delays?
		  ;; (db:sync-tables db:sync-tests-only db inmem)
		  ;; (db:sync-tables db:sync-tests-only inmem refdb)
		  inmem)))))))

;; This routine creates the db if not already present. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
  (let ((mdb (dbr:dbstruct-main dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if mdb
	mdb
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path 0))
		 (dbexists     (file-exists? dbpath))
		 (db           (db:lock-create-open dbpath db:initialize-main-db))
		 (olddb        (db:open-megatest-db))
		 (write-access (file-write-access? dbpath))
		 (dbdat        (cons db dbpath)))
	    (if (and dbexists (not write-access))
		(set! *db-write-access* #f))
	    (dbr:dbstruct-main-set!   dbstruct dbdat)
	    (dbr:dbstruct-olddb-set!  dbstruct olddb) ;; olddb is already a (cons db path)
	    (mutex-unlock! *rundb-mutex*)
	    (if (and (not dbexists)
		     *db-write-access*) ;; did not have a prior db and do have write access
		(db:multi-db-sync #f 'old2new))  ;; migrate data from megatest.db automatically
	    dbdat)))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))

    dbstruct))

;; open the local db for direct access (no server)
;;
(define (db:open-local-db-handle)
  (or *dbstruct-db*
      (let ((dbstruct (db:setup #f local: #t)))
	(set! *dbstruct-db* dbstruct)
	dbstruct)))
	  
;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))
	 (dbexists     (file-exists? dbpath))
	 (db           (db:lock-create-open dbpath
					    (lambda (db)
					      (db:initialize-main-db db)
					      (db:initialize-run-id-db db))))
	 (write-access (file-write-access? dbpath)))
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    (cons db dbpath)))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
  (let ((mtime  (dbr:dbstruct-mtime dbstruct))
	(stime  (dbr:dbstruct-stime dbstruct))
	(rundb  (dbr:dbstruct-rundb dbstruct))
	(inmem  (dbr:dbstruct-inmem dbstruct))
	(maindb (dbr:dbstruct-main  dbstruct))
	(refdb  (dbr:dbstruct-refdb dbstruct))

	(olddb  (dbr:dbstruct-olddb dbstruct))
	;; (runid  (dbr:dbstruct-run-id dbstruct))
	)
    (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
    ;; (mutex-lock! *http-mutex*)

    (if (eq? run-id 0)
	;; runid equal to 0 is main.db
	(if maindb
	    (if (or (not (number? mtime))
		    (not (number? stime))
		    (> mtime stime)
		    force-sync)
		(begin
		  (db:delay-if-busy maindb)
		  (db:delay-if-busy olddb)
		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
		    (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
		    num-synced)
		  0))
	    (begin
	      ;; this can occur when using local access (i.e. not in a server)
	      ;; need a flag to turn it off.
	      ;;
	      (debug:print 3 *default-log-port* "WARNING: call to sync main.db to megatest.db but main not initialized")
	      0))
	;; any other runid is a run
	(if (or (not (number? mtime))
		(not (number? stime))
		(> mtime stime)
		force-sync)
	    (begin
	      (db:delay-if-busy rundb)
	      (db:delay-if-busy olddb)
	      (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
		;; (mutex-unlock! *http-mutex*)
		num-synced)
	      (begin
		;; (mutex-unlock! *http-mutex*)
		0))))))

(define (db:close-main dbstruct)
  (let ((maindb (dbr:dbstruct-main dbstruct)))
    (if maindb
	(begin
	  (sqlite3:finalize! (db:dbdat-get-db maindb))
	  (dbr:dbstruct-main-set! dbstruct #f)))))

(define (db:close-run-db dbstruct run-id)
  (let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
    (if (and rdb
	     (sqlite3:database? rdb))
	(begin
	  (sqlite3:finalize! rdb)
	  (dbr:dbstruct-localdb-set! dbstruct run-id #f)
	  (dbr:dbstruct-inmem-set! dbstruct #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)

  ;; finalize main.db
  (db:sync-touched dbstruct 0 force-sync: #t)
  ;;(common:db-block-further-queries)
  ;; (mutex-lock! *db-sync-mutex*) ;; with this perhaps it isn't necessary to use the block-further-queries mechanism?

  (db:close-main dbstruct)


  
  (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
    (if (hash-table? locdbs)
	(for-each (lambda (run-id)
		    (db:close-run-db dbstruct run-id))
		  (hash-table-keys locdbs)))))

(define (db:open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (db:initialize-run-id-db db)
    (cons db #f)))

;; just tests, test_steps and test_data tables
(define db:sync-tests-only
  (list
   ;; (list "strs"
   ;;       '("id"             #f)
   ;;       '("str"            #f))







|
|
|
<
<
<
<
<
<
<
<
<
|
|
<
<
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
<
<
|
|
|
|
|
<
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
|

|

|
|
|
|
<
|
|
|
|
|
|
<
|
|
|
|
|
|
|
|
|





|
|
|
>






|



|

|
|













|
|
|
|
|
|
>
|




>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|



>
|
|
<
<
|
|
>
>

|
|
|
|
|

|
|
|
|
|
|







203
204
205
206
207
208
209
210
211
212









213
214


215

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

232
233
234
235
236
237


238
239
240
241
242

243








244






245
246
247
248
249
250
251
252

253
254
255
256
257
258

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373


374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
		(initproc db)))
	  ;; (release-dot-lock fname)
	  db)
	(begin
	  (debug:print 2 *default-log-port* "WARNING: opening db in non-writable dir " fname)
	  (sqlite3:open-database fname))))) ;; )

;; ;; This routine creates the db. It is only called if the db is not already opened
;; ;; 
;; (define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))









;;   (let* ((dbfile       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
;;          (dbexists     (file-exists? dbfile))


;;          (db           (db:lock-create-open dbfile (lambda (db)

;;                                                      (handle-exceptions
;;                                                       exn
;;                                                       (begin
;;                                                         ;; (release-dot-lock dbpath)
;;                                                         (if (> attemptnum 2)
;;                                                             (debug:print-error 0 *default-log-port* "tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
;;                                                             (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
;;                                                       (db:initialize-run-id-db db)
;;                                                       (sqlite3:execute 
;;                                                        db
;;                                                        "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
;;                                                        (* run-id 30000) ;; allow for up to 30k tests per run
;;                                                        run-id)
;;                                                       ;; do a dummy query to test that the table exists and the db is truly readable
;;                                                       (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
;;                                                       )))) ;; add strings db to rundb, not in use yet

;;          (olddb        (if *megatest-db*
;;                            *megatest-db* 
;;                            (let ((db (db:open-megatest-db)))
;;                              (set! *megatest-db* db)
;;                              db)))
;;          (write-access (file-write-access? dbfile)))


;;     (if (and dbexists (not write-access))
;;         (set! *db-write-access* #f)) ;; only unset so other db's also can use this control
;;     (dbr:dbstruct-rundb-set!  dbstruct (cons db dbfile))
;;     (dbr:dbstruct-inuse-set!  dbstruct #t)
;;     (dbr:dbstruct-olddb-set!  dbstruct olddb)

;;     ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's?








;;     (db:sync-tables db:sync-tests-only *megatest-db* db)






;;     db))

;; This routine creates the db if not already present. It is only called if the db is not already opened
;;
(define (db:open-db dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
  (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
    (if tmpdb
	tmpdb

        ;; (mutex-lock! *rundb-mutex*)
        (let* ((dbpath       (db:dbfile-path)) ;;  0))
               (dbexists     (file-exists? dbpath))
               (tmpdb        (db:open-megatest-db dbdir: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
               (mtdb         (db:open-megatest-db))
               (write-access (file-write-access? dbpath)))

          (if (and dbexists (not write-access))
              (set! *db-write-access* #f))
          (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb) ;; olddb is already a (cons db path)
          ;;	    (mutex-unlock! *rundb-mutex*)
          (if (and (not dbexists)
                   *db-write-access*) ;; did not have a prior db and do have write access
              (db:multi-db-sync #f 'old2new))  ;; migrate data from megatest.db automatically
          tmpdb))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(define (db:setup) ;;  . junk) ;;  #!key (run-id #f) (local #f))
  (let* (;; (dbdir    (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
         (dbstruct (make-dbr:dbstruct))) ;; ) ;;  path: dbdir local: local)))
    (db:open-db dbstruct)
    dbstruct))

;; open the local db for direct access (no server)
;;
(define (db:open-local-db-handle)
  (or *dbstruct-db*
      (let ((dbstruct (db:setup))) ;;  #f local: #t)))
	(set! *dbstruct-db* dbstruct)
	dbstruct)))
	  
;; Open the classic megatest.db file (defaults to open in toppath)
;;
(define (db:open-megatest-db #!key (dbdir #f))
  (let* ((dbpath       (conc (or dbdir *toppath*) "/megatest.db"))
	 (dbexists     (file-exists? dbpath))
	 (db           (db:lock-create-open dbpath
					    (lambda (db)
					      (db:initialize-main-db db)
					      (db:initialize-run-id-db db))))
	 (write-access (file-write-access? dbpath)))
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    (cons db dbpath)))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
  (let (;; (mtime  (dbr:dbstruct-mtime dbstruct))
	;; (stime  (dbr:dbstruct-stime dbstruct))
	;; (rundb  (dbr:dbstruct-rundb dbstruct))
	;; (inmem  (dbr:dbstruct-inmem dbstruct))
	;; (maindb (dbr:dbstruct-main  dbstruct))
	;; (refdb  (dbr:dbstruct-refdb dbstruct))
        (tmpdb  (dbr:dbstruct-tmpdb dbstruct))
	(mtdb  (dbr:dbstruct-mtdb dbstruct))
	;; (runid  (dbr:dbstruct-run-id dbstruct))
	)
    (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
    ;; (mutex-lock! *http-mutex*)
    (db:sync-tables (db:sync-all-tables-list tmpdb) tmpdb mtdb)))
;;    (if (eq? run-id 0)
;;	;; runid equal to 0 is main.db
;;	(if maindb
;;	    (if (or (not (number? mtime))
;;		    (not (number? stime))
;;		    (> mtime stime)
;;		    force-sync)
;;		(begin
;;		  (db:delay-if-busy maindb)
;;		  (db:delay-if-busy olddb)
;;		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
;;		    (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
;;		    num-synced)
;;		  0))
;;	    (begin
;;	      ;; this can occur when using local access (i.e. not in a server)
;;	      ;; need a flag to turn it off.
;;	      ;;
;;	      (debug:print 3 *default-log-port* "WARNING: call to sync main.db to megatest.db but main not initialized")
;;	      0))
;;	;; any other runid is a run
;;	(if (or (not (number? mtime))
;;		(not (number? stime))
;;		(> mtime stime)
;;		force-sync)
;;	    (begin
;;	      (db:delay-if-busy rundb)
;;	      (db:delay-if-busy olddb)
;;	      (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
;;	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
;;		;; (mutex-unlock! *http-mutex*)
;;		num-synced)
;;	      (begin
;;		;; (mutex-unlock! *http-mutex*)
;;		0))))))

;; (define (db:close-main dbstruct)
;;   (let ((maindb (dbr:dbstruct-main dbstruct)))
;;     (if maindb
;; 	(begin
;; 	  (sqlite3:finalize! (db:dbdat-get-db maindb))
;; 	  (dbr:dbstruct-main-set! dbstruct #f)))))
;; 
;; (define (db:close-run-db dbstruct run-id)
;;   (let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
;;     (if (and rdb
;; 	     (sqlite3:database? rdb))
;; 	(begin
;; 	  (sqlite3:finalize! rdb)
;; 	  (dbr:dbstruct-localdb-set! dbstruct run-id #f)
;; 	  (dbr:dbstruct-inmem-set! dbstruct #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (if (dbr:dbstruct? dbstruct)
      (begin
        (db:sync-touched dbstruct 0 force-sync: #t)


        (let ((tdb (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
              (mdb (db:dbdat-get-db (dbr:dbstruct-mtdb  dbstruct))))
          (if tdb (sqlite3:finalize! tdb))
          (if mdb (sqlite3:finalize! mdb))))))
  
;;   (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
;;     (if (hash-table? locdbs)
;; 	(for-each (lambda (run-id)
;; 		    (db:close-run-db dbstruct run-id))
;; 		  (hash-table-keys locdbs)))))

;; (define (db:open-inmem-db)
;;   (let* ((db      (sqlite3:open-database ":memory:"))
;; 	 (handler (make-busy-timeout 3600)))
;;     (sqlite3:set-busy-handler! db handler)
;;     (db:initialize-run-id-db db)
;;     (cons db #f)))

;; just tests, test_steps and test_data tables
(define db:sync-tests-only
  (list
   ;; (list "strs"
   ;;       '("id"             #f)
   ;;       '("str"            #f))
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:sync-main-list db)
  (let ((keys  (db:get-keys db)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 







|
|







437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:sync-main-list dbstruct)
  (let ((keys  (db:get-keys dbstruct)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 
511
512
513
514
515
516
517




518
519
520
521
522
523
524
	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
	   '("avg_runtime"    #f)
	   '("avg_disk"       #f)
	   '("tags"           #f)
	   '("jobgroup"       #f)))))





;; use bunch of Unix commands to try to break the lock and recreate the db
;;
(define (db:move-and-recreate-db dbdat)
  (let* ((dbpath   (db:dbdat-get-path        dbdat))
	 (dbdir    (pathname-directory       dbpath))
	 (fname    (pathname-strip-directory dbpath))







>
>
>
>







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
	   '("avg_runtime"    #f)
	   '("avg_disk"       #f)
	   '("tags"           #f)
	   '("jobgroup"       #f)))))

(define (db:sync-all-tables-list dbstruct)
  (append (db:sync-main-list dbstruct)
	  db:sync-tests-only))

;; use bunch of Unix commands to try to break the lock and recreate the db
;;
(define (db:move-and-recreate-db dbdat)
  (let* ((dbpath   (db:dbdat-get-path        dbdat))
	 (dbdir    (pathname-directory       dbpath))
	 (fname    (pathname-strip-directory dbpath))
807
808
809
810
811
812
813
814

815
816

817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838

839
840
841
842
843
844
845
846
847
848
849
850
851

852
853
854
855
856
857
858
859
860
861
862
863
864
865
866

867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db
;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup))

	 (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	 (mtdb     (if toppath (db:open-megatest-db)))

	 (allow-cleanup (if run-ids #f #t))
	 (run-ids  (if run-ids 
		       run-ids
		       (if toppath (begin
				     (db:delay-if-busy mtdb)
				     (db:get-all-run-ids mtdb)))))
	 (tdbdat  (tasks:open-db))
	 (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
    
    ;; kill servers
    (if (member 'killservers options)
	(for-each
	 (lambda (server)
	   (tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
	   (tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
	 servers))

    ;; clear out junk records
    ;;
    (if (member 'dejunk options)
	(begin
	  (db:delay-if-busy mtdb)

	  (db:clean-up mtdb)))

    ;; adjust test-ids to fit into proper range
    ;;
    (if (member 'adj-testids options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:prep-megatest.db-for-migration mtdb)))

    ;; sync runs, test_meta etc.
    ;;
    (if (member 'old2new options)
	(begin

	  (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
	  (for-each 
	   (lambda (run-id)
	     (db:delay-if-busy mtdb)
	     (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
	       (debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct)))))
	   run-ids)))

    ;; now ensure all newdb data are synced to megatest.db
    ;; do not use the run-ids list passed in to the function
    ;;
    (if (member 'new2old options)

	(let* ((maindb      (make-dbr:dbstruct path: toppath local: #t))
	       (src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0)))))
	       (all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
	       (count       1)
	       (total       (length all-run-ids))
	       (dead-runs  '()))
          ;; first fix schema if needed
          (map
           (lambda (th)
             (thread-join! th))
           (map
            (lambda (run-id)
              (thread-start! 
               (make-thread
                (lambda ()
                  (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
                         (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
                    (if (eq? run-id 0)
                        (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
                          (db:patch-schema-maindb run-id maindb))
                        (db:patch-schema-rundb run-id frundb)))
                  (set! count (+ count 1))
                  (debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
            all-run-ids))
          ;; Then sync and fix db's
          (set! count 0)
          (process-fork
           (lambda ()
             (map
              (lambda (th)
                (thread-join! th))
              (map
               (lambda (run-id)
                 (thread-start! 
                  (make-thread
                   (lambda ()
                     (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
                            (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
                       (if (eq? run-id 0)
                           (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
                             (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
                             (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))))
                           (begin
                             ;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
                             (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
                             (db:clean-up-rundb (db:get-db fromdb run-id)))))
                     (set! count (+ count 1))
                     (debug:print 0 *default-log-port* "Finished clean up of "
                                  (if (eq? run-id 0)
                                      " main.db " (conc run-id ".db")) ", " count " of " total)))))
               all-run-ids))))

          ;; removed deleted runs
	  (let ((dbdir (tasks:get-task-db-path)))
	    (for-each (lambda (run-id)
			(let ((fullname (conc dbdir "/" run-id ".db")))
			  (if (file-exists? fullname)
			      (begin
				(debug:print 0 *default-log-port* "Removing database file for deleted run " fullname)
				(delete-file fullname)))))
		      dead-runs))))

    ;; (db:close-all dbstruct)
    ;; (sqlite3:finalize! mdb)
    ))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db (cond







|
>
|
|
>
|
|
|
<
<
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
>
|

|
|
|
|
|
|

|
|
|
|
>
|
|
|
|
|
|
|
|
|
|

|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775


776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db
;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (if (not (launch:setup))
      (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
      (let* ((dbstruct (db:setup))
	     (mtdb     (dbr:dbstruct-mtdb dbstruct))
	     (tmpdb    (dbr:dbstruct-tmpdb dbstruct))
	     (allow-cleanup (if run-ids #f #t))
;; 	     (run-ids  (if run-ids 
;; 			   run-ids


;; 			   (db:get-all-run-ids mtdb)))
	     (tdbdat  (tasks:open-db))
	     (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
    
	;; kill servers
	(if (member 'killservers options)
	    (for-each
	     (lambda (server)
	       (tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
	       (tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
	     servers))

	;; clear out junk records
	;;
	(if (member 'dejunk options)
	    (begin
	      (db:delay-if-busy mtdb)
	      (db:clean-up mtdb)
	      (db:clean-up tmpdb)))

	;; adjust test-ids to fit into proper range
	;;
	;; (if (member 'adj-testids options)
	;;     (begin
	;;       (db:delay-if-busy mtdb)
	;;       (db:prep-megatest.db-for-migration mtdb)))

	;; sync runs, test_meta etc.
	;;
	(if (member 'old2new options)
	    ;; (begin
	    (db:sync-tables (db:sync-all-tables-list dbstruct) mtdb tmpdb))
			      ;; (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
;; 	      (for-each 
;; 	       (lambda (run-id)
;; 		 (db:delay-if-busy mtdb)
;; 		 (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
;; ;;		       (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
;; 		   (debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
;; 		   (db:replace-test-records dbstruct run-id testrecs)
;; 		   (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct)))))
;; 	       run-ids)))

	;; now ensure all newdb data are synced to megatest.db
	;; do not use the run-ids list passed in to the function
	;;
	(if (member 'new2old options)
	    (db:sync-tables (db:sync-all-tables-list dbstruct) tmpdb mtdb))
	;; (let* ((maindb      (make-dbr:dbstruct path: toppath local: #t))
	;; 	   (src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0)))))
	;; 	   (all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
	;; 	   (count       1)
	;; 	   (total       (length all-run-ids))
	;; 	   (dead-runs  '()))
	;;   ;; first fix schema if needed
	;;   (map
	;;    (lambda (th)
	;; 	 (thread-join! th))
	;;    (map
	;; 	(lambda (run-id)
	;; 	  (thread-start! 
	;; 	   (make-thread
	;; 	    (lambda ()
	;; 	      (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
	;; 		     (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	;; 		(if (eq? run-id 0)
	;; 		    (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
	;; 		      (db:patch-schema-maindb run-id maindb))
	;; 		    (db:patch-schema-rundb run-id frundb)))
	;; 	      (set! count (+ count 1))
	;; 	      (debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
	;; 	all-run-ids))
	;;   ;; Then sync and fix db's
	;;   (set! count 0)
	;;   (process-fork
	;;    (lambda ()
	;; 	 (map
	;; 	  (lambda (th)
	;; 	    (thread-join! th))
	;; 	  (map
	;; 	   (lambda (run-id)
	;; 	     (thread-start! 
	;; 	      (make-thread
	;; 	       (lambda ()
	;; 		 (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
	;; 			(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	;; 		   (if (eq? run-id 0)
	;; 		       (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
	;; 			 (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
	;; 			 (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))))
	;; 		       (begin
	;; 			 ;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
	;; 			 (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
	;; 			 (db:clean-up-rundb (db:get-db fromdb run-id)))))
	;; 		 (set! count (+ count 1))
	;; 		 (debug:print 0 *default-log-port* "Finished clean up of "
	;; 			      (if (eq? run-id 0)
	;; 				  " main.db " (conc run-id ".db")) ", " count " of " total)))))
	;; 	   all-run-ids))))

	;; removed deleted runs
;; (let ((dbdir (tasks:get-task-db-path)))
;;   (for-each (lambda (run-id)
;; 	      (let ((fullname (conc dbdir "/" run-id ".db")))
;; 		(if (file-exists? fullname)
;; 		    (begin
;; 		      (debug:print 0 *default-log-port* "Removing database file for deleted run " fullname)
;; 		      (delete-file fullname)))))
;; 	    dead-runs))))
;; 
	;; (db:close-all dbstruct)
	;; (sqlite3:finalize! mdb)
	)))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db (cond
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
		   )))
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))







|







1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
		   )))
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))

Added docs/inprogress/graph-draw-arch.fig version [c5d001fa40].









































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
#FIG 3.2  Produced by xfig version 3.2.5-alpha5
Landscape
Center
Inches
Letter  
100.00
Single
-2
1200 2
6 5700 3075 8400 3675
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5700 3075 8400 3075 8400 3675 5700 3675 5700 3075
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 9
	 5700 3525 5925 3525 5925 3225 6750 3225 6750 3450 7350 3450
	 7350 3600 8325 3600 8250 3525
-6
6 7425 6825 10125 7425
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 7425 6825 10125 6825 10125 7425 7425 7425 7425 6825
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 9
	 7425 7275 7650 7275 7650 6975 8475 6975 8475 7200 9075 7200
	 9075 7350 10050 7350 9975 7275
-6
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 3000 4650 3000 3225 600 3225 600 4650 3000 4650
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 2550 5100 2550 3675 150 3675 150 5100 2550 5100
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 3000 3825 5550 3450
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5475 2400 8475 2400 8475 4650 5475 4650 5475 2400
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 7275 4725 8175 6375
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 1
	 8175 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 6225 6300 11025 6300 11025 9000 6225 9000 6225 6300
2 4 2 1 0 7 50 -1 -1 3.000 0 0 7 0 0 5
	 8850 5850 8850 900 75 900 75 5850 8850 5850
2 4 0 1 0 7 50 -1 -1 3.000 0 0 7 0 0 5
	 4875 5550 4875 4500 3450 4500 3450 5550 4875 5550
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 4500 4500 5475 4200
4 0 0 50 -1 0 12 0.0000 4 195 915 750 3525 graph data\001
4 0 0 50 -1 0 12 0.0000 4 195 525 5550 2700 layout\001
4 0 0 50 -1 0 12 0.0000 4 195 1800 6375 6525 display on dashboard\001
4 0 0 50 -1 0 12 0.0000 4 195 1065 3525 4875 megatest.db\001
4 0 0 50 -1 0 12 0.0000 4 195 6150 675 1425 Very slow! Threaded running of procedure: runtimes-tab-layout-updater\001
4 0 0 50 -1 0 12 0.0000 4 195 2865 8325 6225 fast!runtimes-tab-canvas-updater\001

Added docs/inprogress/megatest-architecture-proposed-2.fig version [8f30e0932f].





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
#FIG 3.2  Produced by xfig version 3.2.5-alpha5
Landscape
Center
Inches
Letter  
100.00
Single
-2
1200 2
6 600 1350 1575 2400
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 1125 1500 450 150 1125 1500 1575 1650
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 1124 2177 450 150 1124 2177 1574 2327
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 675 1575 675 2175
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 1575 1500 1575 2175
-6
6 1875 825 2850 1875
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 2400 975 450 150 2400 975 2850 1125
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 2399 1652 450 150 2399 1652 2849 1802
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 1950 1050 1950 1650
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 2850 975 2850 1650
-6
6 3225 450 4200 1500
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 3750 600 450 150 3750 600 4200 750
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 3749 1277 450 150 3749 1277 4199 1427
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 3300 675 3300 1275
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 4200 600 4200 1275
-6
6 3075 2925 4050 3975
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 3600 3075 450 150 3600 3075 4050 3225
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 3599 3752 450 150 3599 3752 4049 3902
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 3150 3150 3150 3750
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 4050 3075 4050 3750
-6
6 7275 4050 12825 9675
6 8175 4125 8400 8625
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 4125 8400 4125 8400 4350 8175 4350 8175 4125
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 4350 8400 4350 8400 4575 8175 4575 8175 4350
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 4575 8400 4575 8400 4800 8175 4800 8175 4575
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 4800 8400 4800 8400 5025 8175 5025 8175 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 5025 8400 5025 8400 5250 8175 5250 8175 5025
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 5250 8400 5250 8400 5475 8175 5475 8175 5250
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 5475 8400 5475 8400 5700 8175 5700 8175 5475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 5700 8400 5700 8400 5925 8175 5925 8175 5700
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 5925 8400 5925 8400 6150 8175 6150 8175 5925
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 6150 8400 6150 8400 6375 8175 6375 8175 6150
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 6375 8400 6375 8400 6600 8175 6600 8175 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 6600 8400 6600 8400 6825 8175 6825 8175 6600
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 6825 8400 6825 8400 7050 8175 7050 8175 6825
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 7050 8400 7050 8400 7275 8175 7275 8175 7050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 7275 8400 7275 8400 7500 8175 7500 8175 7275
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 7500 8400 7500 8400 7725 8175 7725 8175 7500
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 7725 8400 7725 8400 7950 8175 7950 8175 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 7950 8400 7950 8400 8175 8175 8175 8175 7950
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 8175 8400 8175 8400 8400 8175 8400 8175 8175
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8175 8400 8400 8400 8400 8625 8175 8625 8175 8400
-6
6 8475 4125 8700 8625
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 4125 8700 4125 8700 4350 8475 4350 8475 4125
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 4350 8700 4350 8700 4575 8475 4575 8475 4350
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 4575 8700 4575 8700 4800 8475 4800 8475 4575
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 4800 8700 4800 8700 5025 8475 5025 8475 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 5025 8700 5025 8700 5250 8475 5250 8475 5025
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 5250 8700 5250 8700 5475 8475 5475 8475 5250
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 5475 8700 5475 8700 5700 8475 5700 8475 5475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 5700 8700 5700 8700 5925 8475 5925 8475 5700
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 5925 8700 5925 8700 6150 8475 6150 8475 5925
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 6150 8700 6150 8700 6375 8475 6375 8475 6150
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 6375 8700 6375 8700 6600 8475 6600 8475 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 6600 8700 6600 8700 6825 8475 6825 8475 6600
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 6825 8700 6825 8700 7050 8475 7050 8475 6825
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 7050 8700 7050 8700 7275 8475 7275 8475 7050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 7275 8700 7275 8700 7500 8475 7500 8475 7275
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 7500 8700 7500 8700 7725 8475 7725 8475 7500
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 7725 8700 7725 8700 7950 8475 7950 8475 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 7950 8700 7950 8700 8175 8475 8175 8475 7950
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 8175 8700 8175 8700 8400 8475 8400 8475 8175
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8475 8400 8700 8400 8700 8625 8475 8625 8475 8400
-6
6 8775 4125 9000 8625
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 4125 9000 4125 9000 4350 8775 4350 8775 4125
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 4350 9000 4350 9000 4575 8775 4575 8775 4350
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 4575 9000 4575 9000 4800 8775 4800 8775 4575
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 4800 9000 4800 9000 5025 8775 5025 8775 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 5025 9000 5025 9000 5250 8775 5250 8775 5025
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 5250 9000 5250 9000 5475 8775 5475 8775 5250
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 5475 9000 5475 9000 5700 8775 5700 8775 5475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 5700 9000 5700 9000 5925 8775 5925 8775 5700
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 5925 9000 5925 9000 6150 8775 6150 8775 5925
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 6150 9000 6150 9000 6375 8775 6375 8775 6150
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 6375 9000 6375 9000 6600 8775 6600 8775 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 6600 9000 6600 9000 6825 8775 6825 8775 6600
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 6825 9000 6825 9000 7050 8775 7050 8775 6825
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 7050 9000 7050 9000 7275 8775 7275 8775 7050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 7275 9000 7275 9000 7500 8775 7500 8775 7275
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 7500 9000 7500 9000 7725 8775 7725 8775 7500
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 7725 9000 7725 9000 7950 8775 7950 8775 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 7950 9000 7950 9000 8175 8775 8175 8775 7950
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 8175 9000 8175 9000 8400 8775 8400 8775 8175
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 8775 8400 9000 8400 9000 8625 8775 8625 8775 8400
-6
6 9075 4125 9300 8625
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 4125 9300 4125 9300 4350 9075 4350 9075 4125
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 4350 9300 4350 9300 4575 9075 4575 9075 4350
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 4575 9300 4575 9300 4800 9075 4800 9075 4575
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 4800 9300 4800 9300 5025 9075 5025 9075 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 5025 9300 5025 9300 5250 9075 5250 9075 5025
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 5250 9300 5250 9300 5475 9075 5475 9075 5250
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 5475 9300 5475 9300 5700 9075 5700 9075 5475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 5700 9300 5700 9300 5925 9075 5925 9075 5700
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 5925 9300 5925 9300 6150 9075 6150 9075 5925
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 6150 9300 6150 9300 6375 9075 6375 9075 6150
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 6375 9300 6375 9300 6600 9075 6600 9075 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 6600 9300 6600 9300 6825 9075 6825 9075 6600
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 6825 9300 6825 9300 7050 9075 7050 9075 6825
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 7050 9300 7050 9300 7275 9075 7275 9075 7050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 7275 9300 7275 9300 7500 9075 7500 9075 7275
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 7500 9300 7500 9300 7725 9075 7725 9075 7500
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 7725 9300 7725 9300 7950 9075 7950 9075 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 7950 9300 7950 9300 8175 9075 8175 9075 7950
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 8175 9300 8175 9300 8400 9075 8400 9075 8175
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9075 8400 9300 8400 9300 8625 9075 8625 9075 8400
-6
6 9375 4125 9600 8625
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 4125 9600 4125 9600 4350 9375 4350 9375 4125
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 4350 9600 4350 9600 4575 9375 4575 9375 4350
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 4575 9600 4575 9600 4800 9375 4800 9375 4575
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 4800 9600 4800 9600 5025 9375 5025 9375 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 5025 9600 5025 9600 5250 9375 5250 9375 5025
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 5250 9600 5250 9600 5475 9375 5475 9375 5250
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 5475 9600 5475 9600 5700 9375 5700 9375 5475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 5700 9600 5700 9600 5925 9375 5925 9375 5700
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 5925 9600 5925 9600 6150 9375 6150 9375 5925
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 6150 9600 6150 9600 6375 9375 6375 9375 6150
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 6375 9600 6375 9600 6600 9375 6600 9375 6375
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 6600 9600 6600 9600 6825 9375 6825 9375 6600
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 6825 9600 6825 9600 7050 9375 7050 9375 6825
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 7050 9600 7050 9600 7275 9375 7275 9375 7050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 7275 9600 7275 9600 7500 9375 7500 9375 7275
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 7500 9600 7500 9600 7725 9375 7725 9375 7500
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 7725 9600 7725 9600 7950 9375 7950 9375 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 7950 9600 7950 9600 8175 9375 8175 9375 7950
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 8175 9600 8175 9600 8400 9375 8400 9375 8175
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9375 8400 9600 8400 9600 8625 9375 8625 9375 8400
-6
# Dimension line: 1-1/16 in
6 7875 9375 9150 9675
# main dimension line
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 1 1 2
	1 1 1.00 60.00 120.00
	1 1 1.00 60.00 120.00
	 7875 9525 9150 9525
# text box
2 3 0 1 4 7 49 -1 20 0.000 0 0 -1 0 0 5
	 8085 9375 8085 9675 8939 9675 8939 9375 8085 9375
# tick
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 0 0 2
	 7875 9375 7875 9675
# tick
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 0 0 2
	 9150 9375 9150 9675
4 1 0 48 -1 0 12 -0.0000 4 180 735 8512 9585 1-1/16 in\001
-6
# Dimension line: 1-11/16 in
6 7425 4125 7725 6150
# main dimension line
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 1 1 2
	1 1 1.00 60.00 120.00
	1 1 1.00 60.00 120.00
	 7575 4125 7575 6150
# text box
2 3 0 1 4 7 49 -1 20 0.000 0 0 -1 0 0 5
	 7425 5617 7725 5617 7725 4657 7425 4657 7425 5617
# tick
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 0 0 2
	 7425 6150 7725 6150
# tick
2 1 0 1 0 7 50 -1 -1 4.000 0 0 -1 0 0 2
	 7425 4125 7725 4125
4 1 0 48 -1 0 12 1.5708 4 180 840 7635 5137 1-11/16 in\001
-6
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 7800 4050 12825 4050 12825 8925 7800 8925 7800 4050
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9225 6225 12450 6225 12450 8325 9225 8325 9225 6225
2 2 0 1 4 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 9225 6150 9675 6150 9675 8400 9225 8400 9225 6150
4 0 0 50 -1 0 12 0.0000 4 150 150 8475 9300 X\001
4 0 0 50 -1 0 12 0.0000 4 150 135 7275 6975 Y\001
-6
6 14100 150 19950 6075
6 14850 1350 15825 2400
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 15375 1500 450 150 15375 1500 15825 1650
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 15374 2177 450 150 15374 2177 15824 2327
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 14925 1575 14925 2175
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 15825 1500 15825 2175
-6
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 17025 4050 17025 3450 15750 3450 15750 4050 17025 4050
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16050 3375 15525 2400
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 15825 5325 17175 5325 17175 5850 15825 5850 15825 5325
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16350 4050 16350 5325
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 17550 4800 18900 4800 18900 5325 17550 5325 17550 4800
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 18375 3900 19725 3900 19725 4425 18375 4425 18375 3900
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16725 4050 17850 4800
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 17025 3750 18375 4125
2 1 0 1 14 7 50 -1 -1 3.000 0 0 -1 1 1 3
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 18975 3900 18075 2625 15900 1875
2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
	 14100 150 19950 150 19950 6075 14100 6075 14100 150
4 0 0 50 -1 0 12 0.0000 4 150 900 15825 3675 rpc-server\001
4 0 0 50 -1 0 12 0.0000 4 165 270 17475 3825 tcp\001
4 0 0 50 -1 0 12 0.0000 4 120 315 18525 4125 test\001
4 0 0 50 -1 0 12 0.0000 4 195 1065 14850 1200 megatest.db\001
4 0 0 50 -1 0 12 0.0000 4 150 1020 14325 525 basic model\001
-6
6 14850 7425 15825 8475
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 15375 7575 450 150 15375 7575 15825 7725
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 15374 8252 450 150 15374 8252 15824 8402
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 14925 7650 14925 8250
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 15825 7575 15825 8250
-6
6 17775 6675 18750 7725
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 18300 6825 450 150 18300 6825 18750 6975
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 18299 7502 450 150 18299 7502 18749 7652
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 17850 6900 17850 7500
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 18750 6825 18750 7500
-6
6 4875 6075 5850 7125
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 5400 6225 450 150 5400 6225 5850 6375
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 5399 6902 450 150 5399 6902 5849 7052
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 4950 6300 4950 6900
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 5850 6225 5850 6900
-6
6 5400 7425 7350 8925
6 5475 7650 6450 8700
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 6000 7800 450 150 6000 7800 6450 7950
1 1 0 1 0 7 50 -1 -1 0.000 1 0.0000 5999 8477 450 150 5999 8477 6449 8627
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 5550 7875 5550 8475
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
	 6450 7800 6450 8475
-6
4 0 0 50 -1 0 12 0.0000 4 195 1905 5400 8850 pointers to the servers\001
4 0 0 50 -1 0 12 0.0000 4 150 930 5550 7575 monitor.db\001
-6
6 6150 2700 7500 3225
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 6150 2700 7500 2700 7500 3225 6150 3225 6150 2700
4 0 0 50 -1 0 12 0.0000 4 180 870 6225 2925 run2/test1\001
-6
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 1725 5025 1275 2475
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 5550 4500 5550 225 225 225 225 4500 5550 4500
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 1875 7725 1875 5775
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1425 7725 2775 7725 2775 8250 1425 8250 1425 7725
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3375 7725 4725 7725 4725 8250 3375 8250 3375 7725
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 3675 7725 2175 5775
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 2775 5700 2775 5100 1500 5100 1500 5700 2775 5700
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 6600 3300 2925 5025
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 17025 10125 17025 9525 15750 9525 15750 10125 17025 10125
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16050 9450 15525 8475
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 15825 11400 17175 11400 17175 11925 15825 11925 15825 11400
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16350 10125 16350 11400
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 17550 10875 18900 10875 18900 11400 17550 11400 17550 10875
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 18375 9975 19725 9975 19725 10500 18375 10500 18375 9975
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16725 10125 17850 10875
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 17025 9825 18375 10200
2 1 0 1 14 7 50 -1 -1 3.000 0 0 -1 1 1 3
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 18975 9975 18075 8700 15900 7950
2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
	 14100 6225 19950 6225 19950 12150 14100 12150 14100 6225
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 16575 9375 17850 7950
2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
	 2100 10425 6150 10425 6150 14400 2100 14400 2100 10425
2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
	 2325 10875 5925 10875 5925 13800 2325 13800 2325 10875
2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
	 2400 10950 3975 10950 3975 11625 2400 11625 2400 10950
2 4 0 1 0 7 50 -1 -1 0.000 0 0 7 0 0 5
	 5325 12675 5325 12075 4050 12075 4050 12675 5325 12675
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 3975 11250 4575 12075
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 2175 5025 3075 3750
2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 4800 6375 2850 5550
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
	0 0 1.00 60.00 120.00
	0 0 1.00 60.00 120.00
	 3600 2475 7425 6525
4 0 0 50 -1 0 12 0.0000 4 195 990 1800 2625 last_update\001
4 0 0 50 -1 0 12 0.0000 4 150 690 3150 4125 main.db\001
4 0 0 50 -1 0 12 0.0000 4 195 990 4200 3600 last_update\001
4 0 0 50 -1 0 12 0.0000 4 195 330 1950 6825 http\001
4 0 0 50 -1 0 12 0.0000 4 180 870 1575 7950 run1/test1\001
4 0 0 50 -1 0 12 0.0000 4 150 720 1650 5400 server-1\001
4 0 0 50 -1 0 12 0.0000 4 150 375 2175 2025 2.db\001
4 0 0 50 -1 0 12 0.0000 4 150 375 750 2550 1.db\001
4 0 0 50 -1 0 12 0.0000 4 180 870 3450 7950 run1/test2\001
4 0 0 50 -1 0 12 0.0000 4 150 1110 9675 3750 Dashboardm\001
4 0 0 50 -1 0 12 1.5708 4 150 390 8325 3975 run1\001
4 0 0 50 -1 0 12 0.0000 4 150 900 15825 9750 rpc-server\001
4 0 0 50 -1 0 12 0.0000 4 165 270 17475 9900 tcp\001
4 0 0 50 -1 0 12 0.0000 4 120 315 18525 10200 test\001
4 0 0 50 -1 0 12 0.0000 4 195 1065 14850 7275 megatest.db\001
4 0 0 50 -1 0 12 0.0000 4 195 1305 17700 7875 mysql/postgres\001
4 0 0 50 -1 0 12 0.0000 4 195 1875 14325 6600 mysql/postgres model\001
4 0 0 50 -1 0 12 0.0000 4 195 4065 600 9300 Current state, no bypass - (if we switch to rpc?)\001
4 0 0 50 -1 0 12 0.0000 4 195 1125 2175 10650 prev try RPC\001
4 0 0 50 -1 0 12 0.0000 4 165 1095 2475 11100 rmt:get-tests\001
4 0 0 50 -1 0 12 0.0000 4 195 2205 450 525 /tmp/<user>/??? /.db/*.db\001
4 0 0 50 -1 0 12 0.0000 4 195 1065 4800 7350 megatest.db\001
4 0 0 50 -1 0 12 0.0000 4 150 1785 600 8775 Possible Future state\001
4 0 0 50 -1 0 12 0.0000 4 150 1110 8025 450 CHANGES:\001
4 0 0 50 -1 0 12 0.0000 4 195 2145 8025 705 1. http -> rcp or nanomsg\001
4 0 0 50 -1 0 12 0.0000 4 195 3330 8025 960 2. cache db moves from inmem to /tmp\001

Modified http-transport.scm from [13883e3b0d] to [a60bbd8be7].

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	  ;;
	  (if (eq? server-state 'available)
	      (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
		(if (equal? new-server-id server-id)
		    (begin
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
		      (thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
		      (set! *inmemdb*  (db:setup run-id))
		      ;; force initialization
		      ;; (db:get-db *inmemdb* #t)
		      (db:get-db *inmemdb* run-id)
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
		    (begin ;; gotta exit nicely
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
		      (http-transport:server-shutdown server-id port))))))
      
      (if (< count 1) ;; 3x3 = 9 secs aprox
	  (loop (+ count 1) 'running bad-sync-count))







|


|







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	  ;;
	  (if (eq? server-state 'available)
	      (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
		(if (equal? new-server-id server-id)
		    (begin
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
		      (thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
		      (set! *inmemdb*  (db:setup)) ;;  run-id))
		      ;; force initialization
		      ;; (db:get-db *inmemdb* #t)
		      ;; (db:get-db *inmemdb* run-id)
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
		    (begin ;; gotta exit nicely
		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
		      (http-transport:server-shutdown server-id port))))))
      
      (if (< count 1) ;; 3x3 = 9 secs aprox
	  (loop (+ count 1) 'running bad-sync-count))

Modified rmt.scm from [51e718f694] to [80a7990c07].

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80


81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98



99
100
101
102




103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154

155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u


;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;;
(define (rmt:write-frequency-over-limit? cmd run-id)
  (and (not (member cmd api:read-only-queries))
       (let* ((tmprec (hash-table-ref/default *write-frequency* run-id #f))
	      (record (if tmprec tmprec 
			  (let ((v (vector (current-seconds) 0)))
			    (hash-table-set! *write-frequency* run-id v)
			    v)))
	      (count  (+ 1 (vector-ref record 1)))
	      (start  (vector-ref record 0))
	      (queries-per-second (/ (* count 1.0)
				     (max (- (current-seconds) start) 1))))
	 (vector-set! record 1 count)
	 (if (and (> count 10)
		  (> queries-per-second 10))
	     (begin
	       (debug:print-info 1 *default-log-port* "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second)
	       #t)
	     #f))))

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info run-id)
  (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
    (if cinfo
	cinfo
	;; NB// can cache the answer for server running for 10 seconds ...
	;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
	(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
	    (client:setup run-id)
	    #f))))

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
  ;; clean out old connections
  ;; (mutex-lock! *db-multi-sync-mutex*)


  (let ((expire-time (- (current-seconds) (server:get-timeout) 10))) ;; don't forget the 10 second margin
    (for-each 
     (lambda (run-id)
       (let ((connection (hash-table-ref/default *runremote* run-id #f)))
         (if (and (vector? connection)
        	  (< (http-transport:server-dat-get-last-access connection) expire-time))
             (begin
               (debug:print-info 0 *default-log-port* "Discarding connection to server for run-id " run-id ", too long between accesses")
               ;; bb- disabling nanomsg
               ;; SHOULD CLOSE THE CONNECTION HERE 
	       ;; (case *transport-type*
	       ;;   ((nmsg)(nn-close (http-transport:server-dat-get-socket 
	       ;;  		   (hash-table-ref *runremote* run-id)))))
               (hash-table-delete! *runremote* run-id)))))
     (hash-table-keys *runremote*)))
  ;; (mutex-unlock! *db-multi-sync-mutex*)
  ;; (mutex-lock! *send-receive-mutex*)
  (let* ((run-id          (if rid rid 0))



	 (connection-info (rmt:get-connection-info run-id)))
    ;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
    (if connection-info
	;; use the server if have connection info




	(let* ((dat     (case *transport-type*
			  ((http)(condition-case
				  (http-transport:client-api-send-receive run-id connection-info cmd params)
				  ((commfail)(vector #f "communications fail"))
				  ((exn)(vector #f "other fail"))))
			  ;; ((nmsg)(condition-case
			  ;;         (nmsg-transport:client-api-send-receive run-id connection-info cmd params)
			  ;;         ((timeout)(vector #f "timeout talking to server"))))
			  (else  (exit))))
	       (success (if (vector? dat) (vector-ref dat 0) #f))
	       (res     (if (vector? dat) (vector-ref dat 1) #f)))
	  (if (vector? connection-info)(http-transport:server-dat-update-last-access connection-info))
	  (if success
	      (begin
		;; (mutex-unlock! *send-receive-mutex*)
		(case *transport-type* 
		  ((http) res) ;; (db:string->obj res))
		  ;; ((nmsg) res)
                  )) ;; (vector-ref res 1)))
	      (begin ;; let ((new-connection-info (client:setup run-id)))
		(debug:print 0 *default-log-port* "WARNING: Communication failed, trying call to rmt:send-receive again.")
		;; (case *transport-type*
		;;   ((nmsg)(nn-close (http-transport:server-dat-get-socket connection-info))))
		(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
		;; NOTE: killing server causes this process to block forever. No idea why. Dec 2. 
		;; (if (eq? (modulo attemptnum 5) 0)
		;;     (tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
		;; (mutex-unlock! *send-receive-mutex*) ;; close the mutex here to allow other threads access to communications
		(tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
		;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))

		;; no longer killing the server in http-transport:client-api-send-receive
		;; may kill it here but what are the criteria?
		;; start with three calls then kill server
		;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id))
		;; (thread-sleep! 2)
		(rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1)))))

	;; no connection info? try to start a server, or access locally if no
	;; server and the query is read-only
	;;
	;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call
	;;
	(if (and (< attemptnum 15)
		 (member cmd api:write-queries))
	    (let ((faststart (configf:lookup *configdat* "server" "faststart")))
	      (hash-table-delete! *runremote* run-id)
	      ;; (mutex-unlock! *send-receive-mutex*)
	      (if (and faststart (equal? faststart "no"))
		  (begin
		    (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
		    (thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
		    (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))

		  (let ((start-time (current-milliseconds))
			(max-query  (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
							"300")))
			(newres     (rmt:open-qry-close-locally cmd run-id params)))
		    (let ((delta (- (current-milliseconds) start-time)))
		      (if (> delta max-query)
			  (begin
			    (debug:print-info 0 *default-log-port* "Starting server as query time " delta " is over the limit of " max-query)
			    (server:kind-run run-id)))

		      ;; return the result!
		      newres)
		    )))
	    (begin
	      ;; (debug:print-error 0 *default-log-port* "Communication failed!")
	      ;; (mutex-unlock! *send-receive-mutex*)
	      ;; (exit)
	      (rmt:open-qry-close-locally cmd run-id params)
	      )))))

(define (rmt:update-db-stats run-id rawcmd params duration)
  (mutex-lock! *db-stats-mutex*)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: stats collection failed in update-db-stats")







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







<
<











>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
|
<
|
<
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|







34
35
36
37
38
39
40




















41
42
43
44
45
46
47


48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u


;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================





















;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info run-id)
  (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
    (if cinfo
	cinfo


	(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
	    (client:setup run-id)
	    #f))))

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
  ;; clean out old connections
  ;; (mutex-lock! *db-multi-sync-mutex*)
  (rmt:open-qry-close-locally cmd (if rid rid 0) params))

;;   (let ((expire-time (- (current-seconds) (server:get-timeout) 10))) ;; don't forget the 10 second margin
;;     (for-each 
;;      (lambda (run-id)
;;        (let ((connection (hash-table-ref/default *runremote* run-id #f)))
;;          (if (and (vector? connection)
;;         	  (< (http-transport:server-dat-get-last-access connection) expire-time))
;;              (begin
;;                (debug:print-info 0 *default-log-port* "Discarding connection to server for run-id " run-id ", too long between accesses")
;;                ;; bb- disabling nanomsg
;;                ;; SHOULD CLOSE THE CONNECTION HERE 
;; 	       ;; (case *transport-type*
;; 	       ;;   ((nmsg)(nn-close (http-transport:server-dat-get-socket 
;; 	       ;;  		   (hash-table-ref *runremote* run-id)))))
;;                (hash-table-delete! *runremote* run-id)))))
;;      (hash-table-keys *runremote*)))
;;   ;; (mutex-unlock! *db-multi-sync-mutex*)
;;   ;; (mutex-lock! *send-receive-mutex*)
;;   (let* ((run-id          (if rid rid 0))
;; 	 (home-host       (common:get-homehost))
;; 	 (connection-info (if (cdr home-host) ;; we are on the home-host
;; 			      #f
;; 			      (rmt:get-connection-info run-id))))

;;     (cond

;;      (home-host        (rmt:open-qry-close-locally cmd run-id params))
;;      (connection-info
;;       ;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
;;       ;; use the server if have connection info
;;       (let* ((dat     (case *transport-type*
;; 			((http)(condition-case
;; 				(http-transport:client-api-send-receive run-id connection-info cmd params)
;; 				((commfail)(vector #f "communications fail"))
;; 				((exn)(vector #f "other fail"))))
;; 			;; ((nmsg)(condition-case
;; 			;;         (nmsg-transport:client-api-send-receive run-id connection-info cmd params)
;; 			;;         ((timeout)(vector #f "timeout talking to server"))))
;; 			(else  (exit))))
;; 	     (success (if (vector? dat) (vector-ref dat 0) #f))
;; 	     (res     (if (vector? dat) (vector-ref dat 1) #f)))
;; 	(if (vector? connection-info)(http-transport:server-dat-update-last-access connection-info))
;; 	(if success
;; 	    (begin
;; 	      ;; (mutex-unlock! *send-receive-mutex*)
;; 	      (case *transport-type* 
;; 		((http) res) ;; (db:string->obj res))
;; 		;; ((nmsg) res)
;; 		)) ;; (vector-ref res 1)))
;; 	    (begin ;; let ((new-connection-info (client:setup run-id)))
;; 	      (debug:print 0 *default-log-port* "WARNING: Communication failed, trying call to rmt:send-receive again.")
;; 	      ;; (case *transport-type*
;; 	      ;;   ((nmsg)(nn-close (http-transport:server-dat-get-socket connection-info))))
;; 	      (hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; 	      ;; NOTE: killing server causes this process to block forever. No idea why. Dec 2. 
;; 	      ;; (if (eq? (modulo attemptnum 5) 0)
;; 	      ;;     (tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
;; 	      ;; (mutex-unlock! *send-receive-mutex*) ;; close the mutex here to allow other threads access to communications
;; 	      (tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
;; 	      ;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))
;; 	      
;; 	      ;; no longer killing the server in http-transport:client-api-send-receive
;; 	      ;; may kill it here but what are the criteria?
;; 	      ;; start with three calls then kill server
;; 	      ;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id))
;; 	      ;; (thread-sleep! 2)
;; 	      (rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))))
;;      (else
;;      ;; no connection info? try to start a server, or access locally if no
;;       ;; server and the query is read-only
;;       ;;
;;       ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call
;;       ;;
;;       (if (and (< attemptnum 15)
;; 	       (member cmd api:write-queries))
;; 	  (let ((homehost  (common:get-homehost))) ;; faststart (configf:lookup *configdat* "server" "faststart")))
;; 	      (hash-table-delete! *runremote* run-id)
;; 	      ;; (mutex-unlock! *send-receive-mutex*)
;; 	      (if (not (cdr homehost)) ;; we always require a server if not on homehost ;; (and faststart (equal? faststart "no"))
;; 		  (begin
;; 		    (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
;; 		    (thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
;; 		    (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
;; 		  ;; NB - probably can remove the query time stuff but need to discuss it ....
;; 		  (let ((start-time (current-milliseconds))
;; 			(max-query  (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
;; 							"300")))
;; 			(newres     (rmt:open-qry-close-locally cmd run-id params)))
;; 		    (let ((delta (- (current-milliseconds) start-time)))
;; 		      (if (> delta max-query)
;; 			  (begin
;; 			    (debug:print-info 0 *default-log-port* "WARNING: long query times, you may have an overloaded homehost.") ;; Starting server as query time " delta " is over the limit of " max-query)
;; 			    ;; (server:kind-run run-id)))
;; 			    ))
;; 		      ;; return the result!
;; 		      newres)
;; 		    )))
;; 	  (begin
;; 	    ;; (debug:print-error 0 *default-log-port* "Communication failed!")
;; 	    ;; (mutex-unlock! *send-receive-mutex*)
;; 	    ;; (exit)
;; 	    (rmt:open-qry-close-locally cmd run-id params)
;; 	    ))))))

(define (rmt:update-db-stats run-id rawcmd params duration)
  (mutex-lock! *db-stats-mutex*)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: stats collection failed in update-db-stats")
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
				 (cons 'none 0))
			     (loop (car tal)(cdr tal) newmax-cmd currmax)))))))
    (mutex-unlock! *db-stats-mutex*)
    res))

(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
  (let* ((dbstruct-local (db:open-local-db-handle))
	 (db-file-path   (db:dbfile-path 0))
	 ;; (read-only      (not (file-read-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (api:execute-requests dbstruct-local (vector (symbol->string cmd) params)))
	 (success        (vector-ref resdat 0))
	 (res            (vector-ref resdat 1))
	 (duration       (- (current-milliseconds) start)))
    (if (not success)







|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
				 (cons 'none 0))
			     (loop (car tal)(cdr tal) newmax-cmd currmax)))))))
    (mutex-unlock! *db-stats-mutex*)
    res))

(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
  (let* ((dbstruct-local (db:open-local-db-handle))
	 (db-file-path   (db:dbfile-path)) ;;  0))
	 ;; (read-only      (not (file-read-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (api:execute-requests dbstruct-local (vector (symbol->string cmd) params)))
	 (success        (vector-ref resdat 0))
	 (res            (vector-ref resdat 1))
	 (duration       (- (current-milliseconds) start)))
    (if (not success)