︙ | | | ︙ | |
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
system-information
tcp6
typed-records
uri-common
z3
apimod
clientmod
commonmod
configfmod
dbmod
debugprint
itemsmod
mtver
pgdb
|
<
|
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
system-information
tcp6
typed-records
uri-common
z3
apimod
commonmod
configfmod
dbmod
debugprint
itemsmod
mtver
pgdb
|
︙ | | | ︙ | |
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
(thread-sleep! 4)
(rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries
)))
(if the-srv ;; yes, we have a server, now try connecting to it
(let* ((srv-addr (server-address the-srv))
(ipaddr (alist-ref 'ipaddr the-srv))
(port (alist-ref 'port the-srv))
(srv-key (alist-ref 'srvkey the-srv))
(fullpath (db:dbname->path apath dbname))
(srvready (server-ready? ipaddr port fullpath)))
(if srvready
(begin
(hash-table-set! (rmt:remote-conns remote)
dbname ;; fullpath ;; yes, I'd prefer it to be fullpath - FIXME later
(make-rmt:conn
apath: apath
dbname: dbname
fullname: fullpath
hostport: srv-addr
ipaddr: ipaddr
port: port
srvpkt: the-srv
srvkey: srv-key ;; not the same as signature
lastmsg: (current-seconds)
expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
))
#t)
(start-main-srv)))
(start-main-srv))))
|
|
|
|
|
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
(thread-sleep! 4)
(rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries
)))
(if the-srv ;; yes, we have a server, now try connecting to it
(let* ((srv-addr (server-address the-srv))
(ipaddr (alist-ref 'ipaddr the-srv))
(port (alist-ref 'port the-srv))
(srvkey (alist-ref 'Z the-srv))
(fullpath (db:dbname->path apath dbname))
(srvready (server-ready? ipaddr port srvkey)))
(if srvready
(begin
(hash-table-set! (rmt:remote-conns remote)
dbname ;; fullpath ;; yes, I'd prefer it to be fullpath - FIXME later
(make-rmt:conn
apath: apath
dbname: dbname
fullname: fullpath
hostport: srv-addr
ipaddr: ipaddr
port: port
srvpkt: the-srv
srvkey: srvkey ;; not the same as signature?
lastmsg: (current-seconds)
expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
))
#t)
(start-main-srv)))
(start-main-srv))))
|
︙ | | | ︙ | |
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
|
;; 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))
(server-ready? host port "nokey yet"))
;;======================================================================
;; http-transportmod.scm contents moved here
;;======================================================================
(define (http-transport:make-server-url hostport)
(if (not hostport)
|
|
|
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
|
;; 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))
(server-ready? host port server-id))
;;======================================================================
;; http-transportmod.scm contents moved here
;;======================================================================
(define (http-transport:make-server-url hostport)
(if (not hostport)
|
︙ | | | ︙ | |
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
|
(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.")
|
|
|
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
|
(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)))
(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.")
|
︙ | | | ︙ | |
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
|
(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 (conc apath"/"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)
|
>
|
|
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
|
(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))
(srvkey (alist-ref 'Z spkt)) ;; (alist-ref 'srvkey spkt))
(addr (server-address spkt)))
(if (server-ready? host port srvkey)
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)
|
︙ | | | ︙ | |
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
|
;;
(servdat-uuid-set! sdat
(register-server
pkts-dir *srvpktspec*
(get-host-name)
(servdat-port sdat) server-key
(servdat-host sdat) db-file))
;; now read pkts and see if we are a contender
(let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*))
(viables (get-viable-servers all-pkts db-file))
(best-srv (get-best-candidate viables db-file))
(best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
(debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
;; am I the best-srv, compare server-keys to know
|
|
|
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
|
;;
(servdat-uuid-set! sdat
(register-server
pkts-dir *srvpktspec*
(get-host-name)
(servdat-port sdat) server-key
(servdat-host sdat) db-file))
(set! *my-signature* (servdat-uuid sdat)) ;; replace with Z
;; now read pkts and see if we are a contender
(let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*))
(viables (get-viable-servers all-pkts db-file))
(best-srv (get-best-candidate viables db-file))
(best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
(debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
;; am I the best-srv, compare server-keys to know
|
︙ | | | ︙ | |