1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
|
(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))))))))))
|
<
<
<
<
<
|
|
|
|
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)))
(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
|
(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!")
(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)))
|
>
|
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
|
(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)
(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)
|
>
|
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)
|