Megatest

Diff
Login

Differences From Artifact [0255f4aac4]:

To Artifact [348d9df954]:


1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610



1611
1612
1613
1614
1615
1616
1617
1596
1597
1598
1599
1600
1601
1602








1603
1604
1605
1606
1607
1608
1609
1610
1611
1612







-
-
-
-
-
-
-
-
+
+
+







	  (let loop ((indat (read i)))
	    (if (eof-object? indat)
		(begin
		  (close-input-port i)
		  (close-output-port o)
		  (oloop))
		(let* ((res (api:process-request dbstruct indat)))
		  (case res
		    ((quit)
		     (close-input-port i)
		     (close-output-port o))
		    (else
		     (set! *db-last-access* (current-seconds))
		     (write res o)
		     (loop (read i))))))))))
		  (set! *db-last-access* (current-seconds))
		  (write res o)
		  (loop (read i))))))))
    (let* ((portnum (servdat-port *server-info*)))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))

(define (rmt:try-start-server ipaddrstr portnum)
  (if *server-info*
      (begin
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948







+







		     (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
		(if (equal? best-srv-key server-key)
		    (if (get-lock-db sdat db-file) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
			(begin
			  (debug:print 0 *default-log-port* "I'm the server!")
			  ;; (if (not *server-id*)
			  (servdat-dbfile-set! sdat db-file)
			  (servdat-status-set! sdat 'db-locked))
			(begin
			  (debug:print 0 *default-log-port* "I'm not the server, exiting.")
			  (bdat-time-to-exit-set! *bdat* #t)
			  (thread-sleep! 0.2)
			  (exit)))
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040







+







  (let* ((server-start-time (current-seconds))
	 (pkts-dir          (get-pkts-dir))
	 (server-key        (rmt:mk-signature))
	 (is-main           (equal? (args:get-arg "-db") ".db/main.db"))
	 (last-access       0)
	 (server-timeout    (server:expiration-timeout)))
    ;; main and run db servers have both got wait logic (could/should merge it)
    (set! *server-id* server-key)
    (if is-main
	(http-transport:wait-for-server pkts-dir dbname server-key)
	(http-transport:wait-for-stable-interface))
    ;; this is our forever loop
    (let* ((iface             (servdat-host *server-info*))
	   (port              (servdat-port *server-info*)))
      (let loop ((count         0)