| ︙ | | | ︙ | |
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
chicken.port
chicken.pretty-print
chicken.process
chicken.process-context
chicken.process-context.posix
chicken.sort
chicken.string
chicken.tcp chicken.random
|
>
|
|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
chicken.port
chicken.pretty-print
chicken.process
chicken.process-context
chicken.process-context.posix
chicken.sort
chicken.string
;; chicken.tcp
chicken.random
chicken.time
chicken.time.posix
(prefix sqlite3 sqlite3:)
directory-utils
;; http-client
;; intarweb
|
| ︙ | | | ︙ | |
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
|
(conns *rmt:remote*)
(dbname (db:run-id->dbname rid)))
(rmt:general-open-connection conns apath dbname)
(rmt:send-receive-real conns apath dbname cmd params)))
(define (rmt:send-receive-setup conn)
(if (not (rmt:conn-inport conn))
(let-values ((i o) (tcp-connect (rmt:conn-ipaddr conn)
(rmt:conn-port port)))
(rmt:conn-inport-set! conn i)
(rmt:conn-outport-set! conn o))))
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname cmd params)
|
|
|
|
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
(conns *rmt:remote*)
(dbname (db:run-id->dbname rid)))
(rmt:general-open-connection conns apath dbname)
(rmt:send-receive-real conns apath dbname cmd params)))
(define (rmt:send-receive-setup conn)
(if (not (rmt:conn-inport conn))
(let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
(rmt:conn-port conn))))
(rmt:conn-inport-set! conn i)
(rmt:conn-outport-set! conn o))))
;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname cmd params)
|
| ︙ | | | ︙ | |
294
295
296
297
298
299
300
301
302
303
304
305
306
307
|
(write payload (rmt:conn-outport conn))
(with-input-from-port
(rmt:conn-inport conn)
read-string))))
(if (string? res)
(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
;;
|
>
>
|
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
(write payload (rmt:conn-outport conn))
(with-input-from-port
(rmt:conn-inport conn)
read-string))))
(if (string? res)
(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
;;
|
| ︙ | | | ︙ | |
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
|
all-pkt-files)))
(define (server-address srv-pkt)
(conc (alist-ref 'host srv-pkt) ":"
(alist-ref 'port srv-pkt)))
(define (server-ready? host port key) ;; server-address is host:port
;; ping the server and ask it
;; if it ready
;; (let* ((sdat (servdat-init #f host port #f)))
;; (http-transport:send-receive sdat "abc" 'ping '())))
#;(let* ((res (with-input-from-request
(conc "http://"host":"port"/ping") ;; returns *toppath*/dbname
#f
read-string)))
(if (equal? res key)
#t
(begin
(debug:print-info 0 *default-log-port* "server-ready? key="key", received="res)
#f)))
#f
)
(define (loop-test host port data) ;; server-address is host:port
;; ping the server and ask it
;; if it ready
;; (let* ((sdat (servdat-init #f host port #f)))
;; (http-transport:send-receive sdat "abc" 'ping '())))
#;(let* ((payload (sexpr->string data))
(res (with-input-from-request
|
|
>
|
|
>
>
|
|
>
|
<
<
|
>
>
|
|
>
|
|
|
|
<
<
<
|
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
|
all-pkt-files)))
(define (server-address srv-pkt)
(conc (alist-ref 'host srv-pkt) ":"
(alist-ref 'port srv-pkt)))
(define (server-ready? host port key) ;; server-address is host:port
(let-values (((i o)(handle-exceptions
exn
(values #f #f)
(tcp-connect host port))))
(if (and i o)
(begin
(write `((cmd . ping)
(key . ,key)
(params . ())) o)
(let ((res (with-input-from-port i
read)))
(close-output-port o)
(close-input-port i)
(if (string? res)
(string->sexpr res)
res)))
(begin ;; connection failed
(debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.")
#f))))
(define (loop-test host port data) ;; server-address is host:port
;; ping the server and ask it
;; if it ready
;; (let* ((sdat (servdat-init #f host port #f)))
;; (http-transport:send-receive sdat "abc" 'ping '())))
#;(let* ((payload (sexpr->string data))
(res (with-input-from-request
|
| ︙ | | | ︙ | |