Overview
| Comment: | Removed the wrapper for config:assoc-safe-add |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
7a32ddd847cc5edaa26abbbdb99e1286 |
| User & Date: | mmgraham on 2021-06-23 11:06:29 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-07-13
| ||
| 14:56 | Added propagate-exit-code option. check-in: 34272c5a2d user: mmgraham tags: v1.65 | |
|
2021-06-23
| ||
| 11:06 | Removed the wrapper for config:assoc-safe-add check-in: 7a32ddd847 user: mmgraham tags: v1.65 | |
|
2021-06-12
| ||
| 17:41 | changed Server is in dbprep and no servers running messages to debug 2. Removed the use of grep to find exited server logs. changed the use of numservers to select between 1 to numservers. check-in: 3da36b7bfb user: mmgraham tags: v1.65, v1.6586 | |
Changes
Modified configf.scm from [e25d127827] to [b768bf346e].
| ︙ | ︙ | |||
52 53 54 55 56 57 58 |
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (if metadata
(list key val metadata)
(list key val))))))
;; this is used in megatestqa/ext.scm.
;; remove it from here and there by 12/31/21
| | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 |
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (if metadata
(list key val metadata)
(list key val))))))
;; this is used in megatestqa/ext.scm.
;; remove it from here and there by 12/31/21
;; (define config:assoc-safe-add configf:assoc-safe-add)
(define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f))
(hash-table-set! cfgdat section-name
(configf:assoc-safe-add
(hash-table-ref/default cfgdat section-name '())
var value metadata: metadata)))
|
| ︙ | ︙ |
Modified server.scm from [9aa343c195] to [d261c5be21].
| ︙ | ︙ | |||
229 230 231 232 233 234 235 236 237 238 239 240 241 242 |
(exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
(exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn)))
(directory-exists? (conc areapath "/logs")))
'()))
;; Get the list of server logs. First remove logs for servers that have exited.
(let* (
;; (exiting-servers (system (conc "bash -c 'rm -f `grep -il exiting " areapath "/logs/server-*-*.log 2> /dev/null`'")))
(server-logs (glob (conc areapath "/logs/server-*-*.log")))
(num-serv-logs (length server-logs)))
(if (or (null? server-logs) (= num-serv-logs 0))
(let ()
(debug:print 2 *default-log-port* "There are no servers running at " (common:human-time))
'()
| > | 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 |
(exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
(exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn)))
(directory-exists? (conc areapath "/logs")))
'()))
;; Get the list of server logs. First remove logs for servers that have exited.
(let* (
;; For some reason, when I uncomment the below line, ext-tests sometimes starts 1000's of servers.
;; (exiting-servers (system (conc "bash -c 'rm -f `grep -il exiting " areapath "/logs/server-*-*.log 2> /dev/null`'")))
(server-logs (glob (conc areapath "/logs/server-*-*.log")))
(num-serv-logs (length server-logs)))
(if (or (null? server-logs) (= num-serv-logs 0))
(let ()
(debug:print 2 *default-log-port* "There are no servers running at " (common:human-time))
'()
|
| ︙ | ︙ | |||
453 454 455 456 457 458 459 |
(let ((ns (string->number
(or (configf:lookup *configdat* "server" "numservers") "notanumber"))))
(or ns numservers)))
;; no longer care if multiple servers are started by accident. older servers will drop off in time.
;;
(define (server:check-if-running areapath) ;; #!key (numservers "2"))
| | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 |
(let ((ns (string->number
(or (configf:lookup *configdat* "server" "numservers") "notanumber"))))
(or ns numservers)))
;; no longer care if multiple servers are started by accident. older servers will drop off in time.
;;
(define (server:check-if-running areapath) ;; #!key (numservers "2"))
(let* ((ns (server:get-num-servers)) ;; get the setting the for maximum number of servers allowed
(servers (server:get-best (server:get-list areapath))))
(if (or (and servers
(null? servers))
(not servers)
(and (list? servers)
(< (length servers) (+ 1 (random ns))))) ;; somewhere between 1 and numservers
#f
|
| ︙ | ︙ |