| ︙ | | | ︙ | |
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))
(use address-info)
(module tcp-transportmod
*
(import scheme
|
>
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
;;======================================================================
(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses portlogger))
(use address-info)
(module tcp-transportmod
*
(import scheme
|
| ︙ | | | ︙ | |
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
tcp-server
tcp
debugprint
commonmod
dbfile
dbmod
)
;;======================================================================
;; client
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
|
>
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
tcp-server
tcp
debugprint
commonmod
dbfile
dbmod
portlogger
)
;;======================================================================
;; client
;;======================================================================
;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
|
| ︙ | | | ︙ | |
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
(if (file-exists? servinf)
(begin
(debug:print 0 *default-log-port* "INFO: no ping response from server "host":"port" for "dbfname)
(if (and (file-exists? servinf)
(> (- (current-seconds)(file-modification-time servinf)) 60))
(begin
(debug:print 0 *default-log-port* "INFO: "servinf" file seems old and no ping response, removing it.")
(delete-file* servinf))))
(debug:print 0 *default-log-port* "INFO: connection to server "host":"port" broken for "dbfname", but do not see servinf file "servinf))
(tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe))
(assert #f "FATAL: tt:handler received bad data "res)))))
(begin
(thread-sleep! 1) ;; give it a rest and try again
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))
;; no conn yet, find and or start and find a server
;; (let* ((server (tt:find-server ttdat dbfname)))
;; (if server
;; (let* ((conn (tt:client-connect-to-server server)))
;; (hash-table-set! (tt-conns ttdat) dbfname conn)
;; (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode
;; dbfname testsuite mtexe))
;; ;; no server, try to start a server process
;; (begin
;; (tt:server-process-run areapath testsuite mtexe run-id) ;; #!key (profile-mode ""))
;; (thread-sleep! 1)
;; (tt:handler ttdat cmd run-id params attemptnum area-dat areapath
;; readonly-mode dbfname testsuite mtexe)))))))
|
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
|
(if (file-exists? servinf)
(begin
(debug:print 0 *default-log-port* "INFO: no ping response from server "host":"port" for "dbfname)
(if (and (file-exists? servinf)
(> (- (current-seconds)(file-modification-time servinf)) 60))
(begin
(debug:print 0 *default-log-port* "INFO: "servinf" file seems old and no ping response, removing it.")
(handle-exceptions
exn
#f
(delete-file* servinf)))))
(debug:print 0 *default-log-port* "INFO: connection to server "host":"port" broken for "dbfname", but do not see servinf file "servinf))
(tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe))
(assert #f "FATAL: tt:handler received bad data "res)))))
(begin
(thread-sleep! 1) ;; give it a rest and try again
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))
(define (tt:bid-for-servership run-id)
#f)
;; gets server info and appends path to server file
;; sorts by age, oldest first
;;
;; returns list of (host port startseconds server-id servinfofile)
|
| ︙ | | | ︙ | |
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
|
;; (define (wait-and-close uconn)
;; (thread-join! (udat-cmd-thread uconn))
;; (tcp-close (udat-socket uconn)))
;;
;;
(define (tt:shutdown-server ttdat)
(let* ((cleanproc (tt-cleanup-proc ttdat)))
(tt-state-set! ttdat 'shutdown)
(if cleanproc (cleanproc))
(tcp-close (tt-socket ttdat)) ;; close up ports here
))
;; (define (wait-and-close uconn)
;; (thread-join! (tt-cmd-thread uconn))
;; (tcp-close (tt-socket uconn)))
|
|
>
>
|
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
;; (define (wait-and-close uconn)
;; (thread-join! (udat-cmd-thread uconn))
;; (tcp-close (udat-socket uconn)))
;;
;;
(define (tt:shutdown-server ttdat)
(let* ((cleanproc (tt-cleanup-proc ttdat))
(port (tt-port ttdat)))
(tt-state-set! ttdat 'shutdown)
(portlogger:open-run-close portlogger:set-port port "released")
(if cleanproc (cleanproc))
(tcp-close (tt-socket ttdat)) ;; close up ports here
))
;; (define (wait-and-close uconn)
;; (thread-join! (tt-cmd-thread uconn))
;; (tcp-close (tt-socket uconn)))
|
| ︙ | | | ︙ | |
659
660
661
662
663
664
665
666
667
668
669
670
671
672
|
exn
(if (< port 65535)
(begin
(thread-sleep! 0.25)
(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 (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
(tt-port-set! uconn port)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
|
exn
(if (< port 65535)
(begin
(thread-sleep! 0.25)
(setup-listener uconn (+ port 1)))
#f)
(connect-listener uconn port)))
(define (setup-listener-portlogger uconn)
(let ((port (portlogger:open-run-close portlogger:find-port)))
(assert (tt? uconn) "FATAL: setup-listener called with wrong struct "uconn)
(handle-exceptions
exn
(if (< port 65535)
(begin
(portlogger:open-run-close portlogger:set-failed port)
(thread-sleep! 0.25)
(setup-listener uconn (portlogger:open-run-close portlogger:find-port)))
#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 (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
(tt-port-set! uconn port)
|
| ︙ | | | ︙ | |