Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -31,11 +31,11 @@ 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 +MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm mtargs.scm # Eggs to install (straightforward ones) EGGS=matchable readline aokpropos base64 regex-literals format \ regex-case test coops trace csv dot-locking posix-utils posix-extras \ @@ -201,11 +201,11 @@ # Temporary while transitioning to new routine # runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm # for the modularized stuff -rmt.o : mofiles/ducttape-lib.o mofiles/pkts.o mofiles/stml2.o mofiles/mutils.o +rmt.o : mofiles/ducttape-lib.o mofiles/pkts.o mofiles/stml2.o mofiles/mutils.o mofiles/mtargs.o # *-inc.scm 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 @@ -364,11 +364,17 @@ $(MTQA_FOSSIL) : 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 commonmod.o cookie.o dashboard-main.o ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o tcmt.o + 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 commonmod.o cookie.o dashboard-main.o \ + ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o \ + tcmt.o rm -rf share #====================================================================== # Make the records files #====================================================================== Index: TODO ================================================================== --- TODO +++ TODO @@ -13,25 +13,49 @@ # 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 . +NOTE: This file gets copied occasionally into the wiki as "Roadmap". + Do not make changes in the wiki, they will be lost! + TODO ==== +WW14 +. Streamline compilation - DONE, all non-official egg modules are now bundled. + +WW15 +. syscheck; touch file in home, tmp, runs, links and start xterm +. pull in ftfplan (not integrated, just code pulled in) +. fill newview matrix with data, filter pipeline gui elements +. improve [script], especially indent handling + +WW16 +. split db into megatest.db (runs etc.) db/.db +. release basic newview implementation + +WW18 +. release split db implementation +. mtutil calls from dashboard (for remote control) +. logs browser (esp. for surfacing mtutil related activities) + +WW19 +. break command line into sections; all, run control, queries, utilities etc. + +WW20 . Switch to using simple runs query everywhere . Add end_time to runs and add a rollup call that sets state, status and end_time - - +Future +. Switch to scsh-process pipeline management for job execution/control +. Use call-with-environment-variables more. Migration to inmem db plus per run db ------------------------------------- . Re-work the dbstruct data structure? .. Move main.db to global? .. [ run-id.db inmemdb last-mod last-read last-sync inuse ] -. Re-work all queries to use run-id to dereference server . Open main.db directly in calls to -runtests etc. No need to talk remote? -. remove common:faux-lock Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -34,10 +34,11 @@ ;; (declare (uses daemon)) (declare (uses db)) ;; (declare (uses dcommon)) (declare (uses stml2)) (declare (uses pkts)) +(declare (uses mutils)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. @@ -44,11 +45,11 @@ (declare (uses env)) (declare (uses diff-report)) ;; (declare (uses ftail)) ;; (import ftail) -(import stml2) +(import stml2 mutils) ;; invoke the imports ;; (declare (uses mtargs.import)) ;; (declare (uses mtconfigf.import)) (declare (uses cookie.import)) @@ -242,15 +243,14 @@ cmd: keep-html, restore, save, save-remove -generate-html : create a simple html dashboard for browsing your runs -generate-html-structure : create a top level html veiw to list targets/runs and a Run view within each run directory. -list-run-time : list time requered to complete runs. It supports following switches -run-patt -target-patt -dumpmode - -list-test-time : list time requered to complete each test in a run. It following following arguments + -list-test-time : list time requered to complete each test in a run. It following following arguments -runname -target -dumpmode - - - + -syscheck : do some very basic checks; write access and space in tmp, home, runs, links and + is $DISPLAY valid Diff report -diff-rep : generate diff report (must include -src-target, -src-runname, -target, -runname and either -diff-email or -diff-html) -src-target @@ -263,12 +263,12 @@ -pathmod path : insert path, i.e. path/runame/itempath/logfile.html will clear the field if no rundir/testname/itempath/logfile if it contains forward slashes the path will be converted to windows style Getting started - -create-megatest-area : create a skeleton megatest area. You will be prompted for paths - -create-test testname : create a skeleton megatest test. You will be prompted for info + -create-megatest-area : create a skeleton megatest area. You will be prompted for paths + -create-test testname : create a skeleton megatest test. You will be prompted for info Examples # Get test path, use '.' to get a single path or a specific path/file pattern megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt% @@ -447,10 +447,12 @@ "-logging" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only "-diff-rep" + + "-syscheck" ) args:arg-hash 0)) ;; Add args that use remargs here @@ -2354,17 +2356,24 @@ (let* ((toppath (launch:setup))) (if (tests:create-html-tree #f) (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html") (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html")) (set! *didsomething* #t))) + (if (args:get-arg "-generate-html-structure") (let* ((toppath (launch:setup))) ;(if (tests:create-html-tree #f) (if (tests:create-html-summary #f) (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html") (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html")) (set! *didsomething* #t))) + +(if (args:get-arg "-syscheck") + (begin + (mutils:syscheck) + (set! *didsomething* #t))) + ;;====================================================================== ;; Exit and clean up ;;====================================================================== (if (not *didsomething*) ADDED mtargs.scm Index: mtargs.scm ================================================================== --- /dev/null +++ mtargs.scm @@ -0,0 +1,23 @@ +;;====================================================================== +;; 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 +;; 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 mtargs)) + +(include "mtargs/mtargs.scm") ADDED mtargs/Makefile Index: mtargs/Makefile ================================================================== --- /dev/null +++ mtargs/Makefile @@ -0,0 +1,22 @@ +# Copyright 2007-2010, Matthew Welland. +# +# This program is made available under the GNU GPL version 2.0 or +# greater. See the accompanying file COPYING for details. +# +# This program is distributed WITHOUT ANY WARRANTY; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +# PURPOSE. + +# TARGDIR = $(shell csi -e "(print (car \#\#sys\#include-pathnames))(exit)") + +all : uptodate.log # $(TARGDIR)/mtargs.so + +uptodate.log : mtargs.scm mtargs.setup + chicken-install | tee uptodate.log + +$(TARGDIR)/mtargs.so : mtargs.so + @echo installing to $(TARGDIR) + cp mtargs.so $(TARGDIR) + +mtargs.so : mtargs.scm + csc -s mtargs.scm ADDED mtargs/mtargs.meta Index: mtargs/mtargs.meta ================================================================== --- /dev/null +++ mtargs/mtargs.meta @@ -0,0 +1,20 @@ +( +; Your egg's license: +(license "LGPL") + +; Pick one from the list of categories (see below) for your egg and enter it +; here. +(category misc) + +; A list of eggs mpeg3 depends on. If none, you can omit this declaration +; altogether. If you are making an egg for chicken 3 and you need to use +; procedures from the `files' unit, be sure to include the `files' egg in the +; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit). +; `depends' is an alias to `needs'. +(needs srfi-69 srfi-1) + +; A list of eggs required for TESTING ONLY. See the `Tests' section. +(test-depends test) + +(author "Matt Welland") +(synopsis "Primitive argument processor.")) ADDED mtargs/mtargs.scm Index: mtargs/mtargs.scm ================================================================== --- /dev/null +++ mtargs/mtargs.scm @@ -0,0 +1,96 @@ +;; Copyright 2007-2010, Matthew Welland. +;; +;; This file is part of mtargs. +;; +;; mtargs 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. +;; +;; mtargs 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 mtargs. If not, see . + + +(module mtargs + ( + arg-hash + get-arg + get-arg-from + usage + get-args + print-args + any-defined? + help + ) + +(import scheme chicken data-structures extras posix ports files) +(use srfi-69 srfi-1) + +(define arg-hash (make-hash-table)) +(define help "") + +(define (get-arg arg . default) + (if (null? default) + (hash-table-ref/default arg-hash arg #f) + (hash-table-ref/default arg-hash arg (car default)))) + +(define (any-defined? . args) + (not (null? (filter (lambda (x) x) + (map get-arg args))))) + +;; (define any any-defined?) + +(define (get-arg-from ht arg . default) + (if (null? default) + (hash-table-ref/default ht arg #f) + (hash-table-ref/default ht arg (car default)))) + +(define (usage . args) + (if (> (length args) 0) + (apply print "ERROR: " args)) + (if (string? help) + (print help) + (print "Usage: " (car (argv)) " ... ")) + (exit 0)) + +(define (get-args args params switches arg-hash num-needed) + (let* ((numtargs (length args)) + (adj-num-needed (if num-needed (+ num-needed 2) #f))) + (if (< numtargs (if adj-num-needed adj-num-needed 2)) + (if (>= num-needed 1) + (usage "No arguments provided") + '()) + (let loop ((arg (cadr args)) + (tail (cddr args)) + (remtargs '())) + (cond + ((member arg params) ;; args with params + (if (< (length tail) 1) + (usage "param given without argument " arg) + (let ((val (car tail)) + (newtail (cdr tail))) + (hash-table-set! arg-hash arg val) + (if (null? newtail) remtargs + (loop (car newtail)(cdr newtail) remtargs))))) + ((member arg switches) ;; args with no params (i.e. switches) + (hash-table-set! arg-hash arg #t) + (if (null? tail) remtargs + (loop (car tail)(cdr tail) remtargs))) + (else + (if (null? tail)(append remtargs (list arg)) ;; return the non-used args + (loop (car tail)(cdr tail)(append remtargs (list arg)))))))) + )) + +(define (print-args remtargs arg-hash) + (print "ARGS: " remtargs) + (for-each (lambda (arg) + (print " " arg " " (hash-table-ref/default arg-hash arg #f))) + (hash-table-keys arg-hash))) + + +) ADDED mtargs/mtargs.setup Index: mtargs/mtargs.setup ================================================================== --- /dev/null +++ mtargs/mtargs.setup @@ -0,0 +1,18 @@ +;; Copyright 2007-2010, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. + +;;;; mtargs.setup + +;; compile the code into a dynamically loadable shared object +;; (will generate mtargs.so) +(compile -s mtargs.scm) + +;; Install as extension library +(standard-extension 'mtargs "mtargs.so") + Index: mutils/mutils.scm ================================================================== --- mutils/mutils.scm +++ mutils/mutils.scm @@ -20,10 +20,11 @@ ;; srfi-13 srfi-69 ;; ports extras regex + posix ) (define (mutils:hierhash-ref hh . keys) (if (null? keys) #f @@ -181,6 +182,38 @@ (if (and (list? @l)(not (null? @l))) (car @l))) (if (null? @path) @hierlist (apply mutils:hier-list-get @hierlist @path)))) +;;====================================================================== +;; Other utils +;;====================================================================== + +#;(define (check-write-create fpath) + (and (file-write-access? fpath) + (let ((fname (conc fpath "/junk ". (current-seconds) "-" (random 10000)))) + (print "trying to create/remove " fname) + (handle-exceptions + exn + #f + (begin + (with-output-to-file fname + (lambda () + (print "You can delete this file"))) + (delete-file fname) + #t))))) + +;; do some sanity checks on the system +;; +(define (mutils:syscheck) + ;; current dir writeable and do megatest.config, runconfigs.config files exist/readable + (print "Current directory " (current-directory) " writeable: " + (if #;(check-file-create ".") + (file-write-access? ".")"yes" "no")) + ;; home dir writeable + ;; /tmp writeable + ;; load configs + ;; each run disk read/write + ;; link tree writeable + ) + )