| ︙ | | | ︙ | |
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
matchable
md5
message-digest
ports
posix
regex
regex-case
srfi-1
srfi-18
srfi-4
srfi-69
stack
typed-records
tcp-server
tcp
commonmod
|
>
<
>
>
>
>
|
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
matchable
md5
message-digest
ports
posix
regex
regex-case
s11n
srfi-1
srfi-18
srfi-4
srfi-69
stack
typed-records
tcp-server
tcp
debugprint
commonmod
dbfile
dbmod
)
;;======================================================================
;; client
;;======================================================================
;; (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
;; client related
(conns (make-hash-table)) ;; dbfname -> conn
;; server related
|
| ︙ | | | ︙ | |
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(host-port #f)
(cmd-thread #f)
)
(define (tt:make-remote areapath)
(make-tt area: areapath))
(define (tt:client-connect-to-server ttdat)
#f)
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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
|
(host-port #f)
(cmd-thread #f)
)
(define (tt:make-remote areapath)
(make-tt area: areapath))
;;
;; DUPLICATED WITH tt:handler (I think)
;;
(define (tt:client-connect-to-server ttdat dbfname run-id)
(let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f)))
(if conn
conn ;; we are already connected to the server
(let* ((sdat (tt:get-current-server-info ttdat dbfname run-id)))
(match sdat
((host port start-time server-id pid)
(let ((conn (make-tt-conn
host: host
port: port
dbfname: dbfname
server-id: server-id
server-start: start-time
pid: pid)))
(hash-table-set! (tt-conns ttdat) dbfname conn)
conn))
(else
(tt:server-process-run
(tt-areapath ttdat)
(dbfile:testsuite-name)
(common:find-local-megatest)
run-id)
(thread-sleep! 1)
(tt:client-connect-to-server ttdat dbfname run-id)))))))
;; client side handler
;;
(define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)
;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
(let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f)))
(if conn
|
| ︙ | | | ︙ | |
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
(thread-sleep! 1)
(tt:handler runremote cmd rid params attemptnum area-dat areapath
readonly-mode dbfname testsuite mtexe)))))))
(define (tt:bid-for-servership run-id)
#f)
(define (tt:get-current-server run-id)
#f)
(define (tt:send-receive ttdat conn cmd run-id params)
#f)
|
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(thread-sleep! 1)
(tt:handler runremote cmd rid params attemptnum area-dat areapath
readonly-mode dbfname testsuite mtexe)))))))
(define (tt:bid-for-servership run-id)
#f)
(define (tt:get-current-server-info ttdat dbfname run-id)
(let* ((sfiles (tt:find-server ttdat dbfname)))
(case (length sfiles)
((0) #f) ;; no server around
((1) (tt:server-get-info (car sfiles)))
(else #f) ;; we'll want to wait until extra servers have exited
)))
(define (tt:send-receive ttdat conn cmd run-id params)
(let* ((host-port (conc (tt-conn-host conn)":"(tt-conn-port conn)))
(dat (list cmd run-id params)))
(let-values (((inp oup)(tcp-connect host-port)))
(let ((res (if (and inp oup)
(begin
(serialize dat oup)
(close-output-port oup)
(deserialize inp))
(begin
(debug:print 0 *default-log-port* "ERROR: send called but no receiver has been setup. Please call setup first!")
#f))))
(close-input-port inp)
;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
res))))
;;======================================================================
;; server
;;======================================================================
(define (tt:sync-dbs ttdat)
#f)
|
| ︙ | | | ︙ | |
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
;; future: ping oldest, if alive remove other :<dbfname> files
;;
(define (tt:find-server ttdat dbfname)
(let* ((areapath (tt-areapath ttdat))
(servdir (tt:get-servinfo-dir areapath))
(sfiles (glob (conc servdir"/*:"dbfname))))
sfiles))
;; Given an area path, start a server process ### NOTE ### > file 2>&1
;; if the target-host is set
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
|
;; future: ping oldest, if alive remove other :<dbfname> files
;;
(define (tt:find-server ttdat dbfname)
(let* ((areapath (tt-areapath ttdat))
(servdir (tt:get-servinfo-dir areapath))
(sfiles (glob (conc servdir"/*:"dbfname))))
sfiles))
;; given a path to a server info file return: host port startseconds server-id
;; example of what it's looking for in the log file:
;; SERVER STARTED: 10.38.175.67:50216 AT 1616502350.0 server-id: 4907e90fc55c7a09694e3f658c639cf4
;;
(define (tt:server-get-info logf)
(let ((server-rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+) server-id: (\\S+) pid: (\\d+)")) ;; SERVER STARTED: host:port AT timesecs server id
(dbprep-rx (regexp "^SERVER: dbprep"))
(dbprep-found 0)
(bad-dat (list #f #f #f #f #f)))
(handle-exceptions
exn
(begin
;; WARNING: this is potentially dangerous to blanket ignore the errors
(if (file-exists? logf)
(debug:print-info 2 *default-log-port* "Unable to get server info from "logf", exn=" exn))
bad-dat) ;; no idea what went wrong, call it a bad server
(with-input-from-file
logf
(lambda ()
(let loop ((inl (read-line))
(lnum 0))
(if (not (eof-object? inl))
(let ((mlst (string-match server-rx inl))
(dbprep (string-match dbprep-rx inl)))
(if dbprep (set! dbprep-found 1))
(if (not mlst)
(if (< lnum 500) ;; give up if more than 500 lines of server log read
(loop (read-line)(+ lnum 1))
(begin
(debug:print-info 0 *default-log-port* "Unable to get server info from first 500 lines of " logf )
bad-dat))
(match mlst
((_ host port start server-id pid)
(list host
(string->number port)
(string->number start)
server-id
(string->number pid)))
(else
(debug:print 0 *default-log-port* "ERROR: did not recognise SERVER line info "mlst)
bad-dat))))
(begin
(if dbprep-found
(begin
(debug:print-info 2 *default-log-port* "Server is in dbprep at " (common:human-time))
(thread-sleep! 0.5)) ;; was 25 sec but that blocked things from starting?
(debug:print-info 0 *default-log-port* "Unable to get server info from " logf " at " (seconds->time-string (current-seconds))))
bad-dat))))))))
;; Given an area path, start a server process ### NOTE ### > file 2>&1
;; if the target-host is set
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
|
| ︙ | | | ︙ | |