Megatest

;; example of how to set up and write target mappers
;;
(define *target-mappers*
  `((prefix-contour . ,(lambda (target run-name area area-path reason contour mode-patt)
			 (conc contour "/" target)))))

;; (print "Yep, got here!")

[setup]
pktsdirs /tmp/pkts /some/other/source

[areas]
#         path-to-area   map-target-script(future, optional)
fullrun   tests/fullrun  prefix-contour
ext-tests ext-tests

[contours]
#     mode-patt/tag-expr
quick quick/QUICKPATT
full  all/MAXPATT quick/QUICKPATT

(include "megatest-fossil-hash.scm")

(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

;; this needs some thought regarding security implications.
;;
;;   i. Check that owner of the file and calling user are same?
;;  ii. Check that we are in a legal megatest area?
;; iii. Have some form of authentication or record of the md5sum or similar of the file?
;;
(if (file-exists? "megatest.config")
    (if (file-exists? ".mtutil.so")
	(load ".mtutil.so")
	(if (file-exists? ".mtutil.scm")
	(load ".mtutil.scm"))))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;; Contour actions
;;    import                  : import pkts
;;    dispatch                : dispatch queued run jobs from imported pkts
;;    rungen                  : look at input sense list in [rungen] and generate run pkts

;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.


;; make a run request pkt from basic data
;;
(define (create-run-pkt mtconf area runkey runname mode-patt tag-expr pktsdir reason contour sched) 
  (let* ((area-dat   (string-split (or (configf:lookup mtconf "areas" area) "")))
	 (area-path  (car area-dat))
	 (area-xlatr (if (eq? (length area-dat) 2)(cadr area-dat) #f))
	 (new-target (if area-xlatr
			 (let ((xlatr-key (string->symbol area-xlatr)))
			   (if (alist-ref xlatr-key *target-mappers*)
			       (begin
				 (print "Using target mapper: " area-xlatr)
				 (handle-exceptions
				     exn
				     (begin
				       (print "FAILED TO RUN TARGET MAPPER FOR " area ", called " area-xlatr)
				       (print "   function is: " (alist-ref xlatr-key *target-mappers*))
				       (print " message: " ((condition-property-accessor 'exn 'message) exn))
				       runkey)
				   ((alist-ref xlatr-key *target-mappers*)
				    runkey runname area area-path reason contour mode-patt)))))
			 runkey)))
    (let-values (((uuid pkt)
		  (command-line->pkt
		   "run"
		   (append 
		    `(("-target"     . ,new-target)
		      ("-run-name"   . ,runname)
		      ("-start-dir"  . ,area-path)
		      ("-msg"        . ,reason)
		      ("-contour"    . ,contour))
		    (if mode-patt
			`(("-mode-patt"  . ,mode-patt))
			'())

quick:script:run           run-name=auto;script=checkfossil.sh v1.63

# field          allowed values
# -----          --------------
# minute         0-59
# hour           0-23
# day of month   1-31
# month          1-12 (or names, future development)
# day of week    0-7 (0 or 7 is Sun, or, future development, use names)

# actions:
#  run     - run a testsuite
#  clean   - clear out runs
#  archive - archive runs

quick:scheduled:run     cron=47  * * * * ;run-name=auto