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))
;; make ttdat visible
(define *server-info* #f)
(define (tt:make-remote areapath)
(make-tt areapath: areapath))
|
|
|
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 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
|
(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)
(debug:print 0 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", "))
|
>
>
|
|
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) ", ")))
(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
|
(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
(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
|
|
>
|
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 (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
|