338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
))
(define (tt:keep-running ttdat dbfname dbstruct)
;; verfiy conn for ready
;; listener socket has been started by this stage
;; wait for a port before creating the registration file
;;
(let* ((cleanup (lambda ()
((tt-cleanup-proc ttdat))))))
(let loop ((count 0))
(if (> count 240)
(begin
(debug:print 0 *default-log-port* "FATAL: Could not start a tcp server, giving up.")
(exit 1))
(if (not (tt-port ttdat)) ;; no connection yet
(begin
|
>
>
>
|
|
>
>
>
|
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
|
))
(define (tt:keep-running ttdat dbfname dbstruct)
;; verfiy conn for ready
;; listener socket has been started by this stage
;; wait for a port before creating the registration file
;;
(let* ((db-locked-in #f)
(areapath (tt-areapath ttdat))
(nosyncdbpath (conc areapath"/.megatest"))
(cleanup (lambda ()
(if (tt-cleanup-proc ttdat)
((tt-cleanup-proc ttdat)))
(dbfile:with-no-sync-db nosyncdbpath
(lambda (db)
(db:no-sync-del! db dbfname))))))
(let loop ((count 0))
(if (> count 240)
(begin
(debug:print 0 *default-log-port* "FATAL: Could not start a tcp server, giving up.")
(exit 1))
(if (not (tt-port ttdat)) ;; no connection yet
(begin
|
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
|
(let loop ()
(let* ((servers (tt:get-server-info-sorted ttdat dbfname))
(ok (cond
((null? servers) #f) ;; not ok
((equal? (list-ref (car servers) 6) ;; compare the servinfofile
(tt-servinf-file ttdat))
(debug:print-info 0 *default-log-port* "Keep running, I'm the top server.")
#t)
(else
(debug:print-info 0 *default-log-port* "I'm not the lead server: "servers)
(let* ((leadsrv (car servers)))
(match leadsrv
((host port startseconds server-id pid dbfname servinfofile)
(if (tt:ping host port server-id)
#f ;; not the server, but all good, want to exit
|
>
|
>
>
>
>
>
|
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
|
(let loop ()
(let* ((servers (tt:get-server-info-sorted ttdat dbfname))
(ok (cond
((null? servers) #f) ;; not ok
((equal? (list-ref (car servers) 6) ;; compare the servinfofile
(tt-servinf-file ttdat))
(debug:print-info 0 *default-log-port* "Keep running, I'm the top server.")
(if db-locked-in
#t
(let* ((lockinfo (dbfile:with-no-sync-db nosyncdbpath
(lambda (db)
(db:no-sync-get-lock db dbfname))))
(success (car lockinfo)))
success)))
(else
(debug:print-info 0 *default-log-port* "I'm not the lead server: "servers)
(let* ((leadsrv (car servers)))
(match leadsrv
((host port startseconds server-id pid dbfname servinfofile)
(if (tt:ping host port server-id)
#f ;; not the server, but all good, want to exit
|