Overview
Comment: | More cleanup on exit handling. Exit on ^Z |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
824cbc749e28269c81b424f20d809091 |
User & Date: | matt on 2015-05-27 05:36:52 |
Other Links: | branch diff | manifest | tags |
Context
2015-05-27
| ||
11:40 | Removed exit from on-exit call. check-in: b4a4de8e9e user: mrwellan tags: v1.60, v1.6014a | |
05:36 | More cleanup on exit handling. Exit on ^Z check-in: 824cbc749e user: matt tags: v1.60 | |
2015-05-26
| ||
23:40 | Still trying to get watchdog, on-exit and signal/int or signal/term working gracefully check-in: ec49837f01 user: matt tags: v1.60 | |
Changes
Modified client.scm from [56bcfe26a8] to [ecbc2f1355].
︙ | ︙ | |||
209 210 211 212 213 214 215 | (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))) | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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)))) ;; |
Modified common.scm from [2dd389ebcc] to [6b238a264b].
︙ | ︙ | |||
241 242 243 244 245 246 247 | (pathname-file *toppath*))) ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (std-exit-procedure) | > > > | > | | | | | | | | | | | | | | | | > | | | | | | | | > | > | | | | | | > > | 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) #t)))) (debug:print-info 4 "starting exit process, finalizing databases.") (if (and no-hurry (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")) (if no-hurry (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...") (if no-hurry (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff (thread-sleep! 1)) (debug:print 0 " Done.") (exit)) "clean exit"))) (thread-start! th2) (thread-start! th1) (thread-join! th2)))) (define (std-signal-handler signum) ;; (signal-mask! signum) (set! *time-to-exit* #t) (debug:print 0 "ERROR: Received signal " signum " exiting promptly") ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway (exit)) (set-signal-handler! signal/int std-signal-handler) ;; ^C (set-signal-handler! signal/term std-signal-handler) (set-signal-handler! signal/stop std-signal-handler) ;; ^Z ;;====================================================================== ;; Misc utils ;;====================================================================== ;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5 (define (common:hms-string->seconds tstr) |
︙ | ︙ |
Modified runs.scm from [8d9102e934] to [201ab7c8d7].
︙ | ︙ | |||
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | (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 (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") (exit)))) (th2 (make-thread (lambda () | > > > | | > | 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! 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/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) |
︙ | ︙ |