Megatest

Check-in [9e78ced13a]
Login
Overview
Comment:Couple fixes. basic queries, register-test, get-test-id, login, working and starting a server on demand
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 9e78ced13a6c1bdf36b9e9dbab0df01987e0d5b4
User & Date: matt on 2023-02-19 19:19:57
Other Links: branch diff | manifest | tags
Context
2023-02-19
20:14
list runs now working with data sync'd from ondisk to inmem (but no last_update support). check-in: 12db00e83a user: matt tags: v1.80-tcp-inmem
19:19
Couple fixes. basic queries, register-test, get-test-id, login, working and starting a server on demand check-in: 9e78ced13a user: matt tags: v1.80-tcp-inmem
18:41
Basic communication working, ping, get-keys. check-in: e01a10845a user: matt tags: v1.80-tcp-inmem
Changes

Modified rmt.scm from [ba515dcb54] to [68d59a6ed2].

980
981
982
983
984
985
986
987
988


989
990
991
992
993
994
995
996
997
998
999












1000
1001
1002
1003
1004
1005
1006
(define (rmt:test-set-archive-block-id run-id test-id archive-block-id)
  (assert (number? run-id) "FATAL: Run id required.")
  (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id)))

(define (rmt:test-get-archive-block-info archive-block-id)
  (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id)))


(define (rmtmod:calc-ro-mode runremote *toppath*)


  (if (and runremote
	   (remote-ro-mode-checked runremote))
      (remote-ro-mode runremote)
      (let* ((mtcfgfile  (conc *toppath* "/megatest.config"))
	     (ro-mode (not (file-write-access? mtcfgfile)))) ;; TODO: use dbstruct or runremote to figure this out in future
	(if runremote
	    (begin
	      (remote-ro-mode-set! runremote ro-mode)
	      (remote-ro-mode-checked-set! runremote #t)
	      ro-mode)
	    ro-mode))))













(define (extras-readonly-mode rmt-mutex log-port cmd params)
  (mutex-unlock! rmt-mutex)
  (debug:print-info 12 log-port "rmt:send-receive, case 3")
  (debug:print 0 log-port "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
  #f)








<

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







980
981
982
983
984
985
986

987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
(define (rmt:test-set-archive-block-id run-id test-id archive-block-id)
  (assert (number? run-id) "FATAL: Run id required.")
  (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id)))

(define (rmt:test-get-archive-block-info archive-block-id)
  (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id)))


(define (rmtmod:calc-ro-mode runremote *toppath*)
  (case (rmt:transport-mode)
    ((http)
     (if (and runremote
	      (remote-ro-mode-checked runremote))
	 (remote-ro-mode runremote)
	 (let* ((mtcfgfile  (conc *toppath* "/megatest.config"))
		(ro-mode (not (file-write-access? mtcfgfile)))) ;; TODO: use dbstruct or runremote to figure this out in future
	   (if runremote
	       (begin
		 (remote-ro-mode-set! runremote ro-mode)
		 (remote-ro-mode-checked-set! runremote #t)
		 ro-mode)
	       ro-mode))))
    ((tcp)
     (if (and runremote
	      (tt-ro-mode-checked runremote))
	 (tt-ro-mode runremote)
	 (let* ((mtcfgfile  (conc *toppath* "/megatest.config"))
		(ro-mode (not (file-write-access? mtcfgfile)))) ;; TODO: use dbstruct or runremote to figure this out in future
	   (if runremote
	       (begin
		 (tt-ro-mode-set! runremote ro-mode)
		 (tt-ro-mode-checked-set! runremote #t)
		 ro-mode)
	       ro-mode))))))

(define (extras-readonly-mode rmt-mutex log-port cmd params)
  (mutex-unlock! rmt-mutex)
  (debug:print-info 12 log-port "rmt:send-receive, case 3")
  (debug:print 0 log-port "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
  #f)

Modified tcp-transportmod.scm from [050a577392] to [4e9dddfe4d].

92
93
94
95
96
97
98


99
100
101
102
103
104
105
  (conn         #f)
  (cleanup-proc #f)
  (handler      #f) ;; receives data and responds
  (socket       #f)
  (thread       #f)
  (host-port    #f)
  (cmd-thread   #f)


  (last-access  (current-seconds))
  )

(define (tt:make-remote areapath)
  (make-tt areapath: areapath))

;; do all the busy work of finding and setting up conn for







>
>







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
  (conn         #f)
  (cleanup-proc #f)
  (handler      #f) ;; receives data and responds
  (socket       #f)
  (thread       #f)
  (host-port    #f)
  (cmd-thread   #f)
  (ro-mode      #f)
  (ro-mode-checked #f)
  (last-access  (current-seconds))
  )

(define (tt:make-remote areapath)
  (make-tt areapath: areapath))

;; do all the busy work of finding and setting up conn for
177
178
179
180
181
182
183





184
185
186
187
188
189
190
191
	       ((loaded)
		(debug:print 0 *default-log-port* "WARNING: server is loaded, will try again in a second.")
		(thread-sleep! 1)
		(tt:handler  ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
	       (else
		result)))
	    (else





	     (assert #f "FATAL: tt:handler received bad data "res))))
	(begin
	  (thread-sleep! 1) ;; give it a rest and try again
	  (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))

	;; no conn yet, find and or start and find a server
;; 	(let* ((server (tt:find-server ttdat dbfname)))
;; 	  (if server







>
>
>
>
>
|







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
	       ((loaded)
		(debug:print 0 *default-log-port* "WARNING: server is loaded, will try again in a second.")
		(thread-sleep! 1)
		(tt:handler  ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
	       (else
		result)))
	    (else
	     (if (not res)
		 (begin ;; server likely died
		   (hash-table-set! (tt-conns ttdat) dbfname #f)
		   (debug:print 0 *default-log-port* "INFO: connection to server broken, reconnecting.")
		   (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
		 (assert #f "FATAL: tt:handler received bad data "res)))))
	(begin
	  (thread-sleep! 1) ;; give it a rest and try again
	  (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))

	;; no conn yet, find and or start and find a server
;; 	(let* ((server (tt:find-server ttdat dbfname)))
;; 	  (if server