Megatest

Check-in [1550ea7ddf]
Login
Overview
Comment:Trim couple sleeps that seem unnecessary
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-trim-sleeps
Files: files | file ages | folders
SHA1: 1550ea7ddf75b4478f9cf8719b00fc1cafa26a1e
User & Date: mrwellan on 2019-03-29 17:59:59
Other Links: branch diff | manifest | tags
Context
2019-04-01
08:32
Merged trim sleeps check-in: db1d22eadb user: mrwellan tags: v1.65
2019-03-29
17:59
Trim couple sleeps that seem unnecessary Closed-Leaf check-in: 1550ea7ddf user: mrwellan tags: v1.65-trim-sleeps
13:17
merged changes to reduce load of brute force syner check-in: f61052be3c user: bjbarcla tags: v1.65, v1.6528
Changes

Modified server.scm from [a266765465] to [868645b72c].

326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340







-
+







				(else 600))
			      (random 5)))   ;; add a small random number just in case a lot of jobs hit the work hosts simultaneously
	     (lock-file    (conc areapath "/logs/server-start.lock")))
	(if	(> (- (current-seconds) when-run) run-delay)
		(begin
		  (common:simple-file-lock-and-wait lock-file expire-time: 15)
		  (server:run areapath)
		  (thread-sleep! 5) ;; don't release the lock for at least a few seconds
		  (thread-sleep! 2) ;; don't release the lock for at least a few seconds
		  (common:simple-file-release-lock lock-file)))
	(hash-table-set! *server-kind-run* areapath (list (+ call-num 1)(current-seconds))))))

(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))
	       (try-num    0))
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606







-
+







              (BB> "End do-a-sync with fork-to-background="fork-to-background" persist-until-sync="persist-until-sync" and result="finalres)
              finalres)
            ) ;; end lambda
          ))
    do-a-sync))

(define (server:writable-watchdog dbstruct)
  (thread-sleep! 10) ;; delay for startup
  (thread-sleep! 1) ;; delay for startup
  (let* ((do-a-sync  (server:get-bruteforce-syncer dbstruct))
         (final-sync (server:get-bruteforce-syncer dbstruct fork-to-background: #t persist-until-sync: #t)))
    (when (and (not (args:get-arg "-sync-to-megatest.db")) ;; conditions under which we do not run the sync
	       (args:get-arg "-server"))
      
      (let loop ()
	(do-a-sync)