Megatest

;;======================================================================
;; no-sync.db - small bits of data to be shared between servers
;;======================================================================

(define (db:open-no-sync-db)
  (dbfile:open-no-sync-db (db:dbfile-path)))

;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
  (mutex-lock! *db-access-mutex*)
  (let ((res (if db-in
                 db-in
                 (let ((db (db:open-no-sync-db)))
                   (set! *no-sync-db* db)
                   db))))
    (mutex-unlock! *db-access-mutex*)
    res))

(define (db:no-sync-set db var val)
  (sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))

(define (db:no-sync-del! db var)
  (sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))

(define (db:no-sync-get/default db var default)
  (let ((res default))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     (db:no-sync-db db)
     "SELECT val FROM no_sync_metadat WHERE var=?;"
     var)
    (if res
        (let ((newres (if (string? res)
			  (string->number res)
			  #f)))
          (if newres
              newres
              res))
        res)))

(define (db:no-sync-close-db db stmt-cache)
  (db:safely-close-sqlite3-db db stmt-cache))

;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f . lock-creation-time)
;;    succeeds (returns (#t . lock-creation-time)
;; use (db:no-sync-del! db keyname) to release the lock
;;
(define (db:no-sync-get-lock db-in keyname)
  (let ((db (db:no-sync-db db-in)))
    (sqlite3:with-transaction
     db
     (lambda ()
       (handle-exceptions
	   exn
	 (let ((lock-time (current-seconds)))
	   (debug:print-info 2 *default-log-port* "db:no-sync-get-lock keyname=" keyname ", lock-time=" lock-time ", exn=" exn)
	   (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
	   `(#t . ,lock-time))
	 `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname)))))))



;; use a global for some primitive caching, it is just silly to
;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*

(define (db:lock-and-sync no-sync-db from-db to-db)
  (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
  (let* ((lockdat  (db:no-sync-get-lock no-sync-db from-db))
	 (gotlock  (car lockdat))
	 (locktime (cdr lockdat)))
    (if gotlock
	(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*)
		  
		  (if (and (not *time-to-exit*)