Megatest

Check-in [f1e43b7b99]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Got all PASS on current tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-tcp6
Files: files | file ages | folders
SHA1: f1e43b7b993e157e03f4128c49db58fc5c5121ea
User & Date: matt on 2021-06-06 22:07:33
Other Links: branch diff | manifest | tags
Context
2021-06-06
23:58
all effed Leaf check-in: 58eed43d63 user: matt tags: v1.6584-tcp6
22:07
Got all PASS on current tests check-in: f1e43b7b99 user: matt tags: v1.6584-tcp6
05:31
removed loop-test from basicserver testsuite check-in: 7715fdf527 user: matt tags: v1.6584-tcp6
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified apimod.scm from [5af67fe46a] to [f4ca251106].

︙
409
410
411
412
413
414
415




416
417
418
419
420
421
422
423
424
425
426
427
428
429















430
431

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








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



(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
  (let* ((cmd-in  (alist-ref 'cmd indat)) ;; ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (alist-ref 'params indat))
         (key     (alist-ref 'key indat))    ;; TODO - add this back
	 )
    (debug:print 0 *default-log-port* "cmd:" cmd " with params " params ", key " key)
    (case cmd-in
      ((ping) #t)
      ;; ((quit) (exit))
      (else
    (if (equal? key *my-signature*) ;; 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:  " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	  (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))
       (if (equal? key *my-signature*) ;; 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)
	       res))
	   (begin
	     (debug:print 0 *default-log-port*   "Server refused to process request. Sever id mismatch. recived " key " expected:  " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	     (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))))

)

Modified commonmod.scm from [b07e8c5369] to [f4c84442dd].

︙
3778
3779
3780
3781
3782
3783
3784

3785
3786





3787
3788

3778
3779
3780
3781
3782
3783
3784
3785


3786
3787
3788
3789
3790
3791
3792








+
-
-
+
+
+
+
+




(define (string->sexpr instr)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "ERROR: string->sexpr bad input \""instr"\"")
     #f)
   (if (string? instr)
   (with-input-from-string instr
     read)))
       (with-input-from-string instr
	 read)
       (begin
	 (debug:print-info 0 *default-log-port* "Odd, instr is not a string: "instr)
	 instr))))

)

Modified rmtmod.scm from [0255f4aac4] to [348d9df954].

︙
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610



1611
1612
1613
1614
1615
1616
1617

1596
1597
1598
1599
1600
1601
1602








1603
1604
1605
1606
1607
1608
1609
1610
1611
1612








-
-
-
-
-
-
-
-
+
+
+








	  (let loop ((indat (read i)))
	    (if (eof-object? indat)
		(begin
		  (close-input-port i)
		  (close-output-port o)
		  (oloop))
		(let* ((res (api:process-request dbstruct indat)))
		  (case res
		    ((quit)
		     (close-input-port i)
		     (close-output-port o))
		    (else
		     (set! *db-last-access* (current-seconds))
		     (write res o)
		     (loop (read i))))))))))
		  (set! *db-last-access* (current-seconds))
		  (write res o)
		  (loop (read i))))))))
    (let* ((portnum (servdat-port *server-info*)))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))

(define (rmt:try-start-server ipaddrstr portnum)
  (if *server-info*
      (begin
︙
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952

1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948








+








		     (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
		(debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
		;; am I the best-srv, compare server-keys to know
		(if (equal? best-srv-key server-key)
		    (if (get-lock-db sdat db-file) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
			(begin
			  (debug:print 0 *default-log-port* "I'm the server!")
			  ;; (if (not *server-id*)
			  (servdat-dbfile-set! sdat db-file)
			  (servdat-status-set! sdat 'db-locked))
			(begin
			  (debug:print 0 *default-log-port* "I'm not the server, exiting.")
			  (bdat-time-to-exit-set! *bdat* #t)
			  (thread-sleep! 0.2)
			  (exit)))
︙
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043

2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040








+








  (let* ((server-start-time (current-seconds))
	 (pkts-dir          (get-pkts-dir))
	 (server-key        (rmt:mk-signature))
	 (is-main           (equal? (args:get-arg "-db") ".db/main.db"))
	 (last-access       0)
	 (server-timeout    (server:expiration-timeout)))
    ;; main and run db servers have both got wait logic (could/should merge it)
    (set! *server-id* server-key)
    (if is-main
	(http-transport:wait-for-server pkts-dir dbname server-key)
	(http-transport:wait-for-stable-interface))
    ;; this is our forever loop
    (let* ((iface             (servdat-host *server-info*))
	   (port              (servdat-port *server-info*)))
      (let loop ((count         0)
︙

Modified tests/unittests/basicserver.scm from [4f56e6ab1d] to [d1fb7365d1].

︙
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73

59
60
61
62
63
64
65

66
67
68
69
70
71
72
73








-
+








(define *main*  (rmt:get-conn *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)))
(test #f #t (rmt:send-receive 'ping #f 'hello))

(define *db* (db:setup #f))

;; these let me cut and paste from source easily
(define apath *toppath*)
(define dbname ".db/2.db")
(define remote *rmt:remote*)
︙

Modified vg.scm from [d212ba7d90] to [b7512fe253].

︙
38
39
40
41
42
43
44
45


46
47
48
49
50
51
52

38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53








-
+
+








;; (defstruct vg:lib     comps)
;; (defstruct vg:comp    objs name file)
;; ;; extents caches extents calculated on draw
;; ;; proc is called on draw and takes the obj itself as a parameter
;; ;; attrib is an alist of parameters
;; (defstruct vg:obj     type pts fill-color text line-color call-back angle font attrib extents proc)
;; (defstruct vg:inst    libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache)
;; (defstruct vg:drawing libs insts scalex scaley xoff yoff cnv cache) ;; libs: hash of name->lib, insts: hash of instname->inst
;; (defstruct vg:drawing libs insts scalex scaley xoff yoff cnv cache)
;; ;; libs: hash of name->lib, insts: hash of instname->inst

;; inits
;;
(define (vg:comp-new)
  (make-vg:comp objs: '() name: #f file: #f))

(define (vg:lib-new)
︙

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