Overview
Comment: | tweaked recovery from bad server. use timestamped files and a symlink to make creating .megatest.cfg files fairly robust |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
f0e9d7b937077fd6b8d682754a462fd9 |
User & Date: | matt on 2014-12-07 22:24:25 |
Other Links: | branch diff | manifest | tags |
Context
2014-12-08
| ||
12:39 | Fixed call where :state and :status were not aliased to -state and -status. Improved watch dog exit to not wait gratuitious five seconds before exiting check-in: a834ac5f9e user: mrwellan tags: v1.60 | |
2014-12-07
| ||
22:24 | tweaked recovery from bad server. use timestamped files and a symlink to make creating .megatest.cfg files fairly robust check-in: f0e9d7b937 user: matt tags: v1.60 | |
18:47 | Added caching of megatest.config, no locking yet... check-in: 800fea92da user: matt tags: v1.60 | |
Changes
Modified http-transport.scm from [0d0f56da13] to [ef8d9caccb].
︙ | ︙ | |||
271 272 273 274 275 276 277 | (begin (set! success #f) (debug:print 0 "WARNING: failure in with-input-from-request to " fullurl ".") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) (hash-table-delete! *runremote* run-id) ;; Killing associated server to allow clean retry.") (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine? | | | | 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 | (begin (set! success #f) (debug:print 0 "WARNING: failure in with-input-from-request to " fullurl ".") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) (hash-table-delete! *runremote* run-id) ;; Killing associated server to allow clean retry.") (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine? (signal (make-composite-condition (make-property-condition 'commfail 'message "failed to connect to server"))) "communications failed") (with-input-from-request ;; was dat fullurl (list (cons 'key "thekey") (cons 'cmd cmd) (cons 'params sparams)) read-string)) |
︙ | ︙ |
Modified launch.scm from [3088fdcb77] to [7a10f8ba92].
︙ | ︙ | |||
449 450 451 452 453 454 455 | (define (launch:setup-for-run #!key (force #f)) ;; would set values for KEYS in the environment here for better support of env-override but ;; have chicken/egg scenario. need to read megatest.config then read it again. Going to ;; pass on that idea for now ;; special case (if (or force (not (hash-table? *configdat*))) ;; no need to re-open on every call (begin | | | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 | (define (launch:setup-for-run #!key (force #f)) ;; would set values for KEYS in the environment here for better support of env-override but ;; have chicken/egg scenario. need to read megatest.config then read it again. Going to ;; pass on that idea for now ;; special case (if (or force (not (hash-table? *configdat*))) ;; no need to re-open on every call (begin (set! *configinfo* (or (if (get-environment-variable "MT_MDINFO") ;; we are inside a test - do not reprocess configs (let ((alistconfig (conc (get-environment-variable "MT_LINKTREE") "/" (get-environment-variable "MT_TARGET") "/" (get-environment-variable "MT_RUNNAME") "/" ".megatest.cfg"))) (if (file-exists? alistconfig) (list (configf:read-alist alistconfig) (get-environment-variable "MT_RUN_AREA_HOME")) |
︙ | ︙ | |||
528 529 530 531 532 533 534 | (if (file-exists? linktree) ;; can't proceed without linktree (begin (if (not (file-exists? fulldir)) (create-directory fulldir #t)) ;; need to protect with exception handler (if (and target runname (file-exists? fulldir)) | | > | > > | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 | (if (file-exists? linktree) ;; can't proceed without linktree (begin (if (not (file-exists? fulldir)) (create-directory fulldir #t)) ;; need to protect with exception handler (if (and target runname (file-exists? fulldir)) (let ((tmpfile (conc fulldir "/.megatest.cfg." (current-seconds))) (targfile (conc fulldir "/.megatest.cfg"))) (debug:print-info 0 "Caching megatest.config in " fulldir "/.megatest.cfg") (configf:write-alist *configdat* tmpfile) (system (conc "ln -sf " tmpfile " " targfile)) ))))))) (define (get-best-disk confdat) (let* ((disks (hash-table-ref/default confdat "disks" #f)) (best #f) (bestsize 0)) (if disks |
︙ | ︙ | |||
690 691 692 693 694 695 696 | lnkpath) testname "") ;; (rmt:general-call 'test-set-rundir run-id lnkpath testname "") ;; toptest-path) (if (or (not curr-test-path) (not (directory-exists? toptest-path))) (begin (debug:print-info 2 "Creating " toptest-path " and link " lnkpath) | > > > | | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 | lnkpath) testname "") ;; (rmt:general-call 'test-set-rundir run-id lnkpath testname "") ;; toptest-path) (if (or (not curr-test-path) (not (directory-exists? toptest-path))) (begin (debug:print-info 2 "Creating " toptest-path " and link " lnkpath) (handle-exceptions exn #f ;; don't care to catch and deal with errors here for now. (create-directory toptest-path #t)) (hash-table-set! *toptest-paths* testname toptest-path))))) ;; The toptest path has been created, the link to the test in the linktree has ;; been created. Now, if this is an iterated test the real test dir must be created (if (not not-iterated) ;; this is an iterated test (begin ;; (let ((lnktarget (conc lnkpath "/" item-path))) (debug:print 2 "Setting up sub test run area") |
︙ | ︙ |
Modified rmt.scm from [43798d972b] to [9cda1b0f8b].
︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | ;; ) ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== (define (rmt:call-transport run-id connection-info cmd jparams) (case (server:get-transport) ((rpc) ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)) ((http) (http-transport:client-api-send-receive run-id connection-info cmd jparams)) ((fs) ( fs-transport:client-api-send-receive run-id connection-info cmd jparams)) ((zmq) (zmq-transport:client-api-send-receive run-id connection-info cmd jparams)) (else ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)))) | > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | ;; ) ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; NOT USED ;; (define (rmt:call-transport run-id connection-info cmd jparams) (case (server:get-transport) ((rpc) ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)) ((http) (http-transport:client-api-send-receive run-id connection-info cmd jparams)) ((fs) ( fs-transport:client-api-send-receive run-id connection-info cmd jparams)) ((zmq) (zmq-transport:client-api-send-receive run-id connection-info cmd jparams)) (else ( rpc-transport:client-api-send-receive run-id connection-info cmd jparams)))) |
︙ | ︙ | |||
230 231 232 233 234 235 236 | (hash-table-set! *db-local-sync* (or run-id 0) start-time) ;; the oldest "write" (mutex-unlock! *db-multi-sync-mutex*))) res))) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) ;; (jparams (db:obj->string params)) ;; (rmt:dat->json-str params)) | > | > | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | (hash-table-set! *db-local-sync* (or run-id 0) start-time) ;; the oldest "write" (mutex-unlock! *db-multi-sync-mutex*))) res))) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) ;; (jparams (db:obj->string params)) ;; (rmt:dat->json-str params)) (res (condition-case (http-transport:client-api-send-receive run-id connection-info cmd params) ((commfail)(vector #f "communications fail"))))) (if (and res (vector-ref res 0)) res #f))) ;; (db:string->obj (vector-ref dat 1)) ;; (begin ;; (debug:print 0 "ERROR: rmt:send-receive-no-auto-client-setup failed, attempting to continue. Got " dat) ;; dat)))) |
︙ | ︙ |