293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
|
-
-
-
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname cmd params)
(let* ((conn (rmt:get-conn remote apath dbname)))
(assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
(rmt:send-receive-setup conn)
(let* ((key #f)
(payload (sexpr->string `((cmd . ,cmd)
(key . ,(rmt:conn-srvpkt conn))
(params . ,params))))
(payload `((cmd . ,cmd)
(key . ,(rmt:conn-srvpkt conn))
(params . ,params)))
(res (begin
(write payload (rmt:conn-outport conn))
(with-input-from-port
(rmt:conn-inport conn)
read-string))))
(if (string? res)
(string->sexpr res)
res))))
read))))
res)))
;; (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
;;
(define (rmt:send-receive-server-start remote apath dbname)
(let* ((conn (rmt:get-conn remote apath dbname)))
(assert conn "FATAL: Unable to connect to db "apath"/"dbname)
#;(let* ((res (with-input-from-request
(rmt:conn->uri conn "api")
`((params . (,apath ,dbname)))
read-string)))
(string->sexpr res))))
;; (define (rmt:send-receive-server-start remote apath dbname)
;; (let* ((conn (rmt:get-conn remote apath dbname)))
;; (assert conn "FATAL: Unable to connect to db "apath"/"dbname)
;; #;(let* ((res (with-input-from-request
;; (rmt:conn->uri conn "api")
;; `((params . (,apath ,dbname)))
;; read-string)))
;; (string->sexpr res))))
(define (rmt:print-db-stats)
(let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
(debug:print 18 *default-log-port* "DB Stats\n========")
(debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
(for-each (lambda (cmd)
(let ((cmd-dat (hash-table-ref *db-stats* cmd)))
|
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
|
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
|
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(servdat-host-set! *server-info* ipaddrstr)
(servdat-port-set! *server-info* port)
(servdat-status-set! *server-info* 'trying-port)
(servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
(set! *server-info* (make-servdat host: ipaddrstr port: port)))
(let* ((l (rmt:try-start-server ipaddrstr port))
(dbstruct #f))
(let oloop ()
(let-values (((i o) (tcp-accept l)))
;; (write-line "Hello!" o)
(let loop ((indat (read i)))
(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)))))
(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"))))))
|
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
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
|
1805
1806
1807
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
1840
1841
1842
|
-
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
(tcp-connect host port))))
(if (and i o)
(begin
(write `((cmd . ping)
(key . ,key)
(params . ())) o)
(let ((res (with-input-from-port i
read-string)))
read)))
(close-output-port o)
(close-input-port i)
res))
(if (string? res)
(string->sexpr res)
res)))
;; (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
(conc "http://"host":"port"/loop-test")
`((data . ,payload))
read-string)))
(string->sexpr res))
#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
;; (conc "http://"host":"port"/loop-test")
;; `((data . ,payload))
;; read-string)))
;; (string->sexpr res))
;; #f
)
|