Megatest

Check-in [906bf1567c]
Login
Overview
Comment:inching along
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-ulex-try-again
Files: files | file ages | folders
SHA1: 906bf1567ca42c413f55f2d6de4536e1d59b6e6a
User & Date: matt on 2020-12-29 22:42:32
Other Links: branch diff | manifest | tags
Context
2021-01-04
19:39
Merged check-in: c9e7ad931c user: matt tags: v1.65-ulex-try-again
2020-12-29
22:42
inching along check-in: 906bf1567c user: matt tags: v1.65-ulex-try-again
16:17
Bits 'n pieces in place check-in: e2202d843d user: matt tags: v1.65-ulex-try-again
Changes

Modified Makefile from [609c0953bd] to [06f063c13d].

149
150
151
152
153
154
155




156
157
158
159
160
161
162

163
164
165
166
167
168
169
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

# 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 [6371548b92] to [33a3766d63].

22
23
24
25
26
27
28



29
30
31
32
33
34
35
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")
(include "db_records.scm")

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

72
73
74
75
76
77
78


79
80
81

82
83
84
85
86
87
88
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93







+
+


-
+







      (debug:print 0 *default-log-port* "query rest needed. blocking for 0.1 second. cmd="cmd", run id="rid", params="params)
      (thread-sleep! 0.1) ;; force a rest of a half second
      (set! *rmt-query-last-rest-time* now)
      (set! *rmt-query-last-call-time* now))
     (else ;; sufficient rests have occurred, just record the last query time
      (set! *rmt-query-last-call-time* now)))))

(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 cmd rid params attemptnum: 1 area-dat: #f)
      (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 [34e0576798] to [b05939ffa8].

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
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  #f)
  (ulexdat  (ulex:make-udat))
  )

;; create-alldat also sets up our tcp server
;;
(define (send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (print "Got here.")
  (exit))
(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
;;
#;(define (rmt:connect alldat dbfname dbtype)

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
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)
(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)))
	(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
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 (string-split res)
	  (match (and res (string-split res))
	    ((retcookie owner-host-port)
	     (values (equal? retcookie cookie) 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
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?