Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-tcp-inmem |
| Files: | files | file ages | folders |
| SHA1: |
2c448364b394a730c12faadcc55c332d |
| User & Date: | matt on 2023-02-16 22:05:27 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-17
| ||
| 06:02 | Merged fork check-in: f756aa00cd user: matt tags: v1.80-tcp-inmem | |
|
2023-02-16
| ||
| 22:05 | wip check-in: 2c448364b3 user: matt tags: v1.80-tcp-inmem | |
| 21:40 | wip check-in: 372980efb7 user: matt tags: v1.80-tcp-inmem | |
Changes
Modified tcp-transportmod.scm from [99fe61945c] to [c233cd9055].
| ︙ | ︙ | |||
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 | (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))))) | < < < < < < < < < < | 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 |
(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]])
| > > > > > > > > > > | | 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))
|
| ︙ | ︙ |