Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -85,10 +85,11 @@ ndboard : newdashboard.scm $(OFILES) $(GOFILES) csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard mtut: $(OFILES) megatest-fossil-hash.scm mtut.scm csc $(CSCOPTS) $(OFILES) mtut.scm -o mtut + TCMTOBJS = \ api.o \ archive.o \ cgisetup/models/pgdb.o \ @@ -180,10 +181,12 @@ $(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/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)/mtut : mtut $(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/mtut install-mtut : mtut @@ -190,10 +193,24 @@ $(INSTALL) mtut $(PREFIX)/bin/mtut $(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/mtut utils/mk_wrapper utils/mk_wrapper $(PREFIX) mtut $(PREFIX)/bin/mtutil chmod a+x $(PREFIX)/bin/mtutil + +# mtexec + +mtexec: $(OFILES) megatest-fossil-hash.scm mtexec.scm + csc $(CSCOPTS) $(OFILES) mtexec.scm -o mtexec + +$(PREFIX)/bin/.$(ARCHSTR)/mtexec : mtexec + $(INSTALL) mtexec $(PREFIX)/bin/.$(ARCHSTR)/mtexec + +$(PREFIX)/bin/mtexec : $(PREFIX)/bin/.$(ARCHSTR)/mtexec utils/mk_wrapper + utils/mk_wrapper $(PREFIX) mtexec $(PREFIX)/bin/mtexec + chmod a+x $(PREFIX)/bin/mtexec + +# tcmt $(PREFIX)/bin/.$(ARCHSTR)/tcmt : tcmt $(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/tcmt $(PREFIX)/bin/tcmt : $(PREFIX)/bin/.$(ARCHSTR)/tcmt utils/mk_wrapper @@ -278,11 +295,11 @@ chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ - $(PREFIX)/bin/serialize-env \ + $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \ $(PREFIX)/share/js/jquery-3.1.0.slim.min.js ADDED mtexec.scm Index: mtexec.scm ================================================================== --- /dev/null +++ mtexec.scm @@ -0,0 +1,122 @@ +; Copyright 2006-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 . +;; + +;; (include "common.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) + 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-fossil-hash.scm") + +;; (require-library stml) + +(define help (conc " +mtutil, part of the Megatest tool suite, documentation at http://www.kiatoa.com/fossils/megatest + version " megatest-version " + license GPL, Copyright Matt Welland 2006-2017 + +Usage: mtutil action [options] + -h : this help + -manual : show the Megatest user manual + -version : print megatest version (currently " megatest-version ") + +Queries: + show [areas|contours... ] : show areas, contours or other section from megatest.config + gendot : generate a graphviz dot file from pkts. + +Contour actions: + process : runs import, rungen and dispatch + +Trigger propagation actions: + tsend a=b,c=d... : send trigger info to all recpients in the [listeners] section + tlisten -port N : listen for trigger info on port N + +Misc + -start-dir path : switch to this directory before running mtutil + -set-vars V1=1,V2=2 : Add environment variables to a run NB// these are + overwritten by values set in config files. + -log logfile : send stdout and stderr to logfile + -repl : start a repl (useful for extending megatest) + -load file.scm : load and run file.scm + -debug N|N,M,O... : enable debug messages 0-N or N and M and O ... + -list-pkt-keys : list all pkt keys + +Examples: + +# Start a megatest run in the area \"mytests\" +mtutil run -area mytests -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick + +# Start a contour +mtutil run -contour quick -target v1.63/aa3e + +Called as " (string-intersperse (argv) " ") " +Version " megatest-version ", built from " megatest-fossil-hash )) + ;; first token is our action, but only if no leading dash + +(define *action* (if (and (> (length (argv)) 1) + (not (string-match "^\\-.*" (cadr (argv))))) + (cadr (argv)) + #f)) + +(define *remargs* + (args:get-args + (if *action* (cdr (argv)) (argv)) + '("-log") + '("-h") + args:arg-hash + 0)) + +(if (args:get-arg "-h") + (begin + (print help) + (exit))) + +(if (or (args:get-arg "-repl") + (args:get-arg "-load")) + (begin + (import extras) ;; might not be needed + ;; (import csi) + (import readline) + (import apropos) + ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ... + + (install-history-file (get-environment-variable "HOME") ".mtutil_history") ;; [homedir] [filename] [nlines]) + (current-input-port (make-readline-port "mtutil> ")) + (if (args:get-arg "-repl") + (repl) + (load (args:get-arg "-load"))))) + +#| +(define mtconf (car (simple-setup #f))) +(define dat (common:with-queue-db mtconf (lambda (conn)(get-pkts conn '())))) +(pp (pkts#flatten-all dat '((cmd . ((parent . P)(url . M)))(runtype . ((parent . P)))) 'id 'group-id 'uuid 'parent 'pkt-type 'pkt 'processed)) +|#