Overview
| Comment: | Tidy output on server timeout. Add exception handler on evaluating variables in the shell |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
49e3e23dda3601f2714e1dad935688a5 |
| User & Date: | mrwellan on 2015-10-27 12:28:19 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-11-02
| ||
| 08:04 | More robust handling of rget when dependent vars do not exist. Minor output cleanup check-in: e1476e429d user: mrwellan tags: v1.60 | |
|
2015-10-27
| ||
| 12:28 | Tidy output on server timeout. Add exception handler on evaluating variables in the shell check-in: 49e3e23dda user: mrwellan tags: v1.60 | |
| 11:05 | oops. missed the logs part of the file names ... check-in: 56f19e80ce user: mrwellan tags: v1.60 | |
Changes
Modified configf.scm from [c70b933712] to [b1cdc5542b].
| ︙ | ︙ | |||
41 42 43 44 45 46 47 |
(define (config:assoc-safe-add alist key val #!key (metadata #f))
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (if metadata
(list key val metadata)
(list key val))))))
(define (config:eval-string-in-environment str)
| > > > > > | | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
(define (config:assoc-safe-add alist key val #!key (metadata #f))
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (if metadata
(list key val metadata)
(list key val))))))
(define (config:eval-string-in-environment str)
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
#f)
(let ((cmdres (cmd-run->list (conc "echo " str))))
(if (null? cmdres) ""
(caar cmdres)))))
;;======================================================================
;; Make the regexp's needed globally available
;;======================================================================
(define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
|
| ︙ | ︙ |
Modified http-transport.scm from [96dc217b5c] to [d387fec12a].
| ︙ | ︙ | |||
457 458 459 460 461 462 463 |
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
;;
;; no_traffic, no running tests, if server 0, no running servers
;;
| | | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 |
(set! last-access *last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
;;
;; no_traffic, no running tests, if server 0, no running servers
;;
;; (let ((wait-on-running (configf:lookup *configdat* "server" b"wait-on-running"))) ;; wait on running tasks (if not true then exit on time out)
;;
(let* ((hrs-since-start (/ (- (current-seconds) server-start-time) 3600))
(adjusted-timeout (if (> hrs-since-start 1)
(- server-timeout (inexact->exact (round (* hrs-since-start 60)))) ;; subtract 60 seconds per hour
server-timeout)))
(if (common:low-noise-print 120 "server timeout")
(debug:print-info 0 "Adjusted server timeout: " adjusted-timeout))
(if (and *server-run*
(> (+ last-access server-timeout)
(current-seconds)))
(begin
|
| ︙ | ︙ |