Megatest

Check-in [4622e2fbb0]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 4622e2fbb04508aa4781a73c8b543e8fbb7866a9
User & Date: matt on 2021-12-31 19:24:12
Other Links: branch diff | manifest | tags
Context
2021-12-31
21:50
updates, wip check-in: 3b9599228a user: matt tags: v2.0001
19:24
wip check-in: 4622e2fbb0 user: matt tags: v2.0001
2021-12-30
07:39
Correct params for setup-listener and fix make deps for ulex check-in: 48b4e09917 user: matt tags: v2.0001
Changes

Modified rmtmod.scm from [f7bb8834ef] to [17f860e8b3].

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
  (port #f)
  (uuid #f)
  (rep  #f)
  (dbfile #f)
  (api-url #f)
  (api-uri #f)
  (api-req #f)
  (uconn   #f)
  (mode    #f)
  (status 'starting)
  (trynum 0) ;; count the number of ports we've tried
  ) 

(define (servdat->url sdat)
  (conc (servdat-host sdat)":"(servdat-port sdat)))







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
  (port #f)
  (uuid #f)
  (rep  #f)
  (dbfile #f)
  (api-url #f)
  (api-uri #f)
  (api-req #f)
  (uconn   #f) ;; this is the listener
  (mode    #f)
  (status 'starting)
  (trynum 0) ;; count the number of ports we've tried
  ) 

(define (servdat->url sdat)
  (conc (servdat-host sdat)":"(servdat-port sdat)))
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
  (let* ((fullname (db:dbname->path apath dbname))
	 (conn     (hash-table-ref/default (remotedat-conns remdat) fullname #f)))
    (if (and conn
	     (< (current-seconds) (conndat-expires conn)))
	conn
	#f)))

(define (rmt:find-main-server apath dbname)
  (let* ((pktsdir     (get-pkts-dir apath))
	 (all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
	 ;; (dbpath      (conc apath "/" dbname))
	 (viable-srvs (get-viable-servers all-srvpkts dbname)))
    (get-the-server apath viable-srvs)))


(define *connstart-mutex* (make-mutex))
(define *last-main-start* 0)

;; looks for a connection to main, returns if have and not exired
;; creates new otherwise







|




|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
  (let* ((fullname (db:dbname->path apath dbname))
	 (conn     (hash-table-ref/default (remotedat-conns remdat) fullname #f)))
    (if (and conn
	     (< (current-seconds) (conndat-expires conn)))
	conn
	#f)))

(define (rmt:find-main-server uconn apath dbname)
  (let* ((pktsdir     (get-pkts-dir apath))
	 (all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
	 ;; (dbpath      (conc apath "/" dbname))
	 (viable-srvs (get-viable-servers all-srvpkts dbname)))
    (get-the-server uconn apath viable-srvs)))


(define *connstart-mutex* (make-mutex))
(define *last-main-start* 0)

;; looks for a connection to main, returns if have and not exired
;; creates new otherwise
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
      #;(if (conndat-socket conn)
	  (nng-close! (conndat-socket conn))) ;; TODO - close the ulex server here?
      (hash-table-set! conns fullpath #f) ;; clean up
      (rmt:open-main-connection remdat apath))
     (else
      ;; Below we will find or create and connect to main
      (let* ((dbname         (db:run-id->dbname #f))
	     (the-srv        (rmt:find-main-server apath dbname))
	     (start-main-srv (lambda () ;; call IF there is no the-srv found
			       (mutex-lock! *connstart-mutex*)
			       (if (> (- (current-seconds) *last-main-start*) 5) ;; at least four seconds since last attempt to start main server
				   (begin
				     (api:run-server-process apath dbname)
				     (set! *last-main-start* (current-seconds))
				     (thread-sleep! 1)))







|







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
      #;(if (conndat-socket conn)
	  (nng-close! (conndat-socket conn))) ;; TODO - close the ulex server here?
      (hash-table-set! conns fullpath #f) ;; clean up
      (rmt:open-main-connection remdat apath))
     (else
      ;; Below we will find or create and connect to main
      (let* ((dbname         (db:run-id->dbname #f))
	     (the-srv        (rmt:find-main-server myconn apath dbname))
	     (start-main-srv (lambda () ;; call IF there is no the-srv found
			       (mutex-lock! *connstart-mutex*)
			       (if (> (- (current-seconds) *last-main-start*) 5) ;; at least four seconds since last attempt to start main server
				   (begin
				     (api:run-server-process apath dbname)
				     (set! *last-main-start* (current-seconds))
				     (thread-sleep! 1)))
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
      (let* ((uconn (servdat-uconn *server-info*)))
	(wait-and-close uconn))
      (let* ((port            (portlogger:open-run-close portlogger:find-port))
	     (handler-proc    (lambda (rem-host-port qrykey cmd params) ;;
				(api:execute-requests *dbstruct-db* cmd params))))
	;; (api:process-request *dbstuct-db* 
	(set! *server-info* (make-servdat host: hostn port: port))
	(let* ((uconn (run-listener handler-proc suggested-port: port))
	       (rport (udat-port uconn))) ;; the real port
	  (servdat-host-set! *server-info* hostn)
	  (servdat-port-set! *server-info* rport)
	  (servdat-uconn-set! *server-info* uconn)
	  (wait-and-close uconn)
	  (db:print-current-query-stats)
	  )))







|







1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
      (let* ((uconn (servdat-uconn *server-info*)))
	(wait-and-close uconn))
      (let* ((port            (portlogger:open-run-close portlogger:find-port))
	     (handler-proc    (lambda (rem-host-port qrykey cmd params) ;;
				(api:execute-requests *dbstruct-db* cmd params))))
	;; (api:process-request *dbstuct-db* 
	(set! *server-info* (make-servdat host: hostn port: port))
	(let* ((uconn (run-listener handler-proc port))
	       (rport (udat-port uconn))) ;; the real port
	  (servdat-host-set! *server-info* hostn)
	  (servdat-port-set! *server-info* rport)
	  (servdat-uconn-set! *server-info* uconn)
	  (wait-and-close uconn)
	  (db:print-current-query-stats)
	  )))
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
	   (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
  (let* ((data (sexpr->string  `((cmd . ping)
				 (key . ,key)
				 (params . ()))))
	 (res  (send-receive (conc host ":" port) data)))
    (if res
	(string->sexpr res)
	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)
	res ;; NOTE: sort by age so oldest is considered first
	(let* ((spkt (car tail)))
	  (loop (cdr tail)
		(if (equal? dbpath (alist-ref 'dbpath spkt))
		    (cons spkt res)
		    res))))))

(define (remove-pkts-if-not-alive serv-pkts)
  (filter (lambda (pkt)
	    (let* ((host (alist-ref 'host pkt))
		   (port (alist-ref 'port pkt))
		   (key  (alist-ref 'servkey  pkt))
		   (pktz (alist-ref 'Z        pkt))
		   (res  (server-ready? host port key)))
	      (if res
		  res
		  (let* ((pktsdir (get-pkts-dir *toppath*))
			 (pktpath (conc pktsdir"/"pktz".pkt")))
		    (debug:print 0 *default-log-port* "WARNING: pkt with no server "pktpath)
		    (delete-file* pktpath)
		    #f))))
	  serv-pkts))

;; from viable servers get one that is alive and ready
;;
(define (get-the-server apath 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))
	       (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)







|



|



















|





|











|









|







1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
	   (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? uconn host port key) ;; server-address is host:port
  (let* ((data (sexpr->string  `((cmd . ping)
				 (key . ,key)
				 (params . ()))))
	 (res  (send-receive uconn (conc host ":" port) 'ping data)))
    (if res
	(string->sexpr res)
	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)
	res ;; NOTE: sort by age so oldest is considered first
	(let* ((spkt (car tail)))
	  (loop (cdr tail)
		(if (equal? dbpath (alist-ref 'dbpath spkt))
		    (cons spkt res)
		    res))))))

(define (remove-pkts-if-not-alive uconn serv-pkts)
  (filter (lambda (pkt)
	    (let* ((host (alist-ref 'host pkt))
		   (port (alist-ref 'port pkt))
		   (key  (alist-ref 'servkey  pkt))
		   (pktz (alist-ref 'Z        pkt))
		   (res  (server-ready? uconn host port key)))
	      (if res
		  res
		  (let* ((pktsdir (get-pkts-dir *toppath*))
			 (pktpath (conc pktsdir"/"pktz".pkt")))
		    (debug:print 0 *default-log-port* "WARNING: pkt with no server "pktpath)
		    (delete-file* pktpath)
		    #f))))
	  serv-pkts))

;; from viable servers get one that is alive and ready
;;
(define (get-the-server uconn apath 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))
	       (srvkey (alist-ref 'Z spkt)) ;; (alist-ref 'srvkey spkt))
	       (addr  (server-address spkt)))
	  (if (server-ready? uconn 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)
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
	(debug:print-info 0 *default-log-port* "Waiting for server alive signature")
	(mutex-lock! *heartbeat-mutex*)
	(set! sdat *server-info*)
	(mutex-unlock! *heartbeat-mutex*)
	(if (and sdat
		 (not changed)
		 (> (- (current-seconds) start-time) 2))
	    (begin
	      (servdat-status-set! sdat 'iface-stable)
	      (debug:print-info 0 *default-log-port* "Received server alive signature, now attempting to lock in server")
	      ;; create a server pkt in *toppath*/.meta/srvpkts
	      
	      ;; TODO:
	      ;;   1. change sdat to stuct
	      ;;   2. add uuid to struct
	      ;;   3. update uuid in sdat here
	      ;;
	      (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, no, stick with proper key
	      ;; 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))
		     (alive        (remove-pkts-if-not-alive viables))
		     (best-srv     (get-best-candidate alive db-file))
		     (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f))
		     (i-am-srv     (equal? best-srv-key server-key))
		     (delete-pkt   (lambda ()
				     (let* ((pktfile (conc (get-pkts-dir *toppath*)
							 "/" (servdat-uuid *server-info*)
							 ".pkt")))







|



















|







1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
	(debug:print-info 0 *default-log-port* "Waiting for server alive signature")
	(mutex-lock! *heartbeat-mutex*)
	(set! sdat *server-info*)
	(mutex-unlock! *heartbeat-mutex*)
	(if (and sdat
		 (not changed)
		 (> (- (current-seconds) start-time) 2))
	    (let* ((uconn (servdat-uconn sdat)))
	      (servdat-status-set! sdat 'iface-stable)
	      (debug:print-info 0 *default-log-port* "Received server alive signature, now attempting to lock in server")
	      ;; create a server pkt in *toppath*/.meta/srvpkts
	      
	      ;; TODO:
	      ;;   1. change sdat to stuct
	      ;;   2. add uuid to struct
	      ;;   3. update uuid in sdat here
	      ;;
	      (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, no, stick with proper key
	      ;; 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))
		     (alive        (remove-pkts-if-not-alive uconn viables))
		     (best-srv     (get-best-candidate alive db-file))
		     (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f))
		     (i-am-srv     (equal? best-srv-key server-key))
		     (delete-pkt   (lambda ()
				     (let* ((pktfile (conc (get-pkts-dir *toppath*)
							 "/" (servdat-uuid *server-info*)
							 ".pkt")))