167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(send-response ;; the $ is the request vars proc
body: ((api-proc) *dbstruct-db* $)
headers: '((content-type text/plain)))
(mutex-lock! *heartbeat-mutex*)
(set! *db-last-access* (current-seconds))
(mutex-unlock! *heartbeat-mutex*))
((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)))
|
<
|
>
|
>
>
|
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
(res #f))
(cond
((equal? (uri-path (request-uri (current-request)))
'(/ "api"))
(send-response ;; the $ is the request vars proc
body: ((api-proc) *dbstruct-db* $)
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)))
|
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
|
(read-pkt->alist pkt-file pktspec: pktspec))
all-pkt-files)))
(define (server-address srv-pkt)
(conc (alist-ref 'host srv-pkt) ":"
(alist-ref 'port srv-pkt)))
(define (server-ready? host port) ;; 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 '())))
;; 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 '()))
|
|
|
|
>
>
>
>
>
>
>
>
>
|
|
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
(read-pkt->alist pkt-file pktspec: pktspec))
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))))
;; 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 '()))
|
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
|
;; from viable servers get one that is alive and ready
;;
(define (get-the-server serv-pkts)
(let loop ((tail serv-pkts))
(if (null? tail)
#f
(let* ((spkt (car tail))
(host (alist-ref 'ipaddr spkt))
(port (alist-ref 'port spkt))
(addr (server-address spkt)))
(if (server-ready? host port)
spkt
(loop (cdr tail)))))))
;; am I the "first" in line server? I.e. my D card is smallest
;; use Z card as tie breaker
;;
(define (get-best-candidate serv-pkts dbpath)
|
|
|
|
>
|
|
|
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
|
;; from viable servers get one that is alive and ready
;;
(define (get-the-server serv-pkts)
(let loop ((tail serv-pkts))
(if (null? tail)
#f
(let* ((spkt (car tail))
(host (alist-ref 'ipaddr spkt))
(port (alist-ref 'port spkt))
(dbpth (alist-ref 'dbpath spkt))
(addr (server-address spkt)))
(if (server-ready? host port dbpth)
spkt
(loop (cdr tail)))))))
;; am I the "first" in line server? I.e. my D card is smallest
;; use Z card as tie breaker
;;
(define (get-best-candidate serv-pkts dbpath)
|