Overview
Context
Changes
Modified client.scm
from [56bcfe26a8]
to [ecbc2f1355].
| ︙ | | |
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(client:setup run-id remaining-tries: (- remaining-tries 1)))))))))
;; keep this as a function to ease future
(define (client:start run-id server-info)
(http-transport:client-connect (tasks:hostinfo-get-interface server-info)
(tasks:hostinfo-get-port server-info)))
;; client:signal-handler
(define (client:signal-handler signum)
(signal-mask! signum)
(set! *time-to-exit* #t)
(handle-exceptions
exn
(debug:print " ... exiting ...")
(let ((th1 (make-thread (lambda ()
"") ;; do nothing for now (was flush out last call if applicable)
"eat response"))
(th2 (make-thread (lambda ()
(debug:print 0 "ERROR: Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
(thread-sleep! 1) ;; give the flush one second to do it's stuff
(debug:print 0 " Done.")
(exit 4))
"exit on ^C timer")))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2))))
;; client:launch
;; Need to set the signal handler somewhere other than here as this
;; routine will go away.
;;
(define (client:launch run-id)
(set-signal-handler! signal/int client:signal-handler)
(set-signal-handler! signal/term client:signal-handler)
(if (client:setup run-id)
(debug:print-info 2 "connected as client")
(begin
(debug:print 0 "ERROR: Failed to connect as client")
(exit))))
;; ;; client:signal-handler
;; (define (client:signal-handler signum)
;; (signal-mask! signum)
;; (set! *time-to-exit* #t)
;; (handle-exceptions
;; exn
;; (debug:print " ... exiting ...")
;; (let ((th1 (make-thread (lambda ()
;; "") ;; do nothing for now (was flush out last call if applicable)
;; "eat response"))
;; (th2 (make-thread (lambda ()
;; (debug:print 0 "ERROR: Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
;; (thread-sleep! 1) ;; give the flush one second to do it's stuff
;; (debug:print 0 " Done.")
;; (exit 4))
;; "exit on ^C timer")))
;; (thread-start! th2)
;; (thread-start! th1)
;; (thread-join! th2))))
;;
;; ;; client:launch
;; ;; Need to set the signal handler somewhere other than here as this
;; ;; routine will go away.
;; ;;
;; (define (client:launch run-id)
;; (set-signal-handler! signal/int client:signal-handler)
;; (set-signal-handler! signal/term client:signal-handler)
;; (if (client:setup run-id)
;; (debug:print-info 2 "connected as client")
;; (begin
;; (debug:print 0 "ERROR: Failed to connect as client")
;; (exit))))
;;
|
Modified common.scm
from [2dd389ebcc]
to [6b238a264b].
| ︙ | | |
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
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
|
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
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(pathname-file *toppath*)))
;;======================================================================
;; E X I T H A N D L I N G
;;======================================================================
(define (std-exit-procedure)
(let ((no-hurry (if *time-to-exit* ;; hurry up
#f
(begin
(set! *time-to-exit* #t)
(debug:print-info 4 "starting exit process, finalizing databases.")
(if (debug:debug-mode 18)
(rmt:print-db-stats))
(let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
(let ((run-ids (hash-table-keys *db-local-sync*)))
(if (and (not (null? run-ids))
(configf:lookup *configdat* "setup" "megatest-db"))
(db:multi-db-sync run-ids 'new2old)))
(if *dbstruct-db* (db:close-all *dbstruct-db*))
(if *inmemdb* (db:close-all *inmemdb*))
(if (and *megatest-db*
(sqlite3:database? *megatest-db*))
(begin
(sqlite3:interrupt! *megatest-db*)
(sqlite3:finalize! *megatest-db* #t)
(set! *megatest-db* #f)))
(if *task-db* (let ((db (cdr *task-db*)))
(if (sqlite3:database? db)
(begin
(sqlite3:interrupt! db)
(sqlite3:finalize! db #t)
(vector-set! *task-db* 0 #f)))))) "Cleanup db exit thread"))
(th2 (make-thread (lambda ()
(debug:print 4 "Attempting clean exit. Please be patient and wait a few seconds...")
(thread-sleep! 5) ;; give the clean up few seconds to do it's stuff
(debug:print 0 " Done.")
(exit))
"clean exit")))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))
|
| ︙ | | |
Modified runs.scm
from [8d9102e934]
to [201ab7c8d7].
| ︙ | | |
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
+
+
+
-
+
-
+
+
|
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
(tdbdat (tasks:open-db)))
(if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
(let ((sighand (lambda (signum)
;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
(if (eq? signum signal/stop)
(debug:print 0 "ERROR: attempt to STOP process. Exiting."))
(set! *time-to-exit* #t)
(print "Received signal " signum ", cleaning up before exit. Please wait...")
(let ((th1 (make-thread (lambda ()
(let ((tdbdat (tasks:open-db)))
(rmt:tasks-set-state-given-param-key task-key "killed"))
(print "Killed by signal " signum ". Exiting")
(thread-sleep! 3)
(exit))))
(th2 (make-thread (lambda ()
(thread-sleep! 3)
(thread-sleep! 5)
(debug:print 0 "Done")
(exit 4)))))
(thread-start! th2)
(thread-start! th1)
(thread-join! th2)))))
(set-signal-handler! signal/int sighand)
(set-signal-handler! signal/term sighand))
(set-signal-handler! signal/term sighand)
(set-signal-handler! signal/stop sighand))
;; register this run in monitor.db
(rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
(rmt:tasks-set-state-given-param-key task-key "running")
(runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
|
| ︙ | | |