Overview
| Comment: | Make server runtime settable, improved log rotate |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | server-log-handshaking |
| Files: | files | file ages | folders |
| SHA1: |
581192039a4c965012922abaa54e9638 |
| User & Date: | matt on 2017-01-30 04:46:35 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-01-30
| ||
| 14:24 | Fixed debug message print that was missing the port check-in: 8149616a1d user: mrwellan tags: server-log-handshaking | |
| 04:46 | Make server runtime settable, improved log rotate check-in: 581192039a user: matt tags: server-log-handshaking | |
|
2017-01-29
| ||
| 16:33 | Deprecate api parallel message check-in: a642f429b1 user: matt tags: server-log-handshaking | |
Changes
Modified common.scm from [3380145d50] to [f57c29e310].
| ︙ | ︙ | |||
240 241 242 243 244 245 246 | ;; WARNING: This proc operates assuming that it is in the directory above the ;; logs directory you wish to log-rotate. ;; (define (common:rotate-logs) (if (not (directory-exists? "logs"))(create-directory "logs")) (directory-fold (lambda (file rem) | > > | | > > | | | | | | | > > > > > | 240 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 |
;; WARNING: This proc operates assuming that it is in the directory above the
;; logs directory you wish to log-rotate.
;;
(define (common:rotate-logs)
(if (not (directory-exists? "logs"))(create-directory "logs"))
(directory-fold
(lambda (file rem)
(let* ((fullname (conc "logs/" file))
(file-age (- (current-seconds)(file-modification-time fullname))))
(if (or (and (string-match "^.*.log" file)
(> (file-size (conc "logs/" file)) 200000))
(and (string-match "^server-.*.log" file)
(> (- (current-seconds) (file-modification-time (conc "logs/" file))(* 8 60 60 60)))))
(let ((gzfile (conc "logs/" file ".gz")))
(if (file-exists? gzfile)
(begin
(debug:print-info 0 *default-log-port* "removing " gzfile)
(delete-file gzfile)))
(debug:print-info 0 *default-log-port* "compressing " file)
(system (conc "gzip logs/" file)))
(if (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
(handle-exceptions
exn
#f
(delete-file fullname))))))
'()
"logs"))
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
(if (common:version-changed?)
|
| ︙ | ︙ |
Modified server.scm from [b68dac663e] to [878167efea].
| ︙ | ︙ | |||
217 218 219 220 221 222 223 |
(let ((now (current-seconds)))
(sort
(filter (lambda (rec)
(let ((start-time (list-ref rec 3))
(mod-time (list-ref rec 0)))
;; (print "start-time: " start-time " mod-time: " mod-time)
(and start-time mod-time
| | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 |
(let ((now (current-seconds)))
(sort
(filter (lambda (rec)
(let ((start-time (list-ref rec 3))
(mod-time (list-ref rec 0)))
;; (print "start-time: " start-time " mod-time: " mod-time)
(and start-time mod-time
(> (- now start-time) 0) ;; been running at least 0 seconds
(< (- now mod-time) 16) ;; still alive - file touched in last 16 seconds
(< (- now start-time) (string->number (or (configf:lookup *configdat* "server" "runtime") "3600"))) ;; under one hour running time
)))
srvlst)
(lambda (a b)
(< (list-ref a 3)
(list-ref b 3))))))
(define (server:get-first-best areapath)
|
| ︙ | ︙ | |||
262 263 264 265 266 267 268 |
(define (server:start-and-wait areapath #!key (timeout 60))
(let ((give-up-time (+ (current-seconds) timeout)))
(let loop ((server-url (server:check-if-running areapath)))
(if (or server-url
(> (current-seconds) give-up-time))
server-url
| | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 |
(define (server:start-and-wait areapath #!key (timeout 60))
(let ((give-up-time (+ (current-seconds) timeout)))
(let loop ((server-url (server:check-if-running areapath)))
(if (or server-url
(> (current-seconds) give-up-time))
server-url
(let ((num-ok (length (server:get-best (server:get-list areapath)))))
(if (< num-ok 2) ;; if there are no decent candidates for servers then try starting a new one
(server:kind-run areapath))
(thread-sleep! 5)
(loop (server:check-if-running areapath)))))))
(define server:try-running server:run) ;; there is no more per-run servers ;; REMOVE ME. BUG.
|
| ︙ | ︙ |