Megatest

(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))

(define (common:get-sync-lock-filepath)
  (let* ((tmp-area     (common:get-db-tmp-area))
         (lockfile     (conc tmp-area "/megatest.db.sync-lock")))
         (lockfile     (conc tmp-area "/megatest.db.lock")))
    lockfile))

(define *common:logpro-exit-code->status-sym-alist*
  '( ( 0 . pass )
     ( 1 . fail )
     ( 2 . warn )
     ( 3 . check )

;; uncomment this block to test without tcp or cachedb
;; (dbfile:sync-method 'none)
;; (dbfile:cache-method 'none)
;; (rmt:transport-mode 'nfs)

;; uncomment this block to test with tcp and cachedb
(dbfile:sync-method 'original)
(dbfile:sync-method 'none) ;; original was causing crash on start. 
(dbfile:cache-method 'none)
(rmt:transport-mode 'nfs)

		    (dbfile:cache-method))
       #f)))

(define (dbmod:safely-open-db dbfullname init-proc write-access)
  (dbfile:with-simple-file-lock
   (conc dbfullname".lock")
   (lambda ()
     (let* ((dbexists (file-exists? dbfullname))
     (let* ((db      (sqlite3:open-database dbfullname))
	    (handler (sqlite3:make-busy-timeout 136000)))
	    (db       (sqlite3:open-database dbfullname))
	    (handler  (sqlite3:make-busy-timeout 136000)))
       (sqlite3:set-busy-handler! db handler)
       (if (and dbexists
       (if write-access
		write-access)
	   (init-proc db))
       db))))

(define *sync-in-progress* #f)

;; Open the cachedb db and the on-disk db
;; populate the cachedb db with data

	   (keys        (db:get-keys #f))
	   )
      
      (if (and src-db dest-db)
	  (if (file-exists? src-db)
	      (if (file-exists? lockfile)
		  (debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...")
		  (dbfile:with-simple-file-lock
		  (begin
		    (with-output-to-file lockfile
		      (lambda ()
			(print (current-process-id))))
		    (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
		    (if (not (file-exists? dest-db))
			(begin
			  (debug:print 0 *default-log-port* "Using copy to create "dest-db" from "src-db)
			  (file-copy src-db dest-db))
			(let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys)))
			  (if res
			      (debug:print-info 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db)
			      (debug:print-info 0 *default-log-port* "No sync due to permissions or other issue."))))
		    (delete-file* lockfile)))
		   lockfile
		   (lambda ()
		     ;;(with-output-to-file lockfile
		     ;;  (lambda ()
		     ;;	(print (current-process-id))))
		     (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
		     (if #f ;; (not (file-exists? dest-db))
			 (begin
			   (dbfile:with-simple-file-lock
			    (conc dest-db ".lock") ;; is the db being opened right now?
			    (lambda ()
			      (debug:print 0 *default-log-port* "Using copy to create "dest-db" from "src-db)
			      (file-copy src-db dest-db))))
			 (let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys)))
			   (if res
			       (debug:print-info 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db)
			       (debug:print-info 0 *default-log-port* "No sync due to permissions or other issue."))))
		     ;; (delete-file* lockfile)
		     )))
	      (debug:print 0 *default-log-port* "No sync due to unreadble or non-existant source file"src-db))
	  (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified"))
      (set! *didsomething* #t)))

(if (args:get-arg "-list-test-time")
     (let* ((toppath (launch:setup))) 
     (task:get-test-times)  

						   (let ((res (handle-exceptions
								  exn
								(let* ((errdat (condition->list exn)))
								  (set! exn-result errdat)
								  (debug:print 0 *default-log-port* "ERROR: handler exception, these are bad, will exit in five seconds.")
								  (pp errdat *default-log-port*)
								  ;; these are always bad, set up an exit thread
								  #;(thread-start! (make-thread (lambda ()
								  (thread-start! (make-thread (lambda ()
												(thread-sleep! 5)
												(exit))))
								  #f)
								(handler indat) ;; this is the proc being called by the remote client
								)))
						     (set! result res)))))
				(full-result (list result exn-result (if (equal? stdout-result "") #f stdout-result))))