Megatest

Diff
Login

Differences From Artifact [244278427f]:

To Artifact [d3535701fe]:


79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
79
80
81
82
83
84
85

86
87
88
89
90
91
92







-







	system-information
	tcp6
	typed-records
	uri-common
	z3
       
	apimod
	clientmod
	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
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))
	       (srv-key  (alist-ref 'srvkey the-srv))
	       (srvkey   (alist-ref 'Z      the-srv))
	       (fullpath (db:dbname->path apath dbname))
	       (srvready (server-ready? ipaddr port fullpath)))
	       (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: srv-key ;; not the same as signature
				  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
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 "nokey yet"))
  (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
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)))
		       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
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 (conc apath"/"dbpth))
	  (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
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