Megatest

Check-in [b51df9a459]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: b51df9a459b7b2b90f580e823356d3565e93831e
User & Date: matt on 2023-02-21 15:40:19
Other Links: branch diff | manifest | tags
Context
2023-02-21
16:54
Fixed run-id issue that caused wrong db to be addressed. check-in: c2f5ef0caf user: matt tags: v1.80-tcp-inmem
15:40
wip check-in: b51df9a459 user: matt tags: v1.80-tcp-inmem
11:39
server start smooth, but initial data load to inmem broken. check-in: 677b6ef8e8 user: matt tags: v1.80-tcp-inmem
Changes

Modified tcp-transportmod.scm from [2a0b975322] to [0a6f894ec9].

302
303
304
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
;; NOTE: organise by dbfname, not run-id so we don't need
;;       to pull in more modules
;;
;; This is the routine called in megatest.scm to start a server
;;
;; Server viability is checked in keep-running. Blindly start and run here.
;;
(define (tt:start-server areapath run-id dbfname handler keys)
  (assert areapath "FATAL: areapath not provided for tt:start-server")
  ;; is there already a server for this dbfile? Then exit.
  (let* ((ttdat   (make-tt areapath: areapath)))

    ;; (servers (tt:find-server areapath dbfname))) ;; should use tt:get-current-server-info instead
    ;; (if (null? servers)
    (let* ((dbstruct   (dbmod:open-dbmoddb areapath run-id dbfname (dbfile:db-init-proc) keys)))
      (tt-handler-set! ttdat (handler dbstruct))
      (let* ((tcp-thread (make-thread
			  (lambda ()
			    (tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data
			  "tcp-server-thread"))
	     (run-thread (make-thread
			  (lambda ()
			    (tt:keep-running ttdat dbfname dbstruct)))))
	(thread-start! tcp-thread)
	(thread-start! run-thread)
	(thread-join! run-thread) ;; run thread will exit on timeout or other conditions
	;;
	;; set a flag here to tell tcp-thread to stop running
	;;
	;; (thread-join! tcp-thread) ;; can't wait 
	;;
	;; remove the servinfo file
	;;
	;; close the database, remove lock in on-disk db
	;;
	;; close the listener ports
	;;
	(exit)))
    ;;(begin
    ;; (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
    ;; (exit)))))
    ))

(define (tt:keep-running ttdat dbfname dbstruct)







|


|
>














<
<
<
<
<
<
<
<
<
<
<







302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327











328
329
330
331
332
333
334
;; NOTE: organise by dbfname, not run-id so we don't need
;;       to pull in more modules
;;
;; This is the routine called in megatest.scm to start a server
;;
;; Server viability is checked in keep-running. Blindly start and run here.
;;
(define (tt:start-server areapath run-id dbfname-in handler keys)
  (assert areapath "FATAL: areapath not provided for tt:start-server")
  ;; is there already a server for this dbfile? Then exit.
  (let* ((ttdat   (make-tt areapath: areapath))
	 (dbfname (or dbfname-in (dbmod:run-id->dbfname run-id))))
    ;; (servers (tt:find-server areapath dbfname))) ;; should use tt:get-current-server-info instead
    ;; (if (null? servers)
    (let* ((dbstruct   (dbmod:open-dbmoddb areapath run-id dbfname (dbfile:db-init-proc) keys)))
      (tt-handler-set! ttdat (handler dbstruct))
      (let* ((tcp-thread (make-thread
			  (lambda ()
			    (tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data
			  "tcp-server-thread"))
	     (run-thread (make-thread
			  (lambda ()
			    (tt:keep-running ttdat dbfname dbstruct)))))
	(thread-start! tcp-thread)
	(thread-start! run-thread)
	(thread-join! run-thread) ;; run thread will exit on timeout or other conditions











	(exit)))
    ;;(begin
    ;; (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
    ;; (exit)))))
    ))

(define (tt:keep-running ttdat dbfname dbstruct)
356
357
358
359
360
361
362
363
364
365
366


367
368
369
370
371
372
373
	    (exit 1))
	  (if (not (tt-port ttdat)) ;; no connection yet
	      (let* ((last-update (dbr:dbstruct-last-update dbstruct))
		     (curr-secs   (current-seconds)))
		(if (> (- curr-secs last-update) 3) ;; every 3-4 seconds update the db? maybe this should be refresh the inmem?
		    (begin
		      ((dbr:dbstruct-sync-proc dbstruct) last-update)
		      (dbr:dbstruct-last-update-set! curr-secs)))
		(thread-sleep! 0.25)
		(loop (+ count 1))))))
    


    (tt:create-server-registration-file ttdat dbfname)
    ;; now start watching the last-access, if it hasn't been touched
    ;; in over ten seconds we exit
    (thread-sleep! 0.05) ;; any real need for delay here?
    (let loop ()
      (let* ((servers (tt:get-server-info-sorted ttdat dbfname))
	     (ok      (cond







|


|
>
>







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
	    (exit 1))
	  (if (not (tt-port ttdat)) ;; no connection yet
	      (let* ((last-update (dbr:dbstruct-last-update dbstruct))
		     (curr-secs   (current-seconds)))
		(if (> (- curr-secs last-update) 3) ;; every 3-4 seconds update the db? maybe this should be refresh the inmem?
		    (begin
		      ((dbr:dbstruct-sync-proc dbstruct) last-update)
		      (dbr:dbstruct-last-update-set! dbstruct curr-secs)))
		(thread-sleep! 0.25)
		(loop (+ count 1))))))
    ;; load or reload the data into inmem db before
    ;; ((dbr:dbstruct-sync-proc dbstruct) (dbr:dbstruct-last-update dbstruct))
    ;; (dbr:dbstruct-last-update-set! dbstruct (- (current-seconds) 1))
    (tt:create-server-registration-file ttdat dbfname)
    ;; now start watching the last-access, if it hasn't been touched
    ;; in over ten seconds we exit
    (thread-sleep! 0.05) ;; any real need for delay here?
    (let loop ()
      (let* ((servers (tt:get-server-info-sorted ttdat dbfname))
	     (ok      (cond