Megatest

Check-in [189ea047e6]
Login
Overview
Comment:inching along From: 906bf1567ca42c413f55f2d6de4536e1d59b6e6a User: matt
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-real-ulex
Files: files | file ages | folders
SHA1: 189ea047e61531ec4114c36e62453f1005403d10
User & Date: matt on 2021-02-25 23:13:35
Other Links: branch diff | manifest | tags
Context
2021-02-25
23:13
Merged From: c9e7ad931c72263e94091a00ed4658a259f45133 User: matt check-in: bdde41cc25 user: matt tags: v1.65-real-ulex (unpublished)
23:13
inching along From: 906bf1567ca42c413f55f2d6de4536e1d59b6e6a User: matt check-in: 189ea047e6 user: matt tags: v1.65-real-ulex (unpublished)
23:13
Bits 'n pieces in place From: e2202d843d0604d3d779f23a459dd36944dbcbe9 User: matt check-in: 548d6b2301 user: matt tags: v1.65-real-ulex (unpublished)
Changes

Modified Makefile from [491e5b8dd8] to [abf8b80357].

148
149
150
151
152
153
154




155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
	mkdir -p $(PREFIX)/share/db
	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql

# Special dependencies for the includes
$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm





# common.o : mofiles/commonmod.o megatest-fossil-hash.scm
mofiles/dbmod.o : mofiles/configfmod.o

# commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm

tests.o db.o launch.o runs.o dashboard-tests.o				\
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm


tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm

db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm

tests.o tasks.o dashboard-tasks.o : task_records.scm








>
>
>
>








>







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
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
	mkdir -p $(PREFIX)/share/db
	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql

# Special dependencies for the includes
$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm

#======================================================================
# Other deps
#======================================================================

# common.o : mofiles/commonmod.o megatest-fossil-hash.scm
mofiles/dbmod.o : mofiles/configfmod.o

# commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm

tests.o db.o launch.o runs.o dashboard-tests.o				\
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm
mofiles/ulex.o : ulex/ulex.scm

tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm

db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm

tests.o tasks.o dashboard-tasks.o : task_records.scm

Modified rmt.scm from [2916ff98b8] to [a04ff08cec].

22
23
24
25
26
27
28



29
30
31
32
33
34
35

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses rmtmod))
(import (prefix rmtmod rmtmod:))




(include "common_records.scm")
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;







>
>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses rmtmod))
(import (prefix rmtmod rmtmod:))

(declare (uses ulex))
(import (prefix ulex ulex:))

(include "common_records.scm")
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
53
54
55
56
57
58
59


60
61
62
63
64
65
66
67
68
69
		  (client:setup areapath)
		  #f))))

;;======================================================================

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



(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (equal? (configf:lookup *configdat* "setup" "newapi") "yes")
      (rmtmod:send-receive cmd rid params attemptnum: 1 area-dat: #f)
      (rmt:send-receive-orig cmd rid params attemptnum: 1 area-dat: #f)))

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive-orig cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected

  #;(common:telemetry-log (conc "rmt:"(->string cmd))







>
>


|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
		  (client:setup areapath)
		  #f))))

;;======================================================================

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

(define *alldat* (rmtmod:create-alldat *toppath*))
  
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (equal? (configf:lookup *configdat* "setup" "newapi") "yes")
      (rmtmod:send-receive *alldat* cmd rid params)
      (rmt:send-receive-orig cmd rid params attemptnum: 1 area-dat: #f)))

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive-orig cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected

  #;(common:telemetry-log (conc "rmt:"(->string cmd))

Modified rmtmod.scm from [1e1492e5ec] to [a257f8d50c].

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
;; (include "ulex/ulex.scm")

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)

(import (prefix ulex ulex:))

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )



(define (send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))




  (print "Got here.")





  (exit))





;;======================================================================
;; return the handle struct for sending queries to a specific database
;;  - initializes the connection object if this is the first access
;;    - finds the "captain" and asks who to talk to for the given dbfname
;;    - establishes the connection to the current dbowner
;;







|




|


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







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
;; (include "ulex/ulex.scm")

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(use tcp6)
(import (prefix ulex ulex:))

(defstruct alldat
  (areapath #f)
  (ulexdat  (ulex:make-udat))
  )

;; create-alldat also sets up our tcp server
;;
(define (create-alldat areapath)
  (let* ((adat (make-alldat))
	 (udat (alldat-ulexdat adat)))
    (alldat-areapath-set! adat areapath)
    (if (not (ulex:start-server-find-port udat (+ 4242 (random 5000))))
	(print "Server NOT started properly"))
    (thread-start! (make-thread
		    (lambda ()
		      (ulex:ulex-handler-loop udat))
		    "Ulex handler loop thread"))
    ;; exit handler needed here
    adat))

(define (send-receive adat cmd rid params)
  (let* ((dbpath (conc (alldat-areapath adat) "/dbs/" (modulo (or rid 0) 1000) ".db")))
    (ulex:remote-call (alldat-ulexdat adat) dbpath 'megatest cmd params)))

;;======================================================================
;; return the handle struct for sending queries to a specific database
;;  - initializes the connection object if this is the first access
;;    - finds the "captain" and asks who to talk to for the given dbfname
;;    - establishes the connection to the current dbowner
;;

Modified ulex/ulex.scm from [4ef1a2fa98] to [2f7fad2e95].

103
104
105
106
107
108
109
110
111
112
113
114

115

116
117
118
119
120
121
122
;;  start-server-find-port  ;; gotta have a server port ready from the very begining

;; udata    - all the connection info, captain, server, ulex db etc. MUST BE PASSED IN
;; dbpath   - full path and filename of the db to talk to or a symbol naming the db?
;; callname - the remote call to execute
;; params   - parameters to pass to the remote call
;;
(define (remote-call udata dbpath dbtype callname . params)
  (start-server-find-port udata) ;; ensure we have a local server
  (find-or-setup-captain udata)
  ;; look at connect, process-request, send, send-receive
  (let-values (((cookie-key host-port)(get-db-owner udata dbpath dbtype)))

    (send-receive udata host-port callname cookie-key params)))


;;======================================================================
;; KEY FUNCTIONS - THESE ARE TOO BE EXPOSED AND USED
;;======================================================================

;; connection setup and management functions








|




>
|
>







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
;;  start-server-find-port  ;; gotta have a server port ready from the very begining

;; udata    - all the connection info, captain, server, ulex db etc. MUST BE PASSED IN
;; dbpath   - full path and filename of the db to talk to or a symbol naming the db?
;; callname - the remote call to execute
;; params   - parameters to pass to the remote call
;;
(define (remote-call udata dbpath dbtype callname params)
  (start-server-find-port udata) ;; ensure we have a local server
  (find-or-setup-captain udata)
  ;; look at connect, process-request, send, send-receive
  (let-values (((cookie-key host-port)(get-db-owner udata dbpath dbtype)))
    (if (and cookie-key host-port)
	(send-receive udata host-port callname cookie-key params)
	#f)))

;;======================================================================
;; KEY FUNCTIONS - THESE ARE TOO BE EXPOSED AND USED
;;======================================================================

;; connection setup and management functions

211
212
213
214
215
216
217
218
219
220

221
222
223
224
225
226
227
  (let* ((host-port (udat-captain-host-port udata)))
    (if host-port
	(let* ((cookie (make-cookie udata))
	       (msg    #f) ;; (conc dbname " " dbtype))
	       (params `(,dbname ,dbtype))
	       (res    (send udata host-port 'db-owner cookie msg
			     params: params retval: #t)))
	  (match (string-split res)
	    ((retcookie owner-host-port)
	     (values (equal? retcookie cookie) owner-host-port))))

	(values #f -1))))

;; called in ulex-handler to dispatch work, called on the workers side
;;     calls (proc params data)
;;     returns result with cookie
;;
;; pdat is the info of the caller, used to send the result data







|

|
>







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
  (let* ((host-port (udat-captain-host-port udata)))
    (if host-port
	(let* ((cookie (make-cookie udata))
	       (msg    #f) ;; (conc dbname " " dbtype))
	       (params `(,dbname ,dbtype))
	       (res    (send udata host-port 'db-owner cookie msg
			     params: params retval: #t)))
	  (match (and res (string-split res))
	    ((retcookie owner-host-port)
	     (values (equal? retcookie cookie) owner-host-port))
	    (else (values #f #f))))
	(values #f -1))))

;; called in ulex-handler to dispatch work, called on the workers side
;;     calls (proc params data)
;;     returns result with cookie
;;
;; pdat is the info of the caller, used to send the result data
538
539
540
541
542
543
544


545
546
547
548
549
550
551
	  (udat-my-port    udata) "-"
	  (udat-my-pid     udata) "-"
	  newcnum)))

;; create a tcp listener and return a populated udat struct with
;; my port, address, hostname, pid etc.
;; return #f if fail to find a port to allocate.


;;
;;  if udata-in is #f create the record
;;  if there is already a serv-listener return the udata
;;
(define (start-server-find-port udata-in #!optional (port 4242)(tries 0))
  (let ((udata (or udata-in (make-udat))))
    (if (udat-serv-listener udata) ;; TODO - add check that the listener is alive and ready?







>
>







541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
	  (udat-my-port    udata) "-"
	  (udat-my-pid     udata) "-"
	  newcnum)))

;; create a tcp listener and return a populated udat struct with
;; my port, address, hostname, pid etc.
;; return #f if fail to find a port to allocate.
;;
;;  does not actually start a server thread
;;
;;  if udata-in is #f create the record
;;  if there is already a serv-listener return the udata
;;
(define (start-server-find-port udata-in #!optional (port 4242)(tries 0))
  (let ((udata (or udata-in (make-udat))))
    (if (udat-serv-listener udata) ;; TODO - add check that the listener is alive and ready?