Megatest

Check-in [ad6bc47730]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.7001-multi-db-rb01
Files: files | file ages | folders
SHA1: ad6bc47730f74c8d929b260aabbfb4fb297f1e3c
User & Date: matt on 2022-04-07 05:16:46
Other Links: branch diff | manifest | tags
Context
2022-04-07
06:38
sync working? check-in: f2cf1492f8 user: matt tags: v1.7001-multi-db-rb01
05:16
wip check-in: ad6bc47730 user: matt tags: v1.7001-multi-db-rb01
2022-04-06
20:32
Added simple copy-sync method (not yet working) check-in: b439dea6cd user: matt tags: v1.7001-multi-db-rb01
Changes

Modified db.scm from [21e7872cdd] to [0b86155e4d].

5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088

5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106

5107
5108
5109
5110

5111
5112
5113
5114
5115
5116
5117
	(begin
	  (file-copy from-db to-db)
	  (db:no-sync-del! no-sync-db keyname)
	  #t)
	#f)))

;; straight forward copy based sync
;;  1. for each .db file
;;  2. next if file changed since last sync cycle
;;  2. next if time delta /tmp file to MTRA less than 3 seconds
;;  3. get a lock for the file in nosyncdb
;;  4. copy the file
;;  5. when copy is done release the lock
;;
;;  DONE
(define (server:writable-watchdog-copysync dbstruct)
  (thread-sleep! 0.05) ;; delay for startup
  (let ((legacy-sync        (common:run-sync?))
	(sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
 	(debug-mode         (debug:debug-mode 1))
 	(last-time          (current-seconds))     ;; last time through the sync loop
 	(no-sync-db         (db:open-no-sync-db))
 	(sync-duration      0)  ;; run time of the sync in milliseconds
	(tmp-area           (common:get-db-tmp-area)))
    (set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
    (debug:print-info 2 *default-log-port* "Periodic sync thread started.")
    (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is "legacy-sync" pid="(current-process-id));;  " this-wd-num="this-wd-num)
    
    (if (and legacy-sync (not *time-to-exit*))
 	(begin
 	  (debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
	  (let loop ()
 	    ;; sync for filesystem local db writes
 	    ;;
	    (let* ((dbfiles    (glob (conc tmp-area"/.db/*.db"))))

	      (for-each
	       (lambda (file)
		 (let* ((fname (pathname-file file))
			(fulln (conc *top-level*"/.db/"fname))
			(time1 (file-modification-time fname))
			(time2 (file-modification-time fulln))
			(changed (>= time1 time2))
			(do-cp (cond
				((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
				 (debug:print-info 0 "File "fulln" not found! Copying "fname" to "fulln)
				 #t)
				((and changed
				      (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
				 #t)
				((and changed *time-to-exit*) ;; last copy
				 #t)
				(else
				 #f))))

		   (if do-cp
		       (let* ((start-time (current-milliseconds)))
			 (db:lock-and-sync no-sync-db fname fulln)
			 (set! sync-duration (- (current-milliseconds) start-time))))))

	       dbfile))
	    ;; keep going unless time to exit
	    ;;
	    (if (not *time-to-exit*)
		(let delay-loop ((count 0))
		  ;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
		  







|

















|




|




>











|
|





>



|
>







5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
	(begin
	  (file-copy from-db to-db)
	  (db:no-sync-del! no-sync-db keyname)
	  #t)
	#f)))

;; straight forward copy based sync
;;  1. for each .db fil
;;  2. next if file changed since last sync cycle
;;  2. next if time delta /tmp file to MTRA less than 3 seconds
;;  3. get a lock for the file in nosyncdb
;;  4. copy the file
;;  5. when copy is done release the lock
;;
;;  DONE
(define (server:writable-watchdog-copysync dbstruct)
  (thread-sleep! 0.05) ;; delay for startup
  (let ((legacy-sync        (common:run-sync?))
	(sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
 	(debug-mode         (debug:debug-mode 1))
 	(last-time          (current-seconds))     ;; last time through the sync loop
 	(no-sync-db         (db:open-no-sync-db))
 	(sync-duration      0)  ;; run time of the sync in milliseconds
	(tmp-area           (common:get-db-tmp-area)))
    (set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
    (debug:print-info 2 *default-log-port* "Periodic copy-based sync thread started. sync is "legacy-sync", tmp-area is "tmp-area)
    (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is "legacy-sync" pid="(current-process-id));;  " this-wd-num="this-wd-num)
    
    (if (and legacy-sync (not *time-to-exit*))
 	(begin
 	  (debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
	  (let loop ()
 	    ;; sync for filesystem local db writes
 	    ;;
	    (let* ((dbfiles    (glob (conc tmp-area"/.db/*.db"))))
	      (debug:print-info 0 "dbfiles: "dbfiles)
	      (for-each
	       (lambda (file)
		 (let* ((fname (pathname-file file))
			(fulln (conc *top-level*"/.db/"fname))
			(time1 (file-modification-time fname))
			(time2 (file-modification-time fulln))
			(changed (>= time1 time2))
			(do-cp (cond
				((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
				 (debug:print-info 0 "File "fulln" not found! Copying "fname" to "fulln)
				 #t)
				(changed ;; (and changed
				 ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
				 #t)
				((and changed *time-to-exit*) ;; last copy
				 #t)
				(else
				 #f))))
		   (debug:print-info 0 "file: "file", fname: "fname", time1: "time1", time2: "time2)
		   (if do-cp
		       (let* ((start-time (current-milliseconds)))
			 (db:lock-and-sync no-sync-db fname fulln)
			 (set! sync-duration (- (current-milliseconds) start-time)))
		       (debug:print-info 0 "skipping sync..."))))
	       dbfile))
	    ;; keep going unless time to exit
	    ;;
	    (if (not *time-to-exit*)
		(let delay-loop ((count 0))
		  ;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
		  

Modified http-transport.scm from [bab35e8343] to [58ed70fa3e].

488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	  (let ((new-iface (car sdat))
		(new-port  (cadr sdat)))
	    (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
	    (set! iface new-iface)
	    (set! port  new-port)
             (if (not *server-id*)
              (set! *server-id* (server:mk-signature)))
            (debug:print 0 *default-log-port* (current-seconds) (current-directory) (current-process-id) (argv))
	    (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
	    (flush-output *default-log-port*)))
      
      ;; Transfer *db-last-access* to last-access to use in checking that we are still alive
      (mutex-lock! *heartbeat-mutex*)
      (set! last-access *db-last-access*)
      (mutex-unlock! *heartbeat-mutex*)







|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	  (let ((new-iface (car sdat))
		(new-port  (cadr sdat)))
	    (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
	    (set! iface new-iface)
	    (set! port  new-port)
             (if (not *server-id*)
              (set! *server-id* (server:mk-signature)))
            (debug:print-info 0 *default-log-port* (current-seconds)" "(current-directory)" " (current-process-id) (argv))
	    (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
	    (flush-output *default-log-port*)))
      
      ;; Transfer *db-last-access* to last-access to use in checking that we are still alive
      (mutex-lock! *heartbeat-mutex*)
      (set! last-access *db-last-access*)
      (mutex-unlock! *heartbeat-mutex*)