Megatest

Diff
Login

Differences From Artifact [dde6c522b1]:

To Artifact [8f58514e4b]:


102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+







  (last-access  (current-seconds))
  (servinf-file #f)
  (last-serv-start 0)
  )

;; parameters
;;
(define tt-server-timeout-param (make-parameter 300))
(define tt-server-timeout-param (make-parameter 600))

;; make ttdat visible
(define *server-info* #f)

(define (tt:make-remote areapath)
  (make-tt areapath: areapath))

273
274
275
276
277
278
279


280

281
282
283
284
285
286
287
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289







+
+
-
+







	 (sfiles   (tt:find-server areapath dbfname))
	 (sdats    (filter car (map tt:server-get-info sfiles))) ;; first element is #f if the file disappeared while being read
	 (sorted   (sort sdats (lambda (a b)
				 (< (list-ref a 2)(list-ref b 2)))))
	 (count    0))
    (for-each
     (lambda (rec)
       (if (or (> (length sorted) 1)
	       (common:low-noise-print 120 "server info sorted"))
       (debug:print 0 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", "))
	   (debug:print 0 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", ")))
       (set! count (+ count 1)))
     sorted)
    sorted))
    
(define (tt:get-current-server-info ttdat dbfname)
  (assert (tt-areapath ttdat) "FATAL: areapath not set in ttdat.")
  ;;
408
409
410
411
412
413
414
415


416
417
418
419
420
421
422
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
425







-
+
+







						(debug:print 0 *default-log-port* "Got server lock for "
							     dbfname)
						(set! db-locked-in #t)
						#t)
					      (begin
						(debug:print 0 *default-log-port* "Failed to get server lock for "dbfname)
						#f))))))
			  (if res
			  (if (and res
				   (common:low-noise-print 120 "top server message"))
			      (debug:print-info 0 *default-log-port* "Keep running, I'm the top server for "
						dbfname" on "(tt-host ttdat)":"(tt-port ttdat)))
			  res))
		       (else
			(debug:print-info 0 *default-log-port* "I'm not the lead server: "servers)
			(let* ((leadsrv (car servers)))
			  (match leadsrv