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

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

	 (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 )
		 (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* "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)))
	(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)))))

)








|
>







|
<
<
|
|




<
<
<
<
<
<
<
<
|


|



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-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* ((res (api:execute-requests dbstruct cmd params))) 


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








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

#!/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 unit




|
|


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 unit

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

︙︙
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))))
	  (print "rmt:general-open-connection got res="res)
	  res))))
	  

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

;; Defaults to 








|








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

;;  ./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
 )

(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))
(trace
 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"))

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

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








|
|


















|

|
|
|
|




|








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
 )

(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 #t (number? (rmt:send-receive 'ping #f 'hello)))
(trace
 ;; 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 '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.122s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00