0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 28 69 6e PURPOSE...;; (in
0150: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0160: 6d 22 29 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0170: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0180: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0190: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
01a0: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
01b0: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
01c0: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
01d0: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
01e0: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 73 72 srfi-1 posix sr
01f0: 66 69 2d 36 39 20 72 65 61 64 6c 69 6e 65 20 3b fi-69 readline ;
0200: 3b 20 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ; regex regex-c
0210: 61 73 65 20 73 72 66 69 2d 36 39 20 61 70 72 6f ase srfi-69 apro
0220: 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 2d 63 6c pos json http-cl
0230: 69 65 6e 74 20 64 69 72 65 63 74 6f 72 79 2d 75 ient directory-u
0240: 74 69 6c 73 20 72 70 63 20 74 79 70 65 64 2d 72 tils rpc typed-r
0250: 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 69 20 31 ecords;; (srfi 1
0260: 38 29 20 65 78 74 72 61 73 29 0a 20 20 20 20 20 8) extras).
0270: 73 72 66 69 2d 31 38 20 65 78 74 72 61 73 20 66 srfi-18 extras f
0280: 6f 72 6d 61 74 20 70 6b 74 73 20 72 65 67 65 78 ormat pkts regex
0290: 0a 20 20 20 20 20 28 70 72 65 66 69 78 20 64 62 . (prefix db
02a0: 69 20 64 62 69 3a 29 29 20 3b 3b 20 20 7a 6d 71 i dbi:)) ;; zmq
02b0: 20 65 78 74 72 61 73 29 0a 0a 28 64 65 63 6c 61 extras)..(decla
02c0: 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 re (uses common)
02d0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
02e0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
02f0: 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 n)).(declare (us
0300: 65 73 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c es margs)).(decl
0310: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
0320: 66 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 f)).;; (declare
0330: 28 75 73 65 73 20 72 6d 74 29 29 0a 0a 28 69 6e (uses rmt))..(in
0340: 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d clude "megatest-
0350: 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 fossil-hash.scm"
0360: 29 0a 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 )..(require-libr
0370: 61 72 79 20 73 74 6d 6c 29 0a 0a 28 6c 65 74 20 ary stml)..(let
0380: 28 28 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 20 ((debugcontrolf
0390: 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 (conc (get-envir
03a0: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
03b0: 22 48 4f 4d 45 22 29 20 22 2f 2e 6d 74 75 74 69 "HOME") "/.mtuti
03c0: 6c 72 63 22 29 29 29 0a 20 20 28 69 66 20 28 66 lrc"))). (if (f
03d0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 62 75 ile-exists? debu
03e0: 67 63 6f 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 gcontrolf).
03f0: 20 28 6c 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 (load debugcont
0400: 72 6f 6c 66 29 29 29 0a 0a 3b 3b 20 74 68 69 73 rolf)))..;; this
0410: 20 6e 65 65 64 73 20 73 6f 6d 65 20 74 68 6f 75 needs some thou
0420: 67 68 74 20 72 65 67 61 72 64 69 6e 67 20 73 65 ght regarding se
0430: 63 75 72 69 74 79 20 69 6d 70 6c 69 63 61 74 69 curity implicati
0440: 6f 6e 73 2e 0a 3b 3b 0a 3b 3b 20 20 20 69 2e 20 ons..;;.;; i.
0450: 43 68 65 63 6b 20 74 68 61 74 20 6f 77 6e 65 72 Check that owner
0460: 20 6f 66 20 74 68 65 20 66 69 6c 65 20 61 6e 64 of the file and
0470: 20 63 61 6c 6c 69 6e 67 20 75 73 65 72 20 61 72 calling user ar
0480: 65 20 73 61 6d 65 3f 0a 3b 3b 20 20 69 69 2e 20 e same?.;; ii.
0490: 43 68 65 63 6b 20 74 68 61 74 20 77 65 20 61 72 Check that we ar
04a0: 65 20 69 6e 20 61 20 6c 65 67 61 6c 20 6d 65 67 e in a legal meg
04b0: 61 74 65 73 74 20 61 72 65 61 3f 0a 3b 3b 20 69 atest area?.;; i
04c0: 69 69 2e 20 48 61 76 65 20 73 6f 6d 65 20 66 6f ii. Have some fo
04d0: 72 6d 20 6f 66 20 61 75 74 68 65 6e 74 69 63 61 rm of authentica
04e0: 74 69 6f 6e 20 6f 72 20 72 65 63 6f 72 64 20 6f tion or record o
04f0: 66 20 74 68 65 20 6d 64 35 73 75 6d 20 6f 72 20 f the md5sum or
0500: 73 69 6d 69 6c 61 72 20 6f 66 20 74 68 65 20 66 similar of the f
0510: 69 6c 65 3f 0a 3b 3b 20 20 69 76 2e 20 55 73 65 ile?.;; iv. Use
0520: 20 63 6f 6d 70 69 6c 65 64 20 76 65 72 73 69 6f compiled versio
0530: 6e 20 69 6e 20 70 72 65 66 65 72 65 6e 63 65 20 n in preference
0540: 74 6f 20 2e 73 63 6d 20 76 65 72 73 69 6f 6e 2e to .scm version.
0550: 20 54 68 75 73 20 74 68 65 72 65 20 69 73 20 61 Thus there is a
0560: 20 6d 61 6e 75 61 6c 20 22 62 6c 65 73 73 69 6e manual "blessin
0570: 67 22 0a 3b 3b 20 20 20 20 20 20 72 65 71 75 69 g".;; requi
0580: 72 65 64 20 74 6f 20 75 73 65 20 2e 6d 74 75 74 red to use .mtut
0590: 69 6c 2e 73 63 6d 2e 0a 3b 3b 0a 28 69 66 20 28 il.scm..;;.(if (
05a0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 6d 65 file-exists? "me
05b0: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a gatest.config").
05c0: 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 (if (file-ex
05d0: 69 73 74 73 3f 20 22 2e 6d 74 75 74 69 6c 2e 73 ists? ".mtutil.s
05e0: 6f 22 29 0a 09 28 6c 6f 61 64 20 22 2e 6d 74 75 o")..(load ".mtu
05f0: 74 69 6c 2e 73 6f 22 29 0a 09 28 69 66 20 28 66 til.so")..(if (f
0600: 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e 6d 74 ile-exists? ".mt
0610: 75 74 69 6c 2e 73 63 6d 22 29 0a 09 28 6c 6f 61 util.scm")..(loa
0620: 64 20 22 2e 6d 74 75 74 69 6c 2e 73 63 6d 22 29 d ".mtutil.scm")
0630: 29 29 29 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 )))..;; Disabled
0640: 20 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 help items.;;
0650: 2d 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 -rollup
0660: 20 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 : (curre
0670: 6e 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 ntly disabled) f
0680: 69 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 ill run (set by
0690: 3a 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 :runname) with
06a0: 6c 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b latest test(s).;
06b0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
06d0: 6d 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 m prior runs wit
06e0: 68 20 73 61 6d 65 20 6b 65 79 73 0a 3b 3b 20 43 h same keys.;; C
06f0: 6f 6e 74 6f 75 72 20 61 63 74 69 6f 6e 73 0a 3b ontour actions.;
0700: 3b 20 20 20 20 69 6d 70 6f 72 74 20 20 20 20 20 ; import
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 : i
0720: 6d 70 6f 72 74 20 70 6b 74 73 0a 3b 3b 20 20 20 mport pkts.;;
0730: 20 64 69 73 70 61 74 63 68 20 20 20 20 20 20 20 dispatch
0740: 20 20 20 20 20 20 20 20 20 3a 20 64 69 73 70 61 : dispa
0750: 74 63 68 20 71 75 65 75 65 64 20 72 75 6e 20 6a tch queued run j
0760: 6f 62 73 20 66 72 6f 6d 20 69 6d 70 6f 72 74 65 obs from importe
0770: 64 20 70 6b 74 73 0a 3b 3b 20 20 20 20 72 75 6e d pkts.;; run
0780: 67 65 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 gen
0790: 20 20 20 20 20 3a 20 6c 6f 6f 6b 20 61 74 20 69 : look at i
07a0: 6e 70 75 74 20 73 65 6e 73 65 20 6c 69 73 74 20 nput sense list
07b0: 69 6e 20 5b 72 75 6e 67 65 6e 5d 20 61 6e 64 20 in [rungen] and
07c0: 67 65 6e 65 72 61 74 65 20 72 75 6e 20 70 6b 74 generate run pkt
07d0: 73 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 s..(define help
07e0: 28 63 6f 6e 63 20 22 0a 6d 74 75 74 69 6c 2c 20 (conc ".mtutil,
07f0: 70 61 72 74 20 6f 66 20 74 68 65 20 4d 65 67 61 part of the Mega
0800: 74 65 73 74 20 74 6f 6f 6c 20 73 75 69 74 65 2c test tool suite,
0810: 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 documentation a
0820: 74 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 t http://www.kia
0830: 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f toa.com/fossils/
0840: 6d 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 megatest. versi
0850: 6f 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 on " megatest-ve
0860: 72 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 rsion ". licens
0870: 65 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 e GPL, Copyright
0880: 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 Matt Welland 20
0890: 30 36 2d 32 30 31 37 0a 0a 55 73 61 67 65 3a 20 06-2017..Usage:
08a0: 6d 74 75 74 69 6c 20 61 63 74 69 6f 6e 20 5b 6f mtutil action [o
08b0: 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 ptions]. -h
08c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
08d0: 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 : this help.
08e0: 20 2d 6d 61 6e 75 61 6c 20 20 20 20 20 20 20 20 -manual
08f0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 6f 77 : show
0900: 20 74 68 65 20 4d 65 67 61 74 65 73 74 20 75 73 the Megatest us
0910: 65 72 20 6d 61 6e 75 61 6c 0a 20 20 2d 76 65 72 er manual. -ver
0920: 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 20 20 sion
0930: 20 20 20 20 20 3a 20 70 72 69 6e 74 20 6d 65 67 : print meg
0940: 61 74 65 73 74 20 76 65 72 73 69 6f 6e 20 28 63 atest version (c
0950: 75 72 72 65 6e 74 6c 79 20 22 20 6d 65 67 61 74 urrently " megat
0960: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 29 0a 0a est-version ")..
0970: 41 63 74 69 6f 6e 73 3a 0a 20 20 20 72 75 6e 20 Actions:. run
0980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0990: 20 20 20 20 3a 20 69 6e 69 74 69 61 74 65 20 72 : initiate r
09a0: 75 6e 73 0a 20 20 20 72 65 6d 6f 76 65 20 20 20 uns. remove
09b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
09c0: 20 72 65 6d 6f 76 65 20 72 75 6e 73 0a 20 20 20 remove runs.
09d0: 72 65 72 75 6e 20 20 20 20 20 20 20 20 20 20 20 rerun
09e0: 20 20 20 20 20 20 20 20 3a 20 72 65 67 69 73 74 : regist
09f0: 65 72 20 61 63 74 69 6f 6e 20 66 6f 72 20 70 72 er action for pr
0a00: 6f 63 65 73 73 69 6e 67 0a 20 20 20 73 65 74 2d ocessing. set-
0a10: 73 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ss
0a20: 20 20 20 20 3a 20 73 65 74 20 73 74 61 74 65 2f : set state/
0a30: 73 74 61 74 75 73 0a 20 20 20 61 72 63 68 69 76 status. archiv
0a40: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
0a50: 20 20 3a 20 63 6f 6d 70 72 65 73 73 20 61 6e 64 : compress and
0a60: 20 6d 6f 76 65 20 74 65 73 74 20 64 61 74 61 20 move test data
0a70: 74 6f 20 61 72 63 68 69 76 65 20 64 69 73 6b 0a to archive disk.
0a80: 20 20 20 6b 69 6c 6c 20 20 20 20 20 20 20 20 20 kill
0a90: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 6f : sto
0aa0: 70 20 74 65 73 74 73 20 6f 72 20 65 6e 74 69 72 p tests or entir
0ab0: 65 20 72 75 6e 73 0a 20 20 20 64 62 20 20 20 20 e runs. db
0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ad0: 20 20 3a 20 64 61 74 61 62 61 73 65 20 75 74 69 : database uti
0ae0: 6c 69 74 69 65 73 0a 0a 43 6f 6e 74 6f 75 72 20 lities..Contour
0af0: 61 63 74 69 6f 6e 73 3a 0a 20 20 20 70 72 6f 63 actions:. proc
0b00: 65 73 73 20 20 20 20 20 20 20 20 20 20 20 20 20 ess
0b10: 20 20 20 20 3a 20 72 75 6e 73 20 69 6d 70 6f 72 : runs impor
0b20: 74 2c 20 72 75 6e 67 65 6e 20 61 6e 64 20 64 69 t, rungen and di
0b30: 73 70 61 74 63 68 20 0a 0a 53 65 6c 65 63 74 6f spatch ..Selecto
0b40: 72 73 20 0a 20 20 2d 69 6d 6d 65 64 69 61 74 65 rs . -immediate
0b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
0b60: 20 61 70 70 6c 79 20 74 68 69 73 20 61 63 74 69 apply this acti
0b70: 6f 6e 20 69 6d 6d 65 64 69 61 74 65 6c 79 2c 20 on immediately,
0b80: 64 65 66 61 75 6c 74 20 69 73 20 74 6f 20 71 75 default is to qu
0b90: 65 75 65 20 75 70 20 61 63 74 69 6f 6e 73 0a 20 eue up actions.
0ba0: 20 2d 61 72 65 61 20 61 72 65 61 70 61 74 74 31 -area areapatt1
0bb0: 2c 61 72 65 61 32 2e 2e 2e 20 3a 20 61 70 70 6c ,area2... : appl
0bc0: 79 20 74 68 69 73 20 61 63 74 69 6f 6e 20 6f 6e y this action on
0bd0: 6c 79 20 74 6f 20 74 68 65 20 73 70 65 63 69 66 ly to the specif
0be0: 69 65 64 20 61 72 65 61 73 0a 20 20 2d 74 61 72 ied areas. -tar
0bf0: 67 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e get key1/key2/..
0c00: 2e 20 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b . : run for k
0c10: 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a ey1, key2, etc..
0c20: 20 20 2d 74 65 73 74 2d 70 61 74 74 20 70 31 2f -test-patt p1/
0c30: 70 32 2c 70 33 2f 2e 2e 2e 20 20 3a 20 25 20 69 p2,p3/... : % i
0c40: 73 20 77 69 6c 64 63 61 72 64 0a 20 20 2d 72 75 s wildcard. -ru
0c50: 6e 2d 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 n-name
0c60: 20 20 20 20 20 20 3a 20 72 65 71 75 69 72 65 64 : required
0c70: 2c 20 6e 61 6d 65 20 66 6f 72 20 74 68 69 73 20 , name for this
0c80: 70 61 72 74 69 63 75 6c 61 72 20 74 65 73 74 20 particular test
0c90: 72 75 6e 0a 20 20 2d 63 6f 6e 74 6f 75 72 20 63 run. -contour c
0ca0: 6f 6e 74 6f 75 72 6e 61 6d 65 20 20 20 20 20 3a ontourname :
0cb0: 20 72 75 6e 20 61 6c 6c 20 74 61 72 67 65 74 73 run all targets
0cc0: 20 66 6f 72 20 63 6f 6e 74 6f 75 72 6e 61 6d 65 for contourname
0cd0: 2c 20 72 65 71 75 69 72 65 73 20 2d 72 75 6e 2d , requires -run-
0ce0: 6e 61 6d 65 2c 20 2d 74 61 72 67 65 74 0a 20 20 name, -target.
0cf0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 63 2f -state-status c/
0d00: 70 2c 63 2f 66 20 20 20 20 3a 20 53 70 65 63 69 p,c/f : Speci
0d10: 66 79 20 61 20 6c 69 73 74 20 6f 66 20 73 74 61 fy a list of sta
0d20: 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 70 61 te and status pa
0d30: 74 74 65 72 6e 73 0a 20 20 2d 74 61 67 2d 65 78 tterns. -tag-ex
0d40: 70 72 20 74 61 67 31 2c 74 61 67 32 25 2c 2e 2e pr tag1,tag2%,..
0d50: 20 20 3a 20 73 65 6c 65 63 74 20 74 65 73 74 73 : select tests
0d60: 20 77 69 74 68 20 74 61 67 73 20 6d 61 74 63 68 with tags match
0d70: 69 6e 67 20 65 78 70 72 65 73 73 69 6f 6e 0a 20 ing expression.
0d80: 20 2d 6d 6f 64 65 2d 70 61 74 74 20 6b 65 79 20 -mode-patt key
0d90: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 : load
0da0: 20 74 65 73 74 70 61 74 74 20 66 72 6f 6d 20 3c testpatt from <
0db0: 6b 65 79 3e 20 69 6e 20 72 75 6e 63 6f 6e 66 69 key> in runconfi
0dc0: 67 73 20 69 6e 73 74 65 61 64 20 6f 66 20 64 65 gs instead of de
0dd0: 66 61 75 6c 74 20 54 45 53 54 50 41 54 54 0a 20 fault TESTPATT.
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 2d if -
0e00: 74 65 73 74 70 61 74 74 20 61 6e 64 20 2d 74 61 testpatt and -ta
0e10: 67 65 78 70 72 20 61 72 65 20 6e 6f 74 20 73 70 gexpr are not sp
0e20: 65 63 69 66 69 65 64 0a 20 20 2d 6e 65 77 20 73 ecified. -new s
0e30: 74 61 74 65 2f 73 74 61 74 75 73 20 20 20 20 20 tate/status
0e40: 20 20 20 3a 20 73 70 65 63 69 66 79 20 6e 65 77 : specify new
0e50: 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 66 6f state/status fo
0e60: 72 20 73 65 74 2d 73 73 0a 0a 4d 69 73 63 20 0a r set-ss..Misc .
0e70: 20 20 2d 73 74 61 72 74 2d 64 69 72 20 70 61 74 -start-dir pat
0e80: 68 20 20 20 20 20 20 20 20 20 20 3a 20 73 77 69 h : swi
0e90: 74 63 68 20 74 6f 20 74 68 69 73 20 64 69 72 65 tch to this dire
0ea0: 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 75 6e ctory before run
0eb0: 6e 69 6e 67 20 6d 74 75 74 69 6c 0a 20 20 2d 73 ning mtutil. -s
0ec0: 65 74 2d 76 61 72 73 20 56 31 3d 31 2c 56 32 3d et-vars V1=1,V2=
0ed0: 32 20 20 20 20 20 20 3a 20 41 64 64 20 65 6e 76 2 : Add env
0ee0: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
0ef0: 65 73 20 74 6f 20 61 20 72 75 6e 20 4e 42 2f 2f es to a run NB//
0f00: 20 74 68 65 73 65 20 61 72 65 0a 20 20 20 20 20 these are.
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 20 20 20 20 20 20 20 20 20 20 20 6f 76 65 72 over
0f30: 77 72 69 74 74 65 6e 20 62 79 20 76 61 6c 75 65 written by value
0f40: 73 20 73 65 74 20 69 6e 20 63 6f 6e 66 69 67 20 s set in config
0f50: 66 69 6c 65 73 2e 0a 20 20 2d 6c 6f 67 20 6c 6f files.. -log lo
0f60: 67 66 69 6c 65 20 20 20 20 20 20 20 20 20 20 20 gfile
0f70: 20 20 3a 20 73 65 6e 64 20 73 74 64 6f 75 74 20 : send stdout
0f80: 61 6e 64 20 73 74 64 65 72 72 20 74 6f 20 6c 6f and stderr to lo
0f90: 67 66 69 6c 65 0a 20 20 2d 72 65 70 6c 20 20 20 gfile. -repl
0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fb0: 20 3a 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 : start a repl
0fc0: 28 75 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 (useful for exte
0fd0: 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a nding megatest).
0fe0: 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d -load file.scm
0ff0: 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 : loa
1000: 64 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 d and run file.s
1010: 63 6d 0a 20 20 2d 64 65 62 75 67 20 4e 7c 4e 2c cm. -debug N|N,
1020: 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 20 20 3a 20 M,O... :
1030: 65 6e 61 62 6c 65 20 64 65 62 75 67 20 6d 65 73 enable debug mes
1040: 73 61 67 65 73 20 30 2d 4e 20 6f 72 20 4e 20 61 sages 0-N or N a
1050: 6e 64 20 4d 20 61 6e 64 20 4f 20 2e 2e 2e 0a 0a nd M and O .....
1060: 55 74 69 6c 69 74 79 0a 20 64 62 20 70 67 73 63 Utility. db pgsc
1070: 68 65 6d 61 20 20 20 20 20 20 20 20 20 20 20 20 hema
1080: 20 20 20 3a 20 65 6d 69 74 20 70 6f 73 74 67 72 : emit postgr
1090: 65 73 71 6c 20 73 63 68 65 6d 61 3b 20 64 6f 20 esql schema; do
10a0: 5c 22 6d 74 75 74 69 6c 20 64 62 20 70 67 73 63 \"mtutil db pgsc
10b0: 68 65 6d 61 20 7c 20 70 73 71 6c 20 2d 64 20 6d hema | psql -d m
10c0: 79 64 62 5c 22 0a 0a 45 78 61 6d 70 6c 65 73 3a ydb\"..Examples:
10d0: 0a 0a 23 20 53 74 61 72 74 20 61 20 6d 65 67 61 ..# Start a mega
10e0: 74 65 73 74 20 72 75 6e 20 69 6e 20 74 68 65 20 test run in the
10f0: 61 72 65 61 20 5c 22 6d 79 74 65 73 74 73 5c 22 area \"mytests\"
1100: 0a 6d 74 75 74 69 6c 20 2d 61 72 65 61 20 6d 79 .mtutil -area my
1110: 74 65 73 74 73 20 2d 61 63 74 69 6f 6e 20 72 75 tests -action ru
1120: 6e 20 2d 74 61 72 67 65 74 20 76 31 2e 36 33 2f n -target v1.63/
1130: 61 61 33 65 20 2d 6d 6f 64 65 2d 70 61 74 74 20 aa3e -mode-patt
1140: 4d 59 50 41 54 54 20 2d 74 61 67 2d 65 78 70 72 MYPATT -tag-expr
1150: 20 71 75 69 63 6b 0a 0a 23 20 53 74 61 72 74 20 quick..# Start
1160: 61 20 63 6f 6e 74 6f 75 72 0a 6d 74 75 74 69 6c a contour.mtutil
1170: 20 72 75 6e 20 2d 63 6f 6e 74 6f 75 72 20 71 75 run -contour qu
1180: 69 63 6b 20 2d 74 61 72 67 65 74 20 76 31 2e 36 ick -target v1.6
1190: 33 2f 61 61 33 65 20 0a 0a 43 61 6c 6c 65 64 20 3/aa3e ..Called
11a0: 61 73 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 as " (string-int
11b0: 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 20 ersperse (argv)
11c0: 22 20 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 " ") ".Version "
11d0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
11e0: 6e 20 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 n ", built from
11f0: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
1200: 6c 2d 68 61 73 68 20 29 29 0a 0a 3b 3b 20 61 72 l-hash ))..;; ar
1210: 67 73 20 61 6e 64 20 70 6b 74 20 6b 65 79 20 73 gs and pkt key s
1220: 70 65 63 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 pecs.;;.(define
1230: 2a 61 72 67 2d 6b 65 79 73 2a 0a 20 20 27 28 28 *arg-keys*. '((
1240: 22 2d 61 72 65 61 22 20 20 20 20 20 20 20 2e 20 "-area" .
1250: 47 29 20 3b 3b 20 6d 61 70 73 20 74 6f 20 67 72 G) ;; maps to gr
1260: 6f 75 70 0a 20 20 20 20 28 22 2d 74 61 72 67 65 oup. ("-targe
1270: 74 22 20 20 20 20 20 2e 20 74 29 0a 20 20 20 20 t" . t).
1280: 28 22 2d 72 75 6e 2d 6e 61 6d 65 22 20 20 20 2e ("-run-name" .
1290: 20 6e 29 0a 20 20 20 20 28 22 2d 73 74 61 74 65 n). ("-state
12a0: 22 20 20 20 20 20 20 2e 20 65 29 0a 20 20 20 20 " . e).
12b0: 28 22 2d 73 74 61 74 75 73 22 20 20 20 20 20 2e ("-status" .
12c0: 20 73 29 0a 20 20 20 20 28 22 2d 63 6f 6e 74 6f s). ("-conto
12d0: 75 72 22 20 20 20 20 2e 20 63 29 0a 20 20 20 20 ur" . c).
12e0: 28 22 2d 74 65 73 74 2d 70 61 74 74 22 20 20 2e ("-test-patt" .
12f0: 20 70 29 20 20 3b 3b 20 69 64 65 61 2c 20 65 6e p) ;; idea, en
1300: 68 61 6e 63 65 20 6d 61 72 67 73 20 28 22 2d 74 hance margs ("-t
1310: 65 73 74 2d 70 61 74 74 22 20 22 2d 74 65 73 74 est-patt" "-test
1320: 70 61 74 74 22 29 20 3d 3e 20 79 69 65 6c 64 73 patt") => yields
1330: 20 6f 6e 65 20 76 61 6c 75 65 20 69 6e 20 22 2d one value in "-
1340: 74 65 73 74 2d 70 61 74 74 22 0a 20 20 20 20 28 test-patt". (
1350: 22 2d 6d 6f 64 65 2d 70 61 74 74 22 20 20 2e 20 "-mode-patt" .
1360: 6f 29 0a 20 20 20 20 28 22 2d 74 61 67 2d 65 78 o). ("-tag-ex
1370: 70 72 22 20 20 20 2e 20 78 29 0a 20 20 20 20 28 pr" . x). (
1380: 22 2d 69 74 65 6d 2d 70 61 74 74 22 20 20 2e 20 "-item-patt" .
1390: 69 29 0a 20 20 20 20 3b 3b 20 6d 69 73 63 0a 20 i). ;; misc.
13a0: 20 20 20 28 22 2d 73 74 61 72 74 2d 64 69 72 22 ("-start-dir"
13b0: 20 20 2e 20 53 29 0a 20 20 20 20 28 22 2d 6d 73 . S). ("-ms
13c0: 67 22 20 20 20 20 20 20 20 20 2e 20 4d 29 0a 20 g" . M).
13d0: 20 20 20 28 22 2d 73 65 74 2d 76 61 72 73 22 20 ("-set-vars"
13e0: 20 20 2e 20 76 29 0a 20 20 20 20 28 22 2d 64 65 . v). ("-de
13f0: 62 75 67 22 20 20 20 20 20 20 2e 20 23 66 29 20 bug" . #f)
1400: 20 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 ;; for *verbosi
1410: 74 79 2a 20 3e 20 32 0a 20 20 20 20 28 22 2d 6c ty* > 2. ("-l
1420: 6f 61 64 22 20 20 20 20 20 20 20 2e 20 23 66 29 oad" . #f)
1430: 20 20 3b 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 ;; load and ex
1440: 65 63 74 75 74 65 20 61 20 73 63 68 65 6d 65 20 ectute a scheme
1450: 66 69 6c 65 0a 20 20 20 20 28 22 2d 6c 6f 67 22 file. ("-log"
1460: 20 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 . #f).
1470: 20 20 29 29 0a 28 64 65 66 69 6e 65 20 2a 73 77 )).(define *sw
1480: 69 74 63 68 2d 6b 65 79 73 2a 0a 20 20 27 28 28 itch-keys*. '((
1490: 22 2d 68 22 20 20 20 20 20 20 20 20 20 20 2e 20 "-h" .
14a0: 23 66 29 0a 20 20 20 20 28 22 2d 68 65 6c 70 22 #f). ("-help"
14b0: 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 20 . #f).
14c0: 20 28 22 2d 2d 68 65 6c 70 22 20 20 20 20 20 20 ("--help"
14d0: 2e 20 23 66 29 0a 20 20 20 20 28 22 2d 6d 61 6e . #f). ("-man
14e0: 75 61 6c 22 20 20 20 20 20 2e 20 23 66 29 0a 20 ual" . #f).
14f0: 20 20 20 28 22 2d 76 65 72 73 69 6f 6e 22 20 20 ("-version"
1500: 20 20 2e 20 23 66 29 0a 20 20 20 20 3b 3b 20 6d . #f). ;; m
1510: 69 73 63 0a 20 20 20 20 28 22 2d 72 65 70 6c 22 isc. ("-repl"
1520: 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 20 . #f).
1530: 20 28 22 2d 69 6d 6d 65 64 69 61 74 65 22 20 20 ("-immediate"
1540: 2e 20 49 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 . I). ))..(de
1550: 66 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d 70 61 72 fine (lookup-par
1560: 61 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 20 23 21 am-by-key key #!
1570: 6b 65 79 20 28 69 6e 6c 73 74 20 23 66 29 29 0a key (inlst #f)).
1580: 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 (fold (lambda
1590: 28 61 20 72 65 73 29 0a 09 20 20 28 69 66 20 28 (a res).. (if (
15a0: 65 71 3f 20 28 63 64 72 20 61 29 20 6b 65 79 29 eq? (cdr a) key)
15b0: 0a 09 20 20 20 20 20 20 28 63 61 72 20 61 29 0a .. (car a).
15c0: 09 20 20 20 20 20 20 72 65 73 29 29 0a 09 23 66 . res))..#f
15d0: 0a 09 28 6f 72 20 69 6e 6c 73 74 20 2a 61 72 67 ..(or inlst *arg
15e0: 2d 6b 65 79 73 2a 29 29 29 0a 0a 3b 3b 20 67 69 -keys*)))..;; gi
15f0: 76 65 6e 20 61 20 6d 74 75 74 69 6c 20 70 61 72 ven a mtutil par
1600: 61 6d 2c 20 72 65 74 75 72 6e 20 74 68 65 20 6f am, return the o
1610: 6c 64 20 6d 65 67 61 74 65 73 74 20 65 71 75 69 ld megatest equi
1620: 76 61 6c 65 6e 74 0a 3b 3b 0a 28 64 65 66 69 6e valent.;;.(defin
1630: 65 20 28 70 61 72 61 6d 2d 74 72 61 6e 73 6c 61 e (param-transla
1640: 74 65 20 70 61 72 61 6d 29 0a 20 20 28 6f 72 20 te param). (or
1650: 28 61 6c 69 73 74 2d 72 65 66 20 28 73 74 72 69 (alist-ref (stri
1660: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 70 61 72 61 6d ng->symbol param
1670: 29 0a 09 09 20 27 28 28 2d 74 61 67 2d 65 78 70 )... '((-tag-exp
1680: 72 20 20 2e 20 22 2d 74 61 67 65 78 70 72 22 29 r . "-tagexpr")
1690: 0a 09 09 20 20 20 28 2d 6d 6f 64 65 2d 70 61 74 ... (-mode-pat
16a0: 74 20 2e 20 22 2d 2d 6d 6f 64 65 70 61 74 74 22 t . "--modepatt"
16b0: 29 0a 09 09 20 20 20 28 2d 72 75 6e 2d 6e 61 6d )... (-run-nam
16c0: 65 20 20 2e 20 22 2d 72 75 6e 6e 61 6d 65 22 29 e . "-runname")
16d0: 0a 09 09 20 20 20 28 2d 74 65 73 74 2d 70 61 74 ... (-test-pat
16e0: 74 20 2e 20 22 2d 74 65 73 74 70 61 74 74 22 29 t . "-testpatt")
16f0: 0a 09 09 20 20 20 28 2d 6d 73 67 20 20 20 20 20 ... (-msg
1700: 20 20 2e 20 22 2d 6d 22 29 29 29 0a 20 20 20 20 . "-m"))).
1710: 20 20 70 61 72 61 6d 29 29 0a 0a 3b 3b 20 43 61 param))..;; Ca
1720: 72 64 20 74 79 70 65 73 3a 0a 3b 3b 0a 3b 3b 20 rd types:.;;.;;
1730: 61 20 61 63 74 69 6f 6e 0a 3b 3b 20 75 20 75 73 a action.;; u us
1740: 65 72 6e 61 6d 65 20 28 55 6e 69 78 29 0a 3b 3b ername (Unix).;;
1750: 20 44 20 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 D timestamp.;;
1760: 54 20 63 61 72 64 20 74 79 70 65 0a 0a 3b 3b 20 T card type..;;
1770: 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 64 65 process args.(de
1780: 66 69 6e 65 20 2a 61 63 74 69 6f 6e 2a 20 28 69 fine *action* (i
1790: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 61 72 f (> (length (ar
17a0: 67 76 29 29 20 31 29 0a 09 09 20 20 20 20 20 28 gv)) 1)... (
17b0: 63 61 64 72 20 28 61 72 67 76 29 29 0a 09 09 20 cadr (argv))...
17c0: 20 20 20 20 23 66 29 29 0a 28 64 65 66 69 6e 65 #f)).(define
17d0: 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 remargs (args:g
17e0: 65 74 2d 61 72 67 73 20 0a 09 09 20 28 69 66 20 et-args ... (if
17f0: 2a 61 63 74 69 6f 6e 2a 20 28 63 64 72 20 28 61 *action* (cdr (a
1800: 72 67 76 29 29 20 28 61 72 67 76 29 29 20 3b 3b rgv)) (argv)) ;;
1810: 20 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 64 args:get-args d
1820: 75 6d 70 73 20 66 69 72 73 74 20 69 6e 20 61 72 umps first in ar
1830: 67 76 20 6c 69 73 74 20 28 74 68 65 20 70 72 6f gv list (the pro
1840: 67 72 61 6d 20 6e 61 6d 65 29 0a 09 09 20 28 6d gram name)... (m
1850: 61 70 20 63 61 72 20 2a 61 72 67 2d 6b 65 79 73 ap car *arg-keys
1860: 2a 29 0a 09 09 20 28 6d 61 70 20 63 61 72 20 2a *)... (map car *
1870: 73 77 69 74 63 68 2d 6b 65 79 73 2a 29 0a 09 09 switch-keys*)...
1880: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 args:arg-hash..
1890: 09 20 30 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 . 0))..(if (or (
18a0: 6d 65 6d 62 65 72 20 2a 61 63 74 69 6f 6e 2a 20 member *action*
18b0: 27 28 22 2d 68 22 20 22 2d 68 65 6c 70 22 20 22 '("-h" "-help" "
18c0: 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 29 29 help" "--help"))
18d0: 0a 09 28 61 72 67 73 3a 61 6e 79 2d 64 65 66 69 ..(args:any-defi
18e0: 6e 65 64 3f 20 22 2d 68 22 20 22 2d 68 65 6c 70 ned? "-h" "-help
18f0: 22 20 22 2d 2d 68 65 6c 70 22 29 29 0a 20 20 20 " "--help")).
1900: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
1910: 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 rint help).
1920: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 3b 3b 20 (exit 1)))..;;
1930: 28 70 72 69 6e 74 20 22 2a 61 63 74 69 6f 6e 2a (print "*action*
1940: 3a 20 22 20 2a 61 63 74 69 6f 6e 2a 29 0a 3b 3b : " *action*).;;
1950: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
1960: 75 75 69 64 20 70 6b 74 29 0a 3b 3b 20 09 20 20 uuid pkt).;; .
1970: 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e (command-lin
1980: 65 2d 3e 70 6b 74 20 23 66 20 61 72 67 73 3a 61 e->pkt #f args:a
1990: 72 67 2d 68 61 73 68 29 29 29 0a 3b 3b 20 20 20 rg-hash))).;;
19a0: 28 70 72 69 6e 74 20 70 6b 74 29 29 0a 0a 3b 3b (print pkt))..;;
19b0: 20 41 64 64 20 61 72 67 73 20 74 68 61 74 20 75 Add args that u
19c0: 73 65 20 72 65 6d 61 72 67 73 20 68 65 72 65 0a se remargs here.
19d0: 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 ;;.(if (and (not
19e0: 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 (null? remargs)
19f0: 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a 09 20 20 ).. (not (or..
1a00: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
1a10: 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 0a 09 rg "-runstep")..
1a20: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
1a30: 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 22 29 0a -arg "-envcap").
1a40: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
1a50: 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c 74 61 t-arg "-envdelta
1a60: 22 29 0a 09 20 20 20 20 20 20 20 28 6d 65 6d 62 ").. (memb
1a70: 65 72 20 2a 61 63 74 69 6f 6e 2a 20 27 28 22 64 er *action* '("d
1a80: 62 22 29 29 20 20 20 3b 3b 20 76 65 72 79 20 6c b")) ;; very l
1a90: 6f 6f 73 65 20 63 68 65 63 6b 73 20 6f 6e 20 64 oose checks on d
1aa0: 62 2e 0a 09 20 20 20 20 20 20 20 29 29 29 0a 20 b... ))).
1ab0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
1ac0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
1ad0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 65 -log-port* "Unre
1ae0: 63 6f 67 6e 69 73 65 64 20 61 72 67 75 6d 65 6e cognised argumen
1af0: 74 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ts: " (string-in
1b00: 74 65 72 73 70 65 72 73 65 20 28 69 66 20 28 6c tersperse (if (l
1b10: 69 73 74 3f 20 72 65 6d 61 72 67 73 29 20 72 65 ist? remargs) re
1b20: 6d 61 72 67 73 20 28 61 72 67 76 29 29 20 20 22 margs (argv)) "
1b30: 20 22 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 ")))..(if (or (
1b40: 61 72 67 73 3a 61 6e 79 3f 20 22 2d 68 22 20 22 args:any? "-h" "
1b50: 68 65 6c 70 22 20 22 2d 68 65 6c 70 22 20 22 2d help" "-help" "-
1b60: 2d 68 65 6c 70 22 29 0a 09 28 6d 65 6d 62 65 72 -help")..(member
1b70: 20 2a 61 63 74 69 6f 6e 2a 20 27 28 22 2d 68 22 *action* '("-h"
1b80: 20 22 2d 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 "-help" "--help
1b90: 22 20 22 68 65 6c 70 22 29 29 29 0a 20 20 20 20 " "help"))).
1ba0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 72 (begin. (pr
1bb0: 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 20 int help).
1bc0: 28 65 78 69 74 20 31 29 29 29 0a 0a 3b 3b 3d 3d (exit 1)))..;;==
1bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c10: 3d 3d 3d 3d 0a 3b 3b 20 70 6b 74 73 0a 3b 3b 3d ====.;; pkts.;;=
1c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c60: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
1c70: 77 69 74 68 2d 71 75 65 75 65 2d 64 62 20 6d 74 with-queue-db mt
1c80: 63 6f 6e 66 20 70 72 6f 63 29 0a 20 20 28 6c 65 conf proc). (le
1c90: 74 2a 20 28 28 70 6b 74 73 64 69 72 73 20 28 63 t* ((pktsdirs (c
1ca0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 onfigf:lookup mt
1cb0: 63 6f 6e 66 20 22 73 65 74 75 70 22 20 20 22 70 conf "setup" "p
1cc0: 6b 74 73 64 69 72 73 22 29 29 0a 09 20 28 70 6b ktsdirs")).. (pk
1cd0: 74 73 64 69 72 20 20 28 69 66 20 70 6b 74 73 64 tsdir (if pktsd
1ce0: 69 72 73 20 28 63 61 72 20 28 73 74 72 69 6e 67 irs (car (string
1cf0: 2d 73 70 6c 69 74 20 70 6b 74 73 64 69 72 73 20 -split pktsdirs
1d00: 22 20 22 29 29 20 23 66 29 29 0a 09 20 28 74 6f " ")) #f)).. (to
1d10: 70 70 61 74 68 20 20 28 63 6f 6e 66 69 67 66 3a ppath (configf:
1d20: 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 64 lookup mtconf "d
1d30: 79 6e 64 61 74 22 20 22 74 6f 70 70 61 74 68 22 yndat" "toppath"
1d40: 29 29 0a 09 20 28 70 64 62 70 61 74 68 20 20 28 )).. (pdbpath (
1d50: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
1d60: 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 up mtconf "setup
1d70: 22 20 20 22 70 64 62 70 61 74 68 22 29 20 70 6b " "pdbpath") pk
1d80: 74 73 64 69 72 29 29 29 0a 20 20 20 20 28 69 66 tsdir))). (if
1d90: 20 28 6e 6f 74 20 28 61 6e 64 20 20 70 6b 74 73 (not (and pkts
1da0: 64 69 72 20 74 6f 70 70 61 74 68 20 70 64 62 70 dir toppath pdbp
1db0: 61 74 68 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 ath))..(begin..
1dc0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
1dd0: 73 65 74 74 69 6e 67 73 20 61 72 65 20 6d 69 73 settings are mis
1de0: 73 69 6e 67 20 69 6e 20 79 6f 75 72 20 6d 65 67 sing in your meg
1df0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 6f 72 atest.config for
1e00: 20 61 72 65 61 20 6d 61 6e 61 67 65 6d 65 6e 74 area management
1e10: 2e 22 29 0a 09 20 20 28 70 72 69 6e 74 20 22 20 .").. (print "
1e20: 20 79 6f 75 20 6e 65 65 64 20 74 6f 20 68 61 76 you need to hav
1e30: 65 20 70 6b 74 73 64 69 72 20 69 6e 20 74 68 65 e pktsdir in the
1e40: 20 5b 73 65 74 75 70 5d 20 73 65 63 74 69 6f 6e [setup] section
1e50: 2e 22 29 29 0a 09 28 6c 65 74 2a 20 28 28 70 64 ."))..(let* ((pd
1e60: 62 20 20 28 6f 70 65 6e 2d 71 75 65 75 65 2d 64 b (open-queue-d
1e70: 62 20 70 64 62 70 61 74 68 20 22 70 6b 74 73 2e b pdbpath "pkts.
1e80: 64 62 22 0a 09 09 09 09 20 20 20 20 73 63 68 65 db"..... sche
1e90: 6d 61 3a 20 27 28 22 43 52 45 41 54 45 20 54 41 ma: '("CREATE TA
1ea0: 42 4c 45 20 67 72 6f 75 70 73 20 28 69 64 20 49 BLE groups (id I
1eb0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
1ec0: 45 59 2c 67 72 6f 75 70 6e 61 6d 65 20 54 45 58 EY,groupname TEX
1ed0: 54 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 67 72 T, CONSTRAINT gr
1ee0: 6f 75 70 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 oup_constraint U
1ef0: 4e 49 51 55 45 20 28 67 72 6f 75 70 6e 61 6d 65 NIQUE (groupname
1f00: 29 29 3b 22 29 29 29 29 0a 09 20 20 28 70 72 6f ));")))).. (pro
1f10: 63 20 70 6b 74 73 64 69 72 73 20 70 6b 74 73 64 c pktsdirs pktsd
1f20: 69 72 20 70 64 62 29 0a 09 20 20 28 64 62 69 3a ir pdb).. (dbi:
1f30: 63 6c 6f 73 65 20 70 64 62 29 29 29 29 29 0a 0a close pdb)))))..
1f40: 28 64 65 66 69 6e 65 20 28 6c 6f 61 64 2d 70 6b (define (load-pk
1f50: 74 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 29 ts-to-db mtconf)
1f60: 0a 20 20 28 77 69 74 68 2d 71 75 65 75 65 2d 64 . (with-queue-d
1f70: 62 0a 20 20 20 6d 74 63 6f 6e 66 0a 20 20 20 28 b. mtconf. (
1f80: 6c 61 6d 62 64 61 20 28 70 6b 74 73 64 69 72 73 lambda (pktsdirs
1f90: 20 70 6b 74 73 64 69 72 20 70 64 62 29 0a 20 20 pktsdir pdb).
1fa0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
1fb0: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 73 (lambda (pkts
1fc0: 64 69 72 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 dir) ;; look at
1fd0: 61 6c 6c 0a 09 28 69 66 20 28 61 6e 64 20 28 66 all..(if (and (f
1fe0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 6b 74 73 ile-exists? pkts
1ff0: 64 69 72 29 0a 09 09 20 28 64 69 72 65 63 74 6f dir)... (directo
2000: 72 79 3f 20 70 6b 74 73 64 69 72 29 0a 09 09 20 ry? pktsdir)...
2010: 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 (file-read-acces
2020: 73 3f 20 70 6b 74 73 64 69 72 29 29 0a 09 20 20 s? pktsdir))..
2030: 20 20 28 6c 65 74 20 28 28 70 6b 74 73 20 28 67 (let ((pkts (g
2040: 6c 6f 62 20 28 63 6f 6e 63 20 70 6b 74 73 64 69 lob (conc pktsdi
2050: 72 20 22 2f 2a 2e 70 6b 74 22 29 29 29 29 0a 09 r "/*.pkt"))))..
2060: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a (for-each.
2070: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
2080: 28 70 6b 74 29 0a 09 09 20 28 6c 65 74 2a 20 28 (pkt)... (let* (
2090: 28 75 75 69 64 20 20 20 20 28 63 61 64 72 20 28 (uuid (cadr (
20a0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 2e 2a string-match ".*
20b0: 2f 28 5b 30 2d 39 61 2d 66 5d 2b 29 2e 70 6b 74 /([0-9a-f]+).pkt
20c0: 22 20 70 6b 74 29 29 29 0a 09 09 09 28 65 78 69 " pkt)))....(exi
20d0: 73 74 73 20 20 28 6c 6f 6f 6b 75 70 2d 62 79 2d sts (lookup-by-
20e0: 75 75 69 64 20 70 64 62 20 75 75 69 64 20 23 66 uuid pdb uuid #f
20f0: 29 29 29 0a 09 09 20 20 20 28 69 66 20 28 6e 6f )))... (if (no
2100: 74 20 65 78 69 73 74 73 29 0a 09 09 20 20 20 20 t exists)...
2110: 20 20 20 28 6c 65 74 2a 20 28 28 70 6b 74 64 61 (let* ((pktda
2120: 74 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 t (string-inters
2130: 70 65 72 73 65 0a 09 09 09 09 20 20 20 20 20 20 perse.....
2140: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
2150: 6d 2d 66 69 6c 65 20 70 6b 74 20 72 65 61 64 2d m-file pkt read-
2160: 6c 69 6e 65 73 29 0a 09 09 09 09 20 20 20 20 20 lines).....
2170: 20 20 22 5c 6e 22 29 29 0a 09 09 09 20 20 20 20 "\n"))....
2180: 20 20 28 61 70 6b 74 20 20 20 28 63 6f 6e 76 65 (apkt (conve
2190: 72 74 2d 70 6b 74 2d 3e 61 6c 69 73 74 20 70 6b rt-pkt->alist pk
21a0: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 20 tdat))....
21b0: 28 70 74 79 70 65 20 20 28 61 6c 69 73 74 2d 72 (ptype (alist-r
21c0: 65 66 20 27 54 20 61 70 6b 74 29 29 29 0a 09 09 ef 'T apkt)))...
21d0: 09 20 28 61 64 64 2d 74 6f 2d 71 75 65 75 65 20 . (add-to-queue
21e0: 70 64 62 20 70 6b 74 64 61 74 20 75 75 69 64 20 pdb pktdat uuid
21f0: 28 6f 72 20 70 74 79 70 65 20 27 63 6d 64 29 20 (or ptype 'cmd)
2200: 23 66 20 30 29 0a 09 09 09 20 28 64 65 62 75 67 #f 0).... (debug
2210: 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c :print 4 *defaul
2220: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 64 64 t-log-port* "Add
2230: 65 64 20 22 20 75 75 69 64 20 22 20 6f 66 20 74 ed " uuid " of t
2240: 79 70 65 20 22 20 70 74 79 70 65 20 22 20 74 6f ype " ptype " to
2250: 20 71 75 65 75 65 22 29 29 0a 09 09 20 20 20 20 queue"))...
2260: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
2270: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
2280: 6f 72 74 2a 20 22 70 6b 74 3a 20 22 20 75 75 69 ort* "pkt: " uui
2290: 64 20 22 20 65 78 69 73 74 73 2c 20 73 6b 69 70 d " exists, skip
22a0: 70 69 6e 67 2e 2e 2e 22 29 0a 09 09 20 20 20 20 ping...")...
22b0: 20 20 20 29 29 29 0a 09 20 20 20 20 20 20 20 70 ))).. p
22c0: 6b 74 73 29 29 29 29 0a 20 20 20 20 20 20 28 73 kts)))). (s
22d0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 6b 74 73 tring-split pkts
22e0: 64 69 72 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d dirs)))))..;;===
22f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2330: 3d 3d 3d 0a 3b 3b 20 52 75 6e 73 0a 3b 3b 3d 3d ===.;; Runs.;;==
2340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2380: 3d 3d 3d 3d 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 ====..;; make a
2390: 72 75 6e 6e 61 6d 65 0a 3b 3b 0a 28 64 65 66 69 runname.;;.(defi
23a0: 6e 65 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 ne (make-runname
23b0: 20 70 72 65 20 70 6f 73 74 29 0a 20 28 74 69 6d pre post). (tim
23c0: 65 2d 3e 73 74 72 69 6e 67 0a 20 20 28 73 65 63 e->string. (sec
23d0: 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 onds->local-time
23e0: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
23f0: 73 29 29 20 22 25 59 77 25 56 2e 25 77 2d 25 48 s)) "%Yw%V.%w-%H
2400: 25 4d 22 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 %M"))..;; collec
2410: 74 2c 20 74 72 61 6e 73 6c 61 74 65 2c 20 63 6f t, translate, co
2420: 6c 6c 61 74 65 20 61 6e 64 20 61 73 73 65 6d 62 llate and assemb
2430: 6c 65 20 61 20 70 6b 74 20 66 72 6f 6d 20 74 68 le a pkt from th
2440: 65 20 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 0a 3b e command-line.;
2450: 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d 61 ;.(define (comma
2460: 6e 64 2d 6c 69 6e 65 2d 3e 70 6b 74 20 61 63 74 nd-line->pkt act
2470: 69 6f 6e 20 61 72 67 73 2d 61 6c 69 73 74 20 73 ion args-alist s
2480: 63 68 65 64 2d 69 6e 29 0a 20 20 28 6c 65 74 2a ched-in). (let*
2490: 20 28 28 73 63 68 65 64 20 20 20 20 20 28 63 6f ((sched (co
24a0: 6e 64 0a 09 09 20 20 20 20 20 28 28 76 65 63 74 nd... ((vect
24b0: 6f 72 3f 20 73 63 68 65 64 2d 69 6e 29 28 6c 6f or? sched-in)(lo
24c0: 63 61 6c 2d 74 69 6d 65 2d 3e 73 65 63 6f 6e 64 cal-time->second
24d0: 73 20 73 63 68 65 64 2d 69 6e 29 29 20 3b 3b 20 s sched-in)) ;;
24e0: 77 65 20 72 65 63 69 65 76 65 64 20 61 20 74 69 we recieved a ti
24f0: 6d 65 0a 09 09 20 20 20 20 20 28 28 6e 75 6d 62 me... ((numb
2500: 65 72 3f 20 73 63 68 65 64 2d 69 6e 29 20 73 63 er? sched-in) sc
2510: 68 65 64 2d 69 6e 29 0a 09 09 20 20 20 20 20 28 hed-in)... (
2520: 65 6c 73 65 20 20 20 20 20 28 63 75 72 72 65 6e else (curren
2530: 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 0a 09 20 t-seconds))))..
2540: 28 61 72 67 73 2d 64 61 74 61 20 28 69 66 20 61 (args-data (if a
2550: 72 67 73 2d 61 6c 69 73 74 0a 09 09 09 61 72 67 rgs-alist....arg
2560: 73 2d 61 6c 69 73 74 0a 09 09 09 28 68 61 73 68 s-alist....(hash
2570: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 72 -table->alist ar
2580: 67 73 3a 61 72 67 2d 68 61 73 68 29 29 29 0a 09 gs:arg-hash)))..
2590: 20 28 61 6c 6c 64 61 74 20 20 20 20 28 61 70 70 (alldat (app
25a0: 6c 79 20 61 70 70 65 6e 64 20 28 6c 69 73 74 20 ly append (list
25b0: 27 61 20 61 63 74 69 6f 6e 0a 09 09 09 09 09 27 'a action......'
25c0: 55 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d U (current-user-
25d0: 6e 61 6d 65 29 0a 09 09 09 09 09 27 44 20 73 63 name)......'D sc
25e0: 68 65 64 29 0a 09 09 09 20 20 20 28 6d 61 70 20 hed).... (map
25f0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
2600: 20 20 28 6c 65 74 2a 20 28 28 70 61 72 61 6d 20 (let* ((param
2610: 28 63 61 72 20 78 29 29 0a 09 09 09 09 09 20 28 (car x))...... (
2620: 76 61 6c 75 65 20 28 63 64 72 20 78 29 29 0a 09 value (cdr x))..
2630: 09 09 09 09 20 28 70 6d 65 74 61 20 28 61 73 73 .... (pmeta (ass
2640: 6f 63 20 70 61 72 61 6d 20 2a 61 72 67 2d 6b 65 oc param *arg-ke
2650: 79 73 2a 29 29 0a 09 09 09 09 09 20 28 73 6d 65 ys*))...... (sme
2660: 74 61 20 28 61 73 73 6f 63 20 70 61 72 61 6d 20 ta (assoc param
2670: 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a 29 29 0a *switch-keys*)).
2680: 09 09 09 09 09 20 28 6d 65 74 61 20 20 28 69 66 ..... (meta (if
2690: 20 28 6f 72 20 70 6d 65 74 61 20 73 6d 65 74 61 (or pmeta smeta
26a0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 63 64 72 )....... (cdr
26b0: 20 28 6f 72 20 70 6d 65 74 61 20 73 6d 65 74 61 (or pmeta smeta
26c0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 23 66 29 ))....... #f)
26d0: 29 29 0a 09 09 09 09 20 20 20 20 28 69 66 20 28 ))..... (if (
26e0: 6f 72 20 70 6d 65 74 61 20 73 6d 65 74 61 29 0a or pmeta smeta).
26f0: 09 09 09 09 09 28 6c 69 73 74 20 6d 65 74 61 20 .....(list meta
2700: 76 61 6c 75 65 29 0a 09 09 09 09 09 27 28 29 29 value)......'())
2710: 29 29 0a 09 09 09 09 28 66 69 6c 74 65 72 20 63 )).....(filter c
2720: 64 72 20 61 72 67 73 2d 64 61 74 61 29 29 29 29 dr args-data))))
2730: 29 0a 3b 3b 20 28 70 72 69 6e 74 20 20 22 41 6c ).;; (print "Al
2740: 6c 64 61 74 3a 20 22 20 61 6c 6c 64 61 74 0a 3b ldat: " alldat.;
2750: 3b 20 20 20 20 20 20 20 20 20 22 20 61 72 67 73 ; " args
2760: 2d 64 61 74 61 3a 20 22 20 61 72 67 73 2d 64 61 -data: " args-da
2770: 74 61 29 0a 20 20 20 20 28 61 64 64 2d 7a 2d 63 ta). (add-z-c
2780: 61 72 64 0a 20 20 20 20 20 28 61 70 70 6c 79 20 ard. (apply
2790: 63 6f 6e 73 74 72 75 63 74 2d 73 64 61 74 20 61 construct-sdat a
27a0: 6c 6c 64 61 74 29 29 29 29 0a 0a 28 64 65 66 69 lldat))))..(defi
27b0: 6e 65 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 ne (simple-setup
27c0: 20 73 74 61 72 74 2d 64 69 72 2d 69 6e 29 0a 20 start-dir-in).
27d0: 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 64 (let* ((start-d
27e0: 69 72 20 28 6f 72 20 73 74 61 72 74 2d 64 69 72 ir (or start-dir
27f0: 2d 69 6e 20 22 2e 22 29 29 0a 09 20 28 6d 74 63 -in ".")).. (mtc
2800: 6f 6e 66 69 67 20 20 28 6f 72 20 28 61 72 67 73 onfig (or (args
2810: 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 :get-arg "-confi
2820: 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f g") "megatest.co
2830: 6e 66 69 67 22 29 29 0a 09 20 28 6d 74 63 6f 6e nfig")).. (mtcon
2840: 66 64 61 74 20 28 66 69 6e 64 2d 61 6e 64 2d 72 fdat (find-and-r
2850: 65 61 64 2d 63 6f 6e 66 69 67 20 20 20 20 20 20 ead-config
2860: 20 20 3b 3b 20 4e 42 2f 2f 20 73 65 74 73 20 4d ;; NB// sets M
2870: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 20 T_RUN_AREA_HOME
2880: 61 73 20 73 69 64 65 20 65 66 66 65 63 74 0a 09 as side effect..
2890: 09 20 20 20 20 20 6d 74 63 6f 6e 66 69 67 0a 09 . mtconfig..
28a0: 09 20 20 20 20 20 3b 3b 20 65 6e 76 69 72 6f 6e . ;; environ
28b0: 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 -patt: "env-over
28c0: 72 69 64 65 22 0a 09 09 20 20 20 20 20 67 69 76 ride"... giv
28d0: 65 6e 2d 74 6f 70 70 61 74 68 3a 20 73 74 61 72 en-toppath: star
28e0: 74 2d 64 69 72 0a 09 09 20 20 20 20 20 3b 3b 20 t-dir... ;;
28f0: 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 5f pathenvvar: "MT_
2900: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 0a 09 RUN_AREA_HOME"..
2910: 09 20 20 20 20 20 29 29 0a 09 20 28 6d 74 63 6f . )).. (mtco
2920: 6e 66 20 20 20 20 28 69 66 20 6d 74 63 6f 6e 66 nf (if mtconf
2930: 64 61 74 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 dat (car mtconfd
2940: 61 74 29 20 23 66 29 29 29 0a 20 20 20 20 3b 3b at) #f))). ;;
2950: 20 77 65 20 73 65 74 20 73 6f 6d 65 20 64 79 6e we set some dyn
2960: 61 6d 69 63 20 64 61 74 61 20 69 6e 20 61 20 73 amic data in a s
2970: 65 63 74 69 6f 6e 20 63 61 6c 6c 65 64 20 22 64 ection called "d
2980: 79 6e 64 61 74 61 22 0a 20 20 20 20 28 69 66 20 yndata". (if
2990: 6d 74 63 6f 6e 66 0a 09 28 62 65 67 69 6e 0a 09 mtconf..(begin..
29a0: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
29b0: 6f 6e 2d 76 61 72 2d 73 65 74 21 20 6d 74 63 6f on-var-set! mtco
29c0: 6e 66 20 22 64 79 6e 64 61 74 22 20 22 74 6f 70 nf "dyndat" "top
29d0: 70 61 74 68 22 20 73 74 61 72 74 2d 64 69 72 29 path" start-dir)
29e0: 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 )). ;; (print
29f0: 20 22 54 4f 50 50 41 54 48 3a 20 22 20 28 63 6f "TOPPATH: " (co
2a00: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 nfigf:lookup mtc
2a10: 6f 6e 66 20 22 64 79 6e 64 61 74 22 20 22 74 6f onf "dyndat" "to
2a20: 70 70 61 74 68 22 29 29 0a 20 20 20 20 6d 74 63 ppath")). mtc
2a30: 6f 6e 66 64 61 74 29 29 0a 0a 0a 3b 3b 20 4e 45 onfdat))...;; NE
2a40: 45 44 20 54 49 4d 45 53 54 41 4d 50 20 4f 4e 20 ED TIMESTAMP ON
2a50: 50 4b 54 53 20 66 6f 72 20 65 66 66 69 63 69 65 PKTS for efficie
2a60: 6e 74 20 6c 6f 61 64 69 6e 67 20 6f 66 20 70 61 nt loading of pa
2a70: 63 6b 65 74 73 20 69 6e 74 6f 20 64 62 2e 0a 0a ckets into db...
2a80: 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 75 6e 20 72 .;; make a run r
2a90: 65 71 75 65 73 74 20 70 6b 74 20 66 72 6f 6d 20 equest pkt from
2aa0: 62 61 73 69 63 20 64 61 74 61 0a 3b 3b 0a 28 64 basic data.;;.(d
2ab0: 65 66 69 6e 65 20 28 63 72 65 61 74 65 2d 72 75 efine (create-ru
2ac0: 6e 2d 70 6b 74 20 6d 74 63 6f 6e 66 20 61 72 65 n-pkt mtconf are
2ad0: 61 20 72 75 6e 6b 65 79 20 72 75 6e 6e 61 6d 65 a runkey runname
2ae0: 20 6d 6f 64 65 2d 70 61 74 74 20 74 61 67 2d 65 mode-patt tag-e
2af0: 78 70 72 20 70 6b 74 73 64 69 72 20 72 65 61 73 xpr pktsdir reas
2b00: 6f 6e 20 63 6f 6e 74 6f 75 72 20 73 63 68 65 64 on contour sched
2b10: 29 20 0a 20 20 28 6c 65 74 2a 20 28 28 61 72 65 ) . (let* ((are
2b20: 61 2d 64 61 74 20 20 20 28 73 74 72 69 6e 67 2d a-dat (string-
2b30: 73 70 6c 69 74 20 28 6f 72 20 28 63 6f 6e 66 69 split (or (confi
2b40: 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 gf:lookup mtconf
2b50: 20 22 61 72 65 61 73 22 20 61 72 65 61 29 20 22 "areas" area) "
2b60: 22 29 29 29 0a 09 20 28 61 72 65 61 2d 70 61 74 "))).. (area-pat
2b70: 68 20 20 28 63 61 72 20 61 72 65 61 2d 64 61 74 h (car area-dat
2b80: 29 29 0a 09 20 28 61 72 65 61 2d 78 6c 61 74 72 )).. (area-xlatr
2b90: 20 28 69 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 (if (eq? (lengt
2ba0: 68 20 61 72 65 61 2d 64 61 74 29 20 32 29 28 63 h area-dat) 2)(c
2bb0: 61 64 72 20 61 72 65 61 2d 64 61 74 29 20 23 66 adr area-dat) #f
2bc0: 29 29 0a 09 20 28 6e 65 77 2d 74 61 72 67 65 74 )).. (new-target
2bd0: 20 28 69 66 20 61 72 65 61 2d 78 6c 61 74 72 0a (if area-xlatr.
2be0: 09 09 09 20 28 6c 65 74 20 28 28 78 6c 61 74 72 ... (let ((xlatr
2bf0: 2d 6b 65 79 20 28 73 74 72 69 6e 67 2d 3e 73 79 -key (string->sy
2c00: 6d 62 6f 6c 20 61 72 65 61 2d 78 6c 61 74 72 29 mbol area-xlatr)
2c10: 29 29 0a 09 09 09 20 20 20 28 69 66 20 28 61 6c )).... (if (al
2c20: 69 73 74 2d 72 65 66 20 78 6c 61 74 72 2d 6b 65 ist-ref xlatr-ke
2c30: 79 20 2a 74 61 72 67 65 74 2d 6d 61 70 70 65 72 y *target-mapper
2c40: 73 2a 29 0a 09 09 09 20 20 20 20 20 20 20 28 62 s*).... (b
2c50: 65 67 69 6e 0a 09 09 09 09 20 28 70 72 69 6e 74 egin..... (print
2c60: 20 22 55 73 69 6e 67 20 74 61 72 67 65 74 20 6d "Using target m
2c70: 61 70 70 65 72 3a 20 22 20 61 72 65 61 2d 78 6c apper: " area-xl
2c80: 61 74 72 29 0a 09 09 09 09 20 28 68 61 6e 64 6c atr)..... (handl
2c90: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 e-exceptions....
2ca0: 09 20 20 20 20 20 65 78 6e 0a 09 09 09 09 20 20 . exn.....
2cb0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 (begin.....
2cc0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 41 49 (print "FAI
2cd0: 4c 45 44 20 54 4f 20 52 55 4e 20 54 41 52 47 45 LED TO RUN TARGE
2ce0: 54 20 4d 41 50 50 45 52 20 46 4f 52 20 22 20 61 T MAPPER FOR " a
2cf0: 72 65 61 20 22 2c 20 63 61 6c 6c 65 64 20 22 20 rea ", called "
2d00: 61 72 65 61 2d 78 6c 61 74 72 29 0a 09 09 09 09 area-xlatr).....
2d10: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 (print "
2d20: 20 20 66 75 6e 63 74 69 6f 6e 20 69 73 3a 20 22 function is: "
2d30: 20 28 61 6c 69 73 74 2d 72 65 66 20 78 6c 61 74 (alist-ref xlat
2d40: 72 2d 6b 65 79 20 2a 74 61 72 67 65 74 2d 6d 61 r-key *target-ma
2d50: 70 70 65 72 73 2a 29 29 0a 09 09 09 09 20 20 20 ppers*)).....
2d60: 20 20 20 20 28 70 72 69 6e 74 20 22 20 6d 65 73 (print " mes
2d70: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
2d80: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
2d90: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
2da0: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 20 age) exn)).....
2db0: 20 20 20 20 20 20 72 75 6e 6b 65 79 29 0a 09 09 runkey)...
2dc0: 09 09 20 20 20 28 28 61 6c 69 73 74 2d 72 65 66 .. ((alist-ref
2dd0: 20 78 6c 61 74 72 2d 6b 65 79 20 2a 74 61 72 67 xlatr-key *targ
2de0: 65 74 2d 6d 61 70 70 65 72 73 2a 29 0a 09 09 09 et-mappers*)....
2df0: 09 20 20 20 20 72 75 6e 6b 65 79 20 72 75 6e 6e . runkey runn
2e00: 61 6d 65 20 61 72 65 61 20 61 72 65 61 2d 70 61 ame area area-pa
2e10: 74 68 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 th reason contou
2e20: 72 20 6d 6f 64 65 2d 70 61 74 74 29 29 29 29 29 r mode-patt)))))
2e30: 0a 09 09 09 20 72 75 6e 6b 65 79 29 29 29 0a 20 .... runkey))).
2e40: 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 (let-values (
2e50: 28 28 75 75 69 64 20 70 6b 74 29 0a 09 09 20 20 ((uuid pkt)...
2e60: 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e 70 (command-line->p
2e70: 6b 74 0a 09 09 20 20 20 22 72 75 6e 22 0a 09 09 kt... "run"...
2e80: 20 20 20 28 61 70 70 65 6e 64 20 0a 09 09 20 20 (append ...
2e90: 20 20 60 28 28 22 2d 74 61 72 67 65 74 22 20 20 `(("-target"
2ea0: 20 20 20 2e 20 2c 6e 65 77 2d 74 61 72 67 65 74 . ,new-target
2eb0: 29 0a 09 09 20 20 20 20 20 20 28 22 2d 72 75 6e )... ("-run
2ec0: 2d 6e 61 6d 65 22 20 20 20 2e 20 2c 72 75 6e 6e -name" . ,runn
2ed0: 61 6d 65 29 0a 09 09 20 20 20 20 20 20 28 22 2d ame)... ("-
2ee0: 73 74 61 72 74 2d 64 69 72 22 20 20 2e 20 2c 61 start-dir" . ,a
2ef0: 72 65 61 2d 70 61 74 68 29 0a 09 09 20 20 20 20 rea-path)...
2f00: 20 20 28 22 2d 6d 73 67 22 20 20 20 20 20 20 20 ("-msg"
2f10: 20 2e 20 2c 72 65 61 73 6f 6e 29 0a 09 09 20 20 . ,reason)...
2f20: 20 20 20 20 28 22 2d 63 6f 6e 74 6f 75 72 22 20 ("-contour"
2f30: 20 20 20 2e 20 2c 63 6f 6e 74 6f 75 72 29 29 0a . ,contour)).
2f40: 09 09 20 20 20 20 28 69 66 20 6d 6f 64 65 2d 70 .. (if mode-p
2f50: 61 74 74 0a 09 09 09 60 28 28 22 2d 6d 6f 64 65 att....`(("-mode
2f60: 2d 70 61 74 74 22 20 20 2e 20 2c 6d 6f 64 65 2d -patt" . ,mode-
2f70: 70 61 74 74 29 29 0a 09 09 09 27 28 29 29 0a 09 patt))....'())..
2f80: 09 20 20 20 20 28 69 66 20 74 61 67 2d 65 78 70 . (if tag-exp
2f90: 72 0a 09 09 09 60 28 28 22 2d 74 61 67 2d 65 78 r....`(("-tag-ex
2fa0: 70 72 22 20 20 20 2e 20 2c 74 61 67 2d 65 78 70 pr" . ,tag-exp
2fb0: 72 29 29 0a 09 09 09 27 28 29 29 0a 09 09 20 20 r))....'())...
2fc0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 6d (if (not (or m
2fd0: 6f 64 65 2d 70 61 74 74 20 74 61 67 2d 65 78 70 ode-patt tag-exp
2fe0: 72 29 29 0a 09 09 09 60 28 28 22 2d 69 74 65 6d r))....`(("-item
2ff0: 2d 70 61 74 74 22 20 20 2e 20 22 25 22 29 29 0a -patt" . "%")).
3000: 09 09 09 27 28 29 29 29 0a 09 09 20 20 20 73 63 ...'()))... sc
3010: 68 65 64 29 29 29 0a 20 20 20 20 20 20 28 77 69 hed))). (wi
3020: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
3030: 65 0a 09 20 20 28 63 6f 6e 63 20 70 6b 74 73 64 e.. (conc pktsd
3040: 69 72 20 22 2f 22 20 75 75 69 64 20 22 2e 70 6b ir "/" uuid ".pk
3050: 74 22 29 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a t")..(lambda ().
3060: 09 20 20 28 70 72 69 6e 74 20 70 6b 74 29 29 29 . (print pkt)))
3070: 29 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 74 20 )))..;; collect
3080: 61 6c 6c 20 6e 65 65 64 65 64 20 64 61 74 61 20 all needed data
3090: 61 6e 64 20 63 72 65 61 74 65 20 72 75 6e 20 70 and create run p
30a0: 6b 74 73 20 66 6f 72 20 63 6f 6e 74 6f 75 72 73 kts for contours
30b0: 20 77 69 74 68 20 63 68 61 6e 67 65 64 20 69 6e with changed in
30c0: 70 75 74 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 puts.;;.(define
30d0: 28 67 65 6e 65 72 61 74 65 2d 72 75 6e 2d 70 6b (generate-run-pk
30e0: 74 73 20 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 ts mtconf toppat
30f0: 68 29 0a 20 20 28 77 69 74 68 2d 71 75 65 75 65 h). (with-queue
3100: 2d 64 62 0a 20 20 20 6d 74 63 6f 6e 66 0a 20 20 -db. mtconf.
3110: 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 73 64 69 (lambda (pktsdi
3120: 72 73 20 70 6b 74 73 64 69 72 20 70 64 62 29 0a rs pktsdir pdb).
3130: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 67 63 (let* ((rgc
3140: 6f 6e 66 64 61 74 20 28 66 69 6e 64 2d 61 6e 64 onfdat (find-and
3150: 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f -read-config (co
3160: 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e nc toppath "/run
3170: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 configs.config")
3180: 29 29 0a 09 20 20 20 20 28 72 67 63 6f 6e 66 20 )).. (rgconf
3190: 20 20 20 28 63 61 72 20 72 67 63 6f 6e 66 64 61 (car rgconfda
31a0: 74 29 29 0a 09 20 20 20 20 28 61 72 65 61 73 20 t)).. (areas
31b0: 20 20 20 20 28 6d 61 70 20 63 61 72 20 28 63 6f (map car (co
31c0: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f nfigf:get-sectio
31d0: 6e 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 22 n mtconf "areas"
31e0: 29 29 29 0a 09 20 20 20 20 28 63 6f 6e 74 6f 75 ))).. (contou
31f0: 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 rs (configf:get
3200: 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 -section mtconf
3210: 22 63 6f 6e 74 6f 75 72 73 22 29 29 0a 09 20 20 "contours"))..
3220: 20 20 28 74 6f 72 75 6e 20 20 20 20 20 28 6d 61 (torun (ma
3230: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
3240: 3b 3b 20 74 61 72 67 65 74 20 3d 3e 20 28 20 2e ;; target => ( .
3250: 2e 2e 20 69 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 .. info ... )..
3260: 20 20 20 28 72 67 65 6e 74 61 72 67 73 20 28 68 (rgentargs (h
3270: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
3280: 67 63 6f 6e 66 29 29 29 20 3b 3b 20 74 68 65 73 gconf))) ;; thes
3290: 65 20 61 72 65 20 74 68 65 20 74 61 72 67 65 74 e are the target
32a0: 73 20 72 65 67 69 73 74 65 72 65 64 20 66 6f 72 s registered for
32b0: 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 74 automatically t
32c0: 72 69 67 67 65 72 69 6e 67 0a 20 20 20 20 20 20 riggering.
32d0: 20 0a 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 . (for-ea
32e0: 63 68 0a 09 28 6c 61 6d 62 64 61 20 28 72 75 6e ch..(lambda (run
32f0: 6b 65 79 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 key).. (let* ((
3300: 6b 65 79 64 61 74 73 20 20 20 28 63 6f 6e 66 69 keydats (confi
3310: 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 72 gf:get-section r
3320: 67 63 6f 6e 66 20 72 75 6e 6b 65 79 29 29 29 0a gconf runkey))).
3330: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 . (for-each..
3340: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
3350: 6e 73 65 29 20 3b 3b 20 74 68 65 73 65 20 61 72 nse) ;; these ar
3360: 65 20 74 68 65 20 73 65 6e 73 65 20 72 75 6c 65 e the sense rule
3370: 73 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 s.. (let*
3380: 28 28 6b 65 79 20 20 20 20 20 20 20 20 28 63 61 ((key (ca
3390: 72 20 73 65 6e 73 65 29 29 0a 09 09 20 20 20 20 r sense))...
33a0: 20 20 28 76 61 6c 20 20 20 20 20 20 20 20 28 63 (val (c
33b0: 61 64 72 20 73 65 6e 73 65 29 29 0a 09 09 20 20 adr sense))...
33c0: 20 20 20 20 28 6b 65 79 70 61 72 74 73 20 20 20 (keyparts
33d0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6b 65 (string-split ke
33e0: 79 20 22 3a 22 29 29 0a 09 09 20 20 20 20 20 20 y ":"))...
33f0: 28 63 6f 6e 74 6f 75 72 20 20 20 20 28 63 61 72 (contour (car
3400: 20 6b 65 79 70 61 72 74 73 29 29 0a 09 09 20 20 keyparts))...
3410: 20 20 20 20 28 6c 65 6e 2d 6b 65 79 20 20 20 20 (len-key
3420: 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 72 74 73 (length keyparts
3430: 29 29 0a 09 09 20 20 20 20 20 20 28 72 75 6c 65 ))... (rule
3440: 74 79 70 65 20 20 20 28 69 66 20 28 3e 20 6c 65 type (if (> le
3450: 6e 2d 6b 65 79 20 31 29 28 63 61 64 72 20 6b 65 n-key 1)(cadr ke
3460: 79 70 61 72 74 73 29 20 23 66 29 29 0a 09 09 20 yparts) #f))...
3470: 20 20 20 20 20 28 61 63 74 69 6f 6e 20 20 20 20 (action
3480: 20 28 69 66 20 28 3e 20 6c 65 6e 2d 6b 65 79 20 (if (> len-key
3490: 32 29 28 63 61 64 64 72 20 6b 65 79 70 61 72 74 2)(caddr keypart
34a0: 73 29 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 s) #f))...
34b0: 28 76 61 6c 2d 6c 69 73 74 20 20 20 28 73 74 72 (val-list (str
34c0: 69 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c 64 73 ing-split-fields
34d0: 20 22 3b 5c 5c 73 2a 22 20 76 61 6c 20 23 3a 69 ";\\s*" val #:i
34e0: 6e 66 69 78 29 29 20 3b 3b 20 28 73 74 72 69 6e nfix)) ;; (strin
34f0: 67 2d 73 70 6c 69 74 20 76 61 6c 29 29 20 3b 3b g-split val)) ;;
3500: 20 72 75 6e 6e 61 6d 65 2d 72 75 6c 65 20 70 61 runname-rule pa
3510: 72 61 6d 73 0a 09 09 20 20 20 20 20 20 28 76 61 rams... (va
3520: 6c 2d 61 6c 69 73 74 20 20 28 69 66 20 76 61 6c l-alist (if val
3530: 2d 6c 69 73 74 0a 09 09 09 09 20 20 20 20 20 20 -list.....
3540: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
3550: 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let
3560: 28 28 66 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ((f (string-spli
3570: 74 2d 66 69 65 6c 64 73 20 22 5c 5c 73 2a 3d 5c t-fields "\\s*=\
3580: 5c 73 2a 22 20 78 20 23 3a 69 6e 66 69 78 29 29 \s*" x #:infix))
3590: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 63 )...... (c
35a0: 61 73 65 20 28 6c 65 6e 67 74 68 20 66 29 0a 09 ase (length f)..
35b0: 09 09 09 09 09 20 28 28 30 29 20 60 28 2c 23 66 ..... ((0) `(,#f
35c0: 29 29 20 20 3b 3b 20 6e 75 6c 6c 20 73 74 72 69 )) ;; null stri
35d0: 6e 67 20 63 61 73 65 0a 09 09 09 09 09 09 20 28 ng case....... (
35e0: 28 31 29 20 60 28 2c 28 73 74 72 69 6e 67 2d 3e (1) `(,(string->
35f0: 73 79 6d 62 6f 6c 20 28 63 61 72 20 66 29 29 29 symbol (car f)))
3600: 29 0a 09 09 09 09 09 09 20 28 28 32 29 20 60 28 )....... ((2) `(
3610: 2c 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c ,(string->symbol
3620: 20 28 63 61 72 20 66 29 29 20 2e 20 2c 28 63 61 (car f)) . ,(ca
3630: 64 72 20 66 29 29 29 0a 09 09 09 09 09 09 20 28 dr f)))....... (
3640: 65 6c 73 65 20 66 29 29 29 29 0a 09 09 09 09 09 else f))))......
3650: 20 20 20 76 61 6c 2d 6c 69 73 74 29 0a 09 09 09 val-list)....
3660: 09 20 20 20 20 20 20 27 28 29 29 29 0a 09 09 20 . '()))...
3670: 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 (runname
3680: 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 20 22 (make-runname "
3690: 22 20 22 22 29 29 0a 09 09 20 20 20 20 20 20 28 " ""))... (
36a0: 72 75 6e 73 74 61 72 74 73 20 20 28 66 69 6e 64 runstarts (find
36b0: 2d 70 6b 74 73 20 70 64 62 20 27 28 72 75 6e 73 -pkts pdb '(runs
36c0: 74 61 72 74 29 20 60 28 28 6f 20 2e 20 2c 63 6f tart) `((o . ,co
36d0: 6e 74 6f 75 72 29 0a 09 09 09 09 09 09 09 20 20 ntour)........
36e0: 20 20 20 20 20 28 74 20 2e 20 2c 72 75 6e 6b 65 (t . ,runke
36f0: 79 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 72 y))))... (r
3700: 73 70 6b 74 73 20 20 20 20 20 28 6d 61 70 20 28 spkts (map (
3710: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)......
3720: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 6b 74 (alist-ref 'pkt
3730: 61 20 78 29 29 0a 09 09 09 09 20 20 20 20 20 20 a x)).....
3740: 20 72 75 6e 73 74 61 72 74 73 29 29 0a 09 09 20 runstarts))...
3750: 20 20 20 20 20 28 73 74 61 72 74 74 69 6d 65 73 (starttimes
3760: 20 3b 3b 20 73 6f 72 74 20 62 79 20 61 67 65 20 ;; sort by age
3770: 28 79 6f 75 6e 67 65 73 74 20 66 69 72 73 74 29 (youngest first)
3780: 20 61 6e 64 20 64 65 6c 65 74 65 20 64 75 70 6c and delete dupl
3790: 69 63 61 74 65 73 20 62 79 20 74 61 72 67 65 74 icates by target
37a0: 0a 09 09 20 20 20 20 20 20 20 28 64 65 6c 65 74 ... (delet
37b0: 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 09 09 09 e-duplicates....
37c0: 28 73 6f 72 74 20 0a 09 09 09 20 28 6d 61 70 20 (sort .... (map
37d0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
37e0: 60 28 2c 28 61 6c 69 73 74 2d 72 65 66 20 27 74 `(,(alist-ref 't
37f0: 20 78 29 20 2e 20 2c 28 73 74 72 69 6e 67 2d 3e x) . ,(string->
3800: 6e 75 6d 62 65 72 20 28 61 6c 69 73 74 2d 72 65 number (alist-re
3810: 66 20 27 44 20 78 29 29 29 29 0a 09 09 09 20 20 f 'D x))))....
3820: 20 20 20 20 72 73 70 6b 74 73 29 0a 09 09 09 20 rspkts)....
3830: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3e 20 (lambda (a b)(>
3840: 28 63 64 72 20 61 29 28 63 64 72 20 62 29 29 29 (cdr a)(cdr b)))
3850: 29 20 20 20 20 20 20 3b 3b 20 73 6f 72 74 20 64 ) ;; sort d
3860: 65 73 63 65 6e 64 69 6e 67 0a 09 09 09 28 6c 61 escending....(la
3870: 6d 62 64 61 20 28 61 20 62 29 28 65 71 75 61 6c mbda (a b)(equal
3880: 3f 20 28 63 61 72 20 61 29 28 63 61 72 20 62 29 ? (car a)(car b)
3890: 29 29 29 29 20 3b 3b 20 72 65 6d 6f 76 65 20 64 )))) ;; remove d
38a0: 75 70 6c 69 63 61 74 65 73 20 62 79 20 74 61 72 uplicates by tar
38b0: 67 65 74 0a 09 09 20 20 20 20 20 20 29 0a 09 09 get... )...
38c0: 20 3b 3b 20 6c 6f 6f 6b 20 69 6e 20 72 75 6e 73 ;; look in runs
38d0: 74 61 72 74 73 20 66 6f 72 20 6d 61 74 63 68 69 tarts for matchi
38e0: 6e 67 20 72 75 6e 73 20 62 79 20 74 61 72 67 65 ng runs by targe
38f0: 74 20 61 6e 64 20 63 6f 6e 74 6f 75 72 0a 09 09 t and contour...
3900: 20 3b 3b 20 67 65 74 20 74 68 65 20 74 69 6d 65 ;; get the time
3910: 73 74 61 6d 70 20 66 6f 72 20 77 68 65 6e 20 74 stamp for when t
3920: 68 61 74 20 72 75 6e 20 73 74 61 72 74 65 64 20 hat run started
3930: 61 6e 64 20 70 61 73 73 20 69 74 0a 09 09 20 3b and pass it... ;
3940: 3b 20 74 6f 20 74 68 65 20 72 75 6c 65 20 6c 6f ; to the rule lo
3950: 67 69 63 20 68 65 72 65 20 77 68 65 72 65 20 22 gic here where "
3960: 72 75 6c 65 74 79 70 65 22 20 77 69 6c 6c 20 62 ruletype" will b
3970: 65 20 61 70 70 6c 69 65 64 0a 09 09 20 3b 3b 20 e applied... ;;
3980: 69 66 20 69 74 20 63 6f 6d 65 73 20 62 61 63 6b if it comes back
3990: 20 22 63 68 61 6e 67 65 64 22 20 74 68 65 6e 20 "changed" then
39a0: 70 72 6f 63 65 65 64 20 74 6f 20 72 65 67 69 73 proceed to regis
39b0: 74 65 72 20 74 68 65 20 72 75 6e 73 0a 09 09 20 ter the runs...
39c0: 0a 09 09 20 28 63 61 73 65 20 28 73 74 72 69 6e ... (case (strin
39d0: 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 72 75 g->symbol (or ru
39e0: 6c 65 74 79 70 65 20 22 6e 6f 2d 73 75 63 68 2d letype "no-such-
39f0: 72 75 6c 65 22 29 29 0a 20 20 20 20 20 20 20 20 rule")).
3a00: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 2d ((no-
3a10: 73 75 63 68 2d 72 75 6c 65 29 20 28 70 72 69 6e such-rule) (prin
3a20: 74 20 22 45 52 52 4f 52 3a 20 6e 6f 20 73 75 63 t "ERROR: no suc
3a30: 68 20 72 75 6c 65 20 66 6f 72 20 22 20 73 65 6e h rule for " sen
3a40: 73 65 29 29 0a 09 09 20 20 20 28 28 73 63 68 65 se))... ((sche
3a50: 64 75 6c 65 64 29 0a 09 09 20 20 20 20 28 69 66 duled)... (if
3a60: 20 28 6e 6f 74 20 28 61 6c 69 73 74 2d 72 65 66 (not (alist-ref
3a70: 20 27 63 72 6f 6e 20 76 61 6c 2d 61 6c 69 73 74 'cron val-alist
3a80: 29 29 20 3b 3b 20 67 6f 74 74 61 20 68 61 76 65 )) ;; gotta have
3a90: 20 63 72 6f 6e 20 73 70 65 63 0a 09 09 09 28 70 cron spec....(p
3aa0: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 62 61 64 rint "ERROR: bad
3ab0: 20 73 65 6e 73 65 20 73 70 65 63 20 5c 22 22 20 sense spec \""
3ac0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
3ad0: 72 73 65 20 73 65 6e 73 65 20 22 20 22 29 20 22 rse sense " ") "
3ae0: 5c 22 20 70 61 72 61 6d 73 3a 20 22 20 76 61 6c \" params: " val
3af0: 2d 61 6c 69 73 74 29 0a 09 09 09 28 6c 65 74 2a -alist)....(let*
3b00: 20 28 28 72 75 6e 2d 6e 61 6d 65 20 28 61 6c 69 ((run-name (ali
3b10: 73 74 2d 72 65 66 20 27 72 75 6e 2d 6e 61 6d 65 st-ref 'run-name
3b20: 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 val-alist))....
3b30: 20 20 20 20 20 20 20 28 63 72 6f 6e 74 61 62 20 (crontab
3b40: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 63 72 6f (alist-ref 'cro
3b50: 6e 20 20 20 20 20 76 61 6c 2d 61 6c 69 73 74 29 n val-alist)
3b60: 29 0a 09 09 09 20 20 20 20 20 20 20 28 61 63 74 ).... (act
3b70: 69 6f 6e 20 20 20 28 61 6c 69 73 74 2d 72 65 66 ion (alist-ref
3b80: 20 27 61 63 74 69 6f 6e 20 20 20 76 61 6c 2d 61 'action val-a
3b90: 6c 69 73 74 29 29 0a 09 09 09 20 20 20 20 20 20 list))....
3ba0: 20 28 6c 61 73 74 2d 72 75 6e 20 28 69 66 20 28 (last-run (if (
3bb0: 6e 75 6c 6c 3f 20 73 74 61 72 74 74 69 6d 65 73 null? starttimes
3bc0: 29 20 3b 3b 20 6e 65 76 65 72 20 72 75 6e 0a 09 ) ;; never run..
3bd0: 09 09 09 09 20 20 20 20 20 30 0a 09 09 09 09 09 .... 0......
3be0: 20 20 20 20 20 28 61 70 70 6c 79 20 6d 61 78 20 (apply max
3bf0: 28 6d 61 70 20 63 64 72 20 73 74 61 72 74 74 69 (map cdr startti
3c00: 6d 65 73 29 29 29 29 0a 09 09 09 20 20 20 20 20 mes))))....
3c10: 20 20 28 6e 65 65 64 2d 72 75 6e 20 28 63 6f 6d (need-run (com
3c20: 6d 6f 6e 3a 63 72 6f 6e 2d 65 76 65 6e 74 20 63 mon:cron-event c
3c30: 72 6f 6e 74 61 62 20 23 66 20 6c 61 73 74 2d 72 rontab #f last-r
3c40: 75 6e 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 un)).... (
3c50: 72 75 6e 6e 61 6d 65 20 20 28 69 66 20 6e 65 65 runname (if nee
3c60: 64 2d 72 75 6e 20 28 63 6f 6e 63 20 22 73 63 68 d-run (conc "sch
3c70: 65 64 22 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e ed" (time->strin
3c80: 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 g (seconds->loca
3c90: 6c 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d l-time (current-
3ca0: 73 65 63 6f 6e 64 73 29 29 20 22 25 4d 25 48 25 seconds)) "%M%H%
3cb0: 64 22 29 29 29 29 29 0a 09 09 09 20 20 28 70 72 d"))))).... (pr
3cc0: 69 6e 74 20 22 6c 61 73 74 2d 72 75 6e 3a 20 22 int "last-run: "
3cd0: 20 6c 61 73 74 2d 72 75 6e 20 22 20 6e 65 65 64 last-run " need
3ce0: 2d 72 75 6e 3a 20 22 20 6e 65 65 64 2d 72 75 6e -run: " need-run
3cf0: 29 0a 09 09 09 20 20 28 69 66 20 6e 65 65 64 2d ).... (if need-
3d00: 72 75 6e 0a 09 09 09 20 20 20 20 20 20 28 63 6f run.... (co
3d10: 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 nfigf:section-va
3d20: 72 2d 73 65 74 21 20 74 6f 72 75 6e 20 63 6f 6e r-set! torun con
3d30: 74 6f 75 72 20 72 75 6e 6b 65 79 20 60 28 2c 28 tour runkey `(,(
3d40: 63 6f 6e 63 20 72 75 6c 65 74 79 70 65 20 22 3a conc ruletype ":
3d50: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
3d60: 70 65 72 73 65 20 28 73 74 72 69 6e 67 2d 73 70 perse (string-sp
3d70: 6c 69 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 lit (alist-ref '
3d80: 63 72 6f 6e 20 76 61 6c 2d 61 6c 69 73 74 29 29 cron val-alist))
3d90: 20 22 2d 22 29 29 0a 09 09 09 09 09 09 09 09 09 "-"))..........
3da0: 20 20 20 20 20 20 20 2c 72 75 6e 6e 61 6d 65 20 ,runname
3db0: 2c 6e 65 65 64 2d 72 75 6e 20 2c 61 63 74 69 6f ,need-run ,actio
3dc0: 6e 29 29 29 29 29 29 0a 09 09 20 20 20 28 28 66 n))))))... ((f
3dd0: 69 6c 65 20 66 69 6c 65 2d 6f 72 29 20 3b 3b 20 ile file-or) ;;
3de0: 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 66 69 6c 65 one or more file
3df0: 73 20 6d 75 73 74 20 62 65 20 6e 65 77 65 72 20 s must be newer
3e00: 74 68 61 6e 20 74 68 65 20 72 65 66 65 72 65 6e than the referen
3e10: 63 65 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 ce... (let* (
3e20: 28 66 69 6c 65 2d 67 6c 6f 62 73 20 20 28 61 6c (file-globs (al
3e30: 69 73 74 2d 72 65 66 20 27 67 6c 6f 62 20 76 61 ist-ref 'glob va
3e40: 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 20 20 20 l-alist))....
3e50: 28 79 6f 75 6e 67 65 73 74 64 61 74 20 28 63 6f (youngestdat (co
3e60: 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 75 6e 67 65 73 mmon:get-younges
3e70: 74 20 28 63 6f 6d 6d 6f 6e 3a 62 61 73 68 2d 67 t (common:bash-g
3e80: 6c 6f 62 20 66 69 6c 65 2d 67 6c 6f 62 73 29 29 lob file-globs))
3e90: 29 0a 09 09 09 20 20 20 28 79 6f 75 6e 67 65 73 ).... (younges
3ea0: 74 6d 6f 64 20 28 63 61 72 20 79 6f 75 6e 67 65 tmod (car younge
3eb0: 73 74 64 61 74 29 29 29 0a 09 09 20 20 20 20 20 stdat)))...
3ec0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 79 6f 75 6e ;; (print "youn
3ed0: 67 65 73 74 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 gestmod: " young
3ee0: 65 73 74 6d 6f 64 20 22 20 73 74 61 72 74 74 69 estmod " startti
3ef0: 6d 65 73 3a 20 22 20 73 74 61 72 74 74 69 6d 65 mes: " starttime
3f00: 73 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 s)... (if (
3f10: 6e 75 6c 6c 3f 20 73 74 61 72 74 74 69 6d 65 73 null? starttimes
3f20: 29 20 3b 3b 20 74 68 69 73 20 74 61 72 67 65 74 ) ;; this target
3f30: 20 68 61 73 20 6e 65 76 65 72 20 62 65 65 6e 20 has never been
3f40: 72 75 6e 0a 09 09 09 20 20 28 63 6f 6e 66 69 67 run.... (config
3f50: 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 2d 73 65 f:section-var-se
3f60: 74 21 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 t! torun contour
3f70: 20 72 75 6e 6b 65 79 20 60 28 22 66 69 6c 65 3a runkey `("file:
3f80: 6e 65 76 65 72 72 75 6e 22 20 2c 72 75 6e 6e 61 neverrun" ,runna
3f90: 6d 65 29 29 0a 09 09 09 20 20 28 66 6f 72 2d 65 me)).... (for-e
3fa0: 61 63 68 0a 09 09 09 20 20 20 28 6c 61 6d 62 64 ach.... (lambd
3fb0: 61 20 28 73 74 61 72 74 74 69 6d 65 29 20 3b 3b a (starttime) ;;
3fc0: 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 69 6d look at the tim
3fd0: 65 20 74 68 65 20 6c 61 73 74 20 72 75 6e 20 77 e the last run w
3fe0: 61 73 20 6b 69 63 6b 65 64 20 6f 66 66 20 66 6f as kicked off fo
3ff0: 72 20 74 68 69 73 20 63 6f 6e 74 6f 75 72 0a 09 r this contour..
4000: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 79 6f .. (if (> yo
4010: 75 6e 67 65 73 74 6d 6f 64 20 28 63 64 72 20 73 ungestmod (cdr s
4020: 74 61 72 74 74 69 6d 65 29 29 0a 09 09 09 09 20 tarttime)).....
4030: 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 28 70 (begin..... (p
4040: 72 69 6e 74 20 22 73 74 61 72 74 74 69 6d 65 20 rint "starttime
4050: 79 6f 75 6e 67 65 72 20 74 68 61 6e 20 79 6f 75 younger than you
4060: 6e 67 65 73 74 6d 6f 64 3a 20 22 20 73 74 61 72 ngestmod: " star
4070: 74 74 69 6d 65 20 22 20 59 6f 75 6e 67 65 73 74 ttime " Youngest
4080: 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d mod: " youngestm
4090: 6f 64 29 0a 09 09 09 09 20 20 20 28 63 6f 6e 66 od)..... (conf
40a0: 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 2d igf:section-var-
40b0: 73 65 74 21 20 74 6f 72 75 6e 20 63 6f 6e 74 6f set! torun conto
40c0: 75 72 20 72 75 6e 6b 65 79 20 60 28 2c 28 63 6f ur runkey `(,(co
40d0: 6e 63 20 72 75 6c 65 74 79 70 65 20 22 3a 22 20 nc ruletype ":"
40e0: 28 63 61 64 72 20 79 6f 75 6e 67 65 73 74 64 61 (cadr youngestda
40f0: 74 29 29 20 2c 72 75 6e 6e 61 6d 65 20 23 66 29 t)) ,runname #f)
4100: 29 29 29 29 0a 09 09 09 20 20 20 73 74 61 72 74 )))).... start
4110: 74 69 6d 65 73 29 29 0a 09 09 20 20 20 20 20 20 times))...
4120: 29 29 0a 09 09 20 20 20 28 28 66 69 6c 65 2d 61 ))... ((file-a
4130: 6e 64 29 20 3b 3b 20 61 6c 6c 20 66 69 6c 65 73 nd) ;; all files
4140: 20 6d 75 73 74 20 62 65 20 6e 65 77 65 72 20 74 must be newer t
4150: 68 61 6e 20 74 68 65 20 72 65 66 65 72 65 6e 63 han the referenc
4160: 65 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 e... (let* ((
4170: 66 69 6c 65 2d 67 6c 6f 62 73 20 20 28 61 6c 69 file-globs (ali
4180: 73 74 2d 72 65 66 20 27 67 6c 6f 62 20 76 61 6c st-ref 'glob val
4190: 2d 61 6c 69 73 74 29 29 0a 09 09 09 20 20 20 28 -alist)).... (
41a0: 79 6f 75 6e 67 65 73 74 64 61 74 20 28 63 6f 6d youngestdat (com
41b0: 6d 6f 6e 3a 67 65 74 2d 79 6f 75 6e 67 65 73 74 mon:get-youngest
41c0: 20 66 69 6c 65 2d 67 6c 6f 62 73 29 29 0a 09 09 file-globs))...
41d0: 09 20 20 20 28 79 6f 75 6e 67 65 73 74 6d 6f 64 . (youngestmod
41e0: 20 28 63 61 72 20 79 6f 75 6e 67 65 73 74 64 61 (car youngestda
41f0: 74 29 29 0a 09 09 09 20 20 20 28 73 75 63 63 65 t)).... (succe
4200: 73 73 20 20 20 20 20 23 74 29 29 20 3b 3b 20 61 ss #t)) ;; a
4210: 6e 79 20 63 61 73 65 73 20 6f 66 20 6e 6f 74 20 ny cases of not
4220: 74 72 75 65 2c 20 73 65 74 20 66 6c 61 67 20 74 true, set flag t
4230: 6f 20 23 66 20 66 6f 72 20 41 4e 44 0a 09 09 20 o #f for AND...
4240: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
4250: 79 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 22 20 79 youngestmod: " y
4260: 6f 75 6e 67 65 73 74 6d 6f 64 20 22 20 73 74 61 oungestmod " sta
4270: 72 74 74 69 6d 65 73 3a 20 22 20 73 74 61 72 74 rttimes: " start
4280: 74 69 6d 65 73 29 0a 09 09 20 20 20 20 20 20 28 times)... (
4290: 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 74 if (null? startt
42a0: 69 6d 65 73 29 20 3b 3b 20 74 68 69 73 20 74 61 imes) ;; this ta
42b0: 72 67 65 74 20 68 61 73 20 6e 65 76 65 72 20 62 rget has never b
42c0: 65 65 6e 20 72 75 6e 0a 09 09 09 20 20 28 63 6f een run.... (co
42d0: 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 nfigf:section-va
42e0: 72 2d 73 65 74 21 20 74 6f 72 75 6e 20 63 6f 6e r-set! torun con
42f0: 74 6f 75 72 20 72 75 6e 6b 65 79 20 60 28 22 66 tour runkey `("f
4300: 69 6c 65 3a 6e 65 76 65 72 72 75 6e 22 20 2c 72 ile:neverrun" ,r
4310: 75 6e 6e 61 6d 65 20 23 66 29 29 0a 09 09 09 20 unname #f))....
4320: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 20 20 (for-each....
4330: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 72 74 74 (lambda (startt
4340: 69 6d 65 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 ime) ;; look at
4350: 74 68 65 20 74 69 6d 65 20 74 68 65 20 6c 61 73 the time the las
4360: 74 20 72 75 6e 20 77 61 73 20 6b 69 63 6b 65 64 t run was kicked
4370: 20 6f 66 66 20 66 6f 72 20 74 68 69 73 20 63 6f off for this co
4380: 6e 74 6f 75 72 0a 09 09 09 20 20 20 20 20 28 69 ntour.... (i
4390: 66 20 28 3c 20 79 6f 75 6e 67 65 73 74 6d 6f 64 f (< youngestmod
43a0: 20 28 63 64 72 20 73 74 61 72 74 74 69 6d 65 29 (cdr starttime)
43b0: 29 0a 09 09 09 09 20 28 73 65 74 21 20 73 75 63 )..... (set! suc
43c0: 63 65 73 73 20 23 66 29 29 29 0a 09 09 09 20 20 cess #f)))....
43d0: 20 73 74 61 72 74 74 69 6d 65 73 29 29 0a 09 09 starttimes))...
43e0: 20 20 20 20 20 20 28 69 66 20 73 75 63 63 65 73 (if succes
43f0: 73 0a 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 s.... (begin...
4400: 09 20 20 20 20 28 70 72 69 6e 74 20 22 73 74 61 . (print "sta
4410: 72 74 74 69 6d 65 20 79 6f 75 6e 67 65 72 20 74 rttime younger t
4420: 68 61 6e 20 79 6f 75 6e 67 65 73 74 6d 6f 64 3a han youngestmod:
4430: 20 22 20 73 74 61 72 74 74 69 6d 65 20 22 20 59 " starttime " Y
4440: 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 22 20 79 6f oungestmod: " yo
4450: 75 6e 67 65 73 74 6d 6f 64 29 0a 09 09 09 20 20 ungestmod)....
4460: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
4470: 6f 6e 2d 76 61 72 2d 73 65 74 21 20 74 6f 72 75 on-var-set! toru
4480: 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 n contour runkey
4490: 20 60 28 2c 28 63 6f 6e 63 20 72 75 6c 65 74 79 `(,(conc rulety
44a0: 70 65 20 22 3a 22 20 28 63 61 64 72 20 79 6f 75 pe ":" (cadr you
44b0: 6e 67 65 73 74 64 61 74 29 29 20 2c 72 75 6e 6e ngestdat)) ,runn
44c0: 61 6d 65 20 23 66 29 29 29 29 29 29 0a 09 09 20 ame #f))))))...
44d0: 20 20 29 29 29 0a 09 20 20 20 20 20 6b 65 79 64 ))).. keyd
44e0: 61 74 73 29 29 29 0a 09 28 68 61 73 68 2d 74 61 ats)))..(hash-ta
44f0: 62 6c 65 2d 6b 65 79 73 20 72 67 63 6f 6e 66 29 ble-keys rgconf)
4500: 29 0a 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 ). .
4510: 20 3b 3b 20 6e 6f 77 20 68 61 76 65 20 74 6f 20 ;; now have to
4520: 72 75 6e 20 70 6f 70 75 6c 61 74 65 64 0a 20 20 run populated.
4530: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
4540: 28 6c 61 6d 62 64 61 20 28 63 6f 6e 74 6f 75 72 (lambda (contour
4550: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 6f 64 ).. (let* ((mod
4560: 65 2d 74 61 67 20 20 28 73 74 72 69 6e 67 2d 73 e-tag (string-s
4570: 70 6c 69 74 20 28 6f 72 20 28 63 6f 6e 66 69 67 plit (or (config
4580: 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 f:lookup mtconf
4590: 22 63 6f 6e 74 6f 75 72 73 22 20 63 6f 6e 74 6f "contours" conto
45a0: 75 72 29 20 22 22 29 20 22 2f 22 29 29 0a 09 09 ur) "") "/"))...
45b0: 20 28 6d 6f 64 65 2d 70 61 74 74 20 28 69 66 20 (mode-patt (if
45c0: 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 6d 6f 64 (eq? (length mod
45d0: 65 2d 74 61 67 29 20 32 29 28 63 61 64 72 20 6d e-tag) 2)(cadr m
45e0: 6f 64 65 2d 74 61 67 29 20 23 66 29 29 0a 09 09 ode-tag) #f))...
45f0: 20 28 74 61 67 2d 65 78 70 72 20 20 28 69 66 20 (tag-expr (if
4600: 28 6e 75 6c 6c 3f 20 6d 6f 64 65 2d 74 61 67 29 (null? mode-tag)
4610: 20 23 66 20 28 63 61 72 20 6d 6f 64 65 2d 74 61 #f (car mode-ta
4620: 67 29 29 29 29 0a 09 20 20 20 20 28 66 6f 72 2d g)))).. (for-
4630: 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 6d 62 each.. (lamb
4640: 64 61 20 28 72 75 6e 6b 65 79 64 61 74 29 0a 09 da (runkeydat)..
4650: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 (let* ((r
4660: 75 6e 6b 65 79 20 28 63 61 72 20 72 75 6e 6b 65 unkey (car runke
4670: 79 64 61 74 29 29 0a 09 09 20 20 20 20 20 20 28 ydat))... (
4680: 69 6e 66 6f 20 20 20 28 63 61 64 72 20 72 75 6e info (cadr run
4690: 6b 65 79 64 61 74 29 29 29 0a 09 09 20 28 66 6f keydat)))... (fo
46a0: 72 2d 65 61 63 68 0a 09 09 20 20 28 6c 61 6d 62 r-each... (lamb
46b0: 64 61 20 28 61 72 65 61 29 0a 09 09 20 20 20 20 da (area)...
46c0: 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 69 (if (< (length i
46d0: 6e 66 6f 29 20 33 29 0a 09 09 09 28 70 72 69 6e nfo) 3)....(prin
46e0: 74 20 22 45 52 52 4f 52 3a 20 62 61 64 20 69 6e t "ERROR: bad in
46f0: 66 6f 20 64 61 74 61 20 66 6f 72 20 22 20 63 6f fo data for " co
4700: 6e 74 6f 75 72 20 22 2c 20 22 20 72 75 6e 6b 65 ntour ", " runke
4710: 79 20 22 2c 20 22 20 61 72 65 61 29 0a 09 09 09 y ", " area)....
4720: 28 6c 65 74 20 28 28 72 75 6e 6e 61 6d 65 20 28 (let ((runname (
4730: 63 61 64 72 20 69 6e 66 6f 29 29 0a 09 09 09 20 cadr info))....
4740: 20 20 20 20 20 28 72 65 61 73 6f 6e 20 20 28 63 (reason (c
4750: 61 72 20 20 69 6e 66 6f 29 29 0a 09 09 09 20 20 ar info))....
4760: 20 20 20 20 28 73 63 68 65 64 20 20 20 28 63 61 (sched (ca
4770: 64 64 72 20 69 6e 66 6f 29 29 29 0a 09 09 09 20 ddr info)))....
4780: 20 28 70 72 69 6e 74 20 22 72 75 6e 6b 65 79 3a (print "runkey:
4790: 20 22 20 72 75 6e 6b 65 79 20 22 20 63 6f 6e 74 " runkey " cont
47a0: 6f 75 72 3a 20 22 20 63 6f 6e 74 6f 75 72 20 22 our: " contour "
47b0: 20 69 6e 66 6f 3a 20 22 20 69 6e 66 6f 20 22 20 info: " info "
47c0: 61 72 65 61 3a 20 22 20 61 72 65 61 20 20 22 20 area: " area "
47d0: 74 61 67 2d 65 78 70 72 3a 20 22 20 74 61 67 2d tag-expr: " tag-
47e0: 65 78 70 72 20 22 20 6d 6f 64 65 2d 70 61 74 74 expr " mode-patt
47f0: 3a 20 22 20 6d 6f 64 65 2d 70 61 74 74 29 0a 09 : " mode-patt)..
4800: 09 09 20 20 28 63 72 65 61 74 65 2d 72 75 6e 2d .. (create-run-
4810: 70 6b 74 20 6d 74 63 6f 6e 66 20 61 72 65 61 20 pkt mtconf area
4820: 72 75 6e 6b 65 79 20 72 75 6e 6e 61 6d 65 20 6d runkey runname m
4830: 6f 64 65 2d 70 61 74 74 20 74 61 67 2d 65 78 70 ode-patt tag-exp
4840: 72 20 70 6b 74 73 64 69 72 20 72 65 61 73 6f 6e r pktsdir reason
4850: 20 63 6f 6e 74 6f 75 72 20 73 63 68 65 64 29 29 contour sched))
4860: 29 29 0a 09 09 20 20 61 72 65 61 73 29 29 29 0a ))... areas))).
4870: 09 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 67 . (configf:g
4880: 65 74 2d 73 65 63 74 69 6f 6e 20 74 6f 72 75 6e et-section torun
4890: 20 63 6f 6e 74 6f 75 72 29 29 29 29 0a 09 28 68 contour))))..(h
48a0: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 ash-table-keys t
48b0: 6f 72 75 6e 29 29 29 29 29 29 0a 0a 0a 28 64 65 orun))))))...(de
48c0: 66 69 6e 65 20 28 70 6b 74 2d 3e 63 6d 64 6c 69 fine (pkt->cmdli
48d0: 6e 65 20 70 6b 74 61 29 0a 20 20 28 66 6f 6c 64 ne pkta). (fold
48e0: 20 28 6c 61 6d 62 64 61 20 28 61 20 72 65 73 29 (lambda (a res)
48f0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 20 .. (let* ((key
4900: 28 63 61 72 20 61 29 29 20 3b 3b 20 67 65 74 20 (car a)) ;; get
4910: 74 68 65 20 6b 65 79 20 6e 61 6d 65 0a 09 09 20 the key name...
4920: 28 76 61 6c 20 28 63 64 72 20 61 29 29 0a 09 09 (val (cdr a))...
4930: 20 28 70 61 72 20 28 6c 6f 6f 6b 75 70 2d 70 61 (par (lookup-pa
4940: 72 61 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 29 29 ram-by-key key))
4950: 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ).. ;; (print
4960: 20 22 6b 65 79 3a 20 22 20 6b 65 79 20 22 20 76 "key: " key " v
4970: 61 6c 3a 20 22 20 76 61 6c 20 22 20 70 61 72 3a al: " val " par:
4980: 20 22 20 70 61 72 29 0a 09 20 20 20 20 28 69 66 " par).. (if
4990: 20 70 61 72 0a 09 09 28 63 6f 6e 63 20 72 65 73 par...(conc res
49a0: 20 22 20 22 20 28 70 61 72 61 6d 2d 74 72 61 6e " " (param-tran
49b0: 73 6c 61 74 65 20 70 61 72 29 20 22 20 22 20 76 slate par) " " v
49c0: 61 6c 29 0a 09 09 72 65 73 29 29 29 0a 09 22 6d al)...res))).."m
49d0: 65 67 61 74 65 73 74 20 2d 72 75 6e 22 0a 09 70 egatest -run"..p
49e0: 6b 74 61 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 kta))..(define (
49f0: 77 72 69 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 write-pkt pktsdi
4a00: 72 20 75 75 69 64 20 70 6b 74 29 0a 20 20 28 69 r uuid pkt). (i
4a10: 66 20 70 6b 74 73 64 69 72 0a 20 20 20 20 20 20 f pktsdir.
4a20: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
4a30: 66 69 6c 65 0a 09 20 20 28 63 6f 6e 63 20 70 6b file.. (conc pk
4a40: 74 73 64 69 72 20 22 2f 22 20 75 75 69 64 20 22 tsdir "/" uuid "
4a50: 2e 70 6b 74 22 29 0a 09 28 6c 61 6d 62 64 61 20 .pkt")..(lambda
4a60: 28 29 0a 09 20 20 28 70 72 69 6e 74 20 70 6b 74 ().. (print pkt
4a70: 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 6e 74 ))). (print
4a80: 20 22 45 52 52 4f 52 3a 20 63 61 6e 6e 6f 74 20 "ERROR: cannot
4a90: 70 72 6f 63 65 73 73 20 63 6f 6d 6d 61 6e 64 73 process commands
4aa0: 20 77 69 74 68 6f 75 74 20 61 20 70 6b 74 73 20 without a pkts
4ab0: 64 69 72 65 63 74 6f 72 79 22 29 29 29 0a 0a 3b directory")))..;
4ac0: 3b 20 63 6f 6c 6c 65 63 74 20 61 6c 6c 20 6e 65 ; collect all ne
4ad0: 65 64 65 64 20 64 61 74 61 20 61 6e 64 20 63 72 eded data and cr
4ae0: 65 61 74 65 20 72 75 6e 20 70 6b 74 73 20 66 6f eate run pkts fo
4af0: 72 20 63 6f 6e 74 6f 75 72 73 20 77 69 74 68 20 r contours with
4b00: 63 68 61 6e 67 65 64 20 69 6e 70 75 74 73 0a 3b changed inputs.;
4b10: 3b 0a 28 64 65 66 69 6e 65 20 28 64 69 73 70 61 ;.(define (dispa
4b20: 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 tch-commands mtc
4b30: 6f 6e 66 20 74 6f 70 70 61 74 68 29 0a 20 20 28 onf toppath). (
4b40: 77 69 74 68 2d 71 75 65 75 65 2d 64 62 0a 20 20 with-queue-db.
4b50: 20 6d 74 63 6f 6e 66 0a 20 20 20 28 6c 61 6d 62 mtconf. (lamb
4b60: 64 61 20 28 70 6b 74 73 64 69 72 73 20 70 6b 74 da (pktsdirs pkt
4b70: 73 64 69 72 20 70 64 62 29 0a 20 20 20 20 20 28 sdir pdb). (
4b80: 6c 65 74 2a 20 28 28 72 67 63 6f 6e 66 64 61 74 let* ((rgconfdat
4b90: 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d (find-and-read-
4ba0: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 config (conc top
4bb0: 70 61 74 68 20 22 2f 72 75 6e 63 6f 6e 66 69 67 path "/runconfig
4bc0: 73 2e 63 6f 6e 66 69 67 22 29 29 29 0a 09 20 20 s.config")))..
4bd0: 20 20 28 72 67 63 6f 6e 66 20 20 20 20 28 63 61 (rgconf (ca
4be0: 72 20 72 67 63 6f 6e 66 64 61 74 29 29 0a 09 20 r rgconfdat))..
4bf0: 20 20 20 28 61 72 65 61 73 20 20 20 20 20 28 63 (areas (c
4c00: 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 onfigf:get-secti
4c10: 6f 6e 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 on mtconf "areas
4c20: 22 29 29 0a 09 20 20 20 20 28 63 6f 6e 74 6f 75 ")).. (contou
4c30: 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 rs (configf:get
4c40: 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 -section mtconf
4c50: 22 63 6f 6e 74 6f 75 72 73 22 29 29 0a 09 20 20 "contours"))..
4c60: 20 20 28 70 6b 74 73 20 20 20 20 20 20 28 66 69 (pkts (fi
4c70: 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 63 6d nd-pkts pdb '(cm
4c80: 64 29 20 27 28 29 29 29 0a 09 20 20 20 20 28 74 d) '())).. (t
4c90: 6f 72 75 6e 20 20 20 20 20 28 6d 61 6b 65 2d 68 orun (make-h
4ca0: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 74 ash-table)) ;; t
4cb0: 61 72 67 65 74 20 3d 3e 20 28 20 2e 2e 2e 20 69 arget => ( ... i
4cc0: 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 20 20 20 28 nfo ... ).. (
4cd0: 72 67 65 6e 74 61 72 67 73 20 28 68 61 73 68 2d rgentargs (hash-
4ce0: 74 61 62 6c 65 2d 6b 65 79 73 20 72 67 63 6f 6e table-keys rgcon
4cf0: 66 29 29 29 20 3b 3b 20 74 68 65 73 65 20 61 72 f))) ;; these ar
4d00: 65 20 74 68 65 20 74 61 72 67 65 74 73 20 72 65 e the targets re
4d10: 67 69 73 74 65 72 65 64 20 66 6f 72 20 61 75 74 gistered for aut
4d20: 6f 6d 61 74 69 63 61 6c 6c 79 20 74 72 69 67 67 omatically trigg
4d30: 65 72 69 6e 67 0a 20 20 20 20 20 20 20 28 66 6f ering. (fo
4d40: 72 2d 65 61 63 68 0a 09 28 6c 61 6d 62 64 61 20 r-each..(lambda
4d50: 28 70 6b 74 64 61 74 29 0a 09 20 20 28 6c 65 74 (pktdat).. (let
4d60: 2a 20 28 28 70 6b 74 61 20 20 20 20 28 61 6c 69 * ((pkta (ali
4d70: 73 74 2d 72 65 66 20 27 70 6b 74 61 20 70 6b 74 st-ref 'pkta pkt
4d80: 64 61 74 29 29 0a 09 09 20 28 63 6d 64 6c 69 6e dat))... (cmdlin
4d90: 65 20 28 70 6b 74 2d 3e 63 6d 64 6c 69 6e 65 20 e (pkt->cmdline
4da0: 70 6b 74 61 29 29 0a 09 09 20 28 75 75 69 64 20 pkta))... (uuid
4db0: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 5a (alist-ref 'Z
4dc0: 20 70 6b 74 61 29 29 0a 09 09 20 28 6c 6f 67 66 pkta))... (logf
4dd0: 20 20 20 20 28 63 6f 6e 63 20 22 6c 6f 67 73 2f (conc "logs/
4de0: 22 20 75 75 69 64 20 22 2d 72 75 6e 2e 6c 6f 67 " uuid "-run.log
4df0: 22 29 29 29 0a 09 20 20 20 20 28 73 79 73 74 65 "))).. (syste
4e00: 6d 20 28 63 6f 6e 63 20 22 4e 42 46 41 4b 45 5f m (conc "NBFAKE_
4e10: 4c 4f 47 3d 22 20 6c 6f 67 66 20 22 20 6e 62 66 LOG=" logf " nbf
4e20: 61 6b 65 20 22 20 63 6d 64 6c 69 6e 65 29 29 0a ake " cmdline)).
4e30: 09 20 20 20 20 28 6d 61 72 6b 2d 70 72 6f 63 65 . (mark-proce
4e40: 73 73 65 64 20 70 64 62 20 28 6c 69 73 74 20 28 ssed pdb (list (
4e50: 61 6c 69 73 74 2d 72 65 66 20 27 69 64 20 70 6b alist-ref 'id pk
4e60: 74 64 61 74 29 29 29 0a 09 20 20 20 20 28 6c 65 tdat))).. (le
4e70: 74 2d 76 61 6c 75 65 73 20 28 28 28 61 63 6b 2d t-values (((ack-
4e80: 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 0a 09 09 uuid ack-pkt)...
4e90: 09 20 20 28 61 64 64 2d 7a 2d 63 61 72 64 0a 09 . (add-z-card..
4ea0: 09 09 20 20 20 28 63 6f 6e 73 74 72 75 63 74 2d .. (construct-
4eb0: 73 64 61 74 20 27 50 20 75 75 69 64 0a 09 09 09 sdat 'P uuid....
4ec0: 09 09 20 20 20 27 54 20 22 72 75 6e 73 74 61 72 .. 'T "runstar
4ed0: 74 22 0a 09 09 09 09 09 20 20 20 27 63 20 28 61 t"...... 'c (a
4ee0: 6c 69 73 74 2d 72 65 66 20 27 6f 20 70 6b 74 61 list-ref 'o pkta
4ef0: 29 20 3b 3b 20 54 48 49 53 20 49 53 20 57 52 4f ) ;; THIS IS WRO
4f00: 4e 47 21 20 53 48 4f 55 4c 44 20 42 45 20 27 63 NG! SHOULD BE 'c
4f10: 0a 09 09 09 09 09 20 20 20 27 74 20 28 61 6c 69 ...... 't (ali
4f20: 73 74 2d 72 65 66 20 27 74 20 70 6b 74 61 29 29 st-ref 't pkta))
4f30: 29 29 29 0a 09 20 20 20 20 20 20 28 77 72 69 74 ))).. (writ
4f40: 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 20 61 63 e-pkt pktsdir ac
4f50: 6b 2d 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 29 k-uuid ack-pkt))
4f60: 29 29 0a 09 70 6b 74 73 29 29 29 29 29 0a 0a 28 ))..pkts)))))..(
4f70: 64 65 66 69 6e 65 20 28 67 65 74 2d 70 6b 74 73 define (get-pkts
4f80: 2d 64 69 72 20 6d 74 63 6f 6e 66 29 0a 20 20 28 -dir mtconf). (
4f90: 6c 65 74 20 28 28 70 6b 74 73 64 69 72 73 20 20 let ((pktsdirs
4fa0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
4fb0: 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 mtconf "setup" "
4fc0: 70 6b 74 73 64 69 72 73 22 29 29 0a 09 28 70 6b pktsdirs"))..(pk
4fd0: 74 73 64 69 72 20 20 20 28 69 66 20 70 6b 74 73 tsdir (if pkts
4fe0: 64 69 72 73 20 28 63 61 72 20 28 73 74 72 69 6e dirs (car (strin
4ff0: 67 2d 73 70 6c 69 74 20 70 6b 74 73 64 69 72 73 g-split pktsdirs
5000: 20 22 20 22 29 29 20 23 66 29 29 29 0a 20 20 20 " ")) #f))).
5010: 20 70 6b 74 73 64 69 72 29 29 0a 0a 28 69 66 20 pktsdir))..(if
5020: 2a 61 63 74 69 6f 6e 2a 0a 20 20 20 20 28 63 61 *action*. (ca
5030: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
5040: 6f 6c 20 2a 61 63 74 69 6f 6e 2a 29 0a 20 20 20 ol *action*).
5050: 20 20 20 28 28 72 75 6e 20 72 65 6d 6f 76 65 20 ((run remove
5060: 72 65 72 75 6e 20 73 65 74 2d 73 73 20 61 72 63 rerun set-ss arc
5070: 68 69 76 65 20 6b 69 6c 6c 29 0a 20 20 20 20 20 hive kill).
5080: 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e 66 (let* ((mtconf
5090: 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 dat (simple-setu
50a0: 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 p (args:get-arg
50b0: 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 0a "-start-dir"))).
50c0: 09 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 . (mtconf
50d0: 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 (car mtconfdat
50e0: 29 29 0a 09 20 20 20 20 20 20 28 70 6b 74 73 64 )).. (pktsd
50f0: 69 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f irs (configf:lo
5100: 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 okup mtconf "set
5110: 75 70 22 20 22 70 6b 74 73 64 69 72 73 22 29 29 up" "pktsdirs"))
5120: 0a 09 20 20 20 20 20 20 28 70 6b 74 73 64 69 72 .. (pktsdir
5130: 20 20 20 28 69 66 20 70 6b 74 73 64 69 72 73 20 (if pktsdirs
5140: 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c (car (string-spl
5150: 69 74 20 70 6b 74 73 64 69 72 73 20 22 20 22 29 it pktsdirs " ")
5160: 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 61 ) #f)).. (a
5170: 64 6a 61 72 67 73 20 20 20 28 68 61 73 68 2d 74 djargs (hash-t
5180: 61 62 6c 65 2d 63 6f 70 79 20 61 72 67 73 3a 61 able-copy args:a
5190: 72 67 2d 68 61 73 68 29 29 29 0a 09 20 3b 3b 20 rg-hash))).. ;;
51a0: 28 66 6f 72 2d 65 61 63 68 0a 09 20 3b 3b 20 20 (for-each.. ;;
51b0: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 20 (lambda (key)..
51c0: 3b 3b 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ;; (if (not (
51d0: 6d 65 6d 62 65 72 20 6b 65 79 20 2a 6c 65 67 61 member key *lega
51e0: 6c 2d 70 61 72 61 6d 73 2a 29 29 0a 09 20 3b 3b l-params*)).. ;;
51f0: 20 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 .(hash-table-de
5200: 6c 65 74 65 21 20 61 64 6a 61 72 67 73 20 6b 65 lete! adjargs ke
5210: 79 29 29 29 20 3b 3b 20 77 65 20 6e 65 65 64 20 y))) ;; we need
5220: 74 6f 20 64 65 6c 65 74 65 20 61 6e 79 20 70 61 to delete any pa
5230: 72 61 6d 73 20 69 6e 74 65 6e 64 65 64 20 66 6f rams intended fo
5240: 72 20 6d 74 75 74 69 6c 0a 09 20 3b 3b 20 20 28 r mtutil.. ;; (
5250: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
5260: 61 64 6a 61 72 67 73 29 29 0a 09 20 28 6c 65 74 adjargs)).. (let
5270: 2d 76 61 6c 75 65 73 20 28 28 28 75 75 69 64 20 -values (((uuid
5280: 70 6b 74 29 0a 09 09 20 20 20 20 20 20 20 28 63 pkt)... (c
5290: 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e 70 6b 74 ommand-line->pkt
52a0: 20 2a 61 63 74 69 6f 6e 2a 20 61 64 6a 61 72 67 *action* adjarg
52b0: 73 20 23 66 29 29 29 0a 09 20 20 20 28 77 72 69 s #f))).. (wri
52c0: 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 20 75 te-pkt pktsdir u
52d0: 75 69 64 20 70 6b 74 29 29 29 29 0a 20 20 20 20 uid pkt)))).
52e0: 20 20 28 28 64 69 73 70 61 74 63 68 20 69 6d 70 ((dispatch imp
52f0: 6f 72 74 20 72 75 6e 67 65 6e 20 70 72 6f 63 65 ort rungen proce
5300: 73 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a ss). (let*
5310: 20 28 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 69 ((mtconfdat (si
5320: 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 73 mple-setup (args
5330: 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 :get-arg "-start
5340: 2d 64 69 72 22 29 29 29 0a 09 20 20 20 20 20 20 -dir")))..
5350: 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 61 72 20 (mtconf (car
5360: 6d 74 63 6f 6e 66 64 61 74 29 29 0a 09 20 20 20 mtconfdat))..
5370: 20 20 20 28 74 6f 70 70 61 74 68 20 20 20 28 63 (toppath (c
5380: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 onfigf:lookup mt
5390: 63 6f 6e 66 20 22 64 79 6e 64 61 74 22 20 22 74 conf "dyndat" "t
53a0: 6f 70 70 61 74 68 22 29 29 29 0a 09 20 28 63 61 oppath"))).. (ca
53b0: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
53c0: 6f 6c 20 2a 61 63 74 69 6f 6e 2a 29 0a 09 20 20 ol *action*)..
53d0: 20 28 28 70 72 6f 63 65 73 73 29 20 20 28 62 65 ((process) (be
53e0: 67 69 6e 0a 09 09 09 20 28 6c 6f 61 64 2d 70 6b gin.... (load-pk
53f0: 74 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 29 ts-to-db mtconf)
5400: 0a 09 09 09 20 28 67 65 6e 65 72 61 74 65 2d 72 .... (generate-r
5410: 75 6e 2d 70 6b 74 73 20 6d 74 63 6f 6e 66 20 74 un-pkts mtconf t
5420: 6f 70 70 61 74 68 29 0a 09 09 09 20 28 6c 6f 61 oppath).... (loa
5430: 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 d-pkts-to-db mtc
5440: 6f 6e 66 29 0a 09 09 09 20 28 64 69 73 70 61 74 onf).... (dispat
5450: 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 6f ch-commands mtco
5460: 6e 66 20 74 6f 70 70 61 74 68 29 29 29 0a 09 20 nf toppath)))..
5470: 20 20 28 28 69 6d 70 6f 72 74 29 20 20 20 28 6c ((import) (l
5480: 6f 61 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d oad-pkts-to-db m
5490: 74 63 6f 6e 66 29 29 20 3b 3b 20 69 6d 70 6f 72 tconf)) ;; impor
54a0: 74 20 70 6b 74 73 0a 09 20 20 20 28 28 72 75 6e t pkts.. ((run
54b0: 67 65 6e 29 20 20 20 28 67 65 6e 65 72 61 74 65 gen) (generate
54c0: 2d 72 75 6e 2d 70 6b 74 73 20 6d 74 63 6f 6e 66 -run-pkts mtconf
54d0: 20 74 6f 70 70 61 74 68 29 29 0a 09 20 20 20 28 toppath)).. (
54e0: 28 64 69 73 70 61 74 63 68 29 20 28 64 69 73 70 (dispatch) (disp
54f0: 61 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 atch-commands mt
5500: 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 29 29 29 conf toppath))))
5510: 29 0a 20 20 20 20 20 20 28 28 64 62 29 0a 20 20 ). ((db).
5520: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
5530: 72 65 6d 61 72 67 73 29 0a 09 20 20 20 28 70 72 remargs).. (pr
5540: 69 6e 74 20 22 45 52 52 4f 52 3a 20 6d 69 73 73 int "ERROR: miss
5550: 69 6e 67 20 73 75 62 20 63 6f 6d 6d 61 6e 64 20 ing sub command
5560: 66 6f 72 20 64 62 20 63 6f 6d 6d 61 6e 64 22 29 for db command")
5570: 0a 09 20 20 20 28 6c 65 74 20 28 28 73 75 62 63 .. (let ((subc
5580: 6d 64 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 md (car remargs)
5590: 29 29 0a 09 20 20 20 20 20 28 63 61 73 65 20 28 )).. (case (
55a0: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 string->symbol s
55b0: 75 62 63 6d 64 29 0a 09 20 20 20 20 20 20 20 28 ubcmd).. (
55c0: 28 70 67 73 63 68 65 6d 61 29 0a 09 09 28 6c 65 (pgschema)...(le
55d0: 74 2a 20 28 28 69 6e 73 74 61 6c 6c 2d 68 6f 6d t* ((install-hom
55e0: 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 69 6e e (common:get-in
55f0: 73 74 61 6c 6c 2d 61 72 65 61 29 29 0a 09 09 20 stall-area))...
5600: 20 20 20 20 20 20 28 73 63 68 65 6d 61 2d 66 69 (schema-fi
5610: 6c 65 20 20 28 63 6f 6e 63 20 69 6e 73 74 61 6c le (conc instal
5620: 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 72 65 2f 64 l-home "/share/d
5630: 62 2f 6d 74 2d 70 67 2e 73 71 6c 22 29 29 29 0a b/mt-pg.sql"))).
5640: 09 09 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 .. (if (file-ex
5650: 69 73 74 73 3f 20 73 63 68 65 6d 61 2d 66 69 6c ists? schema-fil
5660: 65 29 0a 09 09 20 20 20 20 20 20 28 73 79 73 74 e)... (syst
5670: 65 6d 20 28 63 6f 6e 63 20 22 2f 62 69 6e 2f 63 em (conc "/bin/c
5680: 61 74 20 22 20 73 63 68 65 6d 61 2d 66 69 6c 65 at " schema-file
5690: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 28 ))))).. ((
56a0: 73 71 6c 69 74 65 33 73 63 68 65 6d 61 29 0a 09 sqlite3schema)..
56b0: 09 28 6c 65 74 2a 20 28 28 69 6e 73 74 61 6c 6c .(let* ((install
56c0: 2d 68 6f 6d 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 -home (common:ge
56d0: 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 t-install-area))
56e0: 0a 09 09 20 20 20 20 20 20 20 28 73 63 68 65 6d ... (schem
56f0: 61 2d 66 69 6c 65 20 20 28 63 6f 6e 63 20 69 6e a-file (conc in
5700: 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 stall-home "/sha
5710: 72 65 2f 64 62 2f 6d 74 2d 73 71 6c 69 74 65 33 re/db/mt-sqlite3
5720: 2e 73 71 6c 22 29 29 29 0a 09 09 20 20 28 69 66 .sql")))... (if
5730: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 (file-exists? s
5740: 63 68 65 6d 61 2d 66 69 6c 65 29 0a 09 09 20 20 chema-file)...
5750: 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e (system (con
5760: 63 20 22 2f 62 69 6e 2f 63 61 74 20 22 20 73 63 c "/bin/cat " sc
5770: 68 65 6d 61 2d 66 69 6c 65 29 29 29 29 29 0a 09 hema-file)))))..
5780: 20 20 20 20 20 20 20 28 28 6a 75 6e 6b 29 0a 09 ((junk)..
5790: 09 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 .(rmt:get-keys))
57a0: 29 29 29 29 29 29 0a 0a 3b 3b 20 49 66 20 48 54 ))))))..;; If HT
57b0: 54 50 5f 48 4f 53 54 20 69 73 20 64 65 66 69 6e TP_HOST is defin
57c0: 65 64 20 74 68 65 6e 20 77 65 20 6d 75 73 74 20 ed then we must
57d0: 62 65 20 69 6e 20 74 68 65 20 63 67 69 20 65 6e be in the cgi en
57e0: 76 69 72 6f 6e 6d 65 6e 74 0a 3b 3b 20 73 6f 20 vironment.;; so
57f0: 72 75 6e 20 73 74 6d 6c 20 61 6e 64 20 65 78 69 run stml and exi
5800: 74 0a 3b 3b 0a 28 69 66 20 28 67 65 74 2d 65 6e t.;;.(if (get-en
5810: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
5820: 6c 65 20 22 48 54 54 50 5f 48 4f 53 54 22 29 0a le "HTTP_HOST").
5830: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
5840: 20 28 73 74 6d 6c 3a 6d 61 69 6e 20 23 66 29 0a (stml:main #f).
5850: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
5860: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 .(if (or (args:g
5870: 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a et-arg "-repl").
5880: 09 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 .(args:get-arg "
5890: 2d 6c 6f 61 64 22 29 29 0a 20 20 20 20 28 62 65 -load")). (be
58a0: 67 69 6e 0a 20 20 20 20 20 20 28 69 6d 70 6f 72 gin. (impor
58b0: 74 20 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 t extras) ;; mig
58c0: 68 74 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 ht not be needed
58d0: 0a 20 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 . ;; (impor
58e0: 74 20 63 73 69 29 0a 20 20 20 20 20 20 28 69 6d t csi). (im
58f0: 70 6f 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 20 port readline).
5900: 20 20 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 (import apr
5910: 6f 70 6f 73 29 0a 20 20 20 20 20 20 3b 3b 20 28 opos). ;; (
5920: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 import (prefix s
5930: 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 qlite3 sqlite3:)
5940: 29 20 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f 72 ) ;; doesn't wor
5950: 6b 20 2e 2e 2e 0a 20 20 20 20 20 20 0a 20 20 20 k .... .
5960: 20 20 20 28 69 6e 73 74 61 6c 6c 2d 68 69 73 74 (install-hist
5970: 6f 72 79 2d 66 69 6c 65 20 28 67 65 74 2d 65 6e ory-file (get-en
5980: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
5990: 6c 65 20 22 48 4f 4d 45 22 29 20 22 2e 6d 74 75 le "HOME") ".mtu
59a0: 74 69 6c 5f 68 69 73 74 6f 72 79 22 29 20 3b 3b til_history") ;;
59b0: 20 20 5b 68 6f 6d 65 64 69 72 5d 20 5b 66 69 6c [homedir] [fil
59c0: 65 6e 61 6d 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 ename] [nlines])
59d0: 0a 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d . (current-
59e0: 69 6e 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 input-port (make
59f0: 2d 72 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 -readline-port "
5a00: 6d 74 75 74 69 6c 3e 20 22 29 29 0a 20 20 20 20 mtutil> ")).
5a10: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
5a20: 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 20 20 arg "-repl")..
5a30: 28 72 65 70 6c 29 0a 09 20 20 28 6c 6f 61 64 20 (repl).. (load
5a40: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
5a50: 6c 6f 61 64 22 29 29 29 29 29 0a load"))))).