Overview
| Comment: | Fixed several unusual crashes |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64 |
| Files: | files | file ages | folders |
| SHA1: |
51fbce80b934b0c5f460159e7893bf91 |
| User & Date: | matt on 2017-03-28 14:59:57 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-03-28
| ||
| 17:07 | adding triage script check-in: 01756c020e user: bjbarcla tags: v1.64 | |
| 14:59 | Fixed several unusual crashes check-in: 51fbce80b9 user: matt tags: v1.64 | |
| 13:06 | Fixed call to runs:clear-cache with wrong arguments. Make tests:get-tests-search-path resistant to bad config data check-in: 619330088c user: matt tags: v1.64 | |
Changes
Modified configf.scm from [0cf569e087] to [e78af9bffb].
| ︙ | ︙ | |||
665 666 667 668 669 670 671 |
(with-input-from-file fname read))))
(define (configf:write-alist cdat fname)
(let ((dat (configf:config->alist cdat)))
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
| | | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 |
(with-input-from-file fname read))))
(define (configf:write-alist cdat fname)
(let ((dat (configf:config->alist cdat)))
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
(if (common:file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
(begin
(handle-exceptions
exn
#f
(debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
|
| ︙ | ︙ |
Modified http-transport.scm from [826398cdb7] to [de2800221f].
| ︙ | ︙ | |||
435 436 437 438 439 440 441 |
((and *server-run*
(> (+ last-access server-timeout)
(current-seconds))
(< (- (current-seconds) server-start-time) 3600)) ;; do not update log or touch log if we've been running for more than one hour.
(if (common:low-noise-print 120 "server continuing")
(debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(let ((curr-time (current-seconds)))
| > > > | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 |
((and *server-run*
(> (+ last-access server-timeout)
(current-seconds))
(< (- (current-seconds) server-start-time) 3600)) ;; do not update log or touch log if we've been running for more than one hour.
(if (common:low-noise-print 120 "server continuing")
(debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(let ((curr-time (current-seconds)))
(handle-exceptions
exn
(debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on log file " server-log-file ". Are you out of space on that disk?")
(change-file-times server-log-file curr-time curr-time))))
(loop 0 server-state bad-sync-count (current-milliseconds)))
(else
(debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
(http-transport:server-shutdown port)))))))
(define (http-transport:server-shutdown port)
(begin
|
| ︙ | ︙ |
Modified runs.scm from [b7a198d7dd] to [6be506be73].
| ︙ | ︙ | |||
78 79 80 81 82 83 84 |
;; from the cached data set the vars
(hash-table-for-each
vals
(lambda (key val)
(debug:print 2 *default-log-port* "setenv " key " " val)
(safe-setenv key val)))
(if (not (get-environment-variable "MT_TARGET"))(setenv "MT_TARGET" target))
| > > > > > > > | | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
;; from the cached data set the vars
(hash-table-for-each
vals
(lambda (key val)
(debug:print 2 *default-log-port* "setenv " key " " val)
(safe-setenv key val)))
(if (not (get-environment-variable "MT_TARGET"))(setenv "MT_TARGET" target))
;; we had a case where there was an exception generated by the hash-table-ref
;; due to *configdat* being #f Adding a handle and exit
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "FATAL: *configdat* was inaccessible! This should never happen.")
(exit 1))
(alist->env-vars (hash-table-ref/default *configdat* "env-override" '())))
;; Lets use this as an opportunity to put MT_RUNNAME in the environment
(let ((runname (if inrunname inrunname (rmt:get-run-name-from-id run-id))))
(if runname
(setenv "MT_RUNNAME" runname)
(debug:print-error 0 *default-log-port* "no value for runname for id " run-id)))
(setenv "MT_RUN_AREA_HOME" *toppath*)
;; if a testname and itempath are available set the remaining appropriate variables
|
| ︙ | ︙ |