Megatest

Check-in [eec8d1d26e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Basic communication and server starting working.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-ck5
Files: files | file ages | folders
SHA1: eec8d1d26e394cf2fe6cbbadebad5b60f735807c
User & Date: matt on 2021-05-14 06:30:52
Other Links: branch diff | manifest | tags
Context
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
06:02
wip check-in: 4fdbc16a0c user: matt tags: v1.6584-ck5
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified apimod.scm from [1fc312f537] to [fc2d6a4da7].

︙
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

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








-
+
+







-
+
-
-
-
-
+
+




-
-
-
-
-
-
-
-
-
+


-
+



;;                 api:process-request
;;                    db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct $) ;; the $ is the request vars proc
  (debug:print 0 *default-log-port* "server-id:"  *server-id*)
  (let* ((cmd     ($ 'cmd))
  (let* ((cmd-in  ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (string->sexpr ($ 'params)))
         (key     ($ 'key))    ;; TODO - add this back
	 )
    (debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key)
    (if (equal? key "nokey") ;; *server-id*) ;; TODO - get real key involved
	(begin
	  (set! *api-process-request-count* (+ *api-process-request-count* 1))
	  (let* ((resdat  (api:execute-requests dbstruct (vector cmd params))) ;; process the request, resdat = #( flag result )
	  (let* ((res (api:execute-requests dbstruct cmd params))) 
		 (success (vector-ref resdat 0))
		 (res     (vector-ref resdat 1))) ;; (vector flag payload), get the payload, ignore the flag (why?)
	    (debug:print 4 *default-log-port* "res:" res)
	    (if (not success)
	    (debug:print 0 *default-log-port* "res:" res)
	    #;(if (not success)
		(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
	    (if (> *api-process-request-count* *max-api-process-requests*)
		(set! *max-api-process-requests* *api-process-request-count*))
	    (set! *api-process-request-count* (- *api-process-request-count* 1))
	    ;; This can be here but needs controls to ensure it doesn't run more than every 4 seconds
	    ;; (rmt:dat->json-str
	    ;;  (if (or (string? res)
	    ;;          (list?   res)
	    ;;          (number? res)
	    ;;          (boolean? res))
	    ;;      res 
	    ;;      (list "ERROR, not string, list, number or boolean" 1 cmd params res)))))
	    (db:obj->string res transport: 'http)))
	    (sexpr->string res)))
	(begin
	  (debug:print 0 *default-log-port*   "Server refused to process request. Sever id mismatch. recived " key " expected:  " *server-id* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	  (db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http)))))
	  (sexpr->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*))))))

)

Modified fullrununit.sh from [9bd1a1d378] to [a13af07ac4]. 

1
2
3
4
5


6

1
2
3


4
5
6




-
-
+
+


#!/bin/bash

(killall mtest -v;sleep 1;killall mtest -v -9;rm tests/simplerun/logs/*;rm tests/basicserver.log) &
ck5 make install
wait 
ck5 make install &&
wait  &&
ck5 make unit

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

︙
244
245
246
247
248
249
250
251

252
253
254
255
256
257
258

244
245
246
247
248
249
250

251
252
253
254
255
256
257
258








-
+








    (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 mainconn "querykeyhere" 'get-server `(,apath ,dbname))))
	(let* ((res (rmt:send-receive 'get-server #f `(,apath ,dbname))))
	  (print "rmt:general-open-connection got res="res)
	  res))))
	  

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

;; Defaults to
︙

Modified tests/unittests/basicserver.scm from [3c2174c06a] to [16c2075b66].

︙
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

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








-
-
+
+


















-
+

-
-
-
-
+
+
+
+




-
+








;;  ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(import rmtmod trace http-transportmod http-client apimod dbmod)
(trace-call-sites #t)
(trace
 ;; db:get-dbdat
 ;; rmt:find-main-server
 rmt:send-receive-real
 sexpr->string
 ;; rmt:send-receive-real
 ;; sexpr->string
 )

(test #f #t (rmt:remote? (let ((r (make-rmt:remote)))
			   (set! *rmt:remote* r)
			   r)))
(test #f #f (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))
(test #f #f (rmt:find-main-server *toppath* ".db/main.db"))
(test #f #t (rmt:open-main-connection *rmt:remote* *toppath*))
(pp (hash-table->alist (rmt:remote-conns *rmt:remote*)))
(test #f #t (rmt:conn? (rmt:get-connection *rmt:remote* *toppath* ".db/main.db")))

(define *main*  (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))

(for-each (lambda (tdat)
	    (test #f tdat (loop-test (rmt:conn-ipaddr *main*)
				     (rmt:conn-port *main*) tdat)))
	  (list 'a
		'(a "b" 123 1.23 )))
(test #f #f (rmt:send-receive 'ping #f 'hello))
(test #f #t (number? (rmt:send-receive 'ping #f 'hello)))
(trace
 rmt:send-receive
 with-input-from-request
 rmt:get-connection
 with-input-from-request
 ;; rmt:send-receive
 ;; with-input-from-request
 ;; 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 #f (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))
(test #f 'server-started (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))

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

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

This page was generated in about 0.136s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00