Overview
| Comment: | Change default server timeout to 10 sec. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-servload |
| Files: | files | file ages | folders |
| SHA1: |
698172aebecca367134a0ffb4ee3cc00 |
| User & Date: | matt on 2023-04-27 21:52:45 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-04-27
| ||
| 21:53 | Attempt to use threads to reduce updater impact on dashboard gui redraw check-in: e4fc754440 user: matt tags: v1.80-servload | |
| 21:52 | Change default server timeout to 10 sec. check-in: 698172aebe user: matt tags: v1.80-servload | |
|
2023-04-26
| ||
| 02:18 | Added back old nmsg-transport.scm check-in: 0b5556b83e user: matt tags: v1.80-servload | |
Changes
Modified server.scm from [39953c681c] to [f67a195591].
| ︙ | ︙ | |||
735 736 737 738 739 740 741 |
(define (server:expiration-timeout)
(let* ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (string? tmo)
(let* ((num (string->number tmo)))
(if num
(* 3600 num)
(common:hms-string->seconds tmo)))
| | | 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 |
(define (server:expiration-timeout)
(let* ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (string? tmo)
(let* ((num (string->number tmo)))
(if num
(* 3600 num)
(common:hms-string->seconds tmo)))
10 ;; this is the default
)))
(define (server:get-best-guess-address hostname)
(let ((res #f))
(for-each
(lambda (adr)
(if (not (eq? (u8vector-ref adr 0) 127))
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [9c6068b733] to [9362adaf8f].
| ︙ | ︙ | |||
105 106 107 108 109 110 111 | (last-access (current-seconds)) (servinf-file #f) (last-serv-start 0) ) ;; parameters ;; | | > > > > | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
(last-access (current-seconds))
(servinf-file #f)
(last-serv-start 0)
)
;; parameters
;;
(define tt-server-timeout-param (make-parameter 10))
;; make ttdat visible
(define *server-info* #f)
(define (tt:make-remote areapath)
(make-tt areapath: areapath))
;; 1 ... or #f
;; and check that dbfname matches. FIXME: the propagation of dbfname and run-id
;; might not make the best sense
;;
(define (tt:valid-run-id run-id dbfname)
(and (or (number? run-id)
(not run-id))
(equal? (dbfile:run-id->dbfname run-id) dbfname)))
(tcp-buffer-size 2048)
;; (max-connections 4096)
;;======================================================================
;; Client side
;;======================================================================
;; do all the busy work of finding and setting up conn for
;; connecting to a server
;;
(define (tt:client-connect-to-server ttdat dbfname run-id testsuite)
(assert (tt:valid-run-id run-id dbfname) "FATAL: invalid run-id "run-id)
(let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
|
| ︙ | ︙ | |||
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | conn) ((starting) (thread-sleep! 0.5) (tt:client-connect-to-server ttdat dbfname run-id testsuite)) (else (let* ((curr-secs (current-seconds))) ;; rm the (last server) would go here (if (> (- curr-secs (tt-last-serv-start ttdat)) 10) (begin (tt-last-serv-start-set! ttdat curr-secs) (server-start-proc))) ;; start server if 30 sec since last attempt (thread-sleep! 1) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) (else ;; no good server found, if haven't started server in > 5 secs, start another (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 5) ;; BUG - grow this number really do not want to swamp the machine with servers (begin (debug:print-info 0 *default-log-port* "No server found. Starting one for run-id "run-id" in dbfile "dbfname) (server-start-proc) (tt-last-serv-start-set! ttdat (current-seconds)))) (thread-sleep! 1) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) (define (tt:ping host port server-id #!optional (tries-left 5)) (let* ((res (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id (try-again (lambda () (if (> tries-left 0) (begin | > > | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | conn) ((starting) (thread-sleep! 0.5) (tt:client-connect-to-server ttdat dbfname run-id testsuite)) (else (let* ((curr-secs (current-seconds))) ;; rm the (last server) would go here (hash-table-delete! (tt-conns ttdat) dbfname) (if (> (- curr-secs (tt-last-serv-start ttdat)) 10) (begin (tt-last-serv-start-set! ttdat curr-secs) (server-start-proc))) ;; start server if 30 sec since last attempt (thread-sleep! 1) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) (else ;; no good server found, if haven't started server in > 5 secs, start another (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 5) ;; BUG - grow this number really do not want to swamp the machine with servers (begin (debug:print-info 0 *default-log-port* "No server found. Starting one for run-id "run-id" in dbfile "dbfname) (server-start-proc) (tt-last-serv-start-set! ttdat (current-seconds)))) (thread-sleep! 1) (hash-table-delete! (tt-conns ttdat) dbfname) (tt:client-connect-to-server ttdat dbfname run-id testsuite))))))) (define (tt:ping host port server-id #!optional (tries-left 5)) (let* ((res (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id (try-again (lambda () (if (> tries-left 0) (begin |
| ︙ | ︙ |