Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -21,21 +21,21 @@ PREFIX=$(PWD) CSCOPTS= INSTALL=install SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \ server.scm configf.scm db.scm keys.scm margs.scm \ - megatest-version.scm process.scm runs.scm tasks.scm \ - tests.scm genexample.scm http-transport.scm filedb.scm \ - tdb.scm client.scm mt.scm ezsteps.scm lock-queue.scm \ - sdb.scm rmt.scm api.scm subrun.scm portlogger.scm \ - archive.scm env.scm diff-report.scm \ - cgisetup/models/pgdb.scm + process.scm runs.scm tasks.scm tests.scm genexample.scm \ + http-transport.scm filedb.scm tdb.scm client.scm mt.scm \ + ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm \ + subrun.scm portlogger.scm archive.scm env.scm \ + diff-report.scm cgisetup/models/pgdb.scm # module source files # ftail.scm rmtmod.scm commonmod.scm removed MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \ - mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm + mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \ + rmtmod.scm apimod.scm GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \ dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \ vg.scm @@ -73,17 +73,14 @@ csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest showmtesthash: @echo $(MTESTHASH) -dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) +dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard -ndboard : newdashboard.scm $(OFILES) $(GOFILES) - csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard - -mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm +mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut include makefile.inc TCMTOBJS = \ @@ -100,16 +97,14 @@ keys.o \ launch.o \ lock-queue.o \ margs.o \ mt.o \ - megatest-version.o \ ods.o \ portlogger.o \ process.o \ rmt.o \ - mofiles/rmtmod.o \ rpc-transport.o \ runconfig.o \ runs.o \ server.o \ tasks.o \ @@ -118,11 +113,11 @@ subrun.o \ ezsteps.o # mofiles/commonmod.o \ -tcmt : $(TCMTOBJS) tcmt.scm +tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) $(MOIMPFILES) tcmt.scm -o tcmt # install documentation to $(PREFIX)/docs # DOES NOT REBUILD DOCS # @@ -139,25 +134,27 @@ $(PREFIX)/share/db/mt-pg.sql : mt-pg.sql mkdir -p $(PREFIX)/share/db $(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql # Special dependencies for the includes -common.o : mofiles/commonmod.o +common.o : mofiles/commonmod.o megatest-fossil-hash.scm + +commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm tests.o db.o launch.o runs.o dashboard-tests.o \ dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o \ -monitor.o dashboard.o archive.o megatest.o : db_records.scm +monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o : run_records.scm db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm -megatest.o : megatest-fossil-hash.scm +megatest.o : megatest-fossil-hash.scm megatest-version.scm rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm common_records.scm : altdb.scm @@ -180,10 +177,12 @@ mofiles/cookie.o : stml2/cookie.scm mofiles/stml2.o : stml2/stml2.scm # for the modularized stuff rmt.o : mofiles/ducttape-lib.o mofiles/pkts.o mofiles/stml2.o mofiles/mutils.o mofiles/mtargs.o + +mofiles/rmtmod.o : mofiles/apimod.o megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi @@ -217,19 +216,10 @@ $(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest chmod a+x $(PREFIX)/bin/megatest -$(PREFIX)/bin/.$(ARCHSTR)/bin/ndboard : ndboard - $(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/bin/ndboard - -$(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper - utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard - chmod a+x $(PREFIX)/bin/newdashboard - -# mtutil - $(PREFIX)/bin/.$(ARCHSTR)/bin/mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/bin/mtut install-mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/mtut @@ -349,15 +339,12 @@ fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL) clean : rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) \ $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut \ - tcmt readline-fix.scm serialize-env dboard dboard.o \ - megatest.o dashboard.o megatest-fossil-hash.* altdb.scm \ - mofiles/*.o vg.o cookie.o dashboard-main.o \ - ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o \ - tcmt.o + tcmt readline-fix.scm serialize-env dboard *.o \ + megatest-fossil-hash.* altdb.scm mofiles/*.o rm -rf share #====================================================================== # Deploy section (not complete yet) #====================================================================== @@ -398,19 +385,19 @@ mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath xterm : sd (export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &) -datashare-testing/spublish : spublish.scm $(OFILES) - csc $(CSCOPTS) spublish.scm megatest-version.o margs.o process.o common.o -o datashare-testing/spublish +datashare-testing/spublish : spublish.scm $(OFILES) megatest-version.scm + csc $(CSCOPTS) spublish.scm margs.o process.o common.o -o datashare-testing/spublish -datashare-testing/sretrieve : sretrieve.scm $(OFILES) - csc $(CSCOPTS) sretrieve.scm megatest-version.o margs.o process.o common.o -o datashare-testing/sretrieve +datashare-testing/sretrieve : sretrieve.scm $(OFILES) megatest-version.scm + csc $(CSCOPTS) sretrieve.scm margs.o process.o common.o -o datashare-testing/sretrieve -datashare-testing/sauthorize : sauthorize.scm $(OFILES) - csc $(CSCOPTS) sauthorize.scm megatest-version.o margs.o process.o common.o -o datashare-testing/sauthorize +datashare-testing/sauthorize : sauthorize.scm $(OFILES) megatest-version.scm + csc $(CSCOPTS) sauthorize.scm margs.o process.o common.o -o datashare-testing/sauthorize sauth-init: mkdir -p datashare-testing rm datashare-testing/sauthorize rm datashare-testing/sretrieve ADDED apimod.scm Index: apimod.scm ================================================================== --- /dev/null +++ apimod.scm @@ -0,0 +1,37 @@ +;;====================================================================== +;; 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 apimod)) +(declare (uses commonmod)) +(declare (uses ulex)) + +(module apimod + * + +(import scheme chicken data-structures extras) +(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) +(import commonmod) +(import (prefix ulex ulex:)) + + +(define (api:execute-requests params) + #f) + +) Index: commonmod.scm ================================================================== --- commonmod.scm +++ commonmod.scm @@ -34,10 +34,20 @@ ;; config file utils ;; misc conversion, data manipulation functions ;; testsuite and area utilites ;; ;;====================================================================== + +(include "megatest-version.scm") +(include "megatest-fossil-hash.scm") + +(define (get-full-version) + (conc megatest-version "-" megatest-fossil-hash)) + +(define (version-signature) + (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) + ;;====================================================================== ;; config file utils ;;====================================================================== Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -44,11 +44,10 @@ (declare (uses dcommon)) (declare (uses dashboard-context-menu)) (declare (uses vg)) (declare (uses subrun)) ;; (declare (uses dashboard-main)) -(declare (uses megatest-version)) (declare (uses mt)) (declare (uses dbmod)) (import (prefix dbmod dbmod:)) (declare (uses commonmod)) @@ -56,10 +55,11 @@ (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") +(include "megatest-version.scm") (include "megatest-fossil-hash.scm") (include "vg_records.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -25,15 +25,15 @@ (import canvas-draw-iup) (use regex typed-records matchable) (declare (unit dcommon)) -(declare (uses megatest-version)) (declare (uses gutils)) (declare (uses db)) ;; (declare (uses synchash)) +(include "megatest-version.scm") (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") (include "run_records.scm") Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -16,8 +16,8 @@ ;; along with Megatest. If not, see . ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. -(declare (unit megatest-version)) +;; (declare (unit megatest-version)) (define megatest-version 1.6603) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -15,17 +15,17 @@ ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see . ;; ;; (include "common.scm") -;; (include "megatest-version.scm") +(include "megatest-version.scm") ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (declare (uses common)) -(declare (uses megatest-version)) +;; (declare (uses megatest-version)) (declare (uses margs)) (declare (uses runs)) (declare (uses launch)) (declare (uses server)) (declare (uses client)) Index: mtexec.scm ================================================================== --- mtexec.scm +++ mtexec.scm @@ -26,17 +26,16 @@ srfi-19 srfi-18 extras format pkts regex regex-case (prefix dbi dbi:) ) ;; (declare (uses common)) -(declare (uses megatest-version)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) ;; (use ducttape-lib) - +(include "megatest-version.scm") (include "megatest-fossil-hash.scm") ;; (require-library stml) (define help (conc " Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -15,11 +15,11 @@ ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see . ;; ;; (include "common.scm") -;; (include "megatest-version.scm") +(include "megatest-version.scm") ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras) @@ -27,11 +27,10 @@ (prefix dbi dbi:) (prefix sqlite3 sqlite3:) nanomsg) (declare (uses common)) -(declare (uses megatest-version)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) (import ducttape-lib pkts) Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -18,74 +18,51 @@ ;;====================================================================== (declare (unit rmtmod)) (declare (uses commonmod)) +(declare (uses apimod)) (declare (uses ulex)) (module rmtmod * (import scheme chicken data-structures extras) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) -(import commonmod) +(import (prefix commonmod cmod:)) +(import apimod) (import (prefix ulex 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 -;; (define (remote-conndat-set! . params) #f) -;; (define (remote-server-url-set! . params) #f) -;; (define (remote-ro-mode . params) #f) -;; (define (remote-ro-mode-set! . params) #f) -;; (define (remote-ro-mode-checked-set! . params) #f) -;; (define (remote-ro-mode-checked . params) #f) -;; (define (debug:print . params) #f) -;; (define (debug:print-info . params) #f) -;; -;; (define (set-functions send-receive rsus -;; close-connections rcs -;; dbgp dbgpinfo -;; ro-mode ro-mode-set -;; ro-mode-checked-set ro-mode-checked -;; ) -;; (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) -;; (set! remote-ro-mode ro-mode) -;; (set! remote-ro-mode-set! ro-mode-set) -;; (set! remote-ro-mode-checked-set! ro-mode-checked-set) -;; (set! remote-ro-mode-checked ro-mode-checked)) +(defstruct alldat + (areapath #f) + (ulexdat #f) + ) ;; return the handle struct for sending queries to a specific database ;; - initializes the connection object if this is the first access ;; - finds the "captain" and asks who to talk to for the given dbfname ;; - establishes the connection to the current dbowner ;; -#;(define (rmt:connect alldat dbfname dbtype) +(define (rmt:connect alldat dbfname dbtype) (let* ((ulexdat (or (alldat-ulexdat alldat) (rmt:setup-ulex alldat)))) (ulex:connect ulexdat dbfname dbtype))) ;; setup the remote calls -#;(define (rmt:setup-ulex alldat) +(define (rmt:setup-ulex alldat) (let* ((udata (ulex:setup))) ;; establish connection to ulex (alldat-ulexdat-set! alldat udata) ;; register all needed procs - (ulex:register-handler udata 'ping common:get-full-version) ;; override ping with get-full-version - (ulex:register-handler udata 'login common:get-full-version) ;; force setup of the connection + (ulex:register-handler udata 'ping cmod:get-full-version) ;; override ping with get-full-version + (ulex:register-handler udata 'login cmod:get-full-version) ;; force setup of the connection (ulex:register-handler udata 'execute api:execute-requests) udata)) ;; set up a connection to the current owner of the dbfile associated with rid ;; then send the query to that dbfile owner and wait for a response. ;; -#;(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected +(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected (let* (;; (alldat *alldat*) (areapath (alldat-areapath alldat)) (dbtype (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db" "main" "runs")) (dbfname (if (equal? dbtype "main") Index: tcmt.scm ================================================================== --- tcmt.scm +++ tcmt.scm @@ -29,12 +29,12 @@ ;; (trace-call-sites #t) (declare (uses margs)) (declare (uses rmt)) (declare (uses common)) -(declare (uses megatest-version)) +(include "megatest-version.scm") (include "megatest-fossil-hash.scm") (include "db_records.scm") (define origargs (cdr (argv))) (define remargs (args:get-args Index: tree.scm ================================================================== --- tree.scm +++ tree.scm @@ -27,17 +27,17 @@ (import (prefix sqlite3 sqlite3:)) (declare (unit tree)) (declare (uses margs)) (declare (uses launch)) -(declare (uses megatest-version)) (declare (uses gutils)) (declare (uses db)) (declare (uses server)) ;; (declare (uses synchash)) (declare (uses dcommon)) +(include "megatest-version.scm") (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") ;;======================================================================