Megatest

Check-in [293027ea36]
Login
Overview
Comment:Trial 3. Backout server throttle code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.65-cleanup-try-3
Files: files | file ages | folders
SHA1: 293027ea364fb47f558f3ac1a8b33e3db8fea908
User & Date: matt on 2020-10-04 22:21:58
Other Links: branch diff | manifest | tags
Context
2020-10-04
22:21
Trial 3. Backout server throttle code. Closed-Leaf check-in: 293027ea36 user: matt tags: v1.65-cleanup-try-3
2020-08-26
22:56
fixed obscure bug when db is slightly malformed due to ^C. Tweak server gating, it is still not quite right... check-in: 58bd90c5bc user: mrwellan tags: v1.65-cleanup
Changes

Modified db.scm from [2f649dc1fb] to [8677e5cc9c].

457
458
459
460
461
462
463

464


465
466
467
468
469
470
471
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472
473







+
-
+
+







	  exn
	(begin
	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
	  (thread-sleep! 3)
	  (sqlite3:interrupt! db)
	  (db:safely-close-sqlite3-db db stmtcache try-num: (- try-num 1)))
	(if (sqlite3:database? db)
	    (let* ((stmts (if (hash-table? stmt-cache)
	    (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
                              (hash-table-ref/default stmt-cache db #f)
                               #f)))
	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
	      (sqlite3:finalize! db)
	      #t)
	    #f))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)

Modified server.scm from [0ee248d5ed] to [6a075dedb1].

322
323
324
325
326
327
328
329
330
331



332
333
334
335
336




337
338
339


340
341
342
343
344
345
346
322
323
324
325
326
327
328



329
330
331


332


333
334
335
336
337
338

339
340
341
342
343
344
345
346
347







-
-
-
+
+
+
-
-

-
-
+
+
+
+


-
+
+








;; wait for server=start-last to be three seconds old
;;
(define (server:wait-for-server-start-last-flag areapath)
  (let* ((start-flag (conc areapath "/logs/server-start-last")))
    (if (file-exists? start-flag)
	(let* ((fmodtime (file-modification-time start-flag))
	       (reftime  (+ 2 (random 3)))
	       (delta    (- (current-seconds) fmodtime))
	       (all-go   (> delta reftime)))
	       (reftime  (+ 3 (random 5)))
	       (delta    (- (current-seconds) fmodtime)))
	  (if (> delta reftime) ;; good enough
	  (if all-go
	      #t ;; (system (conc "touch " start-flag)) ;; lazy but safe
	      (begin
		(debug:print-info 0 *default-log-port* "Gating server start, last start: "
				  fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go)
		(debug:print-info 0 *default-log-port* "Ready to start server, last start: "
				  fmodtime ", delta: " delta ", reftime: " reftime)
		(system (conc "touch " start-flag))) ;; lazy but safe
	      (begin
		(thread-sleep! 5)
		(server:wait-for-server-start-last-flag areapath))))
	#;(system (conc "touch " start-flag)))))
	(system (conc "touch " start-flag)))))
	      

;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
;;
(define (server:kind-run areapath)
  ;; look for $MT_RUN_AREA_HOME/logs/server-start-last
  ;; and wait for it to be at least 3 seconds old