Overview
Context
Changes
Modified apimod.scm
from [d0ed8f0a49]
to [dab49c5a9c].
︙ | | |
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) (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 rmtmod.scm
from [fb260a632c]
to [622fc59774].
︙ | | |
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
-
-
+
+
+
-
+
|
;; S U P P O R T F U N C T I O N S
;;======================================================================
;; set up the api proc, seems like there should be a better place for this?
;;
;; IS THIS NEEDED ANYMORE? TODO - REMOVE IF POSSIBLE
;;
(define api-proc (make-parameter conc))
(api-proc api:execute-requests)
;; (define api-proc (make-parameter conc))
;; (api-proc api:execute-requests)
;; do we have a connection to apath dbname and
;; is it not expired? then return it
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
(define (rmt:get-conn remdat apath dbname)
(let* ((fullname (db:dbname->path apath dbname))
(conn (hash-table-ref/default (servdat-conns remdat) fullname #f)))
(if (and conn
(< (current-seconds) (conndat-expires conn)))
conn
#f ;; TODO - convert this to a refresh for the given db? (server could have moved)
#f)))
)))
(define (rmt:find-main-server uconn apath dbname)
(let* ((pktsdir (get-pkts-dir apath))
(all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
;; (dbpath (conc apath "/" dbname))
(viable-srvs (get-viable-servers all-srvpkts dbname)))
(get-the-server uconn apath viable-srvs)))
|
︙ | | |
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
-
+
+
|
(the-srv (rmt:find-main-server myconn apath dbname))
(start-main-srv (lambda () ;; call IF there is no the-srv found
(mutex-lock! *connstart-mutex*)
(if (> (- (current-seconds) *last-main-start*) 5) ;; at least four seconds since last attempt to start main server
(begin
(api:run-server-process apath dbname)
(set! *last-main-start* (current-seconds))
(thread-sleep! 1)))
(thread-sleep! 1))
(thread-sleep! 0.25))
(mutex-unlock! *connstart-mutex*)
(rmt:open-main-connection remdat apath) ;; TODO: Add limit to number of tries
)))
(if (not the-srv) ;; have server, try connecting to it
(start-main-srv)
(let* ((srv-addr (server-address the-srv)) ;; need serv
(ipaddr (alist-ref 'ipaddr the-srv))
|
︙ | | |
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
-
-
+
+
-
+
+
-
+
-
+
|
(if rid (rmt:general-open-connection sinfo apath dbname))
(rmt:send-receive-real sinfo apath dbname 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 sinfo apath dbname cmd params)
(let* ((conn (rmt:get-conn sinfo apath dbname)))
(assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
(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 conn))
(key . ,(conndat-srvkey cdat))
(params . ,params)))
(uconn (servdat-uconn sinfo))
(res (send-receive conn cmd payload)))
(res (send-receive uconn (conndat-hostport cdat) cmd payload)))
(if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
#f
(string->sexpr res)))))
res))))
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
;; Purpose - call the main.db server and request a server be started
;; for the given area path and dbname
;;
|
︙ | | |
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
|
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
|
+
-
+
|
(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 params))))
(api:execute-requests *dbstruct-db* cmd prms #;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)
|
︙ | | |
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
|
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
|
-
+
|
(define (server-ready? uconn host-port key) ;; server-address is host:port
(let* ((data (sexpr->string `((cmd . ping)
(key . ,key)
(params . ()))))
(res (send-receive uconn host-port 'ping data)))
(if res
(string->sexpr res)
(car res)
res)))
; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each
;; in the list of pkts returned
;;
(define (get-viable-servers serv-pkts dbpath)
|
︙ | | |
Modified tests/unittests/basicserver.scm
from [621aa95c92]
to [eb62de6943].
︙ | | |
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
68
69
70
71
72
73
74
75
76
77
78
79
80
|
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
-
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)
(import rmtmod trace http-client apimod dbmod
launchmod srfi-69 ulex system-information)
(trace-call-sites #t)
(trace
get-the-server
;; get-the-server
;; db:get-dbdat
;; rmt:find-main-server
rmt:find-main-server
;; rmt:send-receive-real
;; rmt:send-receive
;; sexpr->string
server-ready?
;; rmt:register-server
api:run-server-process
rmt:open-main-connection
;; rmt:general-open-connection
;; rmt:get-conny
;; common:watchdog
;; rmt:find-main-server
;; get-all-server-pkts
;; get-viable-servers
;; get-best-candidate
;; api:run-server-process
;; rmt:run
;; rmt:try-start-server
;;
;; ulex
;;
wait-and-close
run-listener
;; wait-and-close
;; run-listener
)
(define-syntax run-in-thread
(syntax-rules ()
((_ body ...)
(let ((th1 (make-thread (lambda ()
body ...)
"the thread")))
(thread-start! th1)
(thread-join! th1)))))
(test #f #t (servdat? (let ((s (make-servdat)))
(set! *servdat* s)
s)))
(test #f #f (rmt:get-conn *servdat* *toppath* ".db/main.db"))
(test #f #f (rmt:find-main-server *servdat* *toppath* ".db/main.db"))
(define th1 (make-thread (lambda ()
(rmt:run (get-host-name)))
"rmt:run thread"))
(thread-start! th1)
(thread-sleep! 0.5) ;; give things some time to get going
;; switch to *db-serv-info* instead of *servdat*
(define *uconn* (servdat-uconn *db-serv-info*))
(print "*uconn*: " *uconn*)
(test #f #t (ulex-listener? (servdat-uconn *db-serv-info*)))
(test #f #t (string? (udat-host-port *uconn*)))
(run-in-thread
(test #f #t (server-ready? *db-serv-dat* (udat-host-port *db-serv-dat*)))
(test #f #t (server-ready? *uconn* (udat-host-port *uconn*) (servdat-uuid *db-serv-info*))))
(test #f #t (rmt:open-main-connection *db-serv-info* *toppath*))
;; (pp (hash-table->alist (remotedat-conns *db-serv-info*)))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(exit)
(define *main* (rmt:get-conn *db-serv-info* *toppath* ".db/main.db"))
|
︙ | | |
Modified ulex/ulex.scm
from [f7e86349bb]
to [afccb56e89].
︙ | | |
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
+
+
|
;; NOTES:
;; Why sql-de-lite and not say, dbi? - performance mostly, then simplicity.
;;
;;======================================================================
(module ulex
(
;; NOTE: looking for the handler proc - find the run-listener :)
run-listener ;; (run-listener handler-proc [port]) => uconn
;; NOTE: handler-proc params;
;; (handler-proc rem-host-port qrykey cmd params)
send-receive ;; (send-receive uconn host-port cmd data)
|
︙ | | |