173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
headers: '((content-type text/plain)))
(set! *db-last-access* (current-seconds)))
((equal? (uri-path (request-uri (current-request)))
'(/ "ping"))
(send-response body: (conc *toppath*"/"(args:get-arg "-db"))
headers: '((content-type text/plain))))
((equal? (uri-path (request-uri (current-request)))
'(/ ""))
(send-response body: ((http-get-function 'http-transport:main-page))))
((equal? (uri-path (request-uri (current-request)))
'(/ "json_api"))
(send-response body: ((http-get-function 'http-transport:main-page))))
((equal? (uri-path (request-uri (current-request)))
'(/ "runs"))
|
>
>
>
>
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
headers: '((content-type text/plain)))
(set! *db-last-access* (current-seconds)))
((equal? (uri-path (request-uri (current-request)))
'(/ "ping"))
(send-response body: (conc *toppath*"/"(args:get-arg "-db"))
headers: '((content-type text/plain))))
((equal? (uri-path (request-uri (current-request)))
'(/ "loop-test"))
(send-response body: (alist-ref 'data ($))
headers: '((content-type text/plain))))
((equal? (uri-path (request-uri (current-request)))
'(/ ""))
(send-response body: ((http-get-function 'http-transport:main-page))))
((equal? (uri-path (request-uri (current-request)))
'(/ "json_api"))
(send-response body: ((http-get-function 'http-transport:main-page))))
((equal? (uri-path (request-uri (current-request)))
'(/ "runs"))
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
|
(close-idle-connections!)))
(set! *http-connections-next-cleanup* (+ (current-seconds) 10))
(mutex-unlock! *http-mutex*))
(define (http-transport:inc-requests-and-prep-to-close-all-connections)
(mutex-lock! *http-mutex*)
(set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))
;; serverdat contains uuid to be used for connection validation
;;
;; NOTE: serverdat must be initialized or created by servdat-init
;;
(define (http-transport:send-receive sdat qry-key cmd params #!key (numretries 3))
(let* ((res #f)
|
>
>
>
>
>
>
>
>
|
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
|
(close-idle-connections!)))
(set! *http-connections-next-cleanup* (+ (current-seconds) 10))
(mutex-unlock! *http-mutex*))
(define (http-transport:inc-requests-and-prep-to-close-all-connections)
(mutex-lock! *http-mutex*)
(set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))
(define (sexpr->string data)
(with-output-to-string
(lambda ()(write data))))
(define (string->sexpr instr)
(with-input-from-string instr
(lambda ()(read))))
;; serverdat contains uuid to be used for connection validation
;;
;; NOTE: serverdat must be initialized or created by servdat-init
;;
(define (http-transport:send-receive sdat qry-key cmd params #!key (numretries 3))
(let* ((res #f)
|
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
|
read-string)))
(if (equal? res key)
#t
(begin
(debug:print-info 0 *default-log-port* "server-ready? key="key", received="res)
#f))))
;; 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)
(let loop ((tail serv-pkts)
(res '()))
(if (null? tail)
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
read-string)))
(if (equal? res key)
#t
(begin
(debug:print-info 0 *default-log-port* "server-ready? key="key", received="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") ;; returns *toppath*/dbname
`((data . ,payload))
read-string)))
(string->sexpr 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)
(let loop ((tail serv-pkts)
(res '()))
(if (null? tail)
|