Megatest

Check-in [9f85a4b1dd]
Login
Overview
Comment:all-rmt unit tests pass
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.001
Files: files | file ages | folders
SHA1: 9f85a4b1dd53efa527ec0e6d83d5135f7dc78575
User & Date: matt on 2021-12-21 17:47:34
Other Links: branch diff | manifest | tags
Context
2021-12-21
18:54
Added beginnings of stress test for nng transport check-in: 421c5670ac user: matt tags: v2.001
17:47
all-rmt unit tests pass check-in: 9f85a4b1dd user: matt tags: v2.001
12:46
wip check-in: 58cfc286d8 user: matt tags: v2.001
Changes

Modified dbmod.scm from [1af1007e9d] to [f6dcc2b111].

524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538







-
+







  (let* ((dbh (db:open-run-db dbfile db:initialize-db))
	 (res (proc dbh dbfile)))
    ;; (sqlite3:finalize! dbh)
    res))

;; called before db is open?
;;
(define (db:get-iam-server-lock dbh dbfname port)
(define (db:get-iam-server-lock dbh dbfname host port)
  (sqlite3:with-transaction
   dbh
   (lambda ()
     (let* ((locker (db:get-locker dbh dbfname)))
       (if locker
	   locker
	   (db:take-lock dbh dbfname port))))))
554
555
556
557
558
559
560
561

562
563




564
565
566
567
568
569
570
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568
569
570
571
572
573
574







-
+


+
+
+
+







     #t)

(define (db:steal-lock-db dbh dbfname port)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname)
  (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
  #t)

(define (db:release-lock dbh dbfname)
(define (db:release-lock-force dbh dbfname)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname))

;; release a lock if it matches
(define (db:release-lock dbh dbfname host port)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=? AND owner_host=? AND owner_port=?;" dbfname host port))

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================

(define (db:general-sqlite-error-dump exn stmt . params)
  (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
    ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)

Modified rmtmod.scm from [4d23f52ced] to [e5bd6bd6c5].

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
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260















































261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277





278
279
280
281
282
283
284
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
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298







+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+
+
+
+
+







;;
;; TODO: This is unnecessarily re-creating the record in the hash table
;;
(define (rmt:open-main-connection remdat apath)
  (let* ((fullpath (db:dbname->path apath "/.db/main.db"))
	 (conns    (remotedat-conns remdat))
	 (conn     (hash-table-ref/default conns fullpath #f))) ;; TODO - create call for this
    (cond
    (if (and conn                                             ;; conn is NOT a socket, just saying ...
	     (< (current-seconds) (conndat-expires conn)))
	#t ;; we are current and good to go - we'll deal elsewhere with a server that was killed or died 
	;; 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)))
				 (mutex-unlock! *connstart-mutex*)
				 (rmt:open-main-connection remdat apath) ;; TODO: Add limit to number of tries
				 )))
	  (if (not the-srv) ;; have server, try connecting to it
	      (start-main-srv)
	      (let* ((srv-addr (server-address the-srv)) ;; need serv
		     (ipaddr   (alist-ref 'ipaddr  the-srv))
		     (port     (alist-ref 'port    the-srv))
		     (srvkey   (alist-ref 'servkey the-srv))
		     (fullpath (db:dbname->path apath dbname))
		     
		     (new-the-srv (make-conndat
				   apath:   apath
				   dbname:  dbname
				   fullname: fullpath
				   hostport: srv-addr
				   socket: (open-nn-connection srv-addr)
				   ipaddr: ipaddr
				   port: port
				   srvpkt: the-srv
				   srvkey: srvkey ;; generated by rmt:get-signature on the server side
				   lastmsg: (current-seconds)
				   expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
				   )))
		(hash-table-set! conns fullpath new-the-srv)))
	  #t))))
     ((and conn                                             ;; conn is NOT a socket, just saying ...
	   (< (current-seconds) (conndat-expires conn)))
      #t) ;; we are current and good to go - we'll deal elsewhere with a server that was killed or died 
     ((and conn
	   (>= (current-seconds)(conndat-expires conn)))
      (debug:print-info 0 *default-log-port* "connection to "fullpath" server expired. Reconnecting.")
      (if (conndat-socket conn)
	  (nng-close! (conndat-socket conn)))
      (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)))
			       (mutex-unlock! *connstart-mutex*)
			       (rmt:open-main-connection remdat apath) ;; TODO: Add limit to number of tries
			       )))
	(if (not the-srv) ;; have server, try connecting to it
	    (start-main-srv)
	    (let* ((srv-addr (server-address the-srv)) ;; need serv
		   (ipaddr   (alist-ref 'ipaddr  the-srv))
		   (port     (alist-ref 'port    the-srv))
		   (srvkey   (alist-ref 'servkey the-srv))
		   (fullpath (db:dbname->path apath dbname))
		   
		   (new-the-srv (make-conndat
				 apath:   apath
				 dbname:  dbname
				 fullname: fullpath
				 hostport: srv-addr
				 socket: (open-nn-connection srv-addr)
				 ipaddr: ipaddr
				 port: port
				 srvpkt: the-srv
				 srvkey: srvkey ;; generated by rmt:get-signature on the server side
				 lastmsg: (current-seconds)
				 expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
				 )))
	      (hash-table-set! conns fullpath new-the-srv)))
	#t)))))

;; NB// remdat is a remotedat struct
;;
(define (rmt:general-open-connection remdat apath dbname #!key (num-tries 5))
  (assert (not (equal? dbname ".db/main.db")) "ERROR: general-open-connection should never be called with main as the db")
  (let* ((mdbname  (db:run-id->dbname #f))
	 (fullname (db:dbname->path apath dbname))
	 (conns    (remotedat-conns remdat))
	 (mconn    (rmt:get-conn remdat apath mdbname)))
    (if (and mconn
	     (not (debug:print-logger)))
	(begin
	  (debug:print-info 0 *default-log-port* "Turning on logging to main, look in logs dir for main log.")
	  (debug:print-logger rmt:log-to-main)))
    (cond
     ((or (not mconn) ;; no channel open to main?
	  (< (conndat-expires mconn)(+ (current-seconds) 2))) ;; restablish connection if less than 2 seconds on the lease
      (if mconn ;; previously opened - clean up NB// consolidate this with the similar code in open main above
	  (begin
	    (debug:print-info 0 *default-log-port* "Clearing out connection to main that has expired.")
	    (nng-close! (conndat-socket mconn))
	    (hash-table-set! conns fullname #f)))
      (rmt:open-main-connection remdat apath)
      (rmt:general-open-connection remdat apath mdbname))
     ((not (rmt:get-conn remdat apath dbname))                 ;; no channel open to dbname?     
      (let* ((res (rmt:send-receive-real remdat apath mdbname 'get-server `(,apath ,dbname))))
	(case res
	  ((server-started)
	   (if (> num-tries 0)
1504
1505
1506
1507
1508
1509
1510

1511

1512
1513
1514
1515
1516
1517
1518
1518
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531
1532
1533







+
-
+







  (not (equal? (common:get-last-run-version)
               (common:version-signature))))

(define (common:api-changed?)
  (not (equal? (substring (->string megatest-version) 0 4)
               (substring (conc (common:get-last-run-version)) 0 4))))

;; host and port are used to ensure we are remove proper records
(define (rmt:server-shutdown)
(define (rmt:server-shutdown host port)
  (let ((dbfile   (servdat-dbfile *server-info*)))
    (debug:print-info 0 *default-log-port* "dbfile is "dbfile)
    (if dbfile
	(let* ((am-server  (args:get-arg "-server"))
	       (dbfile     (args:get-arg "-db"))
	       (apath      *toppath*)
	       (remdat     *remotedat*)) ;; foundation for future fix
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548





1549
1550
1551
1552
1553
1554
1555
1553
1554
1555
1556
1557
1558
1559




1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571







-
-
-
-
+
+
+
+
+







	      (debug:print-info 0 *default-log-port* "I am not a server, should NOT get here!")
	      (if (string-match ".*/main.db$" dbfile)
		  (let ((pkt-file (conc (get-pkts-dir *toppath*)
					"/" (servdat-uuid *server-info*)
					".pkt")))
		    (debug:print-info 0 *default-log-port* "removing pkt "pkt-file)
		    (delete-file* pkt-file)
		    (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile)
		    (db:with-lock-db (servdat-dbfile *server-info*)
				     (lambda (dbh dbfile)
				       (db:release-lock dbh dbfile))))
		    (debug:print-info 0 *default-log-port* "Releasing lock (if any) for "dbfile ", host "host", port "port)
		    (db:with-lock-db
		     (servdat-dbfile *server-info*)
		     (lambda (dbh dbfile)
		       (db:release-lock dbh dbfile host port)))) ;; I'm not the server - should not have a lock to remove
		  (let* ((sdat *server-info*) ;; we have a run-id server
			 (host (servdat-host sdat))
			 (port (servdat-port sdat))
			 (uuid (servdat-uuid sdat))
			 (res  (rmt:deregister-server remdat *toppath* host port uuid dbfile)))
		    (debug:print-info 0 *default-log-port* "deregistered-server, res="res)
		    (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid)
1570
1571
1572
1573
1574
1575
1576
1577


1578
1579
1580
1581
1582
1583
1584
1586
1587
1588
1589
1590
1591
1592

1593
1594
1595
1596
1597
1598
1599
1600
1601







-
+
+







    (let ((th1 (make-thread
		(lambda () ;; thread for cleaning up, give it five seconds
		  (let* ((start-time (current-seconds)))
		    (if (and *server-info*
			     *unclean-shutdown*)
			(begin
			  (debug:print-info 0 *default-log-port* "Unclean server exit, calling server-shtudown")
			  (rmt:server-shutdown)))
			  (rmt:server-shutdown (servdat-host *server-info*)
					       (servdat-port *server-info*))))
		    (debug:print-info 0 *default-log-port* "Shutdown activities completed in "(- (current-seconds) start-time)" seconds"))
		  ;; (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated
		  #;(if (bdat-task-db *bdat*)    ;; TODO: Check that this is correct for task db
		  (let ((db (cdr (bdat-task-db *bdat*))))
		  (if (sqlite3:database? db)
		  (begin
		  (debug:print-info 0 *default-log-port* "Closing down task db "db)
1677
1678
1679
1680
1681
1682
1683
1684


1685


1686

1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700

1701
1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712
1713







-
+
+

+
+
-
+







	  (if (not (eq? res 'quit))
	      (begin
		(set! *db-last-access* (current-seconds))
		(nng-send rep resdat)
		(loop (nng-recv rep)))))))
    (debug:print-info 0 *default-log-port* "After server, should never see this")
    ;; server exit stuff here
    (let* ((portnum (servdat-port *server-info*)))
    (let* ((portnum (servdat-port *server-info*))
	   (host    (servdat-host *server-info*)))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (if (not (equal? (get-host-name) host))
	  (debug:print-info 0 *default-log-port* "Server shutdown called for host "host", but we are on "(get-host-name))
      (rmt:server-shutdown)
	  (rmt:server-shutdown host portnum))
      ;; (bdat-time-to-exit-set! *bdat* #t) ;; tell on-exit to be fast as we've already cleaned up
      (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run
      ;; (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
      ;; (debug:print-info 0 *default-log-port* "Number of cached writes   " *number-of-writes*)
      ;; (debug:print-info 0 *default-log-port* "Average cached write time "
      ;; 		      (if (eq? *number-of-writes* 0)
      ;; 			  "n/a (no writes)"
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
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
1812
1813
1814
1815
1816
1817
1818













































1819
1820
1821
1822
1823
1824

1825
1826
1827
1828

1829
1830
1831
1832
1833
1834
1835


1836
1837
1838
1839
1840
1841
1842
1843
1844







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+
+
+

-
+






-
-
+
+







  (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
  (mutex-unlock! *http-mutex*))

(define (rmt:inc-requests-and-prep-to-close-all-connections)
  (mutex-lock! *http-mutex*)
  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))

;; careful closing of connections stored in *runremote*
;;
(define (rmt:close-connections #!key (area-dat #f))
  (debug:print-info 0 *default-log-port* "rmt:close-connections doesn't do anything now!"))
;;   (let* ((runremote  (or area-dat *runremote*))
;; 	 (server-dat (if runremote
;;                          (remote-conndat runremote)
;;                          #f))) ;; (hash-table-ref/default *runremote* run-id #f)))
;;     (if (vector? server-dat)
;; 	(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
;; 	  (handle-exceptions
;; 	    exn
;; 	    (begin
;; 	      (print-call-chain *default-log-port*)
;; 	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
;; 	    (close-connection! api-dat)
;;             ;;(close-idle-connections!)
;; 	    #t))
;; 	#f)))



;; initialize servdat for client side, setup needed parameters
;; pass in #f as sdat-in to create sdat
;;
#;(define (servdat-init sdat-in iface port uuid)
  (let* ((sdat (or sdat-in (make-servdat))))
    
    (assert #f "This is a bad idea.")

    (if uuid (servdat-uuid-set! sdat uuid))
    (servdat-host-set! sdat iface)
    (servdat-port-set! sdat port)
    (servdat-api-url-set! sdat (conc "http://" iface ":" port "/api"))
    (servdat-api-uri-set! sdat (uri-reference (servdat-api-url sdat)))
    (servdat-api-req-set! sdat (make-request method: 'POST
					     uri: (servdat-api-uri sdat)))
    ;; set up the http-client parameters
    (max-retry-attempts 1)
    ;; consider all requests indempotent
    (retry-request? (lambda (request)
		      #f))
    (determine-proxy (constantly #f))
   sdat))

;;======================================================================
;; NEW SERVER METHOD
;;======================================================================

;; only use for main.db - need to re-write some of this :(
;;
(define (get-lock-db sdat dbfile port)
(define (get-lock-db sdat dbfile host port)
  (assert host "FATAL: get-lock-db called with host not set.")
  (assert port "FATAL: get-lock-db called with port not set.")
  (let* ((dbh (db:open-run-db dbfile db:initialize-db)) ;; open-run-db creates a standard db with schema used by all situations
	 (res (db:get-iam-server-lock dbh dbfile port)))
	 (res (db:get-iam-server-lock dbh dbfile host port)))
    ;; res => list then already locked, check server is responsive
    ;;     => #t then sucessfully got the lock
    ;;     => #f reserved for future use as to indicate something went wrong
    (match res
      ((owner_pid owner_host owner_port event_time)
       (if (server-ready? owner_host owner_port "abc")
	   #f
	   (begin
	   #f      ;; locked by someone else
	   (begin  ;; locked by someone dead and gone
	     (debug:print 0 *default-log-port* "WARNING: stale lock - have to steal it. This may fail.")
	     (db:steal-lock-db dbh dbfile port))))
      (#t  #t) ;; placeholder so that we don't touch res if it is #t
      (else (set! res #f)))
    (sqlite3:finalize! dbh)
    res))

1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923

1924
1925
1926


1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1887
1888
1889
1890
1891
1892
1893







1894



1895
1896



1897














1898
1899
1900
1901
1902
1903
1904







-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-







	(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  (open-send-receive-nn (conc host ":" port) data)))
    (string->sexpr res)))

;; (let ((res (with-input-from-port i
;; 		       read)))
;; 	    (close-output-port o)
;; 	    (close-input-port i)
;; 	    res))
    (if res
;; 	    (if (string? res)
;; 		(string->sexpr res)
;; 		res)))
	(string->sexpr res)
	res)))
;;     (begin ;; connection failed
;; 	  (debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.")
;; 	  #f))))

;; (define (loop-test host port data) ;; 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* ((payload (sexpr->string data))
;; 	 (res     (with-input-from-request
;; 		   (conc "http://"host":"port"/loop-test")
;; 		   `((data . ,payload))
;; 		   read-string)))
;;   (string->sexpr 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  '()))
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973
1974
1975
1976
1912
1913
1914
1915
1916
1917
1918




1919
1920
1921
1922
1923
1924
1925
1926







-
-
-
-
+








(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  (handle-exceptions
			     exn
			     #f
			   (server-ready? host port key))))
		   (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))))
2071
2072
2073
2074
2075
2076
2077
2078

2079
2080
2081
2082
2083
2084
2085
2021
2022
2023
2024
2025
2026
2027

2028
2029
2030
2031
2032
2033
2034
2035







-
+







							 "/" (servdat-uuid *server-info*)
							 ".pkt")))
				       (debug:print-info 0 *default-log-port* "Attempting to remove bogus pkt file "pktfile)
				       (delete-file* pktfile))))) ;; remove immediately instead of waiting for on-exit
		(debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key", i-am-srv: "i-am-srv)
		;; am I the best-srv, compare server-keys to know
		(if i-am-srv
		    (if (get-lock-db sdat db-file (servdat-port sdat)) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
		    (if (get-lock-db sdat db-file (servdat-host sdat)(servdat-port sdat)) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
			(begin
			  (debug:print-info 0 *default-log-port* "I'm the server!")
			  (servdat-dbfile-set! sdat db-file)
			  (servdat-status-set! sdat 'db-locked))
			(begin
			  (debug:print-info 0 *default-log-port* "I'm not the server, exiting.")
			  (bdat-time-to-exit-set! *bdat* #t)
2192
2193
2194
2195
2196
2197
2198
2199

2200
2201
2202

2203
2204
2205
2206
2207
2208
2209
2142
2143
2144
2145
2146
2147
2148

2149
2150
2151

2152
2153
2154
2155
2156
2157
2158
2159







-
+


-
+







  (let* ((remdat            *remotedat*)
	 (server-start-time (current-seconds))
	 (pkts-dir          (get-pkts-dir))
	 (server-key        (rmt:get-signature)) ;; This servers key
	 (is-main           (equal? (args:get-arg "-db") ".db/main.db"))
	 (last-access       0)
	 (server-timeout    (server:expiration-timeout))
	 (shutdown-server-sequence (lambda (port)
	 (shutdown-server-sequence (lambda (host port)
				     (set! *unclean-shutdown* #f)
				     (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
				     (rmt:server-shutdown)
				     (rmt:server-shutdown host port)
				     (portlogger:open-run-close portlogger:set-port port "released")
				     (exit)))
	 (timed-out?        (lambda ()
			      (<= (+ last-access server-timeout)
				  (current-seconds)))))
    (servdat-dbfile-set! *server-info* (args:get-arg "-db"))
    ;; main and run db servers have both got wait logic (could/should merge it)
2230
2231
2232
2233
2234
2235
2236

2237
2238
2239
2240
2241
2242
2243

2244
2245
2246
2247
2248
2249
2250
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202







+







+







	      ;; IFF I'm not main, call into main and register self
	      (if (not is-main)
		  (let ((res (rmt:register-server remdat
						  *toppath* iface port
						  server-key dbname)))
		    (if res ;; we are the server
			(servdat-status-set! *server-info* 'have-interface-and-db)
			;; now check that the db locker is alive, clear it out if not
			(let* ((serv-info (rmt:get-server-info *toppath* dbname)))
			  (match serv-info
			    ((host port servkey pid ipaddr apath dbpath)
			     (if (not (server-ready? host port servkey))
				 (begin
				   (debug:print-info 0 *default-log-port* "Server registered but not alive. Removing and trying again.")
				   (rmt:deregister-server remdat apath host port servkey dbpath) ;; servkey pid ipaddr apath dbpath)
				   
				   (loop (+ count 1) bad-sync-count start-time))))
			    (else
			     (debug:print 0 *default-log-port* "We are not the server for "dbname", exiting. Server info is: "serv-info)
			     (exit)))))))
	      (debug:print 0 *default-log-port*
			   "SERVER: running, db "dbname" opened, megatest version: "
			   (common:get-full-version))
2288
2289
2290
2291
2292
2293
2294
2295

2296
2297
2298

2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310

2311
2312
2313
2314
2315
2316
2317
2240
2241
2242
2243
2244
2245
2246

2247
2248
2249

2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261

2262
2263
2264
2265
2266
2267
2268
2269







-
+


-
+











-
+







	    (begin
	      (debug:print 0 *default-log-port* "Server stats:")
	      (db:print-current-query-stats)))
	(let* ((hrs-since-start  (/ (- (current-seconds) server-start-time) 3600)))
	  (cond
	   ((not *server-run*)
	    (debug:print-info 0 *default-log-port* "*server-run* set to #f. Shutting down.")
	    (shutdown-server-sequence port))
	    (shutdown-server-sequence (get-host-name) port))
	   ((timed-out?)
	    (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
	    (shutdown-server-sequence port))
	    (shutdown-server-sequence (get-host-name) port))
	   ((and *server-run*
		 (or (not (timed-out?))
		     (if is-main ;; do not exit if there are other servers (keep main open until all others gone)
			 (> (rmt:get-count-servers remdat *toppath*) 1)
			 #f)))
	    (if (common:low-noise-print 120 "server continuing")
		(debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)))
	    (loop 0 bad-sync-count (current-milliseconds)))
	   (else
	    (set! *unclean-shutdown* #f)
	    (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
	    (shutdown-server-sequence port)
	    (shutdown-server-sequence (get-host-name) port)
	    #;(debug:print-info 0 *default-log-port* "Sending 'quit to server, received: "
			      (open-send-receive-nn (conc iface":"port)      ;; do this here and not in server-shutdown
						    (sexpr->string 'quit)))
	    )))))))

;; Call this to start the actual server
;;

Modified tests/Makefile from [ee95d53fd2] to [7641740d8e].

38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52







-
+







# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : build unit test4
# test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.log server.log
unit : basicserver.log server.log all-rmt.log
# all-rmt.log all-api.log
# runs.log misc.log tests.log

# inter dependencies on the unit tests, I wish these could be "suggestions"
all-rmt.log : all-api.log

rel : 

Modified tests/unittests/all-rmt.scm from [3c7b17d5c4] to [3a8e222d0c].

27
28
29
30
31
32
33


34
35

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94


























































95
96
97


98
99
100
101
102
103
104
27
28
29
30
31
32
33
34
35
36

37
38


























































39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97


98
99
100
101
102
103
104
105
106







+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+








;; Definitions:
;;   NTN - no test needed
;;   DEP - function is deprecated, no point in testing
;;   NED - function nested under others, no test needed.
;;   DEF - deferred

(import big-chicken rmtmod apimod runsmod)

(print "start dir: " (current-directory))
       
;;        
(define toppath (current-directory))

(test #f #f (server:check-if-running toppath))           ;; these are used by server:start-and-wait
(test #f #t (list? (server:get-list toppath)))
(test #f '() (server:get-best '()))
(test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15))
(test #f "test.lock" (common:simple-file-release-lock "test.lock"))
(test #f #t (server:get-best-guess-address (get-host-name)))
(test #f #t (string? (common:get-homehost)))

;; clean out any old running servers
;;
(let ((servers (server:get-list toppath)))
  (print "Known servers: "  servers)
  (if (not (null? servers))
      (begin
	(for-each
	 (lambda (server)
	   (let ((pid (list-ref server 4)))
	     (thread-start!
	      (make-thread
	       (lambda ()
		 (print "Attempting to kill server: " server)
		 (print "Attempting to kill pid " pid)
		 (system (conc "kill " pid))
		 (thread-sleep! 2)
		 (system (conc "kill -9 " pid)))
	       (conc pid)))))
	 servers)
	(thread-sleep! 2))))
;; let's start up a server the mechanical way
(system "nbfake megatest -server -")
(thread-sleep! 2)
;; (test #f #t (string? (server:start-and-wait *toppath*)))

(test "setup for run" #t (begin (launch:setup)
 				(string? (getenv "MT_RUN_AREA_HOME"))))
(test #f #t (client:setup-http toppath))
(test #f #t (vector? (client:setup toppath)))

(test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
(test #f #t (string? (server:check-if-running ".")))
;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))
;; DEF (rmt:kill-server run-id)
;; DEF (rmt:start-server run-id)
(test #f '(#t "successful login")(rmt:login #f))
;; DEF (rmt:login-no-auto-client-setup connection-info)
(test #f #t (pair? (rmt:get-latest-host-load (get-host-name))))

;; get-latest-host-load does a lookup in the db, it won't return a useful value unless
;; a test ran recently on host
(test-batch rmt:get-latest-host-load
            "rmt:get-latest-host-load"
            (list (list "localhost"  #t (get-host-name))
                  (list "not-a-host" #t "not-a-host"  ))
            post-proc: pair?)
                                           
(test #f #t (list? (rmt:get-changed-record-ids 0)))

;; 
;; (test #f #f (server:check-if-running toppath))           ;; these are used by server:start-and-wait
;; (test #f #t (list? (server:get-list toppath)))
;; (test #f '() (server:get-best '()))
;; (test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15))
;; (test #f "test.lock" (common:simple-file-release-lock "test.lock"))
;; (test #f #t (server:get-best-guess-address (get-host-name)))
;; (test #f #t (string? (common:get-homehost)))
;; 
;; ;; clean out any old running servers
;; ;;
;; (let ((servers (server:get-list toppath)))
;;   (print "Known servers: "  servers)
;;   (if (not (null? servers))
;;       (begin
;; 	(for-each
;; 	 (lambda (server)
;; 	   (let ((pid (list-ref server 4)))
;; 	     (thread-start!
;; 	      (make-thread
;; 	       (lambda ()
;; 		 (print "Attempting to kill server: " server)
;; 		 (print "Attempting to kill pid " pid)
;; 		 (system (conc "kill " pid))
;; 		 (thread-sleep! 2)
;; 		 (system (conc "kill -9 " pid)))
;; 	       (conc pid)))))
;; 	 servers)
;; 	(thread-sleep! 2))))
;; ;; let's start up a server the mechanical way
;; (system "nbfake megatest -server -")
;; (thread-sleep! 2)
;; ;; (test #f #t (string? (server:start-and-wait *toppath*)))
;; 
;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; (test #f #t (client:setup-http toppath))
;; (test #f #t (vector? (client:setup toppath)))
;; 
;; (test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
;; (test #f #t (string? (server:check-if-running ".")))
;; ;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))
;; ;; DEF (rmt:kill-server run-id)
;; ;; DEF (rmt:start-server run-id)
;; (test #f '(#t "successful login")(rmt:login #f))
;; ;; DEF (rmt:login-no-auto-client-setup connection-info)
;; (test #f #t (pair? (rmt:get-latest-host-load (get-host-name))))
;; 
;; ;; get-latest-host-load does a lookup in the db, it won't return a useful value unless
;; ;; a test ran recently on host
;; (test-batch rmt:get-latest-host-load
;;             "rmt:get-latest-host-load"
;;             (list (list "localhost"  #t (get-host-name))
;;                   (list "not-a-host" #t "not-a-host"  ))
;;             post-proc: pair?)
;;                                            
;; (test #f #t (list? (rmt:get-changed-record-ids 0)))
;; 
(test #f #f (begin (runs:update-all-test_meta #f) #f))

(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (rmt:get-tests-tags) equal?) string<=))
 
(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (rmt:get-tests-tags) equal?) string<=?))
(test #f '() (rmt:get-key-val-pairs 0))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys-write)) ;; dummy query to force server start
(test #f '() (rmt:get-key-vals 1))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f "" (rmt:get-target 1))
(test #f #t (rmt:register-test 1 "foo" ""))
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145







-
+







(test #f 0 (rmt:get-count-tests-running-for-testname 1 "foo"))
(test #f 0 (rmt:get-count-tests-running-in-jobgroup 1 "nada"))
(test #f #f (begin (rmt:set-state-status-and-roll-up-items 1 "foo" "" "COMPLETED" "FAIL" "Just yet another message") #f))
(test #f #t (rmt:top-test-set-per-pf-counts 1 "foo"))
(test #f '() (rmt:get-raw-run-stats 1))
(test #f #t (vector? (rmt:get-run-info 1)))
(test #f 0 (rmt:get-num-runs "%"))
(define keypatts '(("SYSTEM" "ubuntu")("RELEASE" "v1.234")) )
(define keypatts '(("SYSTEM" "ubuntu")("RELEASE" "v1.234")))
(test #f 1 (rmt:register-run '(("SYSTEM" "ubuntu")("RELEASE" "v1.234")) "bar" "NEW" "JUSTFINE" "bobafett" "quick"))
(test #f "bar" (rmt:get-run-name-from-id 1))
(test #f #t (begin (rmt:delete-run 2) #t)) ;; delete a non-existant run
(test #f #t (begin (rmt:update-run-stats 1 '()) #t))
(test #f #t (begin (rmt:delete-old-deleted-test-records) #t))
(test #f #t (vector? (rmt:get-runs "%" 10 0 keypatts)))
(test #f '(1)(rmt:get-all-run-ids))
164
165
166
167
168
169
170
171
172


173
174
175


176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215




































166
167
168
169
170
171
172


173
174
175


176
177
178
179
180
181
182



































183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218







-
-
+
+

-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
                                  (> (length rows) 0))))))


(test #f '(("Totals" "UNKNOWN" 1) ("bar" "UNKNOWN" 1)) (begin (rmt:get-run-stats)))
(test #f #t (begin (rmt:set-run-state-status 1 "COMPLETE" "PASS") #t))
(test #f '"COMPLETE" (rmt:get-run-state 1))
(test #f '"PASS" (rmt:get-run-status 1))
(test #f #t (begin (rmt:set-var "foo" "bar")#t))
(test #f "bar" (rmt:get-var "foo"))
(test #f #t (begin (rmt:set-var 1 "foo" "bar")#t))
(test #f "bar" (rmt:get-var 1 "foo"))
(test #f #t (begin (rmt:print-db-stats) #t))
(test #f #t (begin (rmt:del-var "foo") #t))
(test #f #f (rmt:get-var "foo"))
(test #f #t (begin (rmt:del-var 1 "foo") #t))
(test #f #f (rmt:get-var 1 "foo"))
(test #f (vector #f #f #f #f #f #f #f #f #f #f #f #f) (rmt:get-data-info-by-id 1))
(test #f '() (rmt:get-key-vals 1))
(test #f "ubuntu/v1.234" (rmt:get-target 1))
(print (rmt:get-run-info 1))
(test #f '((runs) (tests) (test_steps) (test_data)) (rmt:get-run-record-ids "ubuntu/v1.234" 1 '("fail_count") "bar"))
;; (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; (rmt:get-main-run-stats run-id)
;; (rmt:get-var varname)
;; (rmt:set-var varname value)
;; (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;; (rmt:get-previous-test-run-record run-id test-name item-path)
;; (rmt:get-run-stats)
;; (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile)
;; (rmt:get-steps-for-test run-id test-id)
;; (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) 
;; (rmt:testmeta-add-record testname)
;; (rmt:testmeta-get-record testname)
;; (rmt:testmeta-update-field test-name fld val)
;; (rmt:test-data-rollup run-id test-id status)
;; (rmt:csv->test-data run-id test-id csvdata)
;; (rmt:tasks-find-task-queue-records target run-name test-patt state-patt action-patt)
;; (rmt:tasks-add action owner target runname testpatt params)
;; (rmt:tasks-set-state-given-param-key param-key new-state)
;; (rmt:tasks-get-last target runname)
;; (rmt:archive-get-allocations  testname itempath dneeded)
;; (rmt:archive-register-block-name bdisk-id archive-path)
;; (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
;; (rmt:archive-register-disk bdisk-name bdisk-path df)
;; (rmt:test-set-archive-block-id run-id test-id archive-block-id)
;; (rmt:test-get-archive-block-info archive-block-id)
;; NED (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
;; NED (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
;; DEF (test #f #f (rmt:print-db-stats))
;; DEF (rmt:get-max-query-average run-id)
;; NED (rmt:general-call stmtname run-id . params)
;; DEP (rmt:sdb-qry qry val run-id)
;; DEF (rmt:runtests user run-id testpatt params)
;; DEP (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
;; DEP (rmt:synchash-get run-id proc synckey keynum params)
;; DEP (test #f #f (rmt:update-pass-fail-counts 1 "foo"))
;; ;; (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; ;; (rmt:get-main-run-stats run-id)
;; ;; (rmt:get-var varname)
;; ;; (rmt:set-var varname value)
;; ;; (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;; ;; (rmt:get-previous-test-run-record run-id test-name item-path)
;; ;; (rmt:get-run-stats)
;; ;; (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile)
;; ;; (rmt:get-steps-for-test run-id test-id)
;; ;; (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) 
;; ;; (rmt:testmeta-add-record testname)
;; ;; (rmt:testmeta-get-record testname)
;; ;; (rmt:testmeta-update-field test-name fld val)
;; ;; (rmt:test-data-rollup run-id test-id status)
;; ;; (rmt:csv->test-data run-id test-id csvdata)
;; ;; (rmt:tasks-find-task-queue-records target run-name test-patt state-patt action-patt)
;; ;; (rmt:tasks-add action owner target runname testpatt params)
;; ;; (rmt:tasks-set-state-given-param-key param-key new-state)
;; ;; (rmt:tasks-get-last target runname)
;; ;; (rmt:archive-get-allocations  testname itempath dneeded)
;; ;; (rmt:archive-register-block-name bdisk-id archive-path)
;; ;; (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey)
;; ;; (rmt:archive-register-disk bdisk-name bdisk-path df)
;; ;; (rmt:test-set-archive-block-id run-id test-id archive-block-id)
;; ;; (rmt:test-get-archive-block-info archive-block-id)
;; ;; NED (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
;; ;; NED (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
;; ;; DEF (test #f #f (rmt:print-db-stats))
;; ;; DEF (rmt:get-max-query-average run-id)
;; ;; NED (rmt:general-call stmtname run-id . params)
;; ;; DEP (rmt:sdb-qry qry val run-id)
;; ;; DEF (rmt:runtests user run-id testpatt params)
;; ;; DEP (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
;; ;; DEP (rmt:synchash-get run-id proc synckey keynum params)
;; ;; DEP (test #f #f (rmt:update-pass-fail-counts 1 "foo"))
;; 

Modified tests/unittests/server.scm from [7bdfa0e7f2] to [70755134bd].

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32







-
+







;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


;; Run like this:
;;
;;  (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)
(import rmtmod trace http-client apimod dbmod
(import big-chicken rmtmod trace http-client apimod dbmod
	launchmod)

(trace-call-sites #t)
(trace
   
 ;; db:get-dbdat
 ;; rmt:find-main-server
62
63
64
65
66
67
68


69

70
71
72
73



74
75

76
77
78


79
80

81
82
83
84
85





86
87
62
63
64
65
66
67
68
69
70

71
72



73
74
75
76

77
78


79
80
81

82
83




84
85
86
87
88
89
90







+
+
-
+

-
-
-
+
+
+

-
+

-
-
+
+

-
+

-
-
-
-
+
+
+
+
+


(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))
(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))
(test #f ".db/2.db" (list-ref (rmt:send-receive-real *remotedat* *toppath* ".db/main.db" 'get-server `(,apath ,dbname))
			      6))

(thread-sleep! 2)
(test #f #t (rmt:general-open-connection *remotedat* *toppath* ".db/2.db"))

;; (let loop ((end-time (+ (current-seconds) 61)))
(test #f #t (list? (rmt:get-servers-info *toppath*)))
  (test #f #t (list? (rmt:get-servers-info *toppath*)))

(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
;; (print "Got here.")
  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
  ;; (print "Got here.")

(test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))
  (test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

(test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
;; (test #f 2 (rmt:deregister-server *remotedat* *toppath* iface port server-key dbname
  (test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
  ;; (test #f 2 (rmt:deregister-server *remotedat* *toppath* iface port server-key dbname

(test #f 2 (rmt:get-count-servers *remotedat* *toppath*))
  (test #f 2 (rmt:get-count-servers *remotedat* *toppath*))

(test #f "run2" (rmt:get-run-name-from-id 2))
(test #f #f     (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
      
(test #f #t     (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
  (test #f "run2" (rmt:get-run-name-from-id 2))
  (test #f #f     (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
  
  (test #f #t     (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
;;  (if (< (current-seconds) end-time)(loop end-time)))

(exit)