17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
+
+
|
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses dbmod))
(module tcp-transportmod
*
(import scheme
(prefix sqlite3 sqlite3:)
chicken
|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
+
+
|
stack
typed-records
tcp-server
tcp
commonmod
debugprint
dbfile
dbmod
)
;;======================================================================
;; client
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
|
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-
+
-
+
|
#f)
;; start the listener and start responding to requests
;;
;; NOTE: organise by dbfname, not run-id so we don't need
;; to pull in more modules
;;
(define (tt:start-server areapath dbfname handler)
(define (tt:start-server areapath run-id dbfname handler)
;; is there already a server for this dbfile? Then exit.
(let* ((ttdat (make-tt areapath: areapath))
(servers (tt:find-server ttdat dbfname)))
(tt-handler-set! ttdat handler)
(if (null? servers)
(let* ((dbstruct (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-db))))
(let* ((dbstruct (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-proc))))
(tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
(tt:keep-running ttdat dbfname handler))
(begin
(debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
(exit)))))
;; find a port and start tcp-server
|