Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-tcp6 |
Files: | files | file ages | folders |
SHA1: |
366f739c4e8ad0dcf2dbeee00aecbf5c |
User & Date: | matt on 2021-06-05 03:28:55 |
Other Links: | branch diff | manifest | tags |
Context
2021-06-06
| ||
05:23 | Basic of server working again check-in: 8e33180842 user: matt tags: v1.6584-tcp6 | |
2021-06-05
| ||
03:28 | wip check-in: 366f739c4e user: matt tags: v1.6584-tcp6 | |
02:49 | Simplified server/client signature check-in: fd69de34fe user: matt tags: v1.6584-tcp6 | |
Changes
Modified rmtmod.scm from [244278427f] to [d3535701fe].
︙ | ︙ | |||
79 80 81 82 83 84 85 | system-information tcp6 typed-records uri-common z3 apimod | < | 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 | (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)) | | | | | 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 | ;; 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)) | | | 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 | (tcp-connect host port)))) (if (and i o) (begin (write `((cmd . ping) (key . ,key) (params . ())) o) (let ((res (with-input-from-port i | | | 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 | (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))) | > | | 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 | ;; (servdat-uuid-set! sdat (register-server pkts-dir *srvpktspec* (get-host-name) (servdat-port sdat) server-key (servdat-host sdat) db-file)) | | | 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 |
︙ | ︙ |
Modified tests/unittests/basicserver.scm from [a2f1479995] to [5447eb2d64].
︙ | ︙ | |||
69 70 71 72 73 74 75 76 77 78 79 80 81 82 | ;; these let me cut and paste from source easily (define apath *toppath*) (define dbname ".db/2.db") (define remote *rmt:remote*) (define keyvals '(("SYSTEM" "a")("RELEASE" "b"))) (test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/2.db"))) (set! *dbstruct-db* #f) (exit) (test #f #t (rmt:open-main-connection remote apath)) (test #f #t (rmt:conn? (rmt:get-conn *rmt:remote* *toppath* ".db/main.db"))) | > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | ;; these let me cut and paste from source easily (define apath *toppath*) (define dbname ".db/2.db") (define remote *rmt:remote*) (define keyvals '(("SYSTEM" "a")("RELEASE" "b"))) (test #f '() (string->sexpr "()")) (test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/2.db"))) (set! *dbstruct-db* #f) (exit) (test #f #t (rmt:open-main-connection remote apath)) (test #f #t (rmt:conn? (rmt:get-conn *rmt:remote* *toppath* ".db/main.db"))) |
︙ | ︙ |