| ︙ | | | ︙ | |
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
;;======================================================================
(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
|
>
>
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;;======================================================================
(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses dbmod))
(use address-info)
(module tcp-transportmod
*
(import scheme
(prefix sqlite3 sqlite3:)
chicken
|
| ︙ | | | ︙ | |
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(defstruct tt-conn
host
port
dbfname
server-id
server-start
pid
)
(defstruct tt
|
>
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(defstruct tt-conn
host
port
host-port
dbfname
server-id
server-start
pid
)
(defstruct tt
|
| ︙ | | | ︙ | |
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
(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
;;
(define (tt:start-tcp-server ttdat)
(setup-listener ttdat)
(let* ((socket (tt-socket ttdat))
(handler (tt-handler ttdat)))
((make-tcp-server socket handler)
#t ;; yes, send error messages to std-err
)))
|
<
<
<
<
<
<
<
<
<
<
|
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
(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)))))
(define (tt:keep-running ttdat dbfile)
;; verfiy conn for ready
;; listener socket has been started by this stage
(debug:print 0 *default-log-port* "INFO: Got here!!!!"))
;; ;; given an already set up uconn start the cmd-loop
;; ;;
|
| ︙ | | | ︙ | |
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
|
(assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)
(handle-exceptions
exn
(if (< port 65535)
(setup-listener uconn (+ port 1))
#f)
(connect-listener uconn port)))
(define (connect-listener uconn port)
;; (tcp-listener-socket LISTENER)(socket-name so)
;; sockaddr-address, sockaddr-port, sockaddr->string
(let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
(addr (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
(tt-port-set! uconn port)
(tt-host-port-set! uconn (conc addr":"port))
(tt-socket-set! uconn tlsn)
uconn))
|
>
>
>
>
>
>
>
>
>
>
|
|
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
|
(assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)
(handle-exceptions
exn
(if (< port 65535)
(setup-listener uconn (+ port 1))
#f)
(connect-listener uconn port)))
;; find a port and start tcp-server
;;
(define (tt:start-tcp-server ttdat)
(setup-listener ttdat)
(let* ((socket (tt-socket ttdat))
(handler (tt-handler ttdat)))
((make-tcp-server socket handler)
#t ;; yes, send error messages to std-err
)))
(define (connect-listener uconn port)
;; (tcp-listener-socket LISTENER)(socket-name so)
;; sockaddr-address, sockaddr-port, sockaddr->string
(let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
(addr (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
(tt-port-set! uconn port)
(tt-host-port-set! uconn (conc addr":"port))
(tt-socket-set! uconn tlsn)
uconn))
|
| ︙ | | | ︙ | |