| ︙ | | | ︙ | |
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
chicken.base
chicken.file
chicken.format
chicken.process
chicken.file.posix
chicken.process-context.posix
chicken.process-context
(prefix sqlite3 sqlite3:)
typed-records
srfi-1
srfi-13
srfi-18
srfi-69
|
>
|
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
chicken.base
chicken.file
chicken.format
chicken.process
chicken.file.posix
chicken.process-context.posix
chicken.process-context
chicken.io
(prefix sqlite3 sqlite3:)
typed-records
srfi-1
srfi-13
srfi-18
srfi-69
|
| ︙ | | | ︙ | |
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
(let ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
(if (not mainconn)
(begin
(rmt:open-main-connection remote apath)
(thread-sleep! 1)
(rmt:general-open-connection remote apath dbname))
;; we have a connection to main, ask for contact info for dbname
(let* ((res (http-transport:send-receive mainconn "x" 'get-server `(,apath ,dbname))))
(print "rmt:general-open-connection got res="res)))))
;;======================================================================
;; Defaults to
;;
|
|
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
(let ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
(if (not mainconn)
(begin
(rmt:open-main-connection remote apath)
(thread-sleep! 1)
(rmt:general-open-connection remote apath dbname))
;; we have a connection to main, ask for contact info for dbname
(let* ((res (rmt:send-receive-real remote apath ".db/main.db" #f 'get-server `(,apath ,dbname))))
(print "rmt:general-open-connection got res="res)))))
;;======================================================================
;; Defaults to
;;
|
| ︙ | | | ︙ | |
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
(let* ((host (rmt:conn-ipaddr conn))
(port (rmt:conn-port conn))
(payload (sexpr->string params))
(res (with-input-from-request
(conc "http://"host":"port"/api")
`((params . ,payload)
(cmd . ,cmd)
(key . "nokey")
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)
|
|
|
|
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
(let* ((host (rmt:conn-ipaddr conn))
(port (rmt:conn-port conn))
(payload (sexpr->string params))
(res (with-input-from-request
(conc "http://"host":"port"/api")
`((params . ,payload)
(cmd . ,cmd)
(key . "nokey"))
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)
|
| ︙ | | | ︙ | |
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
|
;; 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.
;;
(define (server:ping host port server-id #!key (do-exit #f))
(let* ((sdat (servdat-init #f host port server-id)))
(http-transport:send-receive sdat 'ping '())))
;; ping the given server
;;
(define (server:check-server server-record)
(let* ((server-url (server:record->url server-record))
(server-id (server:record->id server-record))
(res (server:ping server-url server-id)))
|
|
|
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
|
;; 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.
;;
(define (server:ping host port server-id #!key (do-exit #f))
(let* ((sdat (servdat-init #f host port server-id)))
(rmt:send-receive sdat 'ping '())))
;; ping the given server
;;
(define (server:check-server server-record)
(let* ((server-url (server:record->url server-record))
(server-id (server:record->id server-record))
(res (server:ping server-url server-id)))
|
| ︙ | | | ︙ | |