Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -279,11 +279,13 @@ (conndat #f) (transport *transport-type*) (server-timeout (server:expiration-timeout)) (force-server #f) (ro-mode #f) - (ro-mode-checked #f)) ;; flag that indicates we have checked for ro-mode + (ro-mode-checked #f) ;; flag that indicates we have checked for ro-mode + (ulex:conn #f) ;; ulex db conn is not exactly a db connector, more like a network connector + ) ;; launching and hosts (defstruct host (reachable #f) (last-update 0) ADDED commonmod.scm Index: commonmod.scm ================================================================== --- /dev/null +++ commonmod.scm @@ -0,0 +1,36 @@ +;;====================================================================== +;; Copyright 2017, Matthew Welland. +;; +;; This file is part of Megatest. +;; +;; Megatest is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; Megatest is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with Megatest. If not, see . + +;;====================================================================== + +(declare (unit commonmod)) + +(module commonmod + * + +(import scheme chicken data-structures extras) +(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) + +;; (define (debug:print . params) #f) +;; (define (debug:print-info . params) #f) +;; +;; (define (set-functions dbgp dbgpinfo) +;; (set! debug:print dbgp) +;; (set! debug:print-info dbgpinfo)) + +) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -304,13 +304,19 @@ ;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced ;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f)) ;(fmt (file-modification-time tmpdbfname)) (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime)))) - (when write-access - (sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger") - (sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger")) + (handle-exceptions + exn + (begin + (debug:print 0 *default-log-port* "ERROR: attempted to drop triggers on MTRA/megatest.db but failed.") + TODO: print real stack and error info + (set! write-access #f)) ;; if we failed to drop the triggers then we probably don't have write access + (when write-access + (sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger") + (sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))) ;(print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db")) ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access) (if (and dbexists (not write-access)) (begin Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -25,10 +25,11 @@ (declare (uses http-transport)) (include "common_records.scm") (declare (uses rmtmod)) (import rmtmod) + ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; @@ -53,15 +54,24 @@ (if (server:check-if-running areapath) (client:setup areapath) #f)))) (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id + + ;; this entry point can decide based on cmd whether to dispatch to old api calls via remote or via ulex ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) - (rmt:send-receive-orig cmd rid params attemptnum: attemptnum area-dat: area-dat)) + (if (member cmd '(blah)) + (begin + (mutex-lock! *send-receive-mutex*) + (if (not *runremote*)(set! *runremote* (make-remote))) + (let ((ulex:conn (remote-ulex:conn *runremote*))) + (if (not ulex:conn)(remote-ulex:conn-set! *runremote* (rmtmod:setup-ulex *toppath*))) + (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat))) + (rmt:send-receive-orig cmd rid params attemptnum: attemptnum area-dat: area-dat))) ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; (define (rmt:send-receive-orig cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -1,7 +1,7 @@ ;;====================================================================== -;; Copyright 2017, Matthew Welland. +;; Copyright 2019, Matthew Welland. ;; ;; This file is part of Megatest. ;; ;; Megatest is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -25,10 +25,11 @@ * (import scheme chicken data-structures extras) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) (import commonmod) +(use ulex) ;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time. (define (rmt:send-receive . params) #f) (define (http-transport:close-connections . params) #f) ;; from remote defstruct in common.scm @@ -45,11 +46,11 @@ close-connections rcs dbgp dbgpinfo ro-mode ro-mode-set ro-mode-checked-set ro-mode-checked ) - (set! rmt:send-receive send-receive) + (set! rmt:send-receive send-receive) (set! remote-server-url-set! rsus) (set! http-transport:close-connections close-connections) (set! remote-conndat-set! rcs) (set! debug:print dbgp) (set! debug:print-info dbgpinfo) @@ -113,7 +114,22 @@ (set! *runremote* #f) ;; force starting over (mutex-unlock! *rmt-mutex*) (thread-sleep! wait-delay) (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))) res)) ;; All good, return res + +;;====================================================================== +;; ulex and steps stuff +;;====================================================================== + +(define (rmtmod:setup-ulex toppath) + (ulex:make-area + dbdir: (conc toppath "/ulexdb") + pktsdir: (conc toppath "/pkts") + )) + + + +(define (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat) + #f) )