Megatest

Check-in [581192039a]
Login
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: 581192039a4c965012922abaa54e963896d40bdf
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


247
248
249
250
251
252
253
254
255
















256
257
258
259
260
261
262
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 (and (string-match "^.*.log" file)
	      (> (file-size (conc "logs/" file)) 200000))
	 (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 (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
224

225
226

227
228
229
230
231
232
233
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) 1)    ;; been running at least 1 seconds
		      (> (- 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) 3600) ;; under one hour running time
		      (< (- 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
269

270
271
272
273
274
275
276
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 (server:get-best (server:get-list areapath))))
	  (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.