Megatest

Check-in [db4714b500]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-ck5
Files: files | file ages | folders
SHA1: db4714b50016a3472edf6ba0c2fbbe340bb9679d
User & Date: matt on 2021-05-15 21:57:19
Other Links: branch diff | manifest | tags
Context
2021-05-16
23:22
wip check-in: 58cf8acf44 user: matt tags: v1.6584-ck5
2021-05-15
21:57
wip check-in: db4714b500 user: matt tags: v1.6584-ck5
2021-05-14
06:30
Basic communication and server starting working. check-in: eec8d1d26e user: matt tags: v1.6584-ck5
Changes

Modified commonmod.scm from [89d0b29ed8] to [69a8ca9141].

1244
1245
1246
1247
1248
1249
1250
1251

1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1244
1245
1246
1247
1248
1249
1250

1251





1252
1253
1254
1255
1256
1257
1258







-
+
-
-
-
-
-







;;                    R U N N A M E    A N D   T E S T P A T T
;;======================================================================

;;======================================================================
;; (map print (map car (hash-table->alist (configf:read-config "runconfigs.config" #f #t))))
;;
(define (common:get-runconfig-targets configf) ;; #!key (configf #f))
  (let ((targs       (sort (map car (hash-table->alist configf
  (let ((targs       (sort (map car (hash-table->alist configf))
						       #;(or configf ;; NOTE: There is no value in using runconfig:read here.
					 (configf:read-config (conc *toppath* "/runconfigs.config")
						      #f #t)
						       (make-hash-table))
						       ))
			   string<?))
	(target-patt (args:get-arg "-target")))
    (if target-patt
	(filter (lambda (x)
		  (patt-list-match x target-patt))
		targs)
	targs)))
3778
3779
3780
3781
3782
3783
3784





3785
3786


3787
3788
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784


3785
3786
3787
3788







+
+
+
+
+
-
-
+
+


    

(define (sexpr->string data)
  (with-output-to-string
    (lambda ()(write data))))

(define (string->sexpr instr)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "ERROR: string->sexpr bad input \""instr"\"")
     #f)
  (with-input-from-string instr
      (lambda ()(read))))
   (with-input-from-string instr
     (lambda ()(read)))))

)

Modified megatest.scm from [299bf0c06c] to [3e262da95d].

1197
1198
1199
1200
1201
1202
1203

1204

1205
1206
1207
1208
1209
1210
1211
1197
1198
1199
1200
1201
1202
1203
1204

1205
1206
1207
1208
1209
1210
1211
1212







+
-
+







     
     ;;======================================================================
     ;; Weird special calls that need to run *after* the server has started?
     ;;======================================================================
     
     (if (args:get-arg "-list-targets")
         (if (launch:setup)
             (let* ((rconfdat (configf:read-config (conc *toppath* "/runconfigs.config") #f #f))
             (let ((targets (common:get-runconfig-targets)))
		    (targets  (common:get-runconfig-targets rconfdat)))
               ;; (debug:print 1 *default-log-port* "Found "(length targets) " targets")
               (case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
                 ((alist)
                  (for-each (lambda (x)
                              ;; (print "[" x "]"))
                              (print x))
                            targets))

Modified rmtmod.scm from [1bce58e61d] to [f26d9abd38].

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
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







-
+







-
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	      (start-main-srv)))
	(start-main-srv))))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname)
  (let  ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
    (debug:print 0 *default-log-port* "remote: " remote)
    ;; (debug:print 0 *default-log-port* "remote: " remote)
    (if (not mainconn)
	(begin
	  (rmt:open-main-connection remote apath)
	  (thread-sleep! 1)
	  (rmt:general-open-connection remote apath dbname))
	;; we have a connection to main, ask for contact info for dbname
	(let* ((res (rmt:send-receive 'get-server #f `(,apath ,dbname))))
	  (print "rmt:general-open-connection got res="res)
	  ;; (print "rmt:general-open-connection got res="res)
	  res))))
	  

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

;; Defaults to 
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath *toppath*)
	 (conns *rmt:remote*)
	 (dbname (db:run-id->dbname rid)))
    (rmt:send-receive-real conns apath dbname rid cmd params)))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname rid cmd params)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)
    (let* (;; (host    (rmt:conn-ipaddr conn))
	   ;; (port    (rmt:conn-port   conn))
	   (payload (sexpr->string params))
	   (res      (with-input-from-request
		      (rmt:conn->uri conn "api")
		      `((params . ,payload)
			(cmd    . ,cmd)
			(key    . "nokey"))
		      read-string)))
      (if (string? res)
	  (string->sexpr res)
	  res))))
    (if conn
	(let* (;; (host    (rmt:conn-ipaddr conn))
	       ;; (port    (rmt:conn-port   conn))
	       (payload (sexpr->string params))
	       (res      (with-input-from-request
			  (rmt:conn->uri conn "api")
			  `((params . ,payload)
			    (cmd    . ,cmd)
			    (key    . "nokey"))
			  read-string)))
	  (if (string? res)
	      (string->sexpr res)
	      res))
	;; no conn yet, start it up
	(begin
	  (rmt:general-open-connection remote apath dbname)
	  (rmt:send-receive-real remote apath dbname rid cmd params)))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-server-start remote apath dbname)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)

Modified tests/unittests/basicserver.scm from [16c2075b66] to [983ffc6ad7].

54
55
56
57
58
59
60

61
62
63
64
65
66
67
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68







+







 ;; rmt:get-connection
 ;; with-input-from-request
 )

(define *db* (db:setup #f))
(test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/1.db")))
(test #f 'server-started (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))

;; (delete-file* "logs/1.log")
;; (define run-id 1)

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;;