Megatest

Check-in [2f2d804be0]
Login
Overview
Comment:main.db and <run>.db servers working with ulex
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 2f2d804be032d3ecdb6649b8373c05336f472072
User & Date: matt on 2022-01-03 12:01:45
Other Links: branch diff | manifest | tags
Context
2022-01-03
17:38
wip. rmt:get-keys now works check-in: 3541d27302 user: matt tags: v2.0001
12:01
main.db and <run>.db servers working with ulex check-in: 2f2d804be0 user: matt tags: v2.0001
09:34
wip check-in: db564d80d9 user: matt tags: v2.0001
Changes

Modified apimod.scm from [dab49c5a9c] to [97d3b608d8].

372
373
374
375
376
377
378
379

380
381
382
383
384
385
386
372
373
374
375
376
377
378

379
380
381
382
383
384
385
386







-
+







    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
					  (run-id     (cadr params))
					  (realparams (cddr params)))
				      (db:general-call dbstruct stmtname run-id realparams)))
    ((sdb-qry)                      (apply sdb:qry params))
    ((ping)                         `(#t ,(current-process-id) (cadr params))) ;; (current-process-id))
    ((ping)                         `(#t ,(current-process-id) ,(cadr params))) ;; (current-process-id))
    ((get-changed-record-ids)       (apply db:get-changed-record-ids dbstruct params))
    ((get-run-record-ids) 	   (apply db:get-run-record-ids dbstruct params))	
    ;; TESTMETA
    ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))

    ;; TASKS 
    ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))

Modified megatest.scm from [b00e0e6122] to [7c052417f9].

1065
1066
1067
1068
1069
1070
1071
1072
1073




1074
1075
1076

1077
1078
1079
1080
1081
1082
1083
1065
1066
1067
1068
1069
1070
1071


1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085







-
-
+
+
+
+


-
+







     				       sheetname sectionname varname val)))
     		   (sqlite3:finalize! db)))
     		(else
     		 (pp data))))))
           (if out-file (close-output-port out-port))
           (exit) ;; yes, bending the rules here - need to exit since this is a utility
           ))
     
     (if (args:get-arg "-ping")

  ;; disabled for now
  
     #;(if (args:get-arg "-ping")
         (let* ((server-id     (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
     	   (host:port     (args:get-arg "-ping")))
           (server:ping (or server-id host:port) #f do-exit: #t)))
           (server-ready? (or server-id host:port) #f do-exit: #t)))
     
     ;;======================================================================
     ;; Capture, save and manipulate environments
     ;;======================================================================
     
     ;; NOTE: Keep these above the section where the server or client code is setup
     

Modified rmtmod.scm from [622fc59774] to [77a44ba5d3].

357
358
359
360
361
362
363
364
365
366



367
368

369
370
371
372
373
374
375
357
358
359
360
361
362
363



364
365
366
367

368
369
370
371
372
373
374
375







-
-
-
+
+
+

-
+







;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real sinfo apath dbname cmd params)
  (let* ((cdat (rmt:get-conn sinfo apath dbname)))
    (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened")
    (let* ((key     #f)
	   (payload `((cmd    . ,cmd)
		      (key    . ,(conndat-srvkey cdat))
		      (params . ,params)))
	   #;(payload `(,cmd ;; (cmd    . ,cmd)(key    .
		      ,(conndat-srvkey cdat)
		      ,params))
	   (uconn    (servdat-uconn sinfo))
	   (res      (send-receive uconn (conndat-hostport cdat) cmd payload)))
	   (res      (send-receive uconn (conndat-hostport cdat) cmd params))) ;; payload)))
      (if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
	  #f
	  res))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
1612
1613
1614
1615
1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625
1626







-
+







;; called in megatest.scm, host-port is string hostname:port
;;
;; NOTE: This is NOT called directly from clients as not all transports support a client running
;;       in the same process as the server. 
;;
;; conn is a conndat record
;;
(define (server:ping uconn #!key (do-exit #f))
#;(define (server:ping uconn #!key (do-exit #f))
  (let* ((srvkey (conndat-srvkey uconn))
	 (msg (sexpr->string '(ping ,srvkey))))
    (send-receive uconn 'ping msg))) ;; (server-ready? host port server-id))

;;======================================================================
;; http-transportmod.scm contents moved here
;;======================================================================
1645
1646
1647
1648
1649
1650
1651
1652
1653




1654
1655
1656
1657
1658
1659
1660
1645
1646
1647
1648
1649
1650
1651


1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662







-
-
+
+
+
+







  (debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...")
  (if (and *db-serv-info*
	   (servdat-uconn *db-serv-info*))
      (let* ((uconn (servdat-uconn *db-serv-info*)))
	(wait-and-close uconn))
      (let* ((port            (portlogger:open-run-close portlogger:find-port))
	     (handler-proc    (lambda (rem-host-port qrykey cmd params) ;;
				(let* ((prms (alist-ref 'params params)))
				  (api:execute-requests *dbstruct-db* cmd prms #;params)))))
				;;(let* ((prms (alist-ref 'params params)))
				;; (api:execute-requests *dbstruct-db* cmd prms)))))
				(assert (list? params) "FATAL: handler called with non-list params")
				(api:execute-requests *dbstruct-db* cmd params))))
	;; (api:process-request *dbstuct-db* 
	(if (not *db-serv-info*)
	    (set! *db-serv-info* (make-servdat host: hostn port: port)))
	(let* ((uconn (run-listener handler-proc port))
	       (rport (udat-port uconn))) ;; the real port
	  (servdat-host-set! *db-serv-info* hostn)
	  (servdat-port-set! *db-serv-info* rport)
1789
1790
1791
1792
1793
1794
1795

1796
1797
1798



1799
1800
1801
1802
1803
1804
1805
1791
1792
1793
1794
1795
1796
1797
1798



1799
1800
1801
1802
1803
1804
1805
1806
1807
1808







+
-
-
-
+
+
+







	 all-pkt-files)))

(define (server-address srv-pkt)
  (conc (alist-ref 'host srv-pkt) ":"
	(alist-ref 'port srv-pkt)))
	
(define (server-ready? uconn host-port key) ;; server-address is host:port
  (let* ((params `((cmd . ping)(key . ,key)))
  (let* ((data (sexpr->string  `((cmd . ping)
				 (key . ,key)
				 (params . ()))))
	 (data `((cmd . ping)
		 (key . ,key)
		 (params . ,params))) ;; I don't get it.
	 (res  (send-receive uconn host-port 'ping data)))
    (if res
	(car res)
	res)))

; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each

Modified ulex/ulex.scm from [d58d57adb7] to [5cd5e6659a].

148
149
150
151
152
153
154
155

156
157
158
159
160
161
162
148
149
150
151
152
153
154

155
156
157
158
159
160
161
162







-
+







    (udat-host-port-set! uconn (conc addr":"port))
    (udat-socket-set!    uconn tlsn)
    uconn))

;; run-listener does all the work of starting a listener in a thread
;; it then returns control
;;
(define (run-listener handler-proc #!optional (port-suggestion #f))
(define (run-listener handler-proc #!optional (port-suggestion 4242))
  (let* ((uconn (make-udat)))
    (udat-work-proc-set! uconn handler-proc)
    (if (setup-listener uconn port-suggestion)
	(let* ((th1 (make-thread (lambda ()(ulex-cmd-loop uconn)) "Ulex command loop"))
	       (th2 (make-thread (lambda ()(process-work-queue uconn)) "Ulex work queue processor")))
	  (thread-start! th1)
	  (thread-start! th2)
233
234
235
236
237
238
239

240
241
242
243
244
245
246
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247







+







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

;; take a request, rdat, and if not immediate put it in the work queue
;;
;; Reserved cmds; ack ping goodbye response
;;
(define (ulex-handler uconn rdat)
  (assert (list? rdat) "FATAL: ulex-handler give rdat as not list")
  (match rdat ;;  (string-split controldat)
    ((rem-host-port qrykey cmd params)
     ;; (print "ulex-handler got: "rem-host-port" qrykey: "qrykey" cmd: "cmd" params: "params)
     (let ((mbox (hash-table-ref/default (udat-mboxes uconn) qrykey #f)))
       (case cmd
	 ;; ((ack )(print "Got ack! But why? Should NOT get here.") 'ack)
	 ((ping)