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: 20 72 65 67 65 78 2d 63 61 73 65 0a 20 20 20 20 regex-case.
02a0: 20 28 70 72 65 66 69 78 20 64 62 69 20 64 62 69 (prefix dbi dbi
02b0: 3a 29 29 20 3b 3b 20 20 7a 6d 71 20 65 78 74 72 :)) ;; zmq extr
02c0: 61 73 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 as)..(declare (u
02d0: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 ses common)).(de
02e0: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 61 clare (uses mega
02f0: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a 28 test-version)).(
0300: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
0310: 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 rgs)).(declare (
0320: 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a 3b uses configf)).;
0330: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
0340: 20 72 6d 74 29 29 0a 0a 28 69 6e 63 6c 75 64 65 rmt))..(include
0350: 20 22 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 "megatest-fossi
0360: 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a 0a 28 72 l-hash.scm")..(r
0370: 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 20 73 equire-library s
0380: 74 6d 6c 29 0a 0a 3b 3b 20 73 74 75 66 66 20 66 tml)..;; stuff f
0390: 6f 72 20 74 68 65 20 6d 61 70 70 65 72 20 61 6e or the mapper an
03a0: 64 20 63 68 65 63 6b 65 72 20 66 75 6e 63 74 69 d checker functi
03b0: 6f 6e 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a ons.;;.(define *
03c0: 74 61 72 67 65 74 2d 6d 61 70 70 65 72 73 2a 20 target-mappers*
03d0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
03e0: 65 29 29 20 0a 28 64 65 66 69 6e 65 20 2a 72 75 e)) .(define *ru
03f0: 6e 6e 61 6d 65 2d 6d 61 70 70 65 72 73 2a 20 28 nname-mappers* (
0400: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0410: 29 20 0a 28 64 65 66 69 6e 65 20 2a 61 72 65 61 ) .(define *area
0420: 2d 63 68 65 63 6b 65 72 73 2a 20 20 20 28 6d 61 -checkers* (ma
0430: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
0440: 0a 0a 3b 3b 20 68 65 6c 70 65 72 73 20 66 6f 72 ..;; helpers for
0450: 20 6d 61 70 70 65 72 73 2f 63 68 65 63 6b 65 72 mappers/checker
0460: 73 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d 74 s.(define (add-t
0470: 61 72 67 65 74 2d 6d 61 70 70 65 72 20 6e 61 6d arget-mapper nam
0480: 65 20 70 72 6f 63 29 0a 20 20 28 68 61 73 68 2d e proc). (hash-
0490: 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 61 72 67 table-set! *targ
04a0: 65 74 2d 6d 61 70 70 65 72 73 2a 20 6e 61 6d 65 et-mappers* name
04b0: 20 70 72 6f 63 29 29 0a 28 64 65 66 69 6e 65 20 proc)).(define
04c0: 28 61 64 64 2d 72 75 6e 6e 61 6d 65 2d 6d 61 70 (add-runname-map
04d0: 70 65 72 20 6e 61 6d 65 20 70 72 6f 63 29 0a 20 per name proc).
04e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
04f0: 21 20 2a 72 75 6e 6e 61 6d 65 2d 6d 61 70 70 65 ! *runname-mappe
0500: 72 73 2a 20 6e 61 6d 65 20 70 72 6f 63 29 29 0a rs* name proc)).
0510: 28 64 65 66 69 6e 65 20 28 61 64 64 2d 61 72 65 (define (add-are
0520: 61 2d 63 68 65 63 6b 65 72 20 6e 61 6d 65 20 70 a-checker name p
0530: 72 6f 63 29 0a 20 20 28 68 61 73 68 2d 74 61 62 roc). (hash-tab
0540: 6c 65 2d 73 65 74 21 20 2a 61 72 65 61 2d 63 68 le-set! *area-ch
0550: 65 63 6b 65 72 73 2a 20 6e 61 6d 65 20 70 72 6f eckers* name pro
0560: 63 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 c))..;; given a
0570: 72 75 6e 6b 65 79 2c 20 78 6c 61 74 72 2d 6b 65 runkey, xlatr-ke
0580: 79 20 61 6e 64 20 6f 74 68 65 72 20 69 6e 66 6f y and other info
0590: 20 72 65 74 75 72 6e 20 6f 6e 65 20 6f 66 20 74 return one of t
05a0: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 3a 0a 3b 3b he following:.;;
05b0: 20 20 20 6c 69 73 74 20 6f 66 20 74 61 72 67 65 list of targe
05c0: 74 73 2c 20 6e 75 6c 6c 20 6c 69 73 74 20 74 6f ts, null list to
05d0: 20 73 6b 69 70 20 70 72 6f 63 65 73 73 69 6e 67 skip processing
05e0: 0a 3b 3b 20 20 20 0a 28 64 65 66 69 6e 65 20 28 .;; .(define (
05f0: 6d 61 70 2d 74 61 72 67 65 74 73 20 6d 74 63 6f map-targets mtco
0600: 6e 66 20 61 76 61 6c 2d 61 6c 69 73 74 20 72 75 nf aval-alist ru
0610: 6e 6b 65 79 20 61 72 65 61 20 63 6f 6e 74 6f 75 nkey area contou
0620: 72 20 23 21 6b 65 79 20 28 78 6c 61 74 72 2d 6b r #!key (xlatr-k
0630: 65 79 2d 69 6e 20 23 66 29 29 0a 20 20 28 6c 65 ey-in #f)). (le
0640: 74 2a 20 28 28 78 6c 61 74 72 2d 6b 65 79 20 28 t* ((xlatr-key (
0650: 6f 72 20 78 6c 61 74 72 2d 6b 65 79 2d 69 6e 0a or xlatr-key-in.
0660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0670: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 2d 67 65 (conf-ge
0680: 74 2f 64 65 66 61 75 6c 74 20 6d 74 63 6f 6e 66 t/default mtconf
0690: 20 61 76 61 6c 2d 61 6c 69 73 74 20 27 74 61 72 aval-alist 'tar
06a0: 67 74 72 61 6e 73 29 29 29 0a 20 20 20 20 20 20 gtrans))).
06b0: 20 20 20 28 70 72 6f 63 20 20 20 20 20 20 28 68 (proc (h
06c0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
06d0: 66 61 75 6c 74 20 2a 74 61 72 67 65 74 2d 6d 61 fault *target-ma
06e0: 70 70 65 72 73 2a 20 78 6c 61 74 72 2d 6b 65 79 ppers* xlatr-key
06f0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 70 #f))). (if p
0700: 72 6f 63 0a 20 20 20 20 20 20 20 20 28 62 65 67 roc. (beg
0710: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 28 70 72 in. (pr
0720: 69 6e 74 20 22 55 73 69 6e 67 20 74 61 72 67 65 int "Using targe
0730: 74 20 6d 61 70 70 65 72 3a 20 22 20 61 72 65 61 t mapper: " area
0740: 2d 78 6c 61 74 72 29 0a 20 20 20 20 20 20 20 20 -xlatr).
0750: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
0760: 69 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 ions.
0770: 65 78 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 exn. (
0780: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
0790: 20 20 20 28 70 72 69 6e 74 20 22 46 41 49 4c 45 (print "FAILE
07a0: 44 20 54 4f 20 52 55 4e 20 54 41 52 47 45 54 20 D TO RUN TARGET
07b0: 4d 41 50 50 45 52 20 46 4f 52 20 22 20 61 72 65 MAPPER FOR " are
07c0: 61 20 22 2c 20 63 61 6c 6c 65 64 20 22 20 61 72 a ", called " ar
07d0: 65 61 2d 78 6c 61 74 72 29 0a 20 20 20 20 20 20 ea-xlatr).
07e0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 (print "
07f0: 20 20 66 75 6e 63 74 69 6f 6e 20 69 73 3a 20 22 function is: "
0800: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
0810: 2f 64 65 66 61 75 6c 74 20 2a 74 61 72 67 65 74 /default *target
0820: 2d 6d 61 70 70 65 72 73 2a 20 78 6c 61 74 72 2d -mappers* xlatr-
0830: 6b 65 79 20 23 66 20 29 20 29 0a 20 20 20 20 20 key #f ) ).
0840: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 (print "
0850: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
0860: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
0870: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
0880: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 20 message) exn)).
0890: 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 6b runk
08a0: 65 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ey). (
08b0: 70 72 6f 63 20 72 75 6e 6b 65 79 20 61 72 65 61 proc runkey area
08c0: 20 63 6f 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 contour))).
08d0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
08e0: 20 20 20 20 20 28 69 66 20 78 6c 61 74 72 2d 6b (if xlatr-k
08f0: 65 79 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ey .
0900: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
0910: 20 46 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 Failed to find
0920: 6e 61 6d 65 64 20 74 61 72 67 65 74 20 74 72 61 named target tra
0930: 6e 73 6c 61 74 6f 72 20 22 20 78 6c 61 74 72 2d nslator " xlatr-
0940: 6b 65 79 20 22 2c 20 75 73 69 6e 67 20 6f 72 69 key ", using ori
0950: 67 69 6e 61 6c 20 74 61 72 67 65 74 2e 22 29 29 ginal target."))
0960: 0a 20 20 20 20 20 20 20 20 20 20 60 28 2c 72 75 . `(,ru
0970: 6e 6b 65 79 29 29 29 29 29 20 3b 3b 20 6e 6f 20 nkey))))) ;; no
0980: 70 72 6f 63 20 74 68 65 6e 20 75 73 65 20 72 75 proc then use ru
0990: 6e 6b 65 79 0a 0a 3b 3b 20 67 69 76 65 6e 20 6d nkey..;; given m
09a0: 74 63 6f 6e 66 20 61 6e 64 20 61 72 65 61 63 6f tconf and areaco
09b0: 6e 66 20 65 78 74 72 61 63 74 20 61 20 74 72 61 nf extract a tra
09c0: 6e 73 6c 61 74 6f 72 2f 66 69 6c 74 65 72 2c 20 nslator/filter,
09d0: 66 69 72 73 74 20 6c 6f 6f 6b 20 61 74 20 61 72 first look at ar
09e0: 65 61 63 6f 6e 66 0a 3b 3b 20 74 68 65 6e 20 69 eaconf.;; then i
09f0: 66 20 6e 6f 74 20 66 6f 75 6e 64 20 6c 6f 6f 6b f not found look
0a00: 20 61 74 20 64 65 66 61 75 6c 74 0a 3b 3b 0a 28 at default.;;.(
0a10: 64 65 66 69 6e 65 20 28 63 6f 6e 66 2d 67 65 74 define (conf-get
0a20: 2f 64 65 66 61 75 6c 74 20 6d 74 63 6f 6e 66 20 /default mtconf
0a30: 61 72 65 61 63 6f 6e 66 20 6b 65 79 6e 61 6d 65 areaconf keyname
0a40: 20 23 21 6b 65 79 20 28 64 65 66 61 75 6c 74 20 #!key (default
0a50: 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 72 65 #f)). (let ((re
0a60: 73 20 28 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 s (or (alist-ref
0a70: 20 6b 65 79 6e 61 6d 65 20 61 72 65 61 63 6f 6e keyname areacon
0a80: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
0a90: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (configf:loo
0aa0: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 64 65 66 61 kup mtconf "defa
0ab0: 75 6c 74 22 20 28 63 6f 6e 63 20 6b 65 79 6e 61 ult" (conc keyna
0ac0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 me)).
0ad0: 20 20 20 20 20 20 64 65 66 61 75 6c 74 29 29 29 default)))
0ae0: 0a 20 20 20 20 28 69 66 20 72 65 73 0a 20 20 20 . (if res.
0af0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 (string->sy
0b00: 6d 62 6f 6c 20 72 65 73 29 0a 20 20 20 20 20 20 mbol res).
0b10: 20 20 72 65 73 29 29 29 0a 20 20 0a 3b 3b 20 74 res))). .;; t
0b20: 68 69 73 20 6e 65 65 64 73 20 73 6f 6d 65 20 74 his needs some t
0b30: 68 6f 75 67 68 74 20 72 65 67 61 72 64 69 6e 67 hought regarding
0b40: 20 73 65 63 75 72 69 74 79 20 69 6d 70 6c 69 63 security implic
0b50: 61 74 69 6f 6e 73 2e 0a 3b 3b 0a 3b 3b 20 20 20 ations..;;.;;
0b60: 69 2e 20 43 68 65 63 6b 20 74 68 61 74 20 6f 77 i. Check that ow
0b70: 6e 65 72 20 6f 66 20 74 68 65 20 66 69 6c 65 20 ner of the file
0b80: 61 6e 64 20 63 61 6c 6c 69 6e 67 20 75 73 65 72 and calling user
0b90: 20 61 72 65 20 73 61 6d 65 3f 0a 3b 3b 20 20 69 are same?.;; i
0ba0: 69 2e 20 43 68 65 63 6b 20 74 68 61 74 20 77 65 i. Check that we
0bb0: 20 61 72 65 20 69 6e 20 61 20 6c 65 67 61 6c 20 are in a legal
0bc0: 6d 65 67 61 74 65 73 74 20 61 72 65 61 3f 0a 3b megatest area?.;
0bd0: 3b 20 69 69 69 2e 20 48 61 76 65 20 73 6f 6d 65 ; iii. Have some
0be0: 20 66 6f 72 6d 20 6f 66 20 61 75 74 68 65 6e 74 form of authent
0bf0: 69 63 61 74 69 6f 6e 20 6f 72 20 72 65 63 6f 72 ication or recor
0c00: 64 20 6f 66 20 74 68 65 20 6d 64 35 73 75 6d 20 d of the md5sum
0c10: 6f 72 20 73 69 6d 69 6c 61 72 20 6f 66 20 74 68 or similar of th
0c20: 65 20 66 69 6c 65 3f 0a 3b 3b 20 20 69 76 2e 20 e file?.;; iv.
0c30: 55 73 65 20 63 6f 6d 70 69 6c 65 64 20 76 65 72 Use compiled ver
0c40: 73 69 6f 6e 20 69 6e 20 70 72 65 66 65 72 65 6e sion in preferen
0c50: 63 65 20 74 6f 20 2e 73 63 6d 20 76 65 72 73 69 ce to .scm versi
0c60: 6f 6e 2e 20 54 68 75 73 20 74 68 65 72 65 20 69 on. Thus there i
0c70: 73 20 61 20 6d 61 6e 75 61 6c 20 22 62 6c 65 73 s a manual "bles
0c80: 73 69 6e 67 22 0a 3b 3b 20 20 20 20 20 20 72 65 sing".;; re
0c90: 71 75 69 72 65 64 20 74 6f 20 75 73 65 20 2e 6d quired to use .m
0ca0: 74 75 74 69 6c 2e 73 63 6d 2e 0a 3b 3b 0a 28 69 tutil.scm..;;.(i
0cb0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
0cc0: 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 "megatest.config
0cd0: 22 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c 65 "). (if (file
0ce0: 2d 65 78 69 73 74 73 3f 20 22 2e 6d 74 75 74 69 -exists? ".mtuti
0cf0: 6c 2e 73 6f 22 29 0a 09 28 6c 6f 61 64 20 22 2e l.so")..(load ".
0d00: 6d 74 75 74 69 6c 2e 73 6f 22 29 0a 09 28 69 66 mtutil.so")..(if
0d10: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 (file-exists? "
0d20: 2e 6d 74 75 74 69 6c 2e 73 63 6d 22 29 0a 20 20 .mtutil.scm").
0d30: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 61 64 20 (load
0d40: 22 2e 6d 74 75 74 69 6c 2e 73 63 6d 22 29 29 29 ".mtutil.scm")))
0d50: 29 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 68 )..;; Disabled h
0d60: 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d 72 elp items.;; -r
0d70: 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 20 ollup
0d80: 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e 74 : (current
0d90: 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 6c ly disabled) fil
0da0: 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a 72 l run (set by :r
0db0: 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c 61 unname) with la
0dc0: 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b 3b 20 test test(s).;;
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0de0: 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 from
0df0: 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 20 prior runs with
0e00: 73 61 6d 65 20 6b 65 79 73 0a 3b 3b 20 43 6f 6e same keys.;; Con
0e10: 74 6f 75 72 20 61 63 74 69 6f 6e 73 0a 3b 3b 20 tour actions.;;
0e20: 20 20 20 69 6d 70 6f 72 74 20 20 20 20 20 20 20 import
0e30: 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6d 70 : imp
0e40: 6f 72 74 20 70 6b 74 73 0a 3b 3b 20 20 20 20 64 ort pkts.;; d
0e50: 69 73 70 61 74 63 68 20 20 20 20 20 20 20 20 20 ispatch
0e60: 20 20 20 20 20 20 20 3a 20 64 69 73 70 61 74 63 : dispatc
0e70: 68 20 71 75 65 75 65 64 20 72 75 6e 20 6a 6f 62 h queued run job
0e80: 73 20 66 72 6f 6d 20 69 6d 70 6f 72 74 65 64 20 s from imported
0e90: 70 6b 74 73 0a 3b 3b 20 20 20 20 72 75 6e 67 65 pkts.;; runge
0ea0: 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n
0eb0: 20 20 20 3a 20 6c 6f 6f 6b 20 61 74 20 69 6e 70 : look at inp
0ec0: 75 74 20 73 65 6e 73 65 20 6c 69 73 74 20 69 6e ut sense list in
0ed0: 20 5b 72 75 6e 67 65 6e 5d 20 61 6e 64 20 67 65 [rungen] and ge
0ee0: 6e 65 72 61 74 65 20 72 75 6e 20 70 6b 74 73 0a nerate run pkts.
0ef0: 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 63 .(define help (c
0f00: 6f 6e 63 20 22 0a 6d 74 75 74 69 6c 2c 20 70 61 onc ".mtutil, pa
0f10: 72 74 20 6f 66 20 74 68 65 20 4d 65 67 61 74 65 rt of the Megate
0f20: 73 74 20 74 6f 6f 6c 20 73 75 69 74 65 2c 20 64 st tool suite, d
0f30: 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 ocumentation at
0f40: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
0f50: 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 a.com/fossils/me
0f60: 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 6f 6e gatest. version
0f70: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
0f80: 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 ion ". license
0f90: 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 4d GPL, Copyright M
0fa0: 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 36 att Welland 2006
0fb0: 2d 32 30 31 37 0a 0a 55 73 61 67 65 3a 20 6d 74 -2017..Usage: mt
0fc0: 75 74 69 6c 20 61 63 74 69 6f 6e 20 5b 6f 70 74 util action [opt
0fd0: 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 20 ions]. -h
0fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ff0: 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 : this help.
1000: 20 2d 6d 61 6e 75 61 6c 20 20 20 20 20 20 20 20 -manual
1010: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 68 : sh
1020: 6f 77 20 74 68 65 20 4d 65 67 61 74 65 73 74 20 ow the Megatest
1030: 75 73 65 72 20 6d 61 6e 75 61 6c 0a 20 20 2d 76 user manual. -v
1040: 65 72 73 69 6f 6e 20 20 20 20 20 20 20 20 20 20 ersion
1050: 20 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e 74 : print
1060: 20 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 6f megatest versio
1070: 6e 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 6d n (currently " m
1080: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
1090: 22 29 0a 09 09 09 20 20 20 20 20 0a 41 63 74 69 ").... .Acti
10a0: 6f 6e 73 3a 09 09 20 20 20 20 20 0a 20 20 20 72 ons:.. . r
10b0: 75 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 un
10c0: 20 20 20 20 20 20 20 20 20 3a 20 69 6e 69 74 69 : initi
10d0: 61 74 65 20 72 75 6e 73 0a 20 20 20 72 65 6d 6f ate runs. remo
10e0: 76 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ve
10f0: 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 20 72 : remove r
1100: 75 6e 73 0a 20 20 20 72 65 72 75 6e 20 20 20 20 uns. rerun
1110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1120: 20 3a 20 72 65 67 69 73 74 65 72 20 61 63 74 69 : register acti
1130: 6f 6e 20 66 6f 72 20 70 72 6f 63 65 73 73 69 6e on for processin
1140: 67 0a 20 20 20 73 65 74 2d 73 73 20 20 20 20 20 g. set-ss
1150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1160: 20 73 65 74 20 73 74 61 74 65 2f 73 74 61 74 75 set state/statu
1170: 73 0a 20 20 20 61 72 63 68 69 76 65 20 20 20 20 s. archive
1180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1190: 20 63 6f 6d 70 72 65 73 73 20 61 6e 64 20 6d 6f compress and mo
11a0: 76 65 20 74 65 73 74 20 64 61 74 61 20 74 6f 20 ve test data to
11b0: 61 72 63 68 69 76 65 20 64 69 73 6b 0a 20 20 20 archive disk.
11c0: 6b 69 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 kill
11d0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 6f 70 : stop
11e0: 20 74 65 73 74 73 20 6f 72 20 65 6e 74 69 72 65 tests or entire
11f0: 20 72 75 6e 73 0a 20 20 20 64 62 20 20 20 20 20 runs. db
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1210: 20 20 20 3a 20 64 61 74 61 62 61 73 65 20 75 74 : database ut
1220: 69 6c 69 74 69 65 73 0a 20 20 20 61 72 65 61 73 ilities. areas
1230: 2c 20 63 6f 6e 74 6f 75 72 73 2c 20 73 65 74 75 , contours, setu
1240: 70 20 20 20 20 3a 20 73 68 6f 77 20 61 72 65 61 p : show area
1250: 73 2c 20 63 6f 6e 74 6f 75 72 73 20 6f 72 20 73 s, contours or s
1260: 65 74 75 70 20 73 65 63 74 69 6f 6e 20 66 72 6f etup section fro
1270: 6d 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 m megatest.confi
1280: 67 0a 0a 43 6f 6e 74 6f 75 72 20 61 63 74 69 6f g..Contour actio
1290: 6e 73 3a 0a 20 20 20 70 72 6f 63 65 73 73 20 20 ns:. process
12a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12b0: 20 3a 20 72 75 6e 73 20 69 6d 70 6f 72 74 2c 20 : runs import,
12c0: 72 75 6e 67 65 6e 20 61 6e 64 20 64 69 73 70 61 rungen and dispa
12d0: 74 63 68 20 0a 09 09 09 20 20 20 20 20 0a 53 65 tch .... .Se
12e0: 6c 65 63 74 6f 72 73 20 09 09 20 20 20 20 20 0a lectors .. .
12f0: 20 20 2d 69 6d 6d 65 64 69 61 74 65 20 20 20 20 -immediate
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 61 : a
1310: 70 70 6c 79 20 74 68 69 73 20 61 63 74 69 6f 6e pply this action
1320: 20 69 6d 6d 65 64 69 61 74 65 6c 79 2c 20 64 65 immediately, de
1330: 66 61 75 6c 74 20 69 73 20 74 6f 20 71 75 65 75 fault is to queu
1340: 65 20 75 70 20 61 63 74 69 6f 6e 73 0a 20 20 2d e up actions. -
1350: 61 72 65 61 20 61 72 65 61 70 61 74 74 31 2c 61 area areapatt1,a
1360: 72 65 61 32 2e 2e 2e 20 20 20 3a 20 61 70 70 6c rea2... : appl
1370: 79 20 74 68 69 73 20 61 63 74 69 6f 6e 20 6f 6e y this action on
1380: 6c 79 20 74 6f 20 74 68 65 20 73 70 65 63 69 66 ly to the specif
1390: 69 65 64 20 61 72 65 61 73 0a 20 20 2d 74 61 72 ied areas. -tar
13a0: 67 65 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e get key1/key2/..
13b0: 2e 20 20 20 20 20 20 3a 20 72 75 6e 20 66 6f 72 . : run for
13c0: 20 6b 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 key1, key2, etc
13d0: 2e 0a 20 20 2d 74 65 73 74 2d 70 61 74 74 20 70 .. -test-patt p
13e0: 31 2f 70 32 2c 70 33 2f 2e 2e 2e 20 20 20 20 3a 1/p2,p3/... :
13f0: 20 25 20 69 73 20 77 69 6c 64 63 61 72 64 0a 20 % is wildcard.
1400: 20 2d 72 75 6e 2d 6e 61 6d 65 20 20 20 20 20 20 -run-name
1410: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 : re
1420: 71 75 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 quired, name for
1430: 20 74 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 this particular
1440: 20 74 65 73 74 20 72 75 6e 0a 20 20 2d 63 6f 6e test run. -con
1450: 74 6f 75 72 20 63 6f 6e 74 6f 75 72 6e 61 6d 65 tour contourname
1460: 20 20 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c : run all
1470: 20 74 61 72 67 65 74 73 20 66 6f 72 20 63 6f 6e targets for con
1480: 74 6f 75 72 6e 61 6d 65 2c 20 72 65 71 75 69 72 tourname, requir
1490: 65 73 20 2d 72 75 6e 2d 6e 61 6d 65 2c 20 2d 74 es -run-name, -t
14a0: 61 72 67 65 74 0a 20 20 2d 73 74 61 74 65 2d 73 arget. -state-s
14b0: 74 61 74 75 73 20 63 2f 70 2c 63 2f 66 20 20 20 tatus c/p,c/f
14c0: 20 20 20 3a 20 53 70 65 63 69 66 79 20 61 20 6c : Specify a l
14d0: 69 73 74 20 6f 66 20 73 74 61 74 65 20 61 6e 64 ist of state and
14e0: 20 73 74 61 74 75 73 20 70 61 74 74 65 72 6e 73 status patterns
14f0: 0a 20 20 2d 74 61 67 2d 65 78 70 72 20 74 61 67 . -tag-expr tag
1500: 31 2c 74 61 67 32 25 2c 2e 2e 20 20 20 20 3a 20 1,tag2%,.. :
1510: 73 65 6c 65 63 74 20 74 65 73 74 73 20 77 69 74 select tests wit
1520: 68 20 74 61 67 73 20 6d 61 74 63 68 69 6e 67 20 h tags matching
1530: 65 78 70 72 65 73 73 69 6f 6e 0a 20 20 2d 6d 6f expression. -mo
1540: 64 65 2d 70 61 74 74 20 6b 65 79 20 20 20 20 20 de-patt key
1550: 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 74 : load t
1560: 65 73 74 70 61 74 74 20 66 72 6f 6d 20 3c 6b 65 estpatt from <ke
1570: 79 3e 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 y> in runconfigs
1580: 20 69 6e 73 74 65 61 64 20 6f 66 20 64 65 66 61 instead of defa
1590: 75 6c 74 20 54 45 53 54 50 41 54 54 0a 20 20 20 ult TESTPATT.
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 2d if -
15c0: 74 65 73 74 70 61 74 74 20 61 6e 64 20 2d 74 61 testpatt and -ta
15d0: 67 65 78 70 72 20 61 72 65 20 6e 6f 74 20 73 70 gexpr are not sp
15e0: 65 63 69 66 69 65 64 0a 20 20 2d 6e 65 77 20 73 ecified. -new s
15f0: 74 61 74 65 2f 73 74 61 74 75 73 20 20 20 20 20 tate/status
1600: 20 20 20 20 20 3a 20 73 70 65 63 69 66 79 20 6e : specify n
1610: 65 77 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 ew state/status
1620: 66 6f 72 20 73 65 74 2d 73 73 0a 09 09 09 20 20 for set-ss....
1630: 20 20 20 0a 4d 69 73 63 20 09 09 09 20 20 20 20 .Misc ...
1640: 20 0a 20 20 2d 73 74 61 72 74 2d 64 69 72 20 70 . -start-dir p
1650: 61 74 68 20 20 20 20 20 20 20 20 20 20 20 20 3a ath :
1660: 20 73 77 69 74 63 68 20 74 6f 20 74 68 69 73 20 switch to this
1670: 64 69 72 65 63 74 6f 72 79 20 62 65 66 6f 72 65 directory before
1680: 20 72 75 6e 6e 69 6e 67 20 6d 74 75 74 69 6c 0a running mtutil.
1690: 20 20 2d 73 65 74 2d 76 61 72 73 20 56 31 3d 31 -set-vars V1=1
16a0: 2c 56 32 3d 32 20 20 20 20 20 20 20 20 3a 20 41 ,V2=2 : A
16b0: 64 64 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 dd environment v
16c0: 61 72 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 ariables to a ru
16d0: 6e 20 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 n NB// these are
16e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1700: 20 20 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 overwritten
1710: 62 79 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e by values set in
1720: 20 63 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 config files..
1730: 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c 65 20 20 20 -log logfile
1740: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 : se
1750: 6e 64 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 nd stdout and st
1760: 64 65 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a derr to logfile.
1770: 20 20 2d 72 65 70 6c 20 20 20 20 20 20 20 20 20 -repl
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1790: 74 61 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 tart a repl (use
17a0: 66 75 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e ful for extendin
17b0: 67 20 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c g megatest). -l
17c0: 6f 61 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 oad file.scm
17d0: 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 : load
17e0: 61 6e 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d and run file.scm
17f0: 0a 20 20 2d 64 65 62 75 67 20 4e 7c 4e 2c 4d 2c . -debug N|N,M,
1800: 4f 2e 2e 2e 20 20 20 20 20 20 20 20 20 20 3a 20 O... :
1810: 65 6e 61 62 6c 65 20 64 65 62 75 67 20 6d 65 73 enable debug mes
1820: 73 61 67 65 73 20 30 2d 4e 20 6f 72 20 4e 20 61 sages 0-N or N a
1830: 6e 64 20 4d 20 61 6e 64 20 4f 20 2e 2e 2e 0a 09 nd M and O .....
1840: 09 09 20 20 20 20 20 0a 55 74 69 6c 69 74 79 09 .. .Utility.
1850: 09 09 20 20 20 20 20 0a 20 64 62 20 70 67 73 63 .. . db pgsc
1860: 68 65 6d 61 20 20 20 20 20 20 20 20 20 20 20 20 hema
1870: 20 20 20 20 20 3a 20 65 6d 69 74 20 70 6f 73 74 : emit post
1880: 67 72 65 73 71 6c 20 73 63 68 65 6d 61 3b 20 64 gresql schema; d
1890: 6f 20 5c 22 6d 74 75 74 69 6c 20 64 62 20 70 67 o \"mtutil db pg
18a0: 73 63 68 65 6d 61 20 7c 20 70 73 71 6c 20 2d 64 schema | psql -d
18b0: 20 6d 79 64 62 5c 22 0a 0a 45 78 61 6d 70 6c 65 mydb\"..Example
18c0: 73 3a 0a 0a 23 20 53 74 61 72 74 20 61 20 6d 65 s:..# Start a me
18d0: 67 61 74 65 73 74 20 72 75 6e 20 69 6e 20 74 68 gatest run in th
18e0: 65 20 61 72 65 61 20 5c 22 6d 79 74 65 73 74 73 e area \"mytests
18f0: 5c 22 0a 6d 74 75 74 69 6c 20 72 75 6e 20 2d 61 \".mtutil run -a
1900: 72 65 61 20 6d 79 74 65 73 74 73 20 2d 74 61 72 rea mytests -tar
1910: 67 65 74 20 76 31 2e 36 33 2f 61 61 33 65 20 2d get v1.63/aa3e -
1920: 6d 6f 64 65 2d 70 61 74 74 20 4d 59 50 41 54 54 mode-patt MYPATT
1930: 20 2d 74 61 67 2d 65 78 70 72 20 71 75 69 63 6b -tag-expr quick
1940: 0a 0a 23 20 53 74 61 72 74 20 61 20 63 6f 6e 74 ..# Start a cont
1950: 6f 75 72 0a 6d 74 75 74 69 6c 20 72 75 6e 20 2d our.mtutil run -
1960: 63 6f 6e 74 6f 75 72 20 71 75 69 63 6b 20 2d 74 contour quick -t
1970: 61 72 67 65 74 20 76 31 2e 36 33 2f 61 61 33 65 arget v1.63/aa3e
1980: 20 0a 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 ..Called as " (
1990: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
19a0: 73 65 20 28 61 72 67 76 29 20 22 20 22 29 20 22 se (argv) " ") "
19b0: 0a 56 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 .Version " megat
19c0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 est-version ", b
19d0: 75 69 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 uilt from " mega
19e0: 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 test-fossil-hash
19f0: 20 29 29 0a 0a 3b 3b 20 61 72 67 73 20 61 6e 64 ))..;; args and
1a00: 20 70 6b 74 20 6b 65 79 20 73 70 65 63 73 0a 3b pkt key specs.;
1a10: 3b 0a 28 64 65 66 69 6e 65 20 2a 61 72 67 2d 6b ;.(define *arg-k
1a20: 65 79 73 2a 0a 20 20 27 28 0a 20 20 20 20 28 22 eys*. '(. ("
1a30: 2d 61 72 65 61 22 20 20 20 20 20 20 20 20 20 20 -area"
1a40: 20 20 2e 20 47 29 20 3b 3b 20 6d 61 70 73 20 74 . G) ;; maps t
1a50: 6f 20 67 72 6f 75 70 0a 20 20 20 20 28 22 2d 63 o group. ("-c
1a60: 6f 6e 74 6f 75 72 22 20 20 20 20 20 20 20 20 20 ontour"
1a70: 2e 20 63 29 0a 20 20 20 20 28 22 2d 61 70 70 65 . c). ("-appe
1a80: 6e 64 2d 63 6f 6e 66 69 67 22 20 20 20 2e 20 64 nd-config" . d
1a90: 29 0a 20 20 20 20 28 22 2d 73 74 61 74 65 22 20 ). ("-state"
1aa0: 20 20 20 20 20 20 20 20 20 20 2e 20 65 29 0a 20 . e).
1ab0: 20 20 20 28 22 2d 69 74 65 6d 2d 70 61 74 74 22 ("-item-patt"
1ac0: 20 20 20 20 20 20 20 2e 20 69 29 0a 20 20 20 20 . i).
1ad0: 28 22 2d 73 79 6e 63 2d 74 6f 22 20 20 20 20 20 ("-sync-to"
1ae0: 20 20 20 20 2e 20 6b 29 0a 20 20 20 20 28 22 2d . k). ("-
1af0: 72 75 6e 2d 6e 61 6d 65 22 20 20 20 20 20 20 20 run-name"
1b00: 20 2e 20 6e 29 0a 20 20 20 20 28 22 2d 6d 6f 64 . n). ("-mod
1b10: 65 2d 70 61 74 74 22 20 20 20 20 20 20 20 2e 20 e-patt" .
1b20: 6f 29 0a 20 20 20 20 28 22 2d 74 65 73 74 2d 70 o). ("-test-p
1b30: 61 74 74 22 20 20 20 20 20 20 20 2e 20 70 29 20 att" . p)
1b40: 20 3b 3b 20 69 64 65 61 2c 20 65 6e 68 61 6e 63 ;; idea, enhanc
1b50: 65 20 6d 61 72 67 73 20 28 22 2d 74 65 73 74 2d e margs ("-test-
1b60: 70 61 74 74 22 20 22 2d 74 65 73 74 70 61 74 74 patt" "-testpatt
1b70: 22 29 20 3d 3e 20 79 69 65 6c 64 73 20 6f 6e 65 ") => yields one
1b80: 20 76 61 6c 75 65 20 69 6e 20 22 2d 74 65 73 74 value in "-test
1b90: 2d 70 61 74 74 22 0a 20 20 20 20 28 22 2d 73 74 -patt". ("-st
1ba0: 61 74 75 73 22 20 20 20 20 20 20 20 20 20 20 2e atus" .
1bb0: 20 73 29 0a 20 20 20 20 28 22 2d 74 61 72 67 65 s). ("-targe
1bc0: 74 22 20 20 20 20 20 20 20 20 20 20 2e 20 74 29 t" . t)
1bd0: 0a 20 20 20 20 28 22 2d 74 61 67 2d 65 78 70 72 . ("-tag-expr
1be0: 22 20 20 20 20 20 20 20 20 2e 20 78 29 0a 20 20 " . x).
1bf0: 20 20 3b 3b 20 6d 69 73 63 0a 20 20 20 20 28 22 ;; misc. ("
1c00: 2d 64 65 62 75 67 22 20 20 20 20 20 20 20 20 20 -debug"
1c10: 20 20 2e 20 23 66 29 20 20 3b 3b 20 66 6f 72 20 . #f) ;; for
1c20: 2a 76 65 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a *verbosity* > 2.
1c30: 20 20 20 20 28 22 2d 6c 6f 61 64 22 20 20 20 20 ("-load"
1c40: 20 20 20 20 20 20 20 20 2e 20 23 66 29 20 20 3b . #f) ;
1c50: 3b 20 6c 6f 61 64 20 61 6e 64 20 65 78 65 63 74 ; load and exect
1c60: 75 74 65 20 61 20 73 63 68 65 6d 65 20 66 69 6c ute a scheme fil
1c70: 65 0a 20 20 20 20 28 22 2d 6c 6f 67 22 20 20 20 e. ("-log"
1c80: 20 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 0a . #f).
1c90: 20 20 20 20 28 22 2d 6d 73 67 22 20 20 20 20 20 ("-msg"
1ca0: 20 20 20 20 20 20 20 20 2e 20 4d 29 0a 20 20 20 . M).
1cb0: 20 28 22 2d 73 74 61 72 74 2d 64 69 72 22 20 20 ("-start-dir"
1cc0: 20 20 20 20 20 2e 20 53 29 0a 20 20 20 20 28 22 . S). ("
1cd0: 2d 73 65 74 2d 76 61 72 73 22 20 20 20 20 20 20 -set-vars"
1ce0: 20 20 2e 20 76 29 0a 20 20 20 20 29 29 0a 28 64 . v). )).(d
1cf0: 65 66 69 6e 65 20 2a 73 77 69 74 63 68 2d 6b 65 efine *switch-ke
1d00: 79 73 2a 0a 20 20 27 28 0a 20 20 20 20 28 22 2d ys*. '(. ("-
1d10: 68 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h"
1d20: 20 2e 20 23 66 29 0a 20 20 20 20 28 22 2d 68 65 . #f). ("-he
1d30: 6c 70 22 20 20 20 20 20 20 20 20 20 20 20 20 2e lp" .
1d40: 20 23 66 29 0a 20 20 20 20 28 22 2d 2d 68 65 6c #f). ("--hel
1d50: 70 22 20 20 20 20 20 20 20 20 20 20 20 2e 20 23 p" . #
1d60: 66 29 0a 20 20 20 20 28 22 2d 6d 61 6e 75 61 6c f). ("-manual
1d70: 22 20 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 " . #f)
1d80: 0a 20 20 20 20 28 22 2d 76 65 72 73 69 6f 6e 22 . ("-version"
1d90: 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 . #f).
1da0: 20 20 20 3b 3b 20 6d 69 73 63 09 20 20 20 20 20 ;; misc.
1db0: 20 20 20 0a 20 20 20 20 28 22 2d 72 65 70 6c 22 . ("-repl"
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 2e 20 23 66 . #f
1dd0: 29 0a 20 20 20 20 28 22 2d 69 6d 6d 65 64 69 61 ). ("-immedia
1de0: 74 65 22 20 20 20 20 20 20 20 2e 20 49 29 0a 20 te" . I).
1df0: 20 20 20 28 22 2d 70 72 65 63 6c 65 61 6e 22 20 ("-preclean"
1e00: 20 20 20 20 20 20 20 2e 20 72 29 0a 20 20 20 20 . r).
1e10: 28 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 20 20 20 ("-rerun-all"
1e20: 20 20 20 20 2e 20 75 29 0a 20 20 20 20 28 22 2d . u). ("-
1e30: 70 72 65 70 65 6e 64 2d 63 6f 6e 74 6f 75 72 22 prepend-contour"
1e40: 20 2e 20 77 29 0a 20 20 20 20 29 29 0a 0a 3b 3b . w). ))..;;
1e50: 20 61 6c 69 73 74 20 74 6f 20 6d 61 70 20 61 63 alist to map ac
1e60: 74 69 6f 6e 73 20 74 6f 20 6f 6c 64 20 6d 65 67 tions to old meg
1e70: 61 74 65 73 74 20 63 6f 6d 6d 61 6e 64 73 0a 28 atest commands.(
1e80: 64 65 66 69 6e 65 20 2a 61 63 74 69 6f 6e 2d 6b define *action-k
1e90: 65 79 73 2a 0a 20 20 27 28 28 72 75 6e 20 20 20 eys*. '((run
1ea0: 20 20 20 20 20 20 2e 20 22 2d 72 75 6e 22 29 0a . "-run").
1eb0: 20 20 20 20 28 73 79 6e 63 20 20 20 20 20 20 20 (sync
1ec0: 20 2e 20 22 22 29 0a 20 20 20 20 28 61 72 63 68 . ""). (arch
1ed0: 69 76 65 20 20 20 20 20 2e 20 22 2d 61 72 63 68 ive . "-arch
1ee0: 69 76 65 22 29 0a 20 20 20 20 28 73 65 74 2d 73 ive"). (set-s
1ef0: 73 20 20 20 20 20 20 2e 20 22 2d 73 65 74 2d 73 s . "-set-s
1f00: 74 61 74 65 2d 73 74 61 74 75 73 22 29 29 29 0a tate-status"))).
1f10: 0a 3b 3b 20 43 61 72 64 20 74 79 70 65 73 3a 0a .;; Card types:.
1f20: 3b 3b 0a 3b 3b 20 41 20 61 63 74 69 6f 6e 0a 3b ;;.;; A action.;
1f30: 3b 20 55 20 75 73 65 72 6e 61 6d 65 20 28 55 6e ; U username (Un
1f40: 69 78 29 0a 3b 3b 20 44 20 74 69 6d 65 73 74 61 ix).;; D timesta
1f50: 6d 70 0a 3b 3b 20 54 20 63 61 72 64 20 74 79 70 mp.;; T card typ
1f60: 65 0a 0a 3b 3b 20 75 74 69 6c 69 74 61 72 69 61 e..;; utilitaria
1f70: 6e 20 61 6c 69 73 74 20 66 6f 72 20 73 74 61 6e n alist for stan
1f80: 64 61 72 64 20 63 61 72 64 73 0a 3b 3b 0a 28 64 dard cards.;;.(d
1f90: 65 66 69 6e 65 20 2a 61 64 64 69 74 69 6f 6e 61 efine *additiona
1fa0: 6c 2d 63 61 72 64 73 2a 0a 20 20 27 28 0a 20 20 l-cards*. '(.
1fb0: 20 20 3b 3b 20 53 74 61 6e 64 61 72 64 20 43 61 ;; Standard Ca
1fc0: 72 64 73 0a 20 20 20 20 28 41 20 20 2e 20 61 63 rds. (A . ac
1fd0: 74 69 6f 6e 20 20 20 20 29 0a 20 20 20 20 28 44 tion ). (D
1fe0: 20 20 2e 20 74 69 6d 65 73 74 61 6d 70 20 29 0a . timestamp ).
1ff0: 20 20 20 20 28 54 20 20 2e 20 63 61 72 64 74 79 (T . cardty
2000: 70 65 20 20 29 0a 20 20 20 20 28 55 20 20 2e 20 pe ). (U .
2010: 75 73 65 72 20 20 20 20 20 20 29 20 3b 3b 20 75 user ) ;; u
2020: 73 65 72 6e 61 6d 65 0a 20 20 20 20 28 5a 20 20 sername. (Z
2030: 2e 20 73 68 61 72 31 73 75 6d 20 20 29 0a 0a 20 . shar1sum )..
2040: 20 20 20 3b 3b 20 45 78 74 72 61 73 0a 20 20 20 ;; Extras.
2050: 20 28 61 20 20 2e 20 72 75 6e 6b 65 79 20 20 20 (a . runkey
2060: 20 29 20 3b 3b 20 6e 65 65 64 65 64 20 66 6f 72 ) ;; needed for
2070: 20 6d 61 74 63 68 69 6e 67 20 75 70 20 70 6b 74 matching up pkt
2080: 73 20 77 69 74 68 20 74 61 72 67 65 74 20 64 65 s with target de
2090: 72 69 76 65 64 20 66 72 6f 6d 20 72 75 6e 6b 65 rived from runke
20a0: 79 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 69 6e 6c y. ))..;; inl
20b0: 73 74 20 69 73 20 61 6e 20 61 6c 74 65 72 6e 61 st is an alterna
20c0: 74 69 76 65 20 69 6e 70 75 74 0a 3b 3b 0a 28 64 tive input.;;.(d
20d0: 65 66 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d 70 61 efine (lookup-pa
20e0: 72 61 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 20 23 ram-by-key key #
20f0: 21 6b 65 79 20 28 69 6e 6c 73 74 20 23 66 29 29 !key (inlst #f))
2100: 0a 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 64 61 . (fold (lambda
2110: 20 28 61 20 72 65 73 29 0a 09 20 20 28 69 66 20 (a res).. (if
2120: 28 65 71 3f 20 28 63 64 72 20 61 29 20 6b 65 79 (eq? (cdr a) key
2130: 29 0a 09 20 20 20 20 20 20 28 63 61 72 20 61 29 ).. (car a)
2140: 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a 09 23 .. res))..#
2150: 66 0a 09 28 6f 72 20 69 6e 6c 73 74 20 2a 61 72 f..(or inlst *ar
2160: 67 2d 6b 65 79 73 2a 29 29 29 0a 0a 28 64 65 66 g-keys*)))..(def
2170: 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d 61 63 74 69 ine (lookup-acti
2180: 6f 6e 2d 62 79 2d 6b 65 79 20 6b 65 79 29 0a 20 on-by-key key).
2190: 20 28 61 6c 69 73 74 2d 72 65 66 20 28 73 74 72 (alist-ref (str
21a0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6b 65 79 29 ing->symbol key)
21b0: 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 73 2a 29 29 *action-keys*))
21c0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
21d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
21e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
21f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 55 ==========.;; U
2210: 20 54 20 49 20 4c 20 53 0a 3b 3b 3d 3d 3d 3d 3d T I L S.;;=====
2220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2260: 3d 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 6d 74 =..;; given a mt
2270: 75 74 69 6c 20 70 61 72 61 6d 2c 20 72 65 74 75 util param, retu
2280: 72 6e 20 74 68 65 20 6f 6c 64 20 6d 65 67 61 74 rn the old megat
2290: 65 73 74 20 65 71 75 69 76 61 6c 65 6e 74 0a 3b est equivalent.;
22a0: 3b 0a 28 64 65 66 69 6e 65 20 28 70 61 72 61 6d ;.(define (param
22b0: 2d 74 72 61 6e 73 6c 61 74 65 20 70 61 72 61 6d -translate param
22c0: 29 0a 20 20 28 6f 72 20 28 61 6c 69 73 74 2d 72 ). (or (alist-r
22d0: 65 66 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 ef (string->symb
22e0: 6f 6c 20 70 61 72 61 6d 29 0a 09 09 20 27 28 28 ol param)... '((
22f0: 2d 74 61 67 2d 65 78 70 72 20 20 2e 20 22 2d 74 -tag-expr . "-t
2300: 61 67 65 78 70 72 22 29 0a 09 09 20 20 20 28 2d agexpr")... (-
2310: 6d 6f 64 65 2d 70 61 74 74 20 2e 20 22 2d 2d 6d mode-patt . "--m
2320: 6f 64 65 70 61 74 74 22 29 0a 09 09 20 20 20 28 odepatt")... (
2330: 2d 72 75 6e 2d 6e 61 6d 65 20 20 2e 20 22 2d 72 -run-name . "-r
2340: 75 6e 6e 61 6d 65 22 29 0a 09 09 20 20 20 28 2d unname")... (-
2350: 74 65 73 74 2d 70 61 74 74 20 2e 20 22 2d 74 65 test-patt . "-te
2360: 73 74 70 61 74 74 22 29 0a 09 09 20 20 20 28 2d stpatt")... (-
2370: 6d 73 67 20 20 20 20 20 20 20 2e 20 22 2d 6d 22 msg . "-m"
2380: 29 29 29 0a 20 20 20 20 20 20 70 61 72 61 6d 29 ))). param)
2390: 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 61 6c 2d )..(define (val-
23a0: 3e 61 6c 69 73 74 20 76 61 6c 29 0a 20 20 28 6c >alist val). (l
23b0: 65 74 20 28 28 76 61 6c 2d 6c 69 73 74 20 28 73 et ((val-list (s
23c0: 74 72 69 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c tring-split-fiel
23d0: 64 73 20 22 3b 5c 5c 73 2a 22 20 76 61 6c 20 23 ds ";\\s*" val #
23e0: 3a 69 6e 66 69 78 29 29 29 0a 20 20 20 20 28 69 :infix))). (i
23f0: 66 20 76 61 6c 2d 6c 69 73 74 0a 09 28 6d 61 70 f val-list..(map
2400: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 (lambda (x)..
2410: 20 20 20 20 20 28 6c 65 74 20 28 28 66 20 28 73 (let ((f (s
2420: 74 72 69 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c tring-split-fiel
2430: 64 73 20 22 5c 5c 73 2a 3d 5c 5c 73 2a 22 20 78 ds "\\s*=\\s*" x
2440: 20 23 3a 69 6e 66 69 78 29 29 29 0a 09 09 20 28 #:infix)))... (
2450: 63 61 73 65 20 28 6c 65 6e 67 74 68 20 66 29 0a case (length f).
2460: 09 09 20 20 20 28 28 30 29 20 60 28 2c 23 66 29 .. ((0) `(,#f)
2470: 29 20 20 3b 3b 20 6e 75 6c 6c 20 73 74 72 69 6e ) ;; null strin
2480: 67 20 63 61 73 65 0a 09 09 20 20 20 28 28 31 29 g case... ((1)
2490: 20 60 28 2c 28 73 74 72 69 6e 67 2d 3e 73 79 6d `(,(string->sym
24a0: 62 6f 6c 20 28 63 61 72 20 66 29 29 29 29 0a 09 bol (car f))))..
24b0: 09 20 20 20 28 28 32 29 20 60 28 2c 28 73 74 72 . ((2) `(,(str
24c0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63 61 72 ing->symbol (car
24d0: 20 66 29 29 20 2e 20 2c 28 63 61 64 72 20 66 29 f)) . ,(cadr f)
24e0: 29 29 0a 09 09 20 20 20 28 65 6c 73 65 20 66 29 ))... (else f)
24f0: 29 29 29 0a 09 20 20 20 20 20 76 61 6c 2d 6c 69 ))).. val-li
2500: 73 74 29 0a 09 27 28 29 29 29 29 0a 0a 28 64 65 st)..'())))..(de
2510: 66 69 6e 65 20 28 70 75 73 68 2d 72 75 6e 2d 73 fine (push-run-s
2520: 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 pec torun contou
2530: 72 20 72 75 6e 6b 65 79 20 73 70 65 63 29 0a 20 r runkey spec).
2540: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
2550: 6e 2d 76 61 72 2d 73 65 74 21 20 74 6f 72 75 6e n-var-set! torun
2560: 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a contour runkey.
2570: 09 09 09 20 20 20 20 28 63 6f 6e 73 20 73 70 65 ... (cons spe
2580: 63 0a 09 09 09 09 20 20 28 6f 72 20 28 63 6f 6e c..... (or (con
2590: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 6f 72 75 figf:lookup toru
25a0: 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 n contour runkey
25b0: 29 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 29 )..... '())
25c0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 6f )))..(define (fo
25d0: 73 73 69 6c 3a 63 6c 6f 6e 65 2d 6f 72 2d 73 79 ssil:clone-or-sy
25e0: 6e 63 20 75 72 6c 20 6e 61 6d 65 20 64 65 73 74 nc url name dest
25f0: 2d 64 69 72 29 0a 20 20 28 6c 65 74 20 28 28 74 -dir). (let ((t
2600: 61 72 67 2d 66 69 6c 65 20 28 63 6f 6e 63 20 64 arg-file (conc d
2610: 65 73 74 2d 64 69 72 20 22 2f 22 20 6e 61 6d 65 est-dir "/" name
2620: 29 29 29 20 3b 3b 20 64 6f 20 6e 6f 74 20 66 6f ))) ;; do not fo
2630: 72 63 65 20 75 73 61 67 65 20 6f 66 20 2e 66 6f rce usage of .fo
2640: 73 73 69 6c 20 65 78 74 65 6e 73 69 6f 6e 0a 20 ssil extension.
2650: 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 (handle-excep
2660: 74 69 6f 6e 73 0a 09 65 78 6e 0a 09 28 70 72 69 tions..exn..(pri
2670: 6e 74 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 nt "ERROR: faile
2680: 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 d to create dire
2690: 63 74 6f 72 79 20 22 20 64 65 73 74 2d 64 69 72 ctory " dest-dir
26a0: 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 " message: " ((
26b0: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
26c0: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
26d0: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
26e0: 0a 20 20 20 20 20 20 28 63 72 65 61 74 65 2d 64 . (create-d
26f0: 69 72 65 63 74 6f 72 79 20 64 65 73 74 2d 64 69 irectory dest-di
2700: 72 20 23 74 29 29 0a 20 20 20 20 28 68 61 6e 64 r #t)). (hand
2710: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 65 le-exceptions..e
2720: 78 6e 0a 09 28 70 72 69 6e 74 20 22 45 52 52 4f xn..(print "ERRO
2730: 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 63 6c 6f R: failed to clo
2740: 6e 65 20 6f 72 20 73 79 6e 63 20 31 6f 73 73 69 ne or sync 1ossi
2750: 6c 20 22 20 75 72 6c 20 22 20 6d 65 73 73 61 67 l " url " messag
2760: 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e e: " ((condition
2770: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
2780: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
2790: 29 20 65 78 6e 29 29 0a 20 20 20 20 20 20 28 69 ) exn)). (i
27a0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
27b0: 74 61 72 67 2d 66 69 6c 65 29 0a 09 20 20 28 73 targ-file).. (s
27c0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 66 6f 73 ystem (conc "fos
27d0: 73 69 6c 20 70 75 6c 6c 20 2d 2d 6f 6e 63 65 20 sil pull --once
27e0: 22 20 75 72 6c 20 22 20 2d 52 20 22 20 74 61 72 " url " -R " tar
27f0: 67 2d 66 69 6c 65 29 29 0a 09 20 20 28 73 79 73 g-file)).. (sys
2800: 74 65 6d 20 28 63 6f 6e 63 20 22 66 6f 73 73 69 tem (conc "fossi
2810: 6c 20 63 6c 6f 6e 65 20 22 20 75 72 6c 20 22 20 l clone " url "
2820: 22 20 74 61 72 67 2d 66 69 6c 65 29 29 0a 09 20 " targ-file))..
2830: 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))))..(define (
2840: 66 6f 73 73 69 6c 3a 6c 61 73 74 2d 63 68 61 6e fossil:last-chan
2850: 67 65 2d 6e 6f 64 65 2d 61 6e 64 2d 74 69 6d 65 ge-node-and-time
2860: 20 66 6f 73 73 69 6c 73 2d 64 69 72 20 66 6f 73 fossils-dir fos
2870: 73 69 6c 2d 6e 61 6d 65 20 62 72 61 6e 63 68 29 sil-name branch)
2880: 0a 20 20 28 6c 65 74 2a 20 28 28 66 6f 73 73 69 . (let* ((fossi
2890: 6c 2d 66 69 6c 65 20 20 20 28 63 6f 6e 63 20 66 l-file (conc f
28a0: 6f 73 73 69 6c 73 2d 64 69 72 20 22 2f 22 20 66 ossils-dir "/" f
28b0: 6f 73 73 69 6c 2d 6e 61 6d 65 29 29 0a 09 20 28 ossil-name)).. (
28c0: 74 69 6d 65 6c 69 6e 65 2d 70 6f 72 74 20 28 69 timeline-port (i
28d0: 66 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 f (file-read-acc
28e0: 65 73 73 3f 20 66 6f 73 73 69 6c 2d 66 69 6c 65 ess? fossil-file
28f0: 29 0a 09 09 09 20 20 20 20 28 68 61 6e 64 6c 65 ).... (handle
2900: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 -exceptions.....
2910: 65 78 6e 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 exn.....(begin..
2920: 09 09 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 ... (print "ERR
2930: 4f 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 67 65 OR: failed to ge
2940: 74 20 74 69 6d 65 6c 69 6e 65 20 66 72 6f 6d 20 t timeline from
2950: 22 20 66 6f 73 73 69 6c 2d 66 69 6c 65 20 22 20 " fossil-file "
2960: 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e message: " ((con
2970: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
2980: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
2990: 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 essage) exn))...
29a0: 09 09 20 20 23 66 29 0a 09 09 09 20 20 20 20 20 .. #f)....
29b0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 (open-input-pip
29c0: 65 20 28 63 6f 6e 63 20 22 66 6f 73 73 69 6c 20 e (conc "fossil
29d0: 74 69 6d 65 6c 69 6e 65 20 2d 74 20 63 69 20 2d timeline -t ci -
29e0: 57 20 30 20 2d 6e 20 30 20 2d 52 20 22 20 66 6f W 0 -n 0 -R " fo
29f0: 73 73 69 6c 2d 66 69 6c 65 29 29 29 0a 09 09 09 ssil-file)))....
2a00: 20 20 20 20 23 66 29 29 0a 09 20 28 67 65 74 2d #f)).. (get-
2a10: 6c 69 6e 65 20 20 20 20 20 20 28 6c 61 6d 62 64 line (lambd
2a20: 61 20 28 29 0a 09 09 09 20 20 28 68 61 6e 64 6c a ().... (handl
2a30: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 e-exceptions....
2a40: 20 20 20 20 20 20 65 78 6e 0a 09 09 09 20 20 20 exn....
2a50: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 28 70 (begin.....(p
2a60: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 66 61 69 rint "ERROR: fai
2a70: 6c 65 64 20 74 6f 20 72 65 61 64 20 66 72 6f 6d led to read from
2a80: 20 66 69 6c 65 20 22 20 66 6f 73 73 69 6c 2d 66 file " fossil-f
2a90: 69 6c 65 20 22 20 6d 65 73 73 61 67 65 3a 20 22 ile " message: "
2aa0: 20 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 ((condition-pr
2ab0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
2ac0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
2ad0: 78 6e 29 29 0a 09 09 09 09 23 66 29 0a 09 09 09 xn)).....#f)....
2ae0: 20 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 20 74 (read-line t
2af0: 69 6d 65 6c 69 6e 65 2d 70 6f 72 74 29 29 29 29 imeline-port))))
2b00: 0a 09 20 28 64 61 74 65 2d 72 78 20 20 20 20 20 .. (date-rx
2b10: 20 20 28 72 65 67 65 78 70 20 22 5e 3d 3d 3d 20 (regexp "^===
2b20: 28 5c 5c 53 2b 29 20 3d 3d 3d 24 22 29 29 0a 09 (\\S+) ===$"))..
2b30: 20 28 6e 6f 64 65 2d 72 78 20 20 20 20 20 20 20 (node-rx
2b40: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 (regexp "^(\\S+)
2b50: 20 5c 5c 5b 28 5c 5c 53 2b 29 5c 5c 5d 2e 2a 5c \\[(\\S+)\\].*\
2b60: 5c 28 2e 2a 74 61 67 73 3a 5c 5c 73 2b 28 5b 5e \(.*tags:\\s+([^
2b70: 5c 5c 29 5d 2b 29 5c 5c 29 24 22 29 29 29 0a 20 \\)]+)\\)$"))).
2b80: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 (let loop ((i
2b90: 6e 6c 20 28 67 65 74 2d 6c 69 6e 65 29 29 0a 09 nl (get-line))..
2ba0: 20 20 20 20 20 20 20 28 64 61 74 65 20 23 66 29 (date #f)
2bb0: 0a 09 20 20 20 20 20 20 20 28 6e 6f 64 65 20 23 .. (node #
2bc0: 66 29 0a 09 20 20 20 20 20 20 20 28 74 69 6d 65 f).. (time
2bd0: 20 23 66 29 29 0a 20 20 20 20 20 20 28 63 6f 6e #f)). (con
2be0: 64 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 64 d. ((and d
2bf0: 61 74 65 20 74 69 6d 65 20 6e 6f 64 65 29 20 3b ate time node) ;
2c00: 3b 20 68 61 76 65 20 61 6c 6c 2c 20 72 65 74 75 ; have all, retu
2c10: 72 6e 20 27 65 6d 0a 09 28 63 6c 6f 73 65 2d 69 rn 'em..(close-i
2c20: 6e 70 75 74 2d 70 6f 72 74 20 74 69 6d 65 6c 69 nput-port timeli
2c30: 6e 65 2d 70 6f 72 74 29 0a 09 28 76 61 6c 75 65 ne-port)..(value
2c40: 73 20 28 63 6f 6d 6d 6f 6e 3a 64 61 74 65 2d 74 s (common:date-t
2c50: 69 6d 65 2d 3e 73 65 63 6f 6e 64 73 20 28 63 6f ime->seconds (co
2c60: 6e 63 20 64 61 74 65 20 22 20 22 20 74 69 6d 65 nc date " " time
2c70: 29 29 20 6e 6f 64 65 29 29 0a 20 20 20 20 20 20 )) node)).
2c80: 20 28 28 61 6e 64 20 69 6e 6c 20 28 6e 6f 74 20 ((and inl (not
2c90: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c (eof-object? inl
2ca0: 29 29 29 20 3b 3b 20 68 61 76 65 20 61 20 6c 69 ))) ;; have a li
2cb0: 6e 65 20 74 6f 20 70 72 6f 63 65 73 73 0a 09 28 ne to process..(
2cc0: 72 65 67 65 78 2d 63 61 73 65 20 69 6e 6c 0a 09 regex-case inl..
2cd0: 20 20 28 64 61 74 65 2d 72 78 20 28 20 5f 20 6e (date-rx ( _ n
2ce0: 65 77 64 61 74 65 20 29 20 28 6c 6f 6f 70 20 28 ewdate ) (loop (
2cf0: 67 65 74 2d 6c 69 6e 65 29 20 6e 65 77 64 61 74 get-line) newdat
2d00: 65 20 6e 6f 64 65 20 74 69 6d 65 29 29 0a 09 20 e node time))..
2d10: 20 3b 3b 20 32 32 3a 34 37 3a 34 38 20 5b 61 30 ;; 22:47:48 [a0
2d20: 32 34 64 39 65 36 30 66 5d 20 41 64 64 65 64 20 24d9e60f] Added
2d30: 2a 75 73 65 72 2d 68 61 73 68 2d 64 61 74 61 2a *user-hash-data*
2d40: 20 2d 20 61 20 67 6c 6f 62 61 6c 20 74 68 61 74 - a global that
2d50: 20 63 61 6e 20 62 65 20 75 73 65 64 20 69 6e 20 can be used in
2d60: 2d 72 65 70 6c 20 61 6e 64 20 23 7b 73 63 68 65 -repl and #{sche
2d70: 6d 65 20 2e 2e 2e 7d 20 63 61 6c 6c 73 20 62 79 me ...} calls by
2d80: 20 74 68 65 20 65 6e 64 20 75 73 65 72 20 28 75 the end user (u
2d90: 73 65 72 3a 20 6d 61 74 74 20 74 61 67 73 3a 20 ser: matt tags:
2da0: 76 31 2e 36 33 29 0a 09 20 20 28 6e 6f 64 65 2d v1.63).. (node-
2db0: 72 78 20 28 20 5f 20 6e 65 77 74 69 6d 65 20 6e rx ( _ newtime n
2dc0: 65 77 6e 6f 64 65 20 61 6c 6c 74 61 67 73 20 29 ewnode alltags )
2dd0: 0a 09 09 20 20 20 28 6c 65 74 20 28 28 74 61 67 ... (let ((tag
2de0: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d s (string-split-
2df0: 66 69 65 6c 64 73 20 22 2c 5c 5c 73 2a 22 20 61 fields ",\\s*" a
2e00: 6c 6c 74 61 67 73 20 23 3a 69 6e 66 69 78 29 29 lltags #:infix))
2e10: 29 0a 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 )... (print
2e20: 22 74 61 67 73 3a 20 22 20 74 61 67 73 29 0a 09 "tags: " tags)..
2e30: 09 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 . (if (membe
2e40: 72 20 62 72 61 6e 63 68 20 74 61 67 73 29 0a 09 r branch tags)..
2e50: 09 09 20 28 6c 6f 6f 70 20 28 67 65 74 2d 6c 69 .. (loop (get-li
2e60: 6e 65 29 20 64 61 74 65 20 6e 65 77 6e 6f 64 65 ne) date newnode
2e70: 20 6e 65 77 74 69 6d 65 29 0a 09 09 09 20 28 6c newtime).... (l
2e80: 6f 6f 70 20 28 67 65 74 2d 6c 69 6e 65 29 20 64 oop (get-line) d
2e90: 61 74 65 20 6e 6f 64 65 20 74 69 6d 65 29 29 29 ate node time)))
2ea0: 29 0a 09 20 20 28 65 6c 73 65 20 3b 3b 20 68 61 ).. (else ;; ha
2eb0: 76 65 20 73 6f 6d 65 20 75 6e 72 65 63 6f 67 6e ve some unrecogn
2ec0: 69 73 65 64 20 6a 75 6e 6b 3f 20 73 70 69 74 20 ised junk? spit
2ed0: 6f 75 74 20 65 72 72 6f 72 20 6d 65 73 73 61 67 out error messag
2ee0: 65 0a 09 20 20 20 28 70 72 69 6e 74 20 22 45 52 e.. (print "ER
2ef0: 52 4f 52 3a 20 66 6f 73 73 69 6c 20 74 69 6d 65 ROR: fossil time
2f00: 6c 69 6e 65 20 72 65 74 75 72 6e 65 64 20 75 6e line returned un
2f10: 72 65 63 6f 67 6e 69 73 61 62 6c 65 20 6a 75 6e recognisable jun
2f20: 6b 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a k \"" inl "\"").
2f30: 09 20 20 20 28 6c 6f 6f 70 20 28 67 65 74 2d 6c . (loop (get-l
2f40: 69 6e 65 29 20 64 61 74 65 20 6e 6f 64 65 20 74 ine) date node t
2f50: 69 6d 65 29 29 29 29 0a 20 20 20 20 20 20 20 28 ime)))). (
2f60: 65 6c 73 65 20 3b 3b 20 6e 6f 20 6d 6f 72 65 20 else ;; no more
2f70: 64 61 74 61 74 20 61 6e 64 20 6c 61 73 74 20 6e datat and last n
2f80: 6f 64 65 20 6f 6e 20 62 72 61 6e 63 68 20 6e 6f ode on branch no
2f90: 74 20 66 6f 75 6e 64 0a 09 28 63 6c 6f 73 65 2d t found..(close-
2fa0: 69 6e 70 75 74 2d 70 6f 72 74 20 74 69 6d 65 6c input-port timel
2fb0: 69 6e 65 2d 70 6f 72 74 29 0a 09 28 76 61 6c 75 ine-port)..(valu
2fc0: 65 73 20 20 28 63 6f 6d 6d 6f 6e 3a 64 61 74 65 es (common:date
2fd0: 2d 74 69 6d 65 2d 3e 73 65 63 6f 6e 64 73 20 28 -time->seconds (
2fe0: 63 6f 6e 63 20 64 61 74 65 20 22 20 22 20 74 69 conc date " " ti
2ff0: 6d 65 29 29 20 6e 6f 64 65 29 29 29 29 29 29 0a me)) node)))))).
3000: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 4c 4f =========.;; GLO
3050: 42 41 4c 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d BALS.;;=========
3060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
30a0: 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 ; process args.(
30b0: 64 65 66 69 6e 65 20 2a 61 63 74 69 6f 6e 2a 20 define *action*
30c0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 (if (> (length (
30d0: 61 72 67 76 29 29 20 31 29 0a 09 09 20 20 20 20 argv)) 1)...
30e0: 20 28 63 61 64 72 20 28 61 72 67 76 29 29 0a 09 (cadr (argv))..
30f0: 09 20 20 20 20 20 23 66 29 29 0a 28 64 65 66 69 . #f)).(defi
3100: 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 ne remargs (args
3110: 3a 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 69 :get-args ... (i
3120: 66 20 2a 61 63 74 69 6f 6e 2a 20 28 63 64 72 20 f *action* (cdr
3130: 28 61 72 67 76 29 29 20 28 61 72 67 76 29 29 20 (argv)) (argv))
3140: 3b 3b 20 61 72 67 73 3a 67 65 74 2d 61 72 67 73 ;; args:get-args
3150: 20 64 75 6d 70 73 20 66 69 72 73 74 20 69 6e 20 dumps first in
3160: 61 72 67 76 20 6c 69 73 74 20 28 74 68 65 20 70 argv list (the p
3170: 72 6f 67 72 61 6d 20 6e 61 6d 65 29 0a 09 09 20 rogram name)...
3180: 28 6d 61 70 20 63 61 72 20 2a 61 72 67 2d 6b 65 (map car *arg-ke
3190: 79 73 2a 29 0a 09 09 20 28 6d 61 70 20 63 61 72 ys*)... (map car
31a0: 20 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a 29 0a *switch-keys*).
31b0: 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 .. args:arg-hash
31c0: 0a 09 09 20 30 29 29 0a 0a 28 69 66 20 28 6f 72 ... 0))..(if (or
31d0: 20 28 6d 65 6d 62 65 72 20 2a 61 63 74 69 6f 6e (member *action
31e0: 2a 20 27 28 22 2d 68 22 20 22 2d 68 65 6c 70 22 * '("-h" "-help"
31f0: 20 22 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 "help" "--help"
3200: 29 29 0a 09 28 61 72 67 73 3a 61 6e 79 2d 64 65 ))..(args:any-de
3210: 66 69 6e 65 64 3f 20 22 2d 68 22 20 22 2d 68 65 fined? "-h" "-he
3220: 6c 70 22 20 22 2d 2d 68 65 6c 70 22 29 29 0a 20 lp" "--help")).
3230: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
3240: 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 (print help).
3250: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 0a 3b (exit 1)))..;
3260: 3b 20 28 70 72 69 6e 74 20 22 2a 61 63 74 69 6f ; (print "*actio
3270: 6e 2a 3a 20 22 20 2a 61 63 74 69 6f 6e 2a 29 0a n*: " *action*).
3280: 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 ;; (let-values (
3290: 28 28 75 75 69 64 20 70 6b 74 29 0a 3b 3b 20 09 ((uuid pkt).;; .
32a0: 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c (command-l
32b0: 69 6e 65 2d 3e 70 6b 74 20 23 66 20 61 72 67 73 ine->pkt #f args
32c0: 3a 61 72 67 2d 68 61 73 68 29 29 29 0a 3b 3b 20 :arg-hash))).;;
32d0: 20 20 28 70 72 69 6e 74 20 70 6b 74 29 29 0a 0a (print pkt))..
32e0: 3b 3b 20 41 64 64 20 61 72 67 73 20 74 68 61 74 ;; Add args that
32f0: 20 75 73 65 20 72 65 6d 61 72 67 73 20 68 65 72 use remargs her
3300: 65 0a 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 6e e.;;.(if (and (n
3310: 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 ot (null? remarg
3320: 73 29 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a 09 s)).. (not (or..
3330: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
3340: 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 29 -arg "-runstep")
3350: 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 .. (args:g
3360: 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 22 et-arg "-envcap"
3370: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
3380: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 6c get-arg "-envdel
3390: 74 61 22 29 0a 09 20 20 20 20 20 20 20 28 6d 65 ta").. (me
33a0: 6d 62 65 72 20 2a 61 63 74 69 6f 6e 2a 20 27 28 mber *action* '(
33b0: 22 64 62 22 29 29 20 20 20 3b 3b 20 76 65 72 79 "db")) ;; very
33c0: 20 6c 6f 6f 73 65 20 63 68 65 63 6b 73 20 6f 6e loose checks on
33d0: 20 64 62 2e 0a 09 20 20 20 20 20 20 20 28 65 71 db... (eq
33e0: 75 61 6c 3f 20 2a 61 63 74 69 6f 6e 2a 20 22 73 ual? *action* "s
33f0: 68 6f 77 22 29 20 20 20 20 3b 3b 20 6a 75 73 74 how") ;; just
3400: 20 6b 65 65 70 20 67 6f 69 6e 67 20 69 66 20 6c keep going if l
3410: 69 73 74 0a 09 20 20 20 20 20 20 20 29 29 29 0a ist.. ))).
3420: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3430: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
3440: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 72 t-log-port* "Unr
3450: 65 63 6f 67 6e 69 73 65 64 20 61 72 67 75 6d 65 ecognised argume
3460: 6e 74 73 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 nts: " (string-i
3470: 6e 74 65 72 73 70 65 72 73 65 20 28 69 66 20 28 ntersperse (if (
3480: 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 29 20 72 list? remargs) r
3490: 65 6d 61 72 67 73 20 28 61 72 67 76 29 29 20 20 emargs (argv))
34a0: 22 20 22 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 " ")))..(if (or
34b0: 28 61 72 67 73 3a 61 6e 79 3f 20 22 2d 68 22 20 (args:any? "-h"
34c0: 22 68 65 6c 70 22 20 22 2d 68 65 6c 70 22 20 22 "help" "-help" "
34d0: 2d 2d 68 65 6c 70 22 29 0a 09 28 6d 65 6d 62 65 --help")..(membe
34e0: 72 20 2a 61 63 74 69 6f 6e 2a 20 27 28 22 2d 68 r *action* '("-h
34f0: 22 20 22 2d 68 65 6c 70 22 20 22 2d 2d 68 65 6c " "-help" "--hel
3500: 70 22 20 22 68 65 6c 70 22 29 29 29 0a 20 20 20 p" "help"))).
3510: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
3520: 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 rint help).
3530: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 3b 3b 3d (exit 1)))..;;=
3540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3580: 3d 3d 3d 3d 3d 0a 3b 3b 20 70 6b 74 73 0a 3b 3b =====.;; pkts.;;
3590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35d0: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
35e0: 28 77 69 74 68 2d 71 75 65 75 65 2d 64 62 20 6d (with-queue-db m
35f0: 74 63 6f 6e 66 20 70 72 6f 63 29 0a 20 20 28 6c tconf proc). (l
3600: 65 74 2a 20 28 28 70 6b 74 73 64 69 72 73 20 28 et* ((pktsdirs (
3610: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d configf:lookup m
3620: 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 20 22 tconf "setup" "
3630: 70 6b 74 73 64 69 72 73 22 29 29 0a 09 20 28 70 pktsdirs")).. (p
3640: 6b 74 73 64 69 72 20 20 28 69 66 20 70 6b 74 73 ktsdir (if pkts
3650: 64 69 72 73 20 28 63 61 72 20 28 73 74 72 69 6e dirs (car (strin
3660: 67 2d 73 70 6c 69 74 20 70 6b 74 73 64 69 72 73 g-split pktsdirs
3670: 20 22 20 22 29 29 20 23 66 29 29 0a 09 20 28 74 " ")) #f)).. (t
3680: 6f 70 70 61 74 68 20 20 28 63 6f 6e 66 69 67 66 oppath (configf
3690: 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 :lookup mtconf "
36a0: 64 79 6e 64 61 74 22 20 22 74 6f 70 70 61 74 68 dyndat" "toppath
36b0: 22 29 29 0a 09 20 28 70 64 62 70 61 74 68 20 20 ")).. (pdbpath
36c0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
36d0: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 kup mtconf "setu
36e0: 70 22 20 20 22 70 64 62 70 61 74 68 22 29 20 70 p" "pdbpath") p
36f0: 6b 74 73 64 69 72 29 29 29 0a 20 20 20 20 28 69 ktsdir))). (i
3700: 66 20 28 6e 6f 74 20 28 61 6e 64 20 20 70 6b 74 f (not (and pkt
3710: 73 64 69 72 20 74 6f 70 70 61 74 68 20 70 64 62 sdir toppath pdb
3720: 70 61 74 68 29 29 0a 09 28 62 65 67 69 6e 0a 09 path))..(begin..
3730: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
3740: 20 73 65 74 74 69 6e 67 73 20 61 72 65 20 6d 69 settings are mi
3750: 73 73 69 6e 67 20 69 6e 20 79 6f 75 72 20 6d 65 ssing in your me
3760: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 6f gatest.config fo
3770: 72 20 61 72 65 61 20 6d 61 6e 61 67 65 6d 65 6e r area managemen
3780: 74 2e 22 29 0a 09 20 20 28 70 72 69 6e 74 20 22 t.").. (print "
3790: 20 20 79 6f 75 20 6e 65 65 64 20 74 6f 20 68 61 you need to ha
37a0: 76 65 20 70 6b 74 73 64 69 72 20 69 6e 20 74 68 ve pktsdir in th
37b0: 65 20 5b 73 65 74 75 70 5d 20 73 65 63 74 69 6f e [setup] sectio
37c0: 6e 2e 22 29 29 0a 09 28 6c 65 74 2a 20 28 28 70 n."))..(let* ((p
37d0: 64 62 20 20 28 6f 70 65 6e 2d 71 75 65 75 65 2d db (open-queue-
37e0: 64 62 20 70 64 62 70 61 74 68 20 22 70 6b 74 73 db pdbpath "pkts
37f0: 2e 64 62 22 0a 09 09 09 09 20 20 20 20 73 63 68 .db"..... sch
3800: 65 6d 61 3a 20 27 28 22 43 52 45 41 54 45 20 54 ema: '("CREATE T
3810: 41 42 4c 45 20 67 72 6f 75 70 73 20 28 69 64 20 ABLE groups (id
3820: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
3830: 4b 45 59 2c 67 72 6f 75 70 6e 61 6d 65 20 54 45 KEY,groupname TE
3840: 58 54 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 67 XT, CONSTRAINT g
3850: 72 6f 75 70 5f 63 6f 6e 73 74 72 61 69 6e 74 20 roup_constraint
3860: 55 4e 49 51 55 45 20 28 67 72 6f 75 70 6e 61 6d UNIQUE (groupnam
3870: 65 29 29 3b 22 29 29 29 0a 09 20 20 20 20 20 20 e));")))..
3880: 20 28 72 65 73 20 20 28 70 72 6f 63 20 70 6b 74 (res (proc pkt
3890: 73 64 69 72 73 20 70 6b 74 73 64 69 72 20 70 64 sdirs pktsdir pd
38a0: 62 29 29 29 0a 09 20 20 28 64 62 69 3a 63 6c 6f b))).. (dbi:clo
38b0: 73 65 20 70 64 62 29 0a 09 20 20 72 65 73 0a 09 se pdb).. res..
38c0: 20 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))..(define
38d0: 28 6c 6f 61 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 (load-pkts-to-db
38e0: 20 6d 74 63 6f 6e 66 29 0a 20 20 28 77 69 74 68 mtconf). (with
38f0: 2d 71 75 65 75 65 2d 64 62 0a 20 20 20 6d 74 63 -queue-db. mtc
3900: 6f 6e 66 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 onf. (lambda (
3910: 70 6b 74 73 64 69 72 73 20 70 6b 74 73 64 69 72 pktsdirs pktsdir
3920: 20 70 64 62 29 0a 20 20 20 20 20 28 66 6f 72 2d pdb). (for-
3930: 65 61 63 68 0a 20 20 20 20 20 20 28 6c 61 6d 62 each. (lamb
3940: 64 61 20 28 70 6b 74 73 64 69 72 29 20 3b 3b 20 da (pktsdir) ;;
3950: 6c 6f 6f 6b 20 61 74 20 61 6c 6c 0a 09 28 69 66 look at all..(if
3960: 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 (and (file-exis
3970: 74 73 3f 20 70 6b 74 73 64 69 72 29 0a 09 09 20 ts? pktsdir)...
3980: 28 64 69 72 65 63 74 6f 72 79 3f 20 70 6b 74 73 (directory? pkts
3990: 64 69 72 29 0a 09 09 20 28 66 69 6c 65 2d 72 65 dir)... (file-re
39a0: 61 64 2d 61 63 63 65 73 73 3f 20 70 6b 74 73 64 ad-access? pktsd
39b0: 69 72 29 29 0a 09 20 20 20 20 28 6c 65 74 20 28 ir)).. (let (
39c0: 28 70 6b 74 73 20 28 67 6c 6f 62 20 28 63 6f 6e (pkts (glob (con
39d0: 63 20 70 6b 74 73 64 69 72 20 22 2f 2a 2e 70 6b c pktsdir "/*.pk
39e0: 74 22 29 29 29 29 0a 09 20 20 20 20 20 20 28 66 t")))).. (f
39f0: 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 20 20 20 or-each..
3a00: 28 6c 61 6d 62 64 61 20 28 70 6b 74 29 0a 09 09 (lambda (pkt)...
3a10: 20 28 6c 65 74 2a 20 28 28 75 75 69 64 20 20 20 (let* ((uuid
3a20: 20 28 63 61 64 72 20 28 73 74 72 69 6e 67 2d 6d (cadr (string-m
3a30: 61 74 63 68 20 22 2e 2a 2f 28 5b 30 2d 39 61 2d atch ".*/([0-9a-
3a40: 66 5d 2b 29 2e 70 6b 74 22 20 70 6b 74 29 29 29 f]+).pkt" pkt)))
3a50: 0a 09 09 09 28 65 78 69 73 74 73 20 20 28 6c 6f ....(exists (lo
3a60: 6f 6b 75 70 2d 62 79 2d 75 75 69 64 20 70 64 62 okup-by-uuid pdb
3a70: 20 75 75 69 64 20 23 66 29 29 29 0a 09 09 20 20 uuid #f)))...
3a80: 20 28 69 66 20 28 6e 6f 74 20 65 78 69 73 74 73 (if (not exists
3a90: 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a )... (let*
3aa0: 20 28 28 70 6b 74 64 61 74 20 28 73 74 72 69 6e ((pktdat (strin
3ab0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 0a 09 09 g-intersperse...
3ac0: 09 09 20 20 20 20 20 20 20 28 77 69 74 68 2d 69 .. (with-i
3ad0: 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 70 nput-from-file p
3ae0: 6b 74 20 72 65 61 64 2d 6c 69 6e 65 73 29 0a 09 kt read-lines)..
3af0: 09 09 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 ... "\n"))
3b00: 0a 09 09 09 20 20 20 20 20 20 28 61 70 6b 74 20 .... (apkt
3b10: 20 20 28 70 6b 74 2d 3e 61 6c 69 73 74 20 70 6b (pkt->alist pk
3b20: 74 64 61 74 29 29 0a 09 09 09 20 20 20 20 20 20 tdat))....
3b30: 28 70 74 79 70 65 20 20 28 61 6c 69 73 74 2d 72 (ptype (alist-r
3b40: 65 66 20 27 54 20 61 70 6b 74 29 29 0a 09 09 09 ef 'T apkt))....
3b50: 20 20 20 20 20 20 28 70 61 72 65 6e 74 20 28 61 (parent (a
3b60: 6c 69 73 74 2d 72 65 66 20 27 50 20 61 70 6b 74 list-ref 'P apkt
3b70: 29 29 29 0a 09 09 09 20 28 61 64 64 2d 74 6f 2d ))).... (add-to-
3b80: 71 75 65 75 65 20 70 64 62 20 70 6b 74 64 61 74 queue pdb pktdat
3b90: 20 75 75 69 64 20 28 6f 72 20 70 74 79 70 65 20 uuid (or ptype
3ba0: 27 63 6d 64 29 20 70 61 72 65 6e 74 20 30 29 0a 'cmd) parent 0).
3bb0: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
3bc0: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
3bd0: 70 6f 72 74 2a 20 22 41 64 64 65 64 20 22 20 75 port* "Added " u
3be0: 75 69 64 20 22 20 6f 66 20 74 79 70 65 20 22 20 uid " of type "
3bf0: 70 74 79 70 65 20 22 20 74 6f 20 71 75 65 75 65 ptype " to queue
3c00: 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 64 65 "))... (de
3c10: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
3c20: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3c30: 70 6b 74 3a 20 22 20 75 75 69 64 20 22 20 65 78 pkt: " uuid " ex
3c40: 69 73 74 73 2c 20 73 6b 69 70 70 69 6e 67 2e 2e ists, skipping..
3c50: 2e 22 29 0a 09 09 20 20 20 20 20 20 20 29 29 29 .")... )))
3c60: 0a 09 20 20 20 20 20 20 20 70 6b 74 73 29 29 29 .. pkts)))
3c70: 29 0a 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d ). (string-
3c80: 73 70 6c 69 74 20 70 6b 74 73 64 69 72 73 29 29 split pktsdirs))
3c90: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 )))..(define (ge
3ca0: 74 2d 70 6b 74 2d 61 6c 69 73 74 73 20 70 6b 74 t-pkt-alists pkt
3cb0: 73 29 0a 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 s). (map (lambd
3cc0: 61 20 28 78 29 0a 09 20 28 61 6c 69 73 74 2d 72 a (x).. (alist-r
3cd0: 65 66 20 27 61 70 6b 74 20 78 29 29 20 3b 3b 20 ef 'apkt x)) ;;
3ce0: 27 70 6b 74 61 20 70 75 6c 6c 73 20 6f 75 74 20 'pkta pulls out
3cf0: 74 68 65 20 61 6c 69 73 74 20 66 72 6f 6d 20 74 the alist from t
3d00: 68 65 20 72 65 61 64 20 70 6b 74 0a 20 20 20 20 he read pkt.
3d10: 20 20 20 70 6b 74 73 29 29 0a 0a 3b 3b 20 67 69 pkts))..;; gi
3d20: 76 65 6e 20 6c 69 73 74 20 6f 66 20 70 6b 74 73 ven list of pkts
3d30: 20 28 61 6c 69 73 74 20 6d 6f 64 65 29 20 72 65 (alist mode) re
3d40: 74 75 72 6e 20 6c 69 73 74 20 6f 66 20 44 20 63 turn list of D c
3d50: 61 72 64 73 20 61 73 20 55 6e 69 78 20 65 70 6f ards as Unix epo
3d60: 63 68 2c 20 73 6f 72 74 65 64 20 64 65 73 63 65 ch, sorted desce
3d70: 6e 64 69 6e 67 0a 3b 3b 20 61 6c 73 6f 20 64 65 nding.;; also de
3d80: 6c 65 74 65 20 64 75 70 6c 69 63 61 74 65 73 20 lete duplicates
3d90: 62 79 20 74 61 72 67 65 74 20 69 2e 65 2e 20 28 by target i.e. (
3da0: 63 61 72 20 70 6b 74 29 0a 28 64 65 66 69 6e 65 car pkt).(define
3db0: 20 28 67 65 74 2d 70 6b 74 2d 74 69 6d 65 73 20 (get-pkt-times
3dc0: 70 6b 74 73 29 0a 20 20 28 64 65 6c 65 74 65 2d pkts). (delete-
3dd0: 64 75 70 6c 69 63 61 74 65 73 0a 20 20 20 28 73 duplicates. (s
3de0: 6f 72 74 20 0a 20 20 20 20 28 6d 61 70 20 28 6c ort . (map (l
3df0: 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 60 28 ambda (x).. `(
3e00: 2c 28 61 6c 69 73 74 2d 72 65 66 20 27 74 20 78 ,(alist-ref 't x
3e10: 29 20 2e 20 2c 28 73 74 72 69 6e 67 2d 3e 6e 75 ) . ,(string->nu
3e20: 6d 62 65 72 20 28 61 6c 69 73 74 2d 72 65 66 20 mber (alist-ref
3e30: 27 44 20 78 29 29 29 29 0a 09 20 70 6b 74 73 29 'D x)))).. pkts)
3e40: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 . (lambda (a
3e50: 62 29 28 3e 20 28 63 64 72 20 61 29 28 63 64 72 b)(> (cdr a)(cdr
3e60: 20 62 29 29 29 29 20 20 20 20 20 20 3b 3b 20 73 b)))) ;; s
3e70: 6f 72 74 20 64 65 73 63 65 6e 64 69 6e 67 0a 20 ort descending.
3e80: 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 (lambda (a b)(
3e90: 65 71 75 61 6c 3f 20 28 63 61 72 20 61 29 28 63 equal? (car a)(c
3ea0: 61 72 20 62 29 29 29 29 29 20 3b 3b 20 72 65 6d ar b))))) ;; rem
3eb0: 6f 76 65 20 64 75 70 6c 69 63 61 74 65 73 20 62 ove duplicates b
3ec0: 79 20 74 61 72 67 65 74 0a 0a 3b 3b 3d 3d 3d 3d y target..;;====
3ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f10: 3d 3d 0a 3b 3b 20 52 75 6e 73 0a 3b 3b 3d 3d 3d ==.;; Runs.;;===
3f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f60: 3d 3d 3d 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 ===..;; make a r
3f70: 75 6e 6e 61 6d 65 0a 3b 3b 0a 28 64 65 66 69 6e unname.;;.(defin
3f80: 65 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 20 e (make-runname
3f90: 70 72 65 20 70 6f 73 74 29 0a 20 28 74 69 6d 65 pre post). (time
3fa0: 2d 3e 73 74 72 69 6e 67 0a 20 20 28 73 65 63 6f ->string. (seco
3fb0: 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 nds->local-time
3fc0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
3fd0: 29 29 20 22 25 59 77 25 56 2e 25 77 2d 25 48 25 )) "%Yw%V.%w-%H%
3fe0: 4d 22 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 74 M"))..;; collect
3ff0: 2c 20 74 72 61 6e 73 6c 61 74 65 2c 20 63 6f 6c , translate, col
4000: 6c 61 74 65 20 61 6e 64 20 61 73 73 65 6d 62 6c late and assembl
4010: 65 20 61 20 70 6b 74 20 66 72 6f 6d 20 74 68 65 e a pkt from the
4020: 20 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 0a 3b 3b command-line.;;
4030: 0a 3b 3b 20 73 63 68 65 64 20 3d 3e 20 66 6f 72 .;; sched => for
4040: 63 65 20 74 68 65 20 72 75 6e 20 73 74 61 72 74 ce the run start
4050: 20 74 69 6d 65 20 74 6f 20 62 65 20 72 65 63 6f time to be reco
4060: 72 64 65 64 20 61 73 20 73 63 68 65 64 20 55 6e rded as sched Un
4070: 69 78 0a 3b 3b 20 65 70 6f 63 68 2e 20 54 68 69 ix.;; epoch. Thi
4080: 73 20 61 6c 69 67 6e 73 20 74 69 6d 65 73 20 70 s aligns times p
4090: 72 6f 70 65 72 6c 79 20 66 6f 72 20 74 72 69 67 roperly for trig
40a0: 67 65 72 73 20 69 6e 20 73 6f 6d 65 20 63 61 73 gers in some cas
40b0: 65 73 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 es..;;.(define (
40c0: 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e 70 6b command-line->pk
40d0: 74 20 61 63 74 69 6f 6e 20 61 72 67 73 2d 61 6c t action args-al
40e0: 69 73 74 20 73 63 68 65 64 2d 69 6e 20 23 21 6b ist sched-in #!k
40f0: 65 79 20 28 65 78 74 72 61 2d 64 61 74 20 27 28 ey (extra-dat '(
4100: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 63 ))). (let* ((sc
4110: 68 65 64 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 hed (cond...
4120: 20 20 20 20 20 28 28 76 65 63 74 6f 72 3f 20 73 ((vector? s
4130: 63 68 65 64 2d 69 6e 29 28 6c 6f 63 61 6c 2d 74 ched-in)(local-t
4140: 69 6d 65 2d 3e 73 65 63 6f 6e 64 73 20 73 63 68 ime->seconds sch
4150: 65 64 2d 69 6e 29 29 20 3b 3b 20 77 65 20 72 65 ed-in)) ;; we re
4160: 63 69 65 76 65 64 20 61 20 74 69 6d 65 0a 09 09 cieved a time...
4170: 20 20 20 20 20 28 28 6e 75 6d 62 65 72 3f 20 73 ((number? s
4180: 63 68 65 64 2d 69 6e 29 20 73 63 68 65 64 2d 69 ched-in) sched-i
4190: 6e 29 0a 09 09 20 20 20 20 20 28 65 6c 73 65 20 n)... (else
41a0: 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (current-sec
41b0: 6f 6e 64 73 29 29 29 29 0a 09 20 28 61 72 67 73 onds)))).. (args
41c0: 2d 64 61 74 61 20 28 69 66 20 61 72 67 73 2d 61 -data (if args-a
41d0: 6c 69 73 74 0a 09 09 09 28 69 66 20 28 68 61 73 list....(if (has
41e0: 68 2d 74 61 62 6c 65 3f 20 61 72 67 73 2d 61 6c h-table? args-al
41f0: 69 73 74 29 20 3b 3b 20 73 65 72 69 6f 75 73 6c ist) ;; seriousl
4200: 79 3f 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d y?.... (hash-
4210: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 72 67 table->alist arg
4220: 73 2d 61 6c 69 73 74 29 0a 09 09 09 20 20 20 20 s-alist)....
4230: 61 72 67 73 2d 61 6c 69 73 74 29 0a 09 09 09 28 args-alist)....(
4240: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
4250: 74 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 t args:arg-hash)
4260: 29 29 20 3b 3b 20 69 66 20 6e 6f 20 61 72 67 73 )) ;; if no args
4270: 2d 61 6c 69 73 74 20 74 68 65 6e 20 77 65 20 61 -alist then we a
4280: 73 73 75 6d 65 20 74 68 69 73 20 69 73 20 61 20 ssume this is a
4290: 63 61 6c 6c 20 64 72 69 76 65 6e 20 64 69 72 65 call driven dire
42a0: 63 74 6c 79 20 62 79 20 63 6f 6d 6d 61 6e 64 6c ctly by commandl
42b0: 69 6e 65 0a 09 20 28 61 6c 6c 64 61 74 20 20 20 ine.. (alldat
42c0: 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 28 (apply append (
42d0: 6c 69 73 74 20 27 54 20 22 63 6d 64 22 0a 09 09 list 'T "cmd"...
42e0: 09 09 09 27 41 20 61 63 74 69 6f 6e 0a 09 09 09 ...'A action....
42f0: 09 09 27 55 20 28 63 75 72 72 65 6e 74 2d 75 73 ..'U (current-us
4300: 65 72 2d 6e 61 6d 65 29 0a 09 09 09 09 09 27 44 er-name)......'D
4310: 20 73 63 68 65 64 29 0a 20 20 20 20 20 20 20 20 sched).
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4330: 20 20 20 65 78 74 72 61 2d 64 61 74 0a 09 09 09 extra-dat....
4340: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
4350: 28 78 29 0a 09 09 09 09 20 20 28 6c 65 74 2a 20 (x)..... (let*
4360: 28 28 70 61 72 61 6d 20 28 63 61 72 20 78 29 29 ((param (car x))
4370: 0a 09 09 09 09 09 20 28 76 61 6c 75 65 20 28 63 ...... (value (c
4380: 64 72 20 78 29 29 0a 09 09 09 09 09 20 28 70 6d dr x))...... (pm
4390: 65 74 61 20 28 61 73 73 6f 63 20 70 61 72 61 6d eta (assoc param
43a0: 20 2a 61 72 67 2d 6b 65 79 73 2a 29 29 20 20 20 *arg-keys*))
43b0: 20 3b 3b 20 74 72 61 6e 73 6c 61 74 65 20 74 68 ;; translate th
43c0: 65 20 63 61 72 64 20 6b 65 79 20 74 6f 20 61 20 e card key to a
43d0: 6d 65 67 61 74 65 73 74 20 73 77 69 74 63 68 20 megatest switch
43e0: 6f 72 20 70 61 72 61 6d 65 74 65 72 0a 09 09 09 or parameter....
43f0: 09 09 20 28 73 6d 65 74 61 20 28 61 73 73 6f 63 .. (smeta (assoc
4400: 20 70 61 72 61 6d 20 2a 73 77 69 74 63 68 2d 6b param *switch-k
4410: 65 79 73 2a 29 29 20 3b 3b 20 66 69 72 73 74 20 eys*)) ;; first
4420: 6c 6f 6f 6b 75 70 20 74 68 65 20 6b 65 79 20 69 lookup the key i
4430: 6e 20 61 72 67 2d 6b 65 79 73 20 6f 72 20 73 77 n arg-keys or sw
4440: 69 74 63 68 2d 6b 65 79 73 0a 09 09 09 09 09 20 itch-keys......
4450: 28 6d 65 74 61 20 20 28 69 66 20 28 6f 72 20 70 (meta (if (or p
4460: 6d 65 74 61 20 73 6d 65 74 61 29 0a 09 09 09 09 meta smeta).....
4470: 09 09 20 20 20 20 28 63 64 72 20 28 6f 72 20 70 .. (cdr (or p
4480: 6d 65 74 61 20 73 6d 65 74 61 29 29 20 20 20 3b meta smeta)) ;
4490: 3b 20 66 6f 75 6e 64 20 69 74 3f 0a 09 09 09 09 ; found it?.....
44a0: 09 09 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 .. #f))).....
44b0: 20 20 20 20 28 69 66 20 28 6f 72 20 70 6d 65 74 (if (or pmet
44c0: 61 20 73 6d 65 74 61 29 20 20 20 20 20 20 20 20 a smeta)
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
44e0: 63 6f 6e 73 74 72 75 63 74 20 74 68 65 20 73 77 construct the sw
44f0: 69 74 63 68 2f 70 61 72 61 6d 20 70 61 69 72 2e itch/param pair.
4500: 0a 09 09 09 09 09 28 6c 69 73 74 20 6d 65 74 61 ......(list meta
4510: 20 76 61 6c 75 65 29 0a 09 09 09 09 09 27 28 29 value)......'()
4520: 29 29 29 0a 09 09 09 09 28 66 69 6c 74 65 72 20 ))).....(filter
4530: 63 64 72 20 61 72 67 73 2d 64 61 74 61 29 29 29 cdr args-data)))
4540: 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 20 22 )). (print "
4550: 41 6c 6c 64 61 74 3a 20 22 20 61 6c 6c 64 61 74 Alldat: " alldat
4560: 0a 09 20 20 20 20 22 20 61 72 67 73 2d 64 61 74 .. " args-dat
4570: 61 3a 20 22 20 61 72 67 73 2d 64 61 74 61 29 0a a: " args-data).
4580: 20 20 20 20 28 61 64 64 2d 7a 2d 63 61 72 64 0a (add-z-card.
4590: 20 20 20 20 20 28 61 70 70 6c 79 20 63 6f 6e 73 (apply cons
45a0: 74 72 75 63 74 2d 73 64 61 74 20 61 6c 6c 64 61 truct-sdat allda
45b0: 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 t))))..(define (
45c0: 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 73 74 61 simple-setup sta
45d0: 72 74 2d 64 69 72 2d 69 6e 29 0a 20 20 28 6c 65 rt-dir-in). (le
45e0: 74 2a 20 28 28 73 74 61 72 74 2d 64 69 72 20 28 t* ((start-dir (
45f0: 6f 72 20 73 74 61 72 74 2d 64 69 72 2d 69 6e 20 or start-dir-in
4600: 22 2e 22 29 29 0a 09 20 28 6d 74 63 6f 6e 66 69 ".")).. (mtconfi
4610: 67 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 g (or (args:get
4620: 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 -arg "-config")
4630: 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 "megatest.config
4640: 22 29 29 0a 09 20 28 6d 74 63 6f 6e 66 64 61 74 ")).. (mtconfdat
4650: 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d (find-and-read-
4660: 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 3b 3b config ;;
4670: 20 4e 42 2f 2f 20 73 65 74 73 20 4d 54 5f 52 55 NB// sets MT_RU
4680: 4e 5f 41 52 45 41 5f 48 4f 4d 45 20 61 73 20 73 N_AREA_HOME as s
4690: 69 64 65 20 65 66 66 65 63 74 0a 09 09 20 20 20 ide effect...
46a0: 20 20 6d 74 63 6f 6e 66 69 67 0a 09 09 20 20 20 mtconfig...
46b0: 20 20 3b 3b 20 65 6e 76 69 72 6f 6e 2d 70 61 74 ;; environ-pat
46c0: 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t: "env-override
46d0: 22 0a 09 09 20 20 20 20 20 67 69 76 65 6e 2d 74 "... given-t
46e0: 6f 70 70 61 74 68 3a 20 73 74 61 72 74 2d 64 69 oppath: start-di
46f0: 72 0a 09 09 20 20 20 20 20 3b 3b 20 70 61 74 68 r... ;; path
4700: 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f envvar: "MT_RUN_
4710: 41 52 45 41 5f 48 4f 4d 45 22 0a 09 09 20 20 20 AREA_HOME"...
4720: 20 20 29 29 0a 09 20 28 6d 74 63 6f 6e 66 20 20 )).. (mtconf
4730: 20 20 28 69 66 20 6d 74 63 6f 6e 66 64 61 74 20 (if mtconfdat
4740: 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 20 (car mtconfdat)
4750: 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 77 65 20 #f))). ;; we
4760: 73 65 74 20 73 6f 6d 65 20 64 79 6e 61 6d 69 63 set some dynamic
4770: 20 64 61 74 61 20 69 6e 20 61 20 73 65 63 74 69 data in a secti
4780: 6f 6e 20 63 61 6c 6c 65 64 20 22 64 79 6e 64 61 on called "dynda
4790: 74 61 22 0a 20 20 20 20 28 69 66 20 6d 74 63 6f ta". (if mtco
47a0: 6e 66 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 63 nf..(begin.. (c
47b0: 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 onfigf:section-v
47c0: 61 72 2d 73 65 74 21 20 6d 74 63 6f 6e 66 20 22 ar-set! mtconf "
47d0: 64 79 6e 64 61 74 22 20 22 74 6f 70 70 61 74 68 dyndat" "toppath
47e0: 22 20 73 74 61 72 74 2d 64 69 72 29 29 29 0a 20 " start-dir))).
47f0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 4f ;; (print "TO
4800: 50 50 41 54 48 3a 20 22 20 28 63 6f 6e 66 69 67 PPATH: " (config
4810: 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 f:lookup mtconf
4820: 22 64 79 6e 64 61 74 22 20 22 74 6f 70 70 61 74 "dyndat" "toppat
4830: 68 22 29 29 0a 20 20 20 20 6d 74 63 6f 6e 66 64 h")). mtconfd
4840: 61 74 29 29 0a 0a 0a 3b 3b 20 4e 45 45 44 20 54 at))...;; NEED T
4850: 49 4d 45 53 54 41 4d 50 20 4f 4e 20 50 4b 54 53 IMESTAMP ON PKTS
4860: 20 66 6f 72 20 65 66 66 69 63 69 65 6e 74 20 6c for efficient l
4870: 6f 61 64 69 6e 67 20 6f 66 20 70 61 63 6b 65 74 oading of packet
4880: 73 20 69 6e 74 6f 20 64 62 2e 0a 0a 0a 3b 3b 20 s into db....;;
4890: 6d 61 6b 65 20 61 20 72 75 6e 20 72 65 71 75 65 make a run reque
48a0: 73 74 20 70 6b 74 20 66 72 6f 6d 20 62 61 73 69 st pkt from basi
48b0: 63 20 64 61 74 61 2c 20 74 68 69 73 20 73 65 72 c data, this ser
48c0: 69 6f 75 73 6c 79 20 6e 65 65 64 73 20 74 6f 20 iously needs to
48d0: 62 65 20 72 65 66 61 63 74 6f 72 65 64 0a 3b 3b be refactored.;;
48e0: 20 20 20 69 2e 20 54 61 6b 65 20 74 68 65 20 63 i. Take the c
48f0: 6f 64 65 20 74 68 61 74 20 62 75 69 6c 64 73 20 ode that builds
4900: 74 68 65 20 69 6e 66 6f 20 74 6f 20 73 75 62 6d the info to subm
4910: 69 74 20 74 6f 20 63 72 65 61 74 65 2d 72 75 6e it to create-run
4920: 2d 70 6b 74 20 61 6e 64 20 68 61 76 65 20 69 74 -pkt and have it
4930: 0a 3b 3b 20 20 20 20 20 20 67 65 6e 65 72 61 74 .;; generat
4940: 65 20 74 68 65 20 70 6b 74 20 6b 65 79 73 20 64 e the pkt keys d
4950: 69 72 65 63 74 6c 79 2e 0a 3b 3b 20 20 69 69 2e irectly..;; ii.
4960: 20 50 61 73 73 20 74 68 65 20 70 6b 74 20 6b 65 Pass the pkt ke
4970: 79 73 20 61 6e 64 20 76 61 6c 75 65 73 20 74 6f ys and values to
4980: 20 74 68 69 73 20 70 72 6f 63 20 61 6e 64 20 67 this proc and g
4990: 6f 20 66 72 6f 6d 20 74 68 65 72 65 2e 0a 3b 3b o from there..;;
49a0: 20 69 69 69 2e 20 4d 61 79 62 65 20 68 61 76 65 iii. Maybe have
49b0: 20 61 6e 20 61 62 73 74 72 61 63 74 69 6f 6e 20 an abstraction
49c0: 61 6c 69 73 74 20 77 69 74 68 20 6d 65 61 6e 69 alist with meani
49d0: 6e 67 66 75 6c 20 6e 61 6d 65 73 20 66 6f 72 20 ngful names for
49e0: 74 68 65 20 70 6b 74 20 6b 65 79 73 0a 3b 3b 0a the pkt keys.;;.
49f0: 3b 3b 20 4f 76 65 72 72 69 64 65 20 74 68 65 20 ;; Override the
4a00: 72 75 6e 20 73 74 61 72 74 20 74 69 6d 65 20 72 run start time r
4a10: 65 63 6f 72 64 20 77 69 74 68 20 73 63 68 65 64 ecord with sched
4a20: 2e 20 55 73 75 61 6c 6c 79 20 23 66 20 69 73 20 . Usually #f is
4a30: 66 69 6e 65 2e 0a 3b 3b 20 0a 28 64 65 66 69 6e fine..;; .(defin
4a40: 65 20 28 63 72 65 61 74 65 2d 72 75 6e 2d 70 6b e (create-run-pk
4a50: 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f 6e 20 t mtconf action
4a60: 61 72 65 61 20 72 75 6e 6b 65 79 20 74 61 72 67 area runkey targ
4a70: 65 74 20 72 75 6e 6e 61 6d 65 20 6d 6f 64 65 2d et runname mode-
4a80: 70 61 74 74 20 0a 20 20 20 20 20 20 20 20 20 20 patt .
4a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 ta
4aa0: 67 2d 65 78 70 72 20 70 6b 74 73 64 69 72 20 72 g-expr pktsdir r
4ab0: 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 73 63 eason contour sc
4ac0: 68 65 64 20 64 62 64 65 73 74 20 61 70 70 65 6e hed dbdest appen
4ad0: 64 2d 63 6f 6e 66 0a 20 20 20 20 20 20 20 20 20 d-conf.
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
4af0: 75 6e 74 72 61 6e 73 29 0a 20 20 28 6c 65 74 2a untrans). (let*
4b00: 20 28 28 67 6f 6f 64 2d 76 61 6c 20 20 20 28 6c ((good-val (l
4b10: 61 6d 62 64 61 20 28 69 6e 76 61 6c 29 28 61 6e ambda (inval)(an
4b20: 64 20 69 6e 76 61 6c 20 28 73 74 72 69 6e 67 3f d inval (string?
4b30: 20 69 6e 76 61 6c 29 28 6e 6f 74 20 28 73 74 72 inval)(not (str
4b40: 69 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 76 61 6c 29 ing-null? inval)
4b50: 29 29 29 29 0a 09 20 28 61 72 65 61 2d 64 61 74 )))).. (area-dat
4b60: 20 20 20 28 76 61 6c 2d 3e 61 6c 69 73 74 20 28 (val->alist (
4b70: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
4b80: 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 up mtconf "areas
4b90: 22 20 61 72 65 61 29 20 22 22 29 29 29 0a 09 20 " area) "")))..
4ba0: 28 61 72 65 61 2d 70 61 74 68 20 20 28 61 6c 69 (area-path (ali
4bb0: 73 74 2d 72 65 66 20 27 70 61 74 68 20 20 20 20 st-ref 'path
4bc0: 20 20 61 72 65 61 2d 64 61 74 29 29 0a 09 20 3b area-dat)).. ;
4bd0: 3b 20 28 61 72 65 61 2d 78 6c 61 74 72 20 28 61 ; (area-xlatr (a
4be0: 6c 69 73 74 2d 72 65 66 20 27 74 61 72 67 74 72 list-ref 'targtr
4bf0: 61 6e 73 20 61 72 65 61 2d 64 61 74 29 29 0a 20 ans area-dat)).
4c00: 20 20 20 20 20 20 20 20 3b 3b 20 28 78 6c 61 74 ;; (xlat
4c10: 72 2d 6b 65 79 20 20 28 69 66 20 61 72 65 61 2d r-key (if area-
4c20: 78 6c 61 74 72 20 28 73 74 72 69 6e 67 2d 3e 73 xlatr (string->s
4c30: 79 6d 62 6f 6c 20 61 72 65 61 2d 78 6c 61 74 72 ymbol area-xlatr
4c40: 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 ) #f)).
4c50: 28 6e 65 77 2d 72 75 6e 6e 61 6d 65 20 28 6c 65 (new-runname (le
4c60: 74 2a 20 28 28 63 61 6c 6c 6e 61 6d 65 20 28 69 t* ((callname (i
4c70: 66 20 28 73 74 72 69 6e 67 3f 20 72 75 6e 74 72 f (string? runtr
4c80: 61 6e 73 29 28 73 74 72 69 6e 67 2d 3e 73 79 6d ans)(string->sym
4c90: 62 6f 6c 20 72 75 6e 74 72 61 6e 73 29 20 23 66 bol runtrans) #f
4ca0: 29 29 0a 09 09 09 20 20 20 20 20 28 6d 61 70 70 )).... (mapp
4cb0: 65 72 20 20 20 28 69 66 20 63 61 6c 6c 6e 61 6d er (if callnam
4cc0: 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 e (hash-table-re
4cd0: 66 2f 64 65 66 61 75 6c 74 20 2a 72 75 6e 6e 61 f/default *runna
4ce0: 6d 65 2d 6d 61 70 70 65 72 73 2a 20 63 61 6c 6c me-mappers* call
4cf0: 6e 61 6d 65 20 23 66 29 20 23 66 29 29 29 0a 09 name #f) #f)))..
4d00: 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 63 61 6c ..;; (print "cal
4d10: 6c 6e 61 6d 65 3d 22 20 63 61 6c 6c 6e 61 6d 65 lname=" callname
4d20: 20 22 20 72 75 6e 74 72 61 6e 73 3d 22 20 72 75 " runtrans=" ru
4d30: 6e 74 72 61 6e 73 20 22 20 6d 61 70 70 65 72 3d ntrans " mapper=
4d40: 22 20 6d 61 70 70 65 72 29 0a 09 09 09 28 69 66 " mapper)....(if
4d50: 20 28 61 6e 64 20 63 61 6c 6c 6e 61 6d 65 0a 09 (and callname..
4d60: 09 09 09 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f ... (not (equal?
4d70: 20 63 61 6c 6c 6e 61 6d 65 20 22 61 75 74 6f 22 callname "auto"
4d80: 29 29 0a 09 09 09 09 20 28 6e 6f 74 20 6d 61 70 ))..... (not map
4d90: 70 65 72 29 29 0a 09 09 09 20 20 20 20 28 70 72 per)).... (pr
4da0: 69 6e 74 20 22 4e 6f 20 6d 61 70 70 65 72 20 22 int "No mapper "
4db0: 20 63 61 6c 6c 6e 61 6d 65 20 22 20 66 6f 72 20 callname " for
4dc0: 61 72 65 61 20 22 20 61 72 65 61 20 22 20 75 73 area " area " us
4dd0: 69 6e 67 20 22 20 63 61 6c 6c 6e 61 6d 65 20 22 ing " callname "
4de0: 20 61 73 20 74 68 65 20 72 75 6e 6e 61 6d 65 22 as the runname"
4df0: 29 29 0a 09 09 09 28 69 66 20 6d 61 70 70 65 72 ))....(if mapper
4e00: 0a 09 09 09 20 20 20 20 28 68 61 6e 64 6c 65 2d .... (handle-
4e10: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 65 exceptions.....e
4e20: 78 6e 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 09 xn.....(begin...
4e30: 09 09 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d .. (print-call-
4e40: 63 68 61 69 6e 29 0a 09 09 09 09 20 20 28 70 72 chain)..... (pr
4e50: 69 6e 74 20 22 46 41 49 4c 45 44 20 54 4f 20 52 int "FAILED TO R
4e60: 55 4e 20 52 55 4e 4e 41 4d 45 20 4d 41 50 50 45 UN RUNNAME MAPPE
4e70: 52 20 22 20 63 61 6c 6c 6e 61 6d 65 20 22 20 46 R " callname " F
4e80: 4f 52 20 41 52 45 41 20 22 20 61 72 65 61 29 0a OR AREA " area).
4e90: 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 6d .... (print " m
4ea0: 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 essage: " ((cond
4eb0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
4ec0: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
4ed0: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 ssage) exn))....
4ee0: 09 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 20 . runname)....
4ef0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 28 6d 61 (print "(ma
4f00: 70 70 65 72 20 22 20 28 73 74 72 69 6e 67 2d 69 pper " (string-i
4f10: 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 74 ntersperse (list
4f20: 20 72 75 6e 6b 65 79 20 72 75 6e 6e 61 6d 65 20 runkey runname
4f30: 61 72 65 61 20 61 72 65 61 2d 70 61 74 68 20 72 area area-path r
4f40: 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f eason contour mo
4f50: 64 65 2d 70 61 74 74 29 20 22 2c 20 22 29 20 22 de-patt) ", ") "
4f60: 29 22 29 0a 09 09 09 20 20 20 20 20 20 28 6d 61 )").... (ma
4f70: 70 70 65 72 20 72 75 6e 6b 65 79 20 72 75 6e 6e pper runkey runn
4f80: 61 6d 65 20 61 72 65 61 20 61 72 65 61 2d 70 61 ame area area-pa
4f90: 74 68 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 th reason contou
4fa0: 72 20 6d 6f 64 65 2d 70 61 74 74 29 29 0a 09 09 r mode-patt))...
4fb0: 09 20 20 20 20 28 63 61 73 65 20 63 61 6c 6c 6e . (case calln
4fc0: 61 6d 65 0a 09 09 09 20 20 20 20 20 20 28 28 61 ame.... ((a
4fd0: 75 74 6f 29 20 72 75 6e 6e 61 6d 65 29 0a 09 09 uto) runname)...
4fe0: 09 20 20 20 20 20 20 28 65 6c 73 65 20 20 20 72 . (else r
4ff0: 75 6e 74 72 61 6e 73 29 29 29 29 29 0a 09 20 28 untrans))))).. (
5000: 6e 65 77 2d 74 61 72 67 65 74 20 20 20 20 20 74 new-target t
5010: 61 72 67 65 74 29 20 3b 3b 20 49 20 62 65 6c 69 arget) ;; I beli
5020: 65 76 65 20 77 65 20 77 69 6c 6c 20 77 61 6e 74 eve we will want
5030: 20 74 61 72 67 65 74 20 6d 61 6e 69 70 75 6c 61 target manipula
5040: 74 69 6f 6e 20 68 65 72 65 20 2e 2e 20 28 6d 61 tion here .. (ma
5050: 70 2d 74 61 72 67 65 74 73 20 78 6c 61 74 72 2d p-targets xlatr-
5060: 6b 65 79 20 72 75 6e 6b 65 79 20 61 72 65 61 20 key runkey area
5070: 63 6f 6e 74 6f 75 72 29 29 0a 09 20 28 61 63 74 contour)).. (act
5080: 75 61 6c 2d 61 63 74 69 6f 6e 20 20 28 69 66 20 ual-action (if
5090: 61 63 74 69 6f 6e 0a 09 09 09 20 20 20 20 20 28 action.... (
50a0: 69 66 20 28 65 71 75 61 6c 3f 20 61 63 74 69 6f if (equal? actio
50b0: 6e 20 22 73 79 6e 63 2d 70 72 65 70 65 6e 64 22 n "sync-prepend"
50c0: 29 0a 09 09 09 09 20 22 73 79 6e 63 22 0a 09 09 )..... "sync"...
50d0: 09 09 20 61 63 74 69 6f 6e 29 0a 09 09 09 20 20 .. action)....
50e0: 20 20 20 22 72 75 6e 22 29 29 29 20 3b 3b 20 74 "run"))) ;; t
50f0: 68 69 73 20 68 61 73 20 67 6f 74 74 65 6e 20 61 his has gotten a
5100: 20 62 69 74 20 75 67 6c 79 2e 20 4e 65 65 64 20 bit ugly. Need
5110: 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 68 61 a function to ha
5120: 6e 64 6c 65 20 61 63 74 69 6f 6e 73 20 70 72 6f ndle actions pro
5130: 63 65 73 73 69 6e 67 2e 0a 20 20 20 20 3b 3b 20 cessing.. ;;
5140: 73 6f 6d 65 20 68 61 63 6b 73 20 74 6f 20 72 65 some hacks to re
5150: 6d 6f 76 65 20 73 77 69 74 63 68 65 73 20 6e 6f move switches no
5160: 74 20 6e 65 65 64 65 64 20 69 6e 20 63 65 72 74 t needed in cert
5170: 61 69 6e 20 63 61 73 65 73 0a 20 20 20 20 28 63 ain cases. (c
5180: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym
5190: 62 6f 6c 20 28 6f 72 20 61 63 74 69 6f 6e 20 22 bol (or action "
51a0: 72 75 6e 22 29 29 0a 20 20 20 20 20 20 28 28 73 run")). ((s
51b0: 79 6e 63 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 ync sync-prepend
51c0: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6e ). (set! n
51d0: 65 77 2d 74 61 72 67 65 74 20 23 66 29 0a 20 20 ew-target #f).
51e0: 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 61 6d (set! runam
51f0: 65 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 e #f))).
5200: 3b 3b 20 28 70 72 69 6e 74 20 22 61 72 65 61 2d ;; (print "area-
5210: 70 61 74 68 3a 20 22 20 61 72 65 61 2d 70 61 74 path: " area-pat
5220: 68 20 22 20 6f 72 69 67 2d 74 61 72 67 65 74 3a h " orig-target:
5230: 20 22 20 72 75 6e 6b 65 79 20 22 20 6e 65 77 2d " runkey " new-
5240: 74 61 72 67 65 74 3a 20 22 20 6e 65 77 2d 74 61 target: " new-ta
5250: 72 67 65 74 29 0a 20 20 20 20 28 6c 65 74 2d 76 rget). (let-v
5260: 61 6c 75 65 73 20 28 28 28 75 75 69 64 20 70 6b alues (((uuid pk
5270: 74 29 0a 09 09 20 20 28 63 6f 6d 6d 61 6e 64 2d t)... (command-
5280: 6c 69 6e 65 2d 3e 70 6b 74 0a 09 09 20 20 20 61 line->pkt... a
5290: 63 74 75 61 6c 2d 61 63 74 69 6f 6e 0a 09 09 20 ctual-action...
52a0: 20 20 28 61 70 70 65 6e 64 20 0a 09 09 20 20 20 (append ...
52b0: 20 60 28 28 22 2d 73 74 61 72 74 2d 64 69 72 22 `(("-start-dir"
52c0: 20 20 2e 20 2c 61 72 65 61 2d 70 61 74 68 29 0a . ,area-path).
52d0: 09 09 20 20 20 20 20 20 28 22 2d 6d 73 67 22 20 .. ("-msg"
52e0: 20 20 20 20 20 20 20 2e 20 2c 72 65 61 73 6f 6e . ,reason
52f0: 29 0a 09 09 20 20 20 20 20 20 28 22 2d 63 6f 6e )... ("-con
5300: 74 6f 75 72 22 20 20 20 20 2e 20 2c 63 6f 6e 74 tour" . ,cont
5310: 6f 75 72 29 29 0a 09 09 20 20 20 20 28 69 66 20 our))... (if
5320: 28 67 6f 6f 64 2d 76 61 6c 20 6e 65 77 2d 72 75 (good-val new-ru
5330: 6e 6e 61 6d 65 29 20 60 28 28 22 2d 72 75 6e 2d nname) `(("-run-
5340: 6e 61 6d 65 22 20 20 20 20 20 20 2e 20 2c 6e 65 name" . ,ne
5350: 77 2d 72 75 6e 6e 61 6d 65 29 29 20 27 28 29 29 w-runname)) '())
5360: 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f 64 ... (if (good
5370: 2d 76 61 6c 20 6e 65 77 2d 74 61 72 67 65 74 29 -val new-target)
5380: 20 20 60 28 28 22 2d 74 61 72 67 65 74 22 20 20 `(("-target"
5390: 20 20 20 20 20 20 2e 20 2c 6e 65 77 2d 74 61 72 . ,new-tar
53a0: 67 65 74 29 29 20 20 27 28 29 29 0a 09 09 20 20 get)) '())...
53b0: 20 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c 20 (if (good-val
53c0: 6d 6f 64 65 2d 70 61 74 74 29 20 20 20 60 28 28 mode-patt) `((
53d0: 22 2d 6d 6f 64 65 2d 70 61 74 74 22 20 20 20 20 "-mode-patt"
53e0: 20 2e 20 2c 6d 6f 64 65 2d 70 61 74 74 29 29 20 . ,mode-patt))
53f0: 20 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 '())... (if
5400: 20 28 67 6f 6f 64 2d 76 61 6c 20 74 61 67 2d 65 (good-val tag-e
5410: 78 70 72 29 20 20 20 20 60 28 28 22 2d 74 61 67 xpr) `(("-tag
5420: 2d 65 78 70 72 22 20 20 20 20 20 20 2e 20 2c 74 -expr" . ,t
5430: 61 67 2d 65 78 70 72 29 29 20 20 20 20 27 28 29 ag-expr)) '()
5440: 29 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f )... (if (goo
5450: 64 2d 76 61 6c 20 64 62 64 65 73 74 29 20 20 20 d-val dbdest)
5460: 20 20 20 60 28 28 22 2d 73 79 6e 63 2d 74 6f 22 `(("-sync-to"
5470: 20 20 20 20 20 20 20 2e 20 2c 64 62 64 65 73 74 . ,dbdest
5480: 29 29 20 20 20 20 20 20 27 28 29 29 0a 09 09 20 )) '())...
5490: 20 20 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c (if (good-val
54a0: 20 61 70 70 65 6e 64 2d 63 6f 6e 66 29 20 60 28 append-conf) `(
54b0: 28 22 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 ("-append-config
54c0: 22 20 2e 20 2c 61 70 70 65 6e 64 2d 63 6f 6e 66 " . ,append-conf
54d0: 29 29 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 )) '())... (i
54e0: 66 20 28 65 71 75 61 6c 3f 20 61 63 74 69 6f 6e f (equal? action
54f0: 20 22 73 79 6e 63 2d 70 72 65 70 65 6e 64 22 29 "sync-prepend")
5500: 20 27 28 28 22 2d 70 72 65 70 65 6e 64 2d 63 6f '(("-prepend-co
5510: 6e 74 6f 75 72 22 20 2e 20 22 20 22 29 29 20 20 ntour" . " "))
5520: 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 20 '())... (if
5530: 28 6e 6f 74 20 28 6f 72 20 6d 6f 64 65 2d 70 61 (not (or mode-pa
5540: 74 74 20 74 61 67 2d 65 78 70 72 29 29 0a 09 09 tt tag-expr))...
5550: 09 60 28 28 22 2d 74 65 73 74 70 61 74 74 22 20 .`(("-testpatt"
5560: 20 2e 20 22 25 22 29 29 0a 09 09 09 27 28 29 29 . "%"))....'())
5570: 0a 09 09 20 20 20 20 28 69 66 20 28 6f 72 20 28 ... (if (or (
5580: 6e 6f 74 20 61 63 74 69 6f 6e 29 0a 09 09 09 20 not action)....
5590: 20 20 20 28 65 71 75 61 6c 3f 20 61 63 74 69 6f (equal? actio
55a0: 6e 20 22 72 75 6e 22 29 29 0a 09 09 09 60 28 28 n "run"))....`((
55b0: 22 2d 70 72 65 63 6c 65 61 6e 22 20 20 2e 20 22 "-preclean" . "
55c0: 20 22 29 0a 09 09 09 20 20 28 22 2d 72 65 72 75 ").... ("-reru
55d0: 6e 2d 61 6c 6c 22 20 2e 20 22 20 22 29 29 20 20 n-all" . " "))
55e0: 20 20 20 20 3b 3b 20 69 66 20 72 75 6e 20 77 65 ;; if run we
55f0: 20 2a 61 6c 77 61 79 73 2a 20 77 61 6e 74 20 70 *always* want p
5600: 72 65 63 6c 65 61 6e 20 73 65 74 2c 20 75 73 65 reclean set, use
5610: 20 73 69 6e 67 6c 65 20 73 70 61 63 65 20 61 73 single space as
5620: 20 70 6c 61 63 65 68 6f 6c 64 65 72 0a 09 09 09 placeholder....
5630: 27 28 29 29 0a 09 09 20 20 20 20 29 0a 09 09 20 '())... )...
5640: 20 20 73 63 68 65 64 0a 20 20 20 20 20 20 20 20 sched.
5650: 20 20 20 20 20 20 20 20 20 20 20 65 78 74 72 61 extra
5660: 2d 64 61 74 3a 20 60 28 61 20 2c 72 75 6e 6b 65 -dat: `(a ,runke
5670: 79 29 20 20 3b 3b 20 77 65 20 6e 65 65 64 20 74 y) ;; we need t
5680: 68 65 20 72 75 6e 20 6b 65 79 20 66 6f 72 20 6d he run key for m
5690: 61 72 6b 69 6e 67 20 74 68 65 20 72 75 6e 20 61 arking the run a
56a0: 73 20 6c 61 75 6e 63 68 65 64 0a 20 20 20 20 20 s launched.
56b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 29 ))
56c0: 29 0a 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 ). (with-ou
56d0: 74 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 20 20 tput-to-file..
56e0: 28 63 6f 6e 63 20 70 6b 74 73 64 69 72 20 22 2f (conc pktsdir "/
56f0: 22 20 75 75 69 64 20 22 2e 70 6b 74 22 29 0a 09 " uuid ".pkt")..
5700: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 28 70 (lambda ().. (p
5710: 72 69 6e 74 20 70 6b 74 29 29 29 29 29 29 0a 0a rint pkt))))))..
5720: 3b 3b 20 6c 6f 6f 6b 20 66 6f 72 20 61 72 65 61 ;; look for area
5730: 73 3d 61 31 2c 61 32 2c 61 33 20 4f 52 20 61 72 s=a1,a2,a3 OR ar
5740: 65 61 66 6e 3d 73 6f 6d 65 66 75 6e 63 6e 61 6d eafn=somefuncnam
5750: 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 61 e.;;.(define (va
5760: 6c 2d 61 6c 69 73 74 2d 3e 61 72 65 61 73 20 76 l-alist->areas v
5770: 61 6c 2d 61 6c 69 73 74 29 0a 20 20 28 6c 65 74 al-alist). (let
5780: 20 28 28 61 72 65 61 73 2d 73 74 72 69 6e 67 20 ((areas-string
5790: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 72 (alist-ref 'ar
57a0: 65 61 73 20 20 76 61 6c 2d 61 6c 69 73 74 29 29 eas val-alist))
57b0: 0a 09 28 61 72 65 61 73 2d 70 72 6f 63 6e 61 6d ..(areas-procnam
57c0: 65 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 72 e (alist-ref 'ar
57d0: 65 61 66 6e 20 76 61 6c 2d 61 6c 69 73 74 29 29 eafn val-alist))
57e0: 29 0a 20 20 20 20 28 69 66 20 61 72 65 61 73 2d ). (if areas-
57f0: 70 72 6f 63 6e 61 6d 65 20 3b 3b 20 61 72 65 61 procname ;; area
5800: 73 2d 70 72 6f 63 6e 61 6d 65 20 74 61 6b 65 20 s-procname take
5810: 70 72 65 63 65 64 65 6e 63 65 0a 09 61 72 65 61 precedence..area
5820: 73 2d 70 72 6f 63 6e 61 6d 65 0a 09 28 73 74 72 s-procname..(str
5830: 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 61 72 ing-split (or ar
5840: 65 61 73 2d 73 74 72 69 6e 67 20 22 22 29 20 22 eas-string "") "
5850: 2c 22 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ,"))))..(define
5860: 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 (area-allowed? a
5870: 72 65 61 20 61 72 65 61 73 20 72 75 6e 6b 65 79 rea areas runkey
5880: 20 63 6f 6e 74 6f 75 72 29 0a 20 20 28 63 6f 6e contour). (con
5890: 64 0a 20 20 20 28 28 6e 6f 74 20 61 72 65 61 73 d. ((not areas
58a0: 29 20 23 74 29 20 3b 3b 20 6e 6f 20 73 70 65 63 ) #t) ;; no spec
58b0: 0a 20 20 20 28 28 73 74 72 69 6e 67 3f 20 61 72 . ((string? ar
58c0: 65 61 73 29 20 3b 3b 20 0a 20 20 20 20 28 6c 65 eas) ;; . (le
58d0: 74 20 28 28 63 68 65 63 6b 2d 66 6e 20 28 68 61 t ((check-fn (ha
58e0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
58f0: 61 75 6c 74 20 2a 61 72 65 61 2d 63 68 65 63 6b ault *area-check
5900: 65 72 73 2a 20 61 72 65 61 73 20 23 66 29 29 29 ers* areas #f)))
5910: 0a 20 20 20 20 20 20 28 69 66 20 63 68 65 63 6b . (if check
5920: 2d 66 6e 0a 09 20 20 28 63 68 65 63 6b 2d 66 6e -fn.. (check-fn
5930: 20 61 72 65 61 20 72 75 6e 6b 65 79 20 63 6f 6e area runkey con
5940: 74 6f 75 72 29 0a 09 20 20 23 66 29 29 29 0a 20 tour).. #f))).
5950: 20 20 28 28 6c 69 73 74 3f 20 61 72 65 61 73 29 ((list? areas)
5960: 28 6d 65 6d 62 65 72 20 61 72 65 61 20 61 72 65 (member area are
5970: 61 73 29 29 0a 20 20 20 28 65 6c 73 65 20 23 66 as)). (else #f
5980: 29 29 29 20 3b 3b 20 73 68 6f 75 6c 64 6e 27 74 ))) ;; shouldn't
5990: 20 67 65 74 20 68 65 72 65 20 0a 0a 3b 3b 20 28 get here ..;; (
59a0: 75 73 65 20 74 72 61 63 65 29 28 74 72 61 63 65 use trace)(trace
59b0: 20 63 72 65 61 74 65 2d 72 75 6e 2d 70 6b 74 29 create-run-pkt)
59c0: 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 74 20 61 6c 6c ..;; collect all
59d0: 20 6e 65 65 64 65 64 20 64 61 74 61 20 61 6e 64 needed data and
59e0: 20 63 72 65 61 74 65 20 72 75 6e 20 70 6b 74 73 create run pkts
59f0: 20 66 6f 72 20 63 6f 6e 74 6f 75 72 73 20 77 69 for contours wi
5a00: 74 68 20 63 68 61 6e 67 65 64 20 69 6e 70 75 74 th changed input
5a10: 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 67 65 s.;;.(define (ge
5a20: 6e 65 72 61 74 65 2d 72 75 6e 2d 70 6b 74 73 20 nerate-run-pkts
5a30: 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 0a mtconf toppath).
5a40: 20 20 28 6c 65 74 20 28 28 73 74 64 2d 72 75 6e (let ((std-run
5a50: 6e 61 6d 65 20 28 63 6f 6e 63 20 22 73 63 68 65 name (conc "sche
5a60: 64 22 20 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e d" (time->strin
5a70: 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 g (seconds->loca
5a80: 6c 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d l-time (current-
5a90: 73 65 63 6f 6e 64 73 29 29 20 22 25 4d 25 48 25 seconds)) "%M%H%
5aa0: 64 22 29 29 29 29 0a 20 20 20 20 28 77 69 74 68 d")))). (with
5ab0: 2d 71 75 65 75 65 2d 64 62 0a 20 20 20 20 20 6d -queue-db. m
5ac0: 74 63 6f 6e 66 0a 20 20 20 20 20 28 6c 61 6d 62 tconf. (lamb
5ad0: 64 61 20 28 70 6b 74 73 64 69 72 73 20 70 6b 74 da (pktsdirs pkt
5ae0: 73 64 69 72 20 70 64 62 29 0a 20 20 20 20 20 20 sdir pdb).
5af0: 20 28 6c 65 74 2a 20 28 28 72 67 63 6f 6e 66 64 (let* ((rgconfd
5b00: 61 74 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 at (find-and-rea
5b10: 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 74 d-config (conc t
5b20: 6f 70 70 61 74 68 20 22 2f 72 75 6e 63 6f 6e 66 oppath "/runconf
5b30: 69 67 73 2e 63 6f 6e 66 69 67 22 29 29 29 0a 09 igs.config")))..
5b40: 20 20 20 20 20 20 28 72 67 63 6f 6e 66 20 20 20 (rgconf
5b50: 20 28 63 61 72 20 72 67 63 6f 6e 66 64 61 74 29 (car rgconfdat)
5b60: 29 0a 09 20 20 20 20 20 20 28 61 6c 6c 2d 61 72 ).. (all-ar
5b70: 65 61 73 20 28 6d 61 70 20 63 61 72 20 28 63 6f eas (map car (co
5b80: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f nfigf:get-sectio
5b90: 6e 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 22 n mtconf "areas"
5ba0: 29 29 29 0a 09 20 20 20 20 20 20 28 63 6f 6e 74 ))).. (cont
5bb0: 6f 75 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 67 ours (configf:g
5bc0: 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e et-section mtcon
5bd0: 66 20 22 63 6f 6e 74 6f 75 72 73 22 29 29 0a 09 f "contours"))..
5be0: 20 20 20 20 20 20 28 74 6f 72 75 6e 20 20 20 20 (torun
5bf0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
5c00: 65 29 29 20 3b 3b 20 74 61 72 67 65 74 20 3d 3e e)) ;; target =>
5c10: 20 28 20 2e 2e 2e 20 69 6e 66 6f 20 2e 2e 2e 20 ( ... info ...
5c20: 29 0a 09 20 20 20 20 20 20 28 72 67 65 6e 74 61 ).. (rgenta
5c30: 72 67 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d rgs (hash-table-
5c40: 6b 65 79 73 20 72 67 63 6f 6e 66 29 29 29 20 3b keys rgconf))) ;
5c50: 3b 20 74 68 65 73 65 20 61 72 65 20 74 68 65 20 ; these are the
5c60: 74 61 72 67 65 74 73 20 72 65 67 69 73 74 65 72 targets register
5c70: 65 64 20 66 6f 72 20 61 75 74 6f 6d 61 74 69 63 ed for automatic
5c80: 61 6c 6c 79 20 74 72 69 67 67 65 72 69 6e 67 0a ally triggering.
5c90: 0a 09 20 28 70 72 69 6e 74 20 22 72 67 65 6e 74 .. (print "rgent
5ca0: 61 72 67 73 3a 20 22 20 72 67 65 6e 74 61 72 67 args: " rgentarg
5cb0: 73 29 0a 09 20 0a 09 20 28 66 6f 72 2d 65 61 63 s).. .. (for-eac
5cc0: 68 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 72 75 h.. (lambda (ru
5cd0: 6e 6b 65 79 29 0a 09 20 20 20 20 28 6c 65 74 2a nkey).. (let*
5ce0: 20 28 28 6b 65 79 64 61 74 73 20 20 20 28 63 6f ((keydats (co
5cf0: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f nfigf:get-sectio
5d00: 6e 20 72 67 63 6f 6e 66 20 72 75 6e 6b 65 79 29 n rgconf runkey)
5d10: 29 29 0a 09 20 20 20 20 20 20 28 66 6f 72 2d 65 )).. (for-e
5d20: 61 63 68 0a 09 20 20 20 20 20 20 20 28 6c 61 6d ach.. (lam
5d30: 62 64 61 20 28 73 65 6e 73 65 29 20 3b 3b 20 74 bda (sense) ;; t
5d40: 68 65 73 65 20 61 72 65 20 74 68 65 20 73 65 6e hese are the sen
5d50: 73 65 20 72 75 6c 65 73 0a 09 09 20 28 6c 65 74 se rules... (let
5d60: 2a 20 28 28 6b 65 79 20 20 20 20 20 20 20 20 28 * ((key (
5d70: 63 61 72 20 73 65 6e 73 65 29 29 0a 09 09 09 28 car sense))....(
5d80: 76 61 6c 20 20 20 20 20 20 20 20 28 63 61 64 72 val (cadr
5d90: 20 73 65 6e 73 65 29 29 0a 09 09 09 28 6b 65 79 sense))....(key
5da0: 70 61 72 74 73 20 20 20 28 73 74 72 69 6e 67 2d parts (string-
5db0: 73 70 6c 69 74 20 6b 65 79 20 22 3a 22 29 29 20 split key ":"))
5dc0: 3b 3b 20 63 6f 6e 74 6f 75 72 3a 72 75 6c 65 74 ;; contour:rulet
5dd0: 79 70 65 3a 61 63 74 69 6f 6e 3a 6f 70 74 69 6f ype:action:optio
5de0: 6e 61 6c 0a 09 09 09 28 63 6f 6e 74 6f 75 72 20 nal....(contour
5df0: 20 20 20 28 63 61 72 20 6b 65 79 70 61 72 74 73 (car keyparts
5e00: 29 29 0a 09 09 09 28 6c 65 6e 2d 6b 65 79 20 20 ))....(len-key
5e10: 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 72 (length keypar
5e20: 74 73 29 29 0a 09 09 09 28 72 75 6c 65 74 79 70 ts))....(ruletyp
5e30: 65 20 20 20 28 69 66 20 28 3e 20 6c 65 6e 2d 6b e (if (> len-k
5e40: 65 79 20 31 29 28 63 61 64 72 20 6b 65 79 70 61 ey 1)(cadr keypa
5e50: 72 74 73 29 20 23 66 29 29 0a 09 09 09 28 61 63 rts) #f))....(ac
5e60: 74 69 6f 6e 20 20 20 20 20 28 69 66 20 28 3e 20 tion (if (>
5e70: 6c 65 6e 2d 6b 65 79 20 32 29 28 63 61 64 64 72 len-key 2)(caddr
5e80: 20 6b 65 79 70 61 72 74 73 29 20 23 66 29 29 0a keyparts) #f)).
5e90: 09 09 09 28 6f 70 74 69 6f 6e 61 6c 20 20 20 28 ...(optional (
5ea0: 69 66 20 28 3e 20 6c 65 6e 2d 6b 65 79 20 33 29 if (> len-key 3)
5eb0: 28 63 61 64 64 64 72 20 6b 65 79 70 61 72 74 73 (cadddr keyparts
5ec0: 29 20 23 66 29 29 0a 09 09 09 3b 3b 20 28 76 61 ) #f))....;; (va
5ed0: 6c 2d 6c 69 73 74 20 20 20 28 73 74 72 69 6e 67 l-list (string
5ee0: 2d 73 70 6c 69 74 2d 66 69 65 6c 64 73 20 22 3b -split-fields ";
5ef0: 5c 5c 73 2a 22 20 76 61 6c 20 23 3a 69 6e 66 69 \\s*" val #:infi
5f00: 78 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 73 x)) ;; (string-s
5f10: 70 6c 69 74 20 76 61 6c 29 29 20 3b 3b 20 72 75 plit val)) ;; ru
5f20: 6e 6e 61 6d 65 2d 72 75 6c 65 20 70 61 72 61 6d nname-rule param
5f30: 73 0a 09 09 09 28 76 61 6c 2d 61 6c 69 73 74 20 s....(val-alist
5f40: 20 28 76 61 6c 2d 3e 61 6c 69 73 74 20 76 61 6c (val->alist val
5f50: 29 29 0a 09 09 09 28 72 75 6e 6e 61 6d 65 20 20 ))....(runname
5f60: 20 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 20 (make-runname
5f70: 22 22 20 22 22 29 29 0a 09 09 09 28 72 75 6e 74 "" ""))....(runt
5f80: 72 61 6e 73 20 20 20 28 61 6c 69 73 74 2d 72 65 rans (alist-re
5f90: 66 20 27 72 75 6e 74 72 61 6e 73 20 76 61 6c 2d f 'runtrans val-
5fa0: 61 6c 69 73 74 29 29 0a 0a 09 09 09 3b 3b 20 74 alist)).....;; t
5fb0: 68 65 73 65 20 6d 61 79 20 6f 72 20 6d 61 79 20 hese may or may
5fc0: 6e 6f 74 20 62 65 20 64 65 66 69 6e 65 64 20 61 not be defined a
5fd0: 6e 64 20 6e 6f 74 20 61 6c 6c 20 61 72 65 20 75 nd not all are u
5fe0: 73 65 64 20 69 6e 20 65 61 63 68 20 68 61 6e 64 sed in each hand
5ff0: 6c 65 72 20 74 79 70 65 20 69 6e 20 74 68 65 20 ler type in the
6000: 63 61 73 65 20 62 65 6c 6f 77 0a 09 09 09 28 72 case below....(r
6010: 75 6e 2d 6e 61 6d 65 20 20 20 28 61 6c 69 73 74 un-name (alist
6020: 2d 72 65 66 20 27 72 75 6e 2d 6e 61 6d 65 20 76 -ref 'run-name v
6030: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 74 al-alist))....(t
6040: 61 72 67 65 74 20 20 20 20 20 28 61 6c 69 73 74 arget (alist
6050: 2d 72 65 66 20 27 74 61 72 67 65 74 20 20 20 76 -ref 'target v
6060: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 63 al-alist))....(c
6070: 72 6f 6e 74 61 62 20 20 20 20 28 61 6c 69 73 74 rontab (alist
6080: 2d 72 65 66 20 27 63 72 6f 6e 20 20 20 20 20 76 -ref 'cron v
6090: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 61 al-alist))....(a
60a0: 72 65 61 73 20 20 20 20 20 20 28 76 61 6c 2d 61 reas (val-a
60b0: 6c 69 73 74 2d 3e 61 72 65 61 73 20 20 20 20 76 list->areas v
60c0: 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 61 72 al-alist)) ;; ar
60d0: 65 61 73 20 63 61 6e 20 62 65 20 61 20 73 69 6e eas can be a sin
60e0: 67 6c 65 20 73 74 72 69 6e 67 20 28 61 20 72 65 gle string (a re
60f0: 66 65 72 65 6e 63 65 20 74 6f 20 63 61 6c 6c 20 ference to call
6100: 61 6e 20 61 72 65 61 73 20 66 75 6e 63 74 69 6f an areas functio
6110: 6e 29 2c 20 6f 72 20 61 20 6c 69 73 74 20 6f 66 n), or a list of
6120: 20 61 72 65 61 20 6e 61 6d 65 73 2e 0a 09 09 09 area names.....
6130: 28 64 62 64 65 73 74 20 20 20 20 20 28 61 6c 69 (dbdest (ali
6140: 73 74 2d 72 65 66 20 27 64 62 64 65 73 74 20 20 st-ref 'dbdest
6150: 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 val-alist))....
6160: 28 61 70 70 65 6e 64 63 6f 6e 66 20 28 61 6c 69 (appendconf (ali
6170: 73 74 2d 72 65 66 20 27 61 70 70 65 6e 64 63 6f st-ref 'appendco
6180: 6e 66 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 nf val-alist))..
6190: 09 09 28 66 69 6c 65 2d 67 6c 6f 62 73 20 28 61 ..(file-globs (a
61a0: 6c 69 73 74 2d 72 65 66 20 27 67 6c 6f 62 20 76 list-ref 'glob v
61b0: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 0a 09 al-alist))......
61c0: 09 09 28 72 75 6e 73 74 61 72 74 73 20 20 28 66 ..(runstarts (f
61d0: 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 72 ind-pkts pdb '(r
61e0: 75 6e 73 74 61 72 74 29 20 60 28 28 6f 20 2e 20 unstart) `((o .
61f0: 2c 63 6f 6e 74 6f 75 72 29 0a 09 09 09 09 09 09 ,contour).......
6200: 09 09 20 28 74 20 2e 20 2c 72 75 6e 6b 65 79 29 .. (t . ,runkey)
6210: 29 29 29 0a 09 09 09 28 72 73 70 6b 74 73 20 20 )))....(rspkts
6220: 20 20 20 28 67 65 74 2d 70 6b 74 2d 61 6c 69 73 (get-pkt-alis
6230: 74 73 20 72 75 6e 73 74 61 72 74 73 29 29 0a 09 ts runstarts))..
6240: 09 09 3b 3b 20 73 74 61 72 74 74 69 6d 65 73 20 ..;; starttimes
6250: 69 73 20 66 6f 72 20 72 75 6e 20 73 74 61 72 74 is for run start
6260: 20 74 69 6d 65 73 20 61 6e 64 20 69 73 20 75 73 times and is us
6270: 65 64 20 74 6f 20 6b 6e 6f 77 20 77 68 65 6e 20 ed to know when
6280: 74 68 65 20 6c 61 73 74 20 72 75 6e 20 77 61 73 the last run was
6290: 20 6c 61 75 6e 63 68 65 64 0a 09 09 09 28 73 74 launched....(st
62a0: 61 72 74 74 69 6d 65 73 20 28 67 65 74 2d 70 6b arttimes (get-pk
62b0: 74 2d 74 69 6d 65 73 20 72 73 70 6b 74 73 29 29 t-times rspkts))
62c0: 20 3b 3b 20 73 6f 72 74 20 62 79 20 61 67 65 20 ;; sort by age
62d0: 28 79 6f 75 6e 67 65 73 74 20 66 69 72 73 74 29 (youngest first)
62e0: 20 61 6e 64 20 64 65 6c 65 74 65 20 64 75 70 6c and delete dupl
62f0: 69 63 61 74 65 73 20 62 79 20 74 61 72 67 65 74 icates by target
6300: 0a 09 09 09 28 6c 61 73 74 2d 72 75 6e 20 20 20 ....(last-run
6310: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 (if (null? start
6320: 74 69 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 29 times) ;; if '()
6330: 20 74 68 65 6e 20 69 74 20 68 61 73 20 6e 65 76 then it has nev
6340: 65 72 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c 73 er been run, els
6350: 65 20 67 65 74 20 74 68 65 20 6d 61 78 0a 09 09 e get the max...
6360: 09 09 09 30 0a 09 09 09 09 09 28 61 70 70 6c 79 ...0......(apply
6370: 20 6d 61 78 20 28 6d 61 70 20 63 64 72 20 73 74 max (map cdr st
6380: 61 72 74 74 69 6d 65 73 29 29 29 29 0a 09 09 09 arttimes))))....
6390: 3b 3b 20 73 79 6e 63 74 69 6d 65 73 20 69 73 20 ;; synctimes is
63a0: 66 6f 72 20 66 69 67 75 72 69 6e 67 20 6f 75 74 for figuring out
63b0: 20 74 68 65 20 6c 61 73 74 20 74 69 6d 65 20 61 the last time a
63c0: 20 73 79 6e 63 20 77 61 73 20 64 6f 6e 65 0a 09 sync was done..
63d0: 09 09 28 73 79 6e 63 73 74 61 72 74 73 20 28 66 ..(syncstarts (f
63e0: 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 73 ind-pkts pdb '(s
63f0: 79 6e 63 73 74 61 72 74 29 20 27 28 29 29 29 20 yncstart) '()))
6400: 3b 3b 20 6e 6f 20 71 75 61 6c 69 66 69 65 72 73 ;; no qualifiers
6410: 2c 20 61 20 73 79 6e 63 20 64 6f 65 73 20 61 6c , a sync does al
6420: 6c 20 74 61 72 65 74 73 20 65 74 63 2e 0a 09 09 l tarets etc....
6430: 09 28 73 73 70 6b 74 73 20 20 20 20 20 28 67 65 .(sspkts (ge
6440: 74 2d 70 6b 74 2d 61 6c 69 73 74 73 20 73 79 6e t-pkt-alists syn
6450: 63 73 74 61 72 74 73 29 29 0a 09 09 09 28 73 79 cstarts))....(sy
6460: 6e 63 74 69 6d 65 73 20 20 28 67 65 74 2d 70 6b nctimes (get-pk
6470: 74 2d 74 69 6d 65 73 20 20 73 73 70 6b 74 73 29 t-times sspkts)
6480: 29 0a 09 09 09 28 6c 61 73 74 2d 73 79 6e 63 20 )....(last-sync
6490: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 79 6e 63 (if (null? sync
64a0: 74 69 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 29 times) ;; if '()
64b0: 20 74 68 65 6e 20 69 74 20 68 61 73 20 6e 65 76 then it has nev
64c0: 65 72 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c 73 er been run, els
64d0: 65 20 67 65 74 20 74 68 65 20 6d 61 78 0a 09 09 e get the max...
64e0: 09 09 09 30 0a 09 09 09 09 09 28 61 70 70 6c 79 ...0......(apply
64f0: 20 6d 61 78 20 28 6d 61 70 20 63 64 72 20 73 79 max (map cdr sy
6500: 6e 63 74 69 6d 65 73 29 29 29 29 0a 09 09 09 29 nctimes))))....)
6510: 0a 0a 09 09 20 20 20 28 6c 65 74 20 28 28 64 65 .... (let ((de
6520: 6c 74 61 20 28 6c 61 6d 62 64 61 20 28 78 29 0a lta (lambda (x).
6530: 09 09 09 09 20 20 28 72 6f 75 6e 64 20 28 2f 20 .... (round (/
6540: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
6550: 6e 64 73 29 20 78 29 20 36 30 29 29 29 29 29 0a nds) x) 60))))).
6560: 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 72 .. (print "r
6570: 75 6e 6b 65 79 3a 20 22 20 72 75 6e 6b 65 79 20 unkey: " runkey
6580: 22 2c 20 72 75 6c 65 74 79 70 65 3a 20 22 20 72 ", ruletype: " r
6590: 75 6c 65 74 79 70 65 20 22 2c 20 61 63 74 69 6f uletype ", actio
65a0: 6e 3a 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 6c n: " action ", l
65b0: 61 73 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 2d ast-run: " last-
65c0: 72 75 6e 20 22 20 74 69 6d 65 20 73 69 6e 63 65 run " time since
65d0: 3b 20 6c 61 73 74 2d 72 75 6e 3a 20 22 20 28 64 ; last-run: " (d
65e0: 65 6c 74 61 20 6c 61 73 74 2d 72 75 6e 29 20 22 elta last-run) "
65f0: 2c 20 6c 61 73 74 2d 73 79 6e 63 3a 20 22 20 28 , last-sync: " (
6600: 64 65 6c 74 61 20 6c 61 73 74 2d 73 79 6e 63 29 delta last-sync)
6610: 29 29 0a 0a 09 09 20 20 20 28 70 72 69 6e 74 20 )).... (print
6620: 22 76 61 6c 2d 61 6c 69 73 74 3d 22 20 76 61 6c "val-alist=" val
6630: 2d 61 6c 69 73 74 20 22 20 72 75 6e 74 72 61 6e -alist " runtran
6640: 73 3d 22 20 72 75 6e 74 72 61 6e 73 29 0a 09 09 s=" runtrans)...
6650: 20 20 20 0a 09 09 20 20 20 3b 3b 20 6c 6f 6f 6b ... ;; look
6660: 20 69 6e 20 72 75 6e 73 74 61 72 74 73 20 66 6f in runstarts fo
6670: 72 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 73 20 r matching runs
6680: 62 79 20 74 61 72 67 65 74 20 61 6e 64 20 63 6f by target and co
6690: 6e 74 6f 75 72 0a 09 09 20 20 20 3b 3b 20 67 65 ntour... ;; ge
66a0: 74 20 74 68 65 20 74 69 6d 65 73 74 61 6d 70 20 t the timestamp
66b0: 66 6f 72 20 77 68 65 6e 20 74 68 61 74 20 72 75 for when that ru
66c0: 6e 20 73 74 61 72 74 65 64 20 61 6e 64 20 70 61 n started and pa
66d0: 73 73 20 69 74 0a 09 09 20 20 20 3b 3b 20 74 6f ss it... ;; to
66e0: 20 74 68 65 20 72 75 6c 65 20 6c 6f 67 69 63 20 the rule logic
66f0: 68 65 72 65 20 77 68 65 72 65 20 22 72 75 6c 65 here where "rule
6700: 74 79 70 65 22 20 77 69 6c 6c 20 62 65 20 61 70 type" will be ap
6710: 70 6c 69 65 64 0a 09 09 20 20 20 3b 3b 20 69 66 plied... ;; if
6720: 20 69 74 20 63 6f 6d 65 73 20 62 61 63 6b 20 22 it comes back "
6730: 63 68 61 6e 67 65 64 22 20 74 68 65 6e 20 70 72 changed" then pr
6740: 6f 63 65 65 64 20 74 6f 20 72 65 67 69 73 74 65 oceed to registe
6750: 72 20 74 68 65 20 72 75 6e 73 0a 09 09 20 20 20 r the runs...
6760: 0a 09 09 20 20 20 28 63 61 73 65 20 28 73 74 72 ... (case (str
6770: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 ing->symbol (or
6780: 72 75 6c 65 74 79 70 65 20 22 6e 6f 2d 73 75 63 ruletype "no-suc
6790: 68 2d 72 75 6c 65 22 29 29 0a 0a 09 09 20 20 20 h-rule"))....
67a0: 20 20 28 28 6e 6f 2d 73 75 63 68 2d 72 75 6c 65 ((no-such-rule
67b0: 29 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a ) (print "ERROR:
67c0: 20 6e 6f 20 73 75 63 68 20 72 75 6c 65 20 66 6f no such rule fo
67d0: 72 20 22 20 73 65 6e 73 65 29 29 0a 0a 09 09 20 r " sense))....
67e0: 20 20 20 20 3b 3b 20 48 61 6e 64 6c 65 20 63 72 ;; Handle cr
67f0: 6f 6e 74 61 62 20 6c 69 6b 65 20 72 75 6c 65 73 ontab like rules
6800: 0a 09 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 ... ;;...
6810: 20 20 28 28 73 63 68 65 64 75 6c 65 64 29 0a 09 ((scheduled)..
6820: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
6830: 28 61 6c 69 73 74 2d 72 65 66 20 27 63 72 6f 6e (alist-ref 'cron
6840: 20 76 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 val-alist)) ;;
6850: 67 6f 74 74 61 20 68 61 76 65 20 63 72 6f 6e 20 gotta have cron
6860: 73 70 65 63 0a 09 09 09 20 20 28 70 72 69 6e 74 spec.... (print
6870: 20 22 45 52 52 4f 52 3a 20 62 61 64 20 73 65 6e "ERROR: bad sen
6880: 73 65 20 73 70 65 63 20 5c 22 22 20 28 73 74 72 se spec \"" (str
6890: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
68a0: 73 65 6e 73 65 20 22 20 22 29 20 22 5c 22 20 70 sense " ") "\" p
68b0: 61 72 61 6d 73 3a 20 22 20 76 61 6c 2d 61 6c 69 arams: " val-ali
68c0: 73 74 29 0a 09 09 09 20 20 28 6c 65 74 2a 20 28 st).... (let* (
68d0: 0a 09 09 09 09 20 3b 3b 20 28 61 63 74 69 6f 6e ..... ;; (action
68e0: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 (alist-ref 'a
68f0: 63 74 69 6f 6e 20 20 20 76 61 6c 2d 61 6c 69 73 ction val-alis
6900: 74 29 29 0a 09 09 09 09 20 28 63 72 6f 6e 2d 73 t))..... (cron-s
6910: 61 66 65 2d 73 74 72 69 6e 67 20 28 73 74 72 69 afe-string (stri
6920: 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 73 74 ng-translate (st
6930: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
6940: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
6950: 72 6f 6e 74 61 62 29 20 22 2d 22 29 20 22 2a 22 rontab) "-") "*"
6960: 20 22 58 22 29 29 0a 09 09 09 09 20 28 72 75 6e "X"))..... (run
6970: 6e 61 6d 65 20 20 73 74 64 2d 72 75 6e 6e 61 6d name std-runnam
6980: 65 29 29 20 3b 3b 20 28 63 6f 6e 63 20 22 73 63 e)) ;; (conc "sc
6990: 68 65 64 22 20 28 74 69 6d 65 2d 3e 73 74 72 69 hed" (time->stri
69a0: 6e 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 ng (seconds->loc
69b0: 61 6c 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 al-time (current
69c0: 2d 73 65 63 6f 6e 64 73 29 29 20 22 25 4d 25 48 -seconds)) "%M%H
69d0: 25 64 22 29 29 29 29 29 0a 09 09 09 20 20 20 20 %d")))))....
69e0: 3b 3b 20 28 70 72 69 6e 74 20 22 6c 61 73 74 2d ;; (print "last-
69f0: 72 75 6e 3a 20 22 20 6c 61 73 74 2d 72 75 6e 20 run: " last-run
6a00: 22 20 6e 65 65 64 2d 72 75 6e 3a 20 22 20 6e 65 " need-run: " ne
6a10: 65 64 2d 72 75 6e 29 0a 09 09 09 20 20 20 20 3b ed-run).... ;
6a20: 3b 20 28 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 ; (if need-run..
6a30: 09 09 20 20 20 20 28 63 61 73 65 20 28 73 74 72 .. (case (str
6a40: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 ing->symbol acti
6a50: 6f 6e 29 0a 09 09 09 20 20 20 20 20 20 28 28 73 on).... ((s
6a60: 79 6e 63 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 ync sync-prepend
6a70: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ).... (if
6a80: 28 63 6f 6d 6d 6f 6e 3a 65 78 74 65 6e 64 65 64 (common:extended
6a90: 2d 63 72 6f 6e 20 63 72 6f 6e 74 61 62 20 23 66 -cron crontab #f
6aa0: 20 6c 61 73 74 2d 73 79 6e 63 29 0a 09 09 09 09 last-sync).....
6ab0: 20 20 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 (push-run-spe
6ac0: 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 c torun contour
6ad0: 72 75 6e 6b 65 79 0a 09 09 09 09 09 09 20 20 60 runkey....... `
6ae0: 28 28 6d 65 73 73 61 67 65 20 2e 20 2c 28 63 6f ((message . ,(co
6af0: 6e 63 20 72 75 6c 65 74 79 70 65 20 22 3a 73 79 nc ruletype ":sy
6b00: 6e 63 2d 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 nc-" cron-safe-s
6b10: 74 72 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 tring)).......
6b20: 20 20 28 61 63 74 69 6f 6e 20 20 2e 20 2c 61 63 (action . ,ac
6b30: 74 69 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 20 tion).......
6b40: 28 64 62 64 65 73 74 20 20 2e 20 2c 64 62 64 65 (dbdest . ,dbde
6b50: 73 74 29 0a 09 09 09 09 09 09 20 20 20 20 28 61 st)....... (a
6b60: 70 70 65 6e 64 20 20 2e 20 2c 61 70 70 65 6e 64 ppend . ,append
6b70: 63 6f 6e 66 29 0a 09 09 09 09 09 09 20 20 20 20 conf).......
6b80: 28 61 72 65 61 73 20 20 20 2e 20 2c 61 72 65 61 (areas . ,area
6b90: 73 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 s)))))....
6ba0: 28 28 72 75 6e 29 0a 09 09 09 20 20 20 20 20 20 ((run)....
6bb0: 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 65 78 74 (if (common:ext
6bc0: 65 6e 64 65 64 2d 63 72 6f 6e 20 63 72 6f 6e 74 ended-cron cront
6bd0: 61 62 20 23 66 20 6c 61 73 74 2d 72 75 6e 29 0a ab #f last-run).
6be0: 09 09 09 09 20 20 20 28 70 75 73 68 2d 72 75 6e .... (push-run
6bf0: 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 -spec torun cont
6c00: 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 our runkey......
6c10: 09 20 20 60 28 28 6d 65 73 73 61 67 65 20 20 2e . `((message .
6c20: 20 2c 28 63 6f 6e 63 20 72 75 6c 65 74 79 70 65 ,(conc ruletype
6c30: 20 22 3a 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 ":" cron-safe-s
6c40: 74 72 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 tring)).......
6c50: 20 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 (runname . ,r
6c60: 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 20 20 unname).......
6c70: 20 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 (runtrans . ,r
6c80: 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 untrans).......
6c90: 20 20 20 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c (action . ,
6ca0: 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 20 20 action).......
6cb0: 20 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 (areas . ,a
6cc0: 72 65 61 73 29 0a 09 09 09 09 09 09 20 20 20 20 reas).......
6cd0: 28 74 61 72 67 65 74 20 20 20 2e 20 2c 74 61 72 (target . ,tar
6ce0: 67 65 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 get))))).
6cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d00: 20 20 20 20 20 20 20 28 28 72 65 6d 6f 76 65 29 ((remove)
6d10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d30: 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 (push-run-spec t
6d40: 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e orun contour run
6d50: 6b 65 79 0a 09 09 09 09 09 09 20 20 60 28 28 6d key....... `((m
6d60: 65 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 essage . ,(conc
6d70: 20 72 75 6c 65 74 79 70 65 20 22 3a 22 20 63 72 ruletype ":" cr
6d80: 6f 6e 2d 73 61 66 65 2d 73 74 72 69 6e 67 29 29 on-safe-string))
6d90: 0a 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 6e ....... (runn
6da0: 61 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 ame . ,runname)
6db0: 0a 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 74 ....... (runt
6dc0: 72 61 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 rans . ,runtrans
6dd0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 61 63 74 )....... (act
6de0: 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 ion . ,action)
6df0: 0a 09 09 09 09 09 09 20 20 20 20 28 61 72 65 61 ....... (area
6e00: 73 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 s . ,areas)..
6e10: 09 09 09 09 09 20 20 20 20 28 74 61 72 67 65 74 ..... (target
6e20: 20 20 20 2e 20 2c 74 61 72 67 65 74 29 29 29 29 . ,target))))
6e30: 0a 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 0a .... (else.
6e40: 09 09 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 ... (print
6e50: 20 22 45 52 52 4f 52 3a 20 61 63 74 69 6f 6e 20 "ERROR: action
6e60: 5c 22 22 20 61 63 74 69 6f 6e 20 22 5c 22 20 68 \"" action "\" h
6e70: 61 73 20 6e 6f 20 73 63 68 65 64 75 6c 65 64 20 as no scheduled
6e80: 68 61 6e 64 6c 65 72 22 29 0a 09 09 09 20 20 20 handler")....
6e90: 20 20 20 20 29 29 29 29 29 0a 0a 09 09 20 20 20 )))))....
6ea0: 20 20 3b 3b 20 73 63 72 69 70 74 20 62 61 73 65 ;; script base
6eb0: 64 20 73 65 6e 73 6f 72 73 0a 09 09 20 20 20 20 d sensors...
6ec0: 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 73 63 72 ;;... ((scr
6ed0: 69 70 74 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 ipt)... ;;
6ee0: 73 79 6e 74 61 78 20 69 73 20 61 20 6c 69 74 74 syntax is a litt
6ef0: 6c 65 20 64 69 66 66 65 72 65 6e 74 20 68 65 72 le different her
6f00: 65 2e 20 49 74 20 69 73 20 61 20 6c 69 73 74 20 e. It is a list
6f10: 6f 66 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 72 of commands to r
6f20: 75 6e 2c 20 22 73 63 72 69 70 74 6e 61 6d 65 20 un, "scriptname
6f30: 3d 20 65 78 74 72 61 5f 70 61 72 61 6d 65 74 65 = extra_paramete
6f40: 72 73 3b 73 63 72 69 70 74 6e 61 6d 65 20 3d 20 rs;scriptname =
6f50: 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 3b 3b 20 ..."... ;;
6f60: 77 68 65 72 65 20 73 63 72 69 70 74 6e 61 6d 65 where scriptname
6f70: 20 6d 61 79 20 62 65 20 72 65 70 65 61 74 65 64 may be repeated
6f80: 20 6d 75 6c 74 69 70 6c 65 20 74 69 6d 65 73 2e multiple times.
6f90: 20 54 68 65 20 73 63 72 69 70 74 20 6d 75 73 74 The script must
6fa0: 20 72 65 74 75 72 6e 20 75 6e 69 78 2d 65 70 6f return unix-epo
6fb0: 63 68 20 6f 66 20 6c 61 73 74 20 63 68 61 6e 67 ch of last chang
6fc0: 65 2c 20 6e 65 77 2d 74 61 72 67 65 74 2d 6e 61 e, new-target-na
6fd0: 6d 65 20 61 6e 64 20 6e 65 77 2d 72 75 6e 2d 6e me and new-run-n
6fe0: 61 6d 65 0a 09 09 20 20 20 20 20 20 3b 3b 20 74 ame... ;; t
6ff0: 68 65 20 73 63 72 69 70 74 20 69 73 20 63 61 6c he script is cal
7000: 6c 65 64 20 6c 69 6b 65 20 74 68 69 73 3a 20 20 led like this:
7010: 73 63 72 69 70 74 6e 61 6d 65 20 63 6f 6e 74 6f scriptname conto
7020: 75 72 20 72 75 6e 6b 65 79 20 73 74 64 2d 72 75 ur runkey std-ru
7030: 6e 6e 61 6d 65 20 61 63 74 69 6f 6e 20 65 78 74 nname action ext
7040: 72 61 5f 70 61 72 61 6d 31 20 65 78 74 72 61 5f ra_param1 extra_
7050: 70 61 72 61 6d 32 20 2e 2e 2e 0a 09 09 20 20 20 param2 ......
7060: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 (for-each...
7070: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
7080: 6d 64 29 0a 09 09 09 20 28 70 72 69 6e 74 20 22 md).... (print "
7090: 63 6d 64 3a 20 22 20 63 6d 64 29 0a 09 09 09 20 cmd: " cmd)....
70a0: 28 6c 65 74 2a 20 28 28 73 63 72 69 70 74 20 28 (let* ((script (
70b0: 63 61 72 20 63 6d 64 29 29 0a 09 09 09 09 28 70 car cmd)).....(p
70c0: 61 72 61 6d 73 20 28 63 64 72 20 63 6d 64 29 29 arams (cdr cmd))
70d0: 0a 09 09 09 09 28 63 6d 64 20 20 20 20 28 63 6f .....(cmd (co
70e0: 6e 63 20 73 63 72 69 70 74 20 22 20 22 20 63 6f nc script " " co
70f0: 6e 74 6f 75 72 20 22 20 22 20 72 75 6e 6b 65 79 ntour " " runkey
7100: 20 22 20 22 20 73 74 64 2d 72 75 6e 6e 61 6d 65 " " std-runname
7110: 20 22 20 22 20 61 63 74 69 6f 6e 20 22 20 22 20 " " action " "
7120: 70 61 72 61 6d 73 29 29 0a 09 09 09 09 28 72 65 params)).....(re
7130: 73 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 s (handle-exc
7140: 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 20 20 20 eptions......
7150: 20 65 78 6e 0a 09 09 09 09 09 20 20 20 20 23 66 exn...... #f
7160: 0a 09 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 ...... (print "
7170: 52 75 6e 6e 69 6e 67 20 22 20 63 6d 64 29 0a 09 Running " cmd)..
7180: 09 09 09 09 20 20 28 77 69 74 68 2d 69 6e 70 75 .... (with-inpu
7190: 74 2d 66 72 6f 6d 2d 70 69 70 65 20 63 6d 64 20 t-from-pipe cmd
71a0: 72 65 61 64 2d 6c 69 6e 65 73 29 29 29 29 0a 09 read-lines))))..
71b0: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 72 65 .. (if (and re
71c0: 73 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 s (not (null? re
71d0: 73 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 s))).... (
71e0: 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 20 20 let* ((parts
71f0: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
7200: 20 28 63 61 72 20 72 65 73 29 29 29 20 3b 3b 0a (car res))) ;;.
7210: 09 09 09 09 20 20 20 20 20 20 28 72 65 6d 2d 6c .... (rem-l
7220: 69 6e 65 73 20 20 20 28 63 64 72 20 72 65 73 29 ines (cdr res)
7230: 29 0a 09 09 09 09 20 20 20 20 20 20 28 6e 75 6d )..... (num
7240: 2d 70 61 72 74 73 20 20 20 28 6c 65 6e 67 74 68 -parts (length
7250: 20 70 61 72 74 73 29 29 0a 09 09 09 09 20 20 20 parts)).....
7260: 20 20 20 28 6c 61 73 74 2d 63 68 61 6e 67 65 20 (last-change
7270: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
7280: 28 69 66 20 28 3e 20 6e 75 6d 2d 70 61 72 74 73 (if (> num-parts
7290: 20 30 29 28 63 61 72 20 70 61 72 74 73 29 20 22 0)(car parts) "
72a0: 61 62 63 22 29 29 29 20 20 3b 3b 20 66 6f 72 63 abc"))) ;; forc
72b0: 65 20 6e 6f 20 72 75 6e 20 69 66 20 6e 6f 74 20 e no run if not
72c0: 61 20 6e 75 6d 62 65 72 20 72 65 74 75 72 6e 65 a number returne
72d0: 64 0a 09 09 09 09 20 20 20 20 20 20 28 6e 65 77 d..... (new
72e0: 2d 74 61 72 67 65 74 20 20 28 69 66 20 28 3e 20 -target (if (>
72f0: 6e 75 6d 2d 70 61 72 74 73 20 31 29 0a 09 09 09 num-parts 1)....
7300: 09 09 09 20 20 20 20 20 20 20 28 63 61 64 72 20 ... (cadr
7310: 70 61 72 74 73 29 0a 09 09 09 09 09 09 20 20 20 parts).......
7320: 20 20 20 20 72 75 6e 6b 65 79 29 29 0a 09 09 09 runkey))....
7330: 09 20 20 20 20 20 20 28 6e 65 77 2d 72 75 6e 6e . (new-runn
7340: 61 6d 65 20 28 69 66 20 28 3e 20 6e 75 6d 2d 70 ame (if (> num-p
7350: 61 72 74 73 20 32 29 0a 09 09 09 09 09 09 20 20 arts 2).......
7360: 20 20 20 20 20 28 63 61 64 64 72 20 70 61 72 74 (caddr part
7370: 73 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 s).......
7380: 73 74 64 2d 72 75 6e 6e 61 6d 65 29 29 0a 09 09 std-runname))...
7390: 09 09 20 20 20 20 20 20 28 6d 65 73 73 61 67 65 .. (message
73a0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
73b0: 72 65 6d 2d 6c 69 6e 65 73 29 0a 09 09 09 09 09 rem-lines)......
73c0: 09 20 20 20 20 20 20 20 63 6d 64 0a 09 09 09 09 . cmd.....
73d0: 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 .. (string
73e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 6d -intersperse rem
73f0: 2d 6c 69 6e 65 73 20 22 2d 22 29 29 29 0a 09 09 -lines "-")))...
7400: 09 09 20 20 20 20 20 20 28 6e 65 65 64 2d 72 75 .. (need-ru
7410: 6e 20 20 20 20 28 3e 20 6c 61 73 74 2d 63 68 61 n (> last-cha
7420: 6e 67 65 20 6c 61 73 74 2d 72 75 6e 29 29 29 0a nge last-run))).
7430: 09 09 09 09 20 28 70 72 69 6e 74 20 22 6c 61 73 .... (print "las
7440: 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 2d 72 75 t-run: " last-ru
7450: 6e 20 22 20 6e 65 65 64 2d 72 75 6e 3a 20 22 20 n " need-run: "
7460: 6e 65 65 64 2d 72 75 6e 29 0a 09 09 09 09 20 28 need-run)..... (
7470: 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 09 09 09 if need-run.....
7480: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 (let* ((key
7490: 2d 6d 73 67 20 20 20 20 60 28 28 6d 65 73 73 61 -msg `((messa
74a0: 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c ge . ,(conc rul
74b0: 65 74 79 70 65 20 22 3a 22 20 6d 65 73 73 61 67 etype ":" messag
74c0: 65 29 29 0a 09 09 09 09 09 09 09 20 20 28 72 75 e))........ (ru
74d0: 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 6d nname . ,runnam
74e0: 65 29 0a 09 09 09 09 09 09 09 20 20 28 72 75 6e e)........ (run
74f0: 74 72 61 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e trans . ,runtran
7500: 73 29 0a 09 09 09 09 09 09 09 20 20 28 61 63 74 s)........ (act
7510: 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 ion . ,action)
7520: 0a 09 09 09 09 09 09 09 20 20 28 61 72 65 61 73 ........ (areas
7530: 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 . ,areas)...
7540: 09 09 09 09 09 20 20 28 74 61 72 67 65 74 20 20 ..... (target
7550: 20 2e 20 2c 6e 65 77 2d 74 61 72 67 65 74 29 20 . ,new-target)
7560: 3b 3b 20 6f 76 65 72 72 69 64 69 6e 67 20 77 69 ;; overriding wi
7570: 74 68 20 72 65 73 75 6c 74 20 66 72 6f 6d 20 72 th result from r
7580: 75 6e 69 6e 67 20 74 68 65 20 73 63 72 69 70 74 uning the script
7590: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
75a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75c0: 20 20 20 20 20 20 20 20 20 20 20 29 29 29 0a 09 )))..
75d0: 09 09 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 ... (print
75e0: 20 22 6b 65 79 2d 6d 73 67 3a 20 22 20 6b 65 79 "key-msg: " key
75f0: 2d 6d 73 67 29 0a 09 09 09 09 20 20 20 20 20 20 -msg).....
7600: 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 (push-run-spec
7610: 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 0a 09 09 torun contour...
7620: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 6f 70 .... (if op
7630: 74 69 6f 6e 61 6c 20 20 3b 3b 20 77 65 20 6e 65 tional ;; we ne
7640: 65 64 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f ed to be able to
7650: 20 64 69 66 66 65 72 65 6e 74 69 61 74 65 20 73 differentiate s
7660: 61 6d 65 20 63 6f 6e 74 6f 75 72 2c 20 64 69 66 ame contour, dif
7670: 66 65 72 65 6e 74 20 62 65 68 61 76 69 6f 72 2e ferent behavior.
7680: 20 0a 09 09 09 09 09 09 09 20 20 28 63 6f 6e 63 ........ (conc
7690: 20 72 75 6e 6b 65 79 20 22 3a 22 20 6f 70 74 69 runkey ":" opti
76a0: 6f 6e 61 6c 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 onal) ;; NOTE:
76b0: 4e 4f 54 20 43 4f 4d 50 4c 45 54 45 4c 59 20 49 NOT COMPLETELY I
76c0: 4d 50 4c 45 4d 45 4e 54 45 44 2e 20 44 4f 20 4e MPLEMENTED. DO N
76d0: 4f 54 20 55 53 45 0a 09 09 09 09 09 09 09 20 20 OT USE........
76e0: 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 09 20 20 runkey).......
76f0: 20 20 20 20 6b 65 79 2d 6d 73 67 29 29 29 29 29 key-msg)))))
7700: 29 29 0a 09 09 20 20 20 20 20 20 20 76 61 6c 2d ))... val-
7710: 61 6c 69 73 74 29 29 20 3b 3b 20 69 74 65 72 61 alist)) ;; itera
7720: 74 65 20 6f 76 65 72 20 74 68 65 20 70 61 72 61 te over the para
7730: 6d 20 73 70 6c 69 74 20 62 79 20 3b 5c 73 2a 0a m split by ;\s*.
7740: 0a 09 09 20 20 20 20 20 3b 3b 20 66 6f 73 73 69 ... ;; fossi
7750: 6c 20 73 63 6d 20 62 61 73 65 64 20 74 72 69 67 l scm based trig
7760: 67 65 72 73 0a 09 09 20 20 20 20 20 3b 3b 0a 09 gers... ;;..
7770: 09 20 20 20 20 20 28 28 66 6f 73 73 69 6c 29 0a . ((fossil).
7780: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
7790: 68 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 h... (lamb
77a0: 64 61 20 28 66 73 70 65 63 29 0a 09 09 09 20 28 da (fspec).... (
77b0: 70 72 69 6e 74 20 22 66 73 70 65 63 3a 20 22 20 print "fspec: "
77c0: 66 73 70 65 63 29 0a 09 09 09 20 28 6c 65 74 2a fspec).... (let*
77d0: 20 28 28 75 72 6c 20 20 20 20 20 20 20 20 20 28 ((url (
77e0: 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 28 symbol->string (
77f0: 63 61 72 20 66 73 70 65 63 29 29 29 20 3b 3b 20 car fspec))) ;;
7800: 54 48 49 53 20 43 4f 55 4c 44 20 42 45 20 54 52 THIS COULD BE TR
7810: 4f 55 42 4c 45 2e 20 41 64 64 20 6f 70 74 69 6f OUBLE. Add optio
7820: 6e 20 74 6f 20 72 65 61 64 69 6e 67 20 6c 69 6e n to reading lin
7830: 65 20 74 6f 20 72 65 74 75 72 6e 20 61 73 20 73 e to return as s
7840: 74 72 69 6e 67 2e 0a 09 09 09 09 28 62 72 61 6e tring......(bran
7850: 63 68 20 20 20 20 20 20 28 63 64 72 20 66 73 70 ch (cdr fsp
7860: 65 63 29 29 0a 09 09 09 09 28 75 72 6c 2d 69 73 ec)).....(url-is
7870: 2d 66 69 6c 65 20 28 73 74 72 69 6e 67 2d 6d 61 -file (string-ma
7880: 74 63 68 20 22 5e 28 2f 7c 66 69 6c 65 3a 29 2e tch "^(/|file:).
7890: 2a 24 22 20 75 72 6c 29 29 0a 09 09 09 09 28 66 *$" url)).....(f
78a0: 6e 61 6d 65 20 20 20 20 20 20 20 28 63 6f 6e 63 name (conc
78b0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 73 69 67 (common:get-sig
78c0: 6e 61 74 75 72 65 20 75 72 6c 29 20 22 2e 66 6f nature url) ".fo
78d0: 73 73 69 6c 22 29 29 0a 09 09 09 09 28 66 64 69 ssil")).....(fdi
78e0: 72 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 r (conc "
78f0: 2f 74 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d /tmp/" (current-
7900: 75 73 65 72 2d 6e 61 6d 65 29 20 22 2f 6d 74 75 user-name) "/mtu
7910: 74 69 6c 5f 63 61 63 68 65 22 29 29 29 0a 09 09 til_cache")))...
7920: 09 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 . ;; (if (not
7930: 75 72 6c 2d 69 73 2d 66 69 6c 65 29 20 3b 3b 20 url-is-file) ;;
7940: 6e 65 65 64 20 74 6f 20 73 79 6e 63 20 66 69 72 need to sync fir
7950: 73 74 20 2d 2d 2d 20 66 6f 72 20 6e 6f 77 2c 20 st --- for now,
7960: 63 6c 6f 6e 65 20 27 65 6d 20 61 6c 6c 2e 0a 09 clone 'em all...
7970: 09 09 20 20 20 28 66 6f 73 73 69 6c 3a 63 6c 6f .. (fossil:clo
7980: 6e 65 2d 6f 72 2d 73 79 6e 63 20 75 72 6c 20 66 ne-or-sync url f
7990: 6e 61 6d 65 20 66 64 69 72 29 20 3b 3b 20 29 0a name fdir) ;; ).
79a0: 09 09 09 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 ... (let-value
79b0: 73 20 28 28 28 64 61 74 65 74 69 6d 65 20 6e 6f s (((datetime no
79c0: 64 65 29 0a 09 09 09 09 09 20 28 66 6f 73 73 69 de)...... (fossi
79d0: 6c 3a 6c 61 73 74 2d 63 68 61 6e 67 65 2d 6e 6f l:last-change-no
79e0: 64 65 2d 61 6e 64 2d 74 69 6d 65 20 66 64 69 72 de-and-time fdir
79f0: 20 66 6e 61 6d 65 20 62 72 61 6e 63 68 29 29 29 fname branch)))
7a00: 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 75 .... (if (nu
7a10: 6c 6c 3f 20 73 74 61 72 74 74 69 6d 65 73 29 0a ll? starttimes).
7a20: 09 09 09 09 20 28 70 75 73 68 2d 72 75 6e 2d 73 .... (push-run-s
7a30: 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 pec torun contou
7a40: 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 09 60 r runkey.......`
7a50: 28 28 6d 65 73 73 61 67 65 20 20 2e 20 2c 28 63 ((message . ,(c
7a60: 6f 6e 63 20 22 66 6f 73 73 69 6c 3a 22 20 62 72 onc "fossil:" br
7a70: 61 6e 63 68 20 22 2d 6e 65 76 65 72 72 75 6e 22 anch "-neverrun"
7a80: 29 29 0a 09 09 09 09 09 09 20 20 28 72 75 6e 6e ))....... (runn
7a90: 61 6d 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 ame . ,(conc ru
7aa0: 6e 6e 61 6d 65 20 22 2d 22 20 6e 6f 64 65 29 29 nname "-" node))
7ab0: 0a 09 09 09 09 09 09 20 20 28 72 75 6e 74 72 61 ....... (runtra
7ac0: 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a ns . ,runtrans).
7ad0: 09 09 09 09 09 09 20 20 28 61 72 65 61 73 20 20 ...... (areas
7ae0: 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 09 09 . ,areas).....
7af0: 09 09 20 20 3b 3b 20 28 74 61 72 67 65 74 20 20 .. ;; (target
7b00: 20 2e 20 2c 72 75 6e 6b 65 79 29 0a 20 20 20 20 . ,runkey).
7b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 29 ))
7b40: 0a 09 09 09 09 20 28 69 66 20 28 3e 20 64 61 74 ..... (if (> dat
7b50: 65 74 69 6d 65 20 6c 61 73 74 2d 72 75 6e 29 20 etime last-run)
7b60: 3b 3b 20 63 68 61 6e 67 65 20 74 69 6d 65 20 69 ;; change time i
7b70: 73 20 67 72 65 61 74 65 72 20 74 68 61 6e 20 6c s greater than l
7b80: 61 73 74 2d 72 75 6e 20 74 69 6d 65 0a 09 09 09 ast-run time....
7b90: 09 20 20 20 20 20 28 70 75 73 68 2d 72 75 6e 2d . (push-run-
7ba0: 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f spec torun conto
7bb0: 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 09 ur runkey.......
7bc0: 20 20 20 20 60 28 28 6d 65 73 73 61 67 65 20 20 `((message
7bd0: 2e 20 2c 28 63 6f 6e 63 20 22 66 6f 73 73 69 6c . ,(conc "fossil
7be0: 3a 22 20 62 72 61 6e 63 68 20 22 2d 22 20 6e 6f :" branch "-" no
7bf0: 64 65 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 de)).......
7c00: 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 28 63 (runname . ,(c
7c10: 6f 6e 63 20 72 75 6e 6e 61 6d 65 20 22 2d 22 20 onc runname "-"
7c20: 6e 6f 64 65 29 29 0a 09 09 09 09 09 09 20 20 20 node)).......
7c30: 20 20 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c (runtrans . ,
7c40: 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 runtrans).......
7c50: 20 20 20 20 20 20 28 61 72 65 61 73 20 20 20 20 (areas
7c60: 2e 20 2c 61 72 65 61 73 29 0a 09 09 09 09 09 09 . ,areas).......
7c70: 20 20 20 20 20 20 3b 3b 20 28 74 61 72 67 65 74 ;; (target
7c80: 20 20 20 2e 20 2c 72 75 6e 6b 65 79 29 0a 20 20 . ,runkey).
7c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cc0: 20 20 20 20 29 29 29 29 0a 09 09 09 20 20 20 20 ))))....
7cd0: 20 28 70 72 69 6e 74 20 22 47 6f 74 20 64 61 74 (print "Got dat
7ce0: 65 74 69 6d 65 3d 22 20 64 61 74 65 74 69 6d 65 etime=" datetime
7cf0: 20 22 20 6e 6f 64 65 3d 22 20 6e 6f 64 65 29 29 " node=" node))
7d00: 29 29 0a 09 09 20 20 20 20 20 20 20 76 61 6c 2d ))... val-
7d10: 61 6c 69 73 74 29 29 0a 0a 09 09 20 20 20 20 20 alist))....
7d20: 3b 3b 20 73 65 6e 73 6f 72 20 6c 6f 6f 6b 69 6e ;; sensor lookin
7d30: 67 20 66 6f 72 20 6f 6e 65 20 6f 72 20 6d 6f 72 g for one or mor
7d40: 65 20 66 69 6c 65 73 20 6e 65 77 65 72 20 74 68 e files newer th
7d50: 61 6e 20 72 65 66 65 72 65 6e 63 65 0a 09 09 20 an reference...
7d60: 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 ;;... ((
7d70: 66 69 6c 65 20 66 69 6c 65 2d 6f 72 29 20 3b 3b file file-or) ;;
7d80: 20 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 66 69 6c one or more fil
7d90: 65 73 20 6d 75 73 74 20 62 65 20 6e 65 77 65 72 es must be newer
7da0: 20 74 68 61 6e 20 74 68 65 20 72 65 66 65 72 65 than the refere
7db0: 6e 63 65 0a 09 09 20 20 20 20 20 20 28 6c 65 74 nce... (let
7dc0: 2a 20 28 28 79 6f 75 6e 67 65 73 74 64 61 74 20 * ((youngestdat
7dd0: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 75 6e (common:get-youn
7de0: 67 65 73 74 20 28 63 6f 6d 6d 6f 6e 3a 62 61 73 gest (common:bas
7df0: 68 2d 67 6c 6f 62 20 66 69 6c 65 2d 67 6c 6f 62 h-glob file-glob
7e00: 73 29 29 29 0a 09 09 09 20 20 20 20 20 28 79 6f s))).... (yo
7e10: 75 6e 67 65 73 74 6d 6f 64 20 28 63 61 72 20 79 ungestmod (car y
7e20: 6f 75 6e 67 65 73 74 64 61 74 29 29 29 0a 09 09 oungestdat)))...
7e30: 09 3b 3b 20 28 70 72 69 6e 74 20 22 79 6f 75 6e .;; (print "youn
7e40: 67 65 73 74 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 gestmod: " young
7e50: 65 73 74 6d 6f 64 20 22 20 73 74 61 72 74 74 69 estmod " startti
7e60: 6d 65 73 3a 20 22 20 73 74 61 72 74 74 69 6d 65 mes: " starttime
7e70: 73 29 0a 09 09 09 28 69 66 20 28 6e 75 6c 6c 3f s)....(if (null?
7e80: 20 73 74 61 72 74 74 69 6d 65 73 29 20 3b 3b 20 starttimes) ;;
7e90: 74 68 69 73 20 74 61 72 67 65 74 20 68 61 73 20 this target has
7ea0: 6e 65 76 65 72 20 62 65 65 6e 20 72 75 6e 0a 09 never been run..
7eb0: 09 09 20 20 20 20 28 70 75 73 68 2d 72 75 6e 2d .. (push-run-
7ec0: 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f spec torun conto
7ed0: 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 20 ur runkey......
7ee0: 20 20 60 28 28 6d 65 73 73 61 67 65 20 20 2e 20 `((message .
7ef0: 22 66 69 6c 65 3a 6e 65 76 65 72 72 75 6e 22 29 "file:neverrun")
7f00: 0a 09 09 09 09 09 20 20 20 20 20 28 61 63 74 69 ...... (acti
7f10: 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a on . ,action).
7f20: 09 09 09 09 09 20 20 20 20 20 28 72 75 6e 74 72 ..... (runtr
7f30: 61 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 ans . ,runtrans)
7f40: 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 28 74 ...... ;; (t
7f50: 61 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b 65 arget . ,runke
7f60: 79 29 0a 09 09 09 09 09 20 20 20 20 20 28 61 72 y)...... (ar
7f70: 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 73 29 eas . ,areas)
7f80: 0a 09 09 09 09 09 20 20 20 20 20 28 72 75 6e 6e ...... (runn
7f90: 61 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 ame . ,runname)
7fa0: 29 29 0a 09 09 09 3b 3b 20 28 66 6f 72 2d 65 61 ))....;; (for-ea
7fb0: 63 68 0a 09 09 09 3b 3b 20 20 28 6c 61 6d 62 64 ch....;; (lambd
7fc0: 61 20 28 73 74 61 72 74 74 69 6d 65 29 20 3b 3b a (starttime) ;;
7fd0: 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 69 6d look at the tim
7fe0: 65 20 74 68 65 20 6c 61 73 74 20 72 75 6e 20 77 e the last run w
7ff0: 61 73 20 6b 69 63 6b 65 64 20 6f 66 66 20 66 6f as kicked off fo
8000: 72 20 74 68 69 73 20 63 6f 6e 74 6f 75 72 0a 09 r this contour..
8010: 09 09 3b 3b 20 20 20 20 28 69 66 20 28 3e 20 79 ..;; (if (> y
8020: 6f 75 6e 67 65 73 74 6d 6f 64 20 28 63 64 72 20 oungestmod (cdr
8030: 73 74 61 72 74 74 69 6d 65 29 29 0a 09 09 09 3b starttime))....;
8040: 3b 20 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ; . (begin....
8050: 3b 3b 20 09 20 20 20 20 20 28 70 72 69 6e 74 20 ;; . (print
8060: 22 73 74 61 72 74 74 69 6d 65 20 79 6f 75 6e 67 "starttime young
8070: 65 72 20 74 68 61 6e 20 79 6f 75 6e 67 65 73 74 er than youngest
8080: 6d 6f 64 3a 20 22 20 73 74 61 72 74 74 69 6d 65 mod: " starttime
8090: 20 22 20 59 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 " Youngestmod:
80a0: 22 20 79 6f 75 6e 67 65 73 74 6d 6f 64 29 0a 09 " youngestmod)..
80b0: 09 09 20 20 20 20 28 69 66 20 28 3e 20 79 6f 75 .. (if (> you
80c0: 6e 67 65 73 74 6d 6f 64 20 6c 61 73 74 2d 72 75 ngestmod last-ru
80d0: 6e 29 0a 09 09 09 09 28 70 75 73 68 2d 72 75 6e n).....(push-run
80e0: 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 -spec torun cont
80f0: 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 our runkey......
8100: 20 20 20 20 20 20 20 60 28 28 6d 65 73 73 61 67 `((messag
8110: 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c 65 e . ,(conc rule
8120: 74 79 70 65 20 22 3a 22 20 28 63 61 64 72 20 79 type ":" (cadr y
8130: 6f 75 6e 67 65 73 74 64 61 74 29 29 29 0a 09 09 oungestdat)))...
8140: 09 09 09 09 20 28 61 63 74 69 6f 6e 20 20 20 2e .... (action .
8150: 20 2c 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 ,action).......
8160: 20 3b 3b 20 28 74 61 72 67 65 74 20 20 20 2e 20 ;; (target .
8170: 2c 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 09 20 ,runkey).......
8180: 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e (runtrans . ,run
8190: 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 28 61 trans)....... (a
81a0: 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 73 reas . ,areas
81b0: 29 0a 09 09 09 09 09 09 20 28 72 75 6e 6e 61 6d )....... (runnam
81c0: 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 e . ,runname)..
81d0: 09 09 09 09 09 20 29 29 29 29 29 29 0a 0a 09 09 ..... ))))))....
81e0: 20 20 20 20 20 3b 3b 20 61 6c 6c 20 67 6c 6f 62 ;; all glob
81f0: 62 65 64 20 66 69 6c 65 73 20 6d 75 73 74 20 62 bed files must b
8200: 65 20 6e 65 77 65 72 20 74 68 61 6e 20 74 68 65 e newer than the
8210: 20 72 65 66 65 72 65 6e 63 65 0a 09 09 20 20 20 reference...
8220: 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 66 69 ;;... ((fi
8230: 6c 65 2d 61 6e 64 29 20 3b 3b 20 61 6c 6c 20 66 le-and) ;; all f
8240: 69 6c 65 73 20 6d 75 73 74 20 62 65 20 6e 65 77 iles must be new
8250: 65 72 20 74 68 61 6e 20 74 68 65 20 72 65 66 65 er than the refe
8260: 72 65 6e 63 65 0a 09 09 20 20 20 20 20 20 28 6c rence... (l
8270: 65 74 2a 20 28 28 79 6f 75 6e 67 65 73 74 64 61 et* ((youngestda
8280: 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f t (common:get-yo
8290: 75 6e 67 65 73 74 20 66 69 6c 65 2d 67 6c 6f 62 ungest file-glob
82a0: 73 29 29 0a 09 09 09 20 20 20 20 20 28 79 6f 75 s)).... (you
82b0: 6e 67 65 73 74 6d 6f 64 20 28 63 61 72 20 79 6f ngestmod (car yo
82c0: 75 6e 67 65 73 74 64 61 74 29 29 0a 09 09 09 20 ungestdat))....
82d0: 20 20 20 20 28 73 75 63 63 65 73 73 20 20 20 20 (success
82e0: 20 23 74 29 29 20 3b 3b 20 61 6e 79 20 63 61 73 #t)) ;; any cas
82f0: 65 73 20 6f 66 20 6e 6f 74 20 74 72 75 65 2c 20 es of not true,
8300: 73 65 74 20 66 6c 61 67 20 74 6f 20 23 66 20 66 set flag to #f f
8310: 6f 72 20 41 4e 44 0a 09 09 09 3b 3b 20 28 70 72 or AND....;; (pr
8320: 69 6e 74 20 22 79 6f 75 6e 67 65 73 74 6d 6f 64 int "youngestmod
8330: 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 : " youngestmod
8340: 22 20 73 74 61 72 74 74 69 6d 65 73 3a 20 22 20 " starttimes: "
8350: 73 74 61 72 74 74 69 6d 65 73 29 0a 09 09 09 28 starttimes)....(
8360: 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 74 if (null? startt
8370: 69 6d 65 73 29 20 3b 3b 20 74 68 69 73 20 74 61 imes) ;; this ta
8380: 72 67 65 74 20 68 61 73 20 6e 65 76 65 72 20 62 rget has never b
8390: 65 65 6e 20 72 75 6e 0a 09 09 09 20 20 20 20 28 een run.... (
83a0: 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f push-run-spec to
83b0: 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b run contour runk
83c0: 65 79 0a 09 09 09 09 09 20 20 20 60 28 28 6d 65 ey...... `((me
83d0: 73 73 61 67 65 20 20 2e 20 22 66 69 6c 65 3a 6e ssage . "file:n
83e0: 65 76 65 72 72 75 6e 22 29 0a 09 09 09 09 09 20 everrun")......
83f0: 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 (runname .
8400: 2c 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 ,runname)......
8410: 20 20 20 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 (runtrans .
8420: 2c 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 ,runtrans)......
8430: 20 20 20 20 20 28 61 72 65 61 73 20 20 20 20 2e (areas .
8440: 20 2c 61 72 65 61 73 29 0a 09 09 09 09 09 20 20 ,areas)......
8450: 20 20 20 3b 3b 20 28 74 61 72 67 65 74 20 20 20 ;; (target
8460: 2e 20 2c 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 . ,runkey)......
8470: 20 20 20 20 20 28 61 63 74 69 6f 6e 20 20 20 2e (action .
8480: 20 2c 61 63 74 69 6f 6e 29 29 29 0a 09 09 09 20 ,action)))....
8490: 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 20 74 68 69 ;; NB// I thi
84a0: 6e 6b 20 74 68 69 73 20 69 73 20 77 72 6f 6e 67 nk this is wrong
84b0: 2e 20 49 74 20 73 68 6f 75 6c 64 20 62 65 20 6c . It should be l
84c0: 6f 6f 6b 69 6e 67 20 61 74 20 6c 61 73 74 2d 72 ooking at last-r
84d0: 75 6e 20 6f 6e 6c 79 2e 0a 09 09 09 20 20 20 20 un only.....
84e0: 28 69 66 20 28 3e 20 79 6f 75 6e 67 65 73 74 6d (if (> youngestm
84f0: 6f 64 20 6c 61 73 74 2d 72 75 6e 29 20 3b 3b 20 od last-run) ;;
8500: 57 41 49 54 21 21 20 53 68 6f 75 6c 64 6e 27 74 WAIT!! Shouldn't
8510: 20 66 69 6c 65 2d 61 6e 64 20 62 65 20 6c 6f 6f file-and be loo
8520: 6b 69 6e 67 20 61 74 20 74 68 65 20 2a 6f 6c 64 king at the *old
8530: 65 73 74 2a 20 66 69 6c 65 20 28 74 68 75 73 20 est* file (thus
8540: 61 6c 6c 20 61 72 65 20 79 6f 75 6e 67 65 72 20 all are younger
8550: 74 68 61 6e 20 2e 2e 2e 29 0a 09 09 09 09 0a 09 than ...).......
8560: 09 09 09 3b 3b 20 09 09 09 20 20 20 20 28 66 6f ...;; ... (fo
8570: 72 2d 65 61 63 68 0a 09 09 09 09 3b 3b 20 09 09 r-each.....;; ..
8580: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 . (lambda (s
8590: 74 61 72 74 74 69 6d 65 29 20 3b 3b 20 6c 6f 6f tarttime) ;; loo
85a0: 6b 20 61 74 20 74 68 65 20 74 69 6d 65 20 74 68 k at the time th
85b0: 65 20 6c 61 73 74 20 72 75 6e 20 77 61 73 20 6b e last run was k
85c0: 69 63 6b 65 64 20 6f 66 66 20 66 6f 72 20 74 68 icked off for th
85d0: 69 73 20 63 6f 6e 74 6f 75 72 0a 09 09 09 09 3b is contour.....;
85e0: 3b 20 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ; ... (if
85f0: 28 3c 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 (< youngestmod (
8600: 63 64 72 20 73 74 61 72 74 74 69 6d 65 29 29 0a cdr starttime)).
8610: 09 09 09 09 3b 3b 20 09 09 09 09 20 20 20 28 73 ....;; .... (s
8620: 65 74 21 20 73 75 63 63 65 73 73 20 23 66 29 29 et! success #f))
8630: 29 0a 09 09 09 09 3b 3b 20 09 09 09 20 20 20 20 ).....;; ...
8640: 20 73 74 61 72 74 74 69 6d 65 73 29 29 0a 09 09 starttimes))...
8650: 09 09 3b 3b 20 09 09 09 28 69 66 20 73 75 63 63 ..;; ...(if succ
8660: 65 73 73 0a 09 09 09 09 3b 3b 20 09 09 09 20 20 ess.....;; ...
8670: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 3b 3b 20 (begin.....;;
8680: 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 ... (print
8690: 22 73 74 61 72 74 74 69 6d 65 20 79 6f 75 6e 67 "starttime young
86a0: 65 72 20 74 68 61 6e 20 79 6f 75 6e 67 65 73 74 er than youngest
86b0: 6d 6f 64 3a 20 22 20 73 74 61 72 74 74 69 6d 65 mod: " starttime
86c0: 20 22 20 59 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 " Youngestmod:
86d0: 22 20 79 6f 75 6e 67 65 73 74 6d 6f 64 29 0a 09 " youngestmod)..
86e0: 09 09 09 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 ...(push-run-spe
86f0: 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 c torun contour
8700: 72 75 6e 6b 65 79 0a 09 09 09 09 09 20 20 20 20 runkey......
8710: 20 20 20 60 28 28 6d 65 73 73 61 67 65 20 20 2e `((message .
8720: 20 2c 28 63 6f 6e 63 20 72 75 6c 65 74 79 70 65 ,(conc ruletype
8730: 20 22 3a 22 20 28 63 61 64 72 20 79 6f 75 6e 67 ":" (cadr young
8740: 65 73 74 64 61 74 29 29 29 0a 09 09 09 09 09 09 estdat))).......
8750: 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 (runname . ,ru
8760: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 20 28 72 nname)....... (r
8770: 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e 74 72 untrans . ,runtr
8780: 61 6e 73 29 0a 09 09 09 09 09 09 20 3b 3b 20 28 ans)....... ;; (
8790: 74 61 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b target . ,runk
87a0: 65 79 29 0a 09 09 09 09 09 09 20 28 61 72 65 61 ey)....... (area
87b0: 73 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 s . ,areas)..
87c0: 09 09 09 09 09 20 28 61 63 74 69 6f 6e 20 20 20 ..... (action
87d0: 2e 20 2c 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 . ,action)......
87e0: 09 20 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 . ))))))...
87f0: 28 65 6c 73 65 20 28 70 72 69 6e 74 20 22 45 52 (else (print "ER
8800: 52 4f 52 3a 20 75 6e 72 65 63 6f 67 6e 69 73 65 ROR: unrecognise
8810: 64 20 72 75 6c 65 20 5c 22 22 20 72 75 6c 65 74 d rule \"" rulet
8820: 79 70 65 29 29 29 29 29 0a 09 20 20 20 20 20 20 ype)))))..
8830: 20 6b 65 79 64 61 74 73 29 29 29 20 3b 3b 20 73 keydats))) ;; s
8840: 65 6e 73 65 20 72 75 6c 65 73 0a 09 20 20 28 68 ense rules.. (h
8850: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
8860: 67 63 6f 6e 66 29 29 0a 09 20 0a 09 20 3b 3b 20 gconf)).. .. ;;
8870: 6e 6f 77 20 68 61 76 65 20 74 6f 20 72 75 6e 20 now have to run
8880: 70 6f 70 75 6c 61 74 65 64 0a 09 20 28 66 6f 72 populated.. (for
8890: 2d 65 61 63 68 0a 09 20 20 28 6c 61 6d 62 64 61 -each.. (lambda
88a0: 20 28 63 6f 6e 74 6f 75 72 29 0a 09 20 20 20 20 (contour)..
88b0: 28 6c 65 74 2a 20 28 28 63 76 61 6c 20 20 20 20 (let* ((cval
88c0: 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a (or (configf:
88d0: 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 63 lookup mtconf "c
88e0: 6f 6e 74 6f 75 72 73 22 20 63 6f 6e 74 6f 75 72 ontours" contour
88f0: 29 20 22 22 29 29 0a 09 09 20 20 20 28 63 76 61 ) ""))... (cva
8900: 6c 2d 61 6c 69 73 74 20 28 76 61 6c 2d 3e 61 6c l-alist (val->al
8910: 69 73 74 20 63 76 61 6c 29 29 20 20 20 20 20 20 ist cval))
8920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
8930: 3b 20 42 45 57 41 52 45 20 2e 2e 2e 20 4e 4f 54 ; BEWARE ... NOT
8940: 20 74 68 65 20 73 61 6d 65 20 76 61 6c 2d 61 6c the same val-al
8950: 69 73 74 20 61 73 20 61 62 6f 76 65 21 0a 09 09 ist as above!...
8960: 20 20 20 28 61 72 65 61 73 20 20 20 20 20 20 28 (areas (
8970: 76 61 6c 2d 61 6c 69 73 74 2d 3e 61 72 65 61 73 val-alist->areas
8980: 20 63 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 cval-alist))...
8990: 20 20 20 28 73 65 6c 65 63 74 6f 72 20 20 20 28 (selector (
89a0: 61 6c 69 73 74 2d 72 65 66 20 27 73 65 6c 65 63 alist-ref 'selec
89b0: 74 6f 72 20 63 76 61 6c 2d 61 6c 69 73 74 29 29 tor cval-alist))
89c0: 0a 09 09 20 20 20 28 6d 6f 64 65 2d 74 61 67 20 ... (mode-tag
89d0: 20 20 28 61 6e 64 20 73 65 6c 65 63 74 6f 72 20 (and selector
89e0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d 66 69 (string-split-fi
89f0: 65 6c 64 73 20 22 2f 22 20 73 65 6c 65 63 74 6f elds "/" selecto
8a00: 72 20 23 3a 69 6e 66 69 78 29 29 29 0a 09 09 20 r #:infix)))...
8a10: 20 20 28 6d 6f 64 65 2d 70 61 74 74 20 20 28 61 (mode-patt (a
8a20: 6e 64 20 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 nd mode-tag (if
8a30: 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 6d 6f 64 (eq? (length mod
8a40: 65 2d 74 61 67 29 20 32 29 28 63 61 64 72 20 6d e-tag) 2)(cadr m
8a50: 6f 64 65 2d 74 61 67 29 20 23 66 29 29 29 0a 09 ode-tag) #f)))..
8a60: 09 20 20 20 28 74 61 67 2d 65 78 70 72 20 20 20 . (tag-expr
8a70: 28 61 6e 64 20 6d 6f 64 65 2d 74 61 67 20 28 69 (and mode-tag (i
8a80: 66 20 28 6e 75 6c 6c 3f 20 6d 6f 64 65 2d 74 61 f (null? mode-ta
8a90: 67 29 20 23 66 20 28 63 61 72 20 6d 6f 64 65 2d g) #f (car mode-
8aa0: 74 61 67 29 29 29 29 29 0a 09 20 20 20 20 20 20 tag)))))..
8ab0: 28 70 72 69 6e 74 20 22 63 6f 6e 74 6f 75 72 3a (print "contour:
8ac0: 20 22 20 63 6f 6e 74 6f 75 72 20 22 20 61 72 65 " contour " are
8ad0: 61 73 3d 22 20 61 72 65 61 73 20 22 20 63 76 61 as=" areas " cva
8ae0: 6c 3d 22 20 63 76 61 6c 29 0a 09 20 20 20 20 20 l=" cval)..
8af0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 (for-each..
8b00: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 6b (lambda (runk
8b10: 65 79 64 61 74 73 65 74 29 0a 09 09 20 3b 3b 20 eydatset)... ;;
8b20: 28 70 72 69 6e 74 20 22 72 75 6e 6b 65 79 64 61 (print "runkeyda
8b30: 74 73 65 74 3a 20 22 29 28 70 70 20 72 75 6e 6b tset: ")(pp runk
8b40: 65 79 64 61 74 73 65 74 29 0a 09 09 20 28 6c 65 eydatset)... (le
8b50: 74 20 28 28 72 75 6e 6b 65 79 20 20 20 20 20 28 t ((runkey (
8b60: 63 61 72 20 72 75 6e 6b 65 79 64 61 74 73 65 74 car runkeydatset
8b70: 29 29 0a 09 09 20 20 20 20 20 20 20 28 72 75 6e ))... (run
8b80: 6b 65 79 64 61 74 73 20 28 63 61 64 72 20 72 75 keydats (cadr ru
8b90: 6e 6b 65 79 64 61 74 73 65 74 29 29 29 0a 09 09 nkeydatset)))...
8ba0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 (for-each...
8bb0: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 6b (lambda (runk
8bc0: 65 79 64 61 74 29 0a 09 09 20 20 20 20 20 20 28 eydat)... (
8bd0: 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 for-each...
8be0: 20 20 28 6c 61 6d 62 64 61 20 28 61 72 65 61 29 (lambda (area)
8bf0: 0a 09 09 09 20 28 69 66 20 28 61 72 65 61 2d 61 .... (if (area-a
8c00: 6c 6c 6f 77 65 64 3f 20 61 72 65 61 20 61 72 65 llowed? area are
8c10: 61 73 20 72 75 6e 6b 65 79 20 63 6f 6e 74 6f 75 as runkey contou
8c20: 72 29 20 3b 3b 20 69 73 20 74 68 69 73 20 61 72 r) ;; is this ar
8c30: 65 61 20 74 6f 20 62 65 20 68 61 6e 64 6c 65 64 ea to be handled
8c40: 20 28 66 72 6f 6d 20 61 72 65 61 73 3d 61 2c 62 (from areas=a,b
8c50: 2c 63 20 4f 52 20 75 73 69 6e 67 20 61 72 65 61 ,c OR using area
8c60: 66 6e 3d 61 62 63 66 6e 20 61 6e 64 20 2a 61 72 fn=abcfn and *ar
8c70: 65 61 2d 63 68 65 63 6b 73 2a 20 2e 2e 2e 29 0a ea-checks* ...).
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
8ca0: 74 2a 20 28 28 61 76 61 6c 20 20 20 20 20 20 20 t* ((aval
8cb0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
8cc0: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 kup mtconf "area
8cd0: 73 22 20 61 72 65 61 29 20 22 22 29 29 0a 20 20 s" area) "")).
8ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d00: 20 20 28 61 76 61 6c 2d 61 6c 69 73 74 20 28 76 (aval-alist (v
8d10: 61 6c 2d 3e 61 6c 69 73 74 20 61 76 61 6c 29 29 al->alist aval))
8d20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d40: 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 (runname
8d50: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 72 75 6e (alist-ref 'run
8d60: 6e 61 6d 65 20 72 75 6e 6b 65 79 64 61 74 29 29 name runkeydat))
8d70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d90: 20 20 20 20 20 28 72 75 6e 74 72 61 6e 73 20 20 (runtrans
8da0: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 72 75 6e (alist-ref 'run
8db0: 74 72 61 6e 73 20 72 75 6e 6b 65 79 64 61 74 29 trans runkeydat)
8dc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8de0: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
8df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e00: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 61 73 (reas
8e10: 6f 6e 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 on (alist-re
8e20: 66 20 27 6d 65 73 73 61 67 65 20 72 75 6e 6b 65 f 'message runke
8e30: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
8e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e50: 20 20 20 20 20 20 20 20 20 20 20 28 73 63 68 65 (sche
8e60: 64 20 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 d (alist-re
8e70: 66 20 27 73 63 68 65 64 20 20 20 72 75 6e 6b 65 f 'sched runke
8e80: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
8e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ea0: 20 20 20 20 20 20 20 20 20 20 20 28 61 63 74 69 (acti
8eb0: 6f 6e 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 on (alist-re
8ec0: 66 20 27 61 63 74 69 6f 6e 20 20 72 75 6e 6b 65 f 'action runke
8ed0: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
8ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ef0: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 64 65 (dbde
8f00: 73 74 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 st (alist-re
8f10: 66 20 27 64 62 64 65 73 74 20 20 72 75 6e 6b 65 f 'dbdest runke
8f20: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
8f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f40: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 (appe
8f50: 6e 64 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 nd (alist-re
8f60: 66 20 27 61 70 70 65 6e 64 20 20 72 75 6e 6b 65 f 'append runke
8f70: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
8f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f90: 20 20 20 20 20 20 20 20 20 20 20 28 74 61 72 67 (targ
8fa0: 65 74 73 20 20 20 20 28 6f 72 20 28 61 6c 69 73 ets (or (alis
8fb0: 74 2d 72 65 66 20 27 74 61 72 67 65 74 20 20 72 t-ref 'target r
8fc0: 75 6e 6b 65 79 64 61 74 29 0a 20 20 20 20 20 20 unkeydat).
8fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
9000: 61 70 2d 74 61 72 67 65 74 73 20 6d 74 63 6f 6e ap-targets mtcon
9010: 66 20 61 76 61 6c 2d 61 6c 69 73 74 20 72 75 6e f aval-alist run
9020: 6b 65 79 20 61 72 65 61 20 63 6f 6e 74 6f 75 72 key area contour
9030: 29 29 29 29 20 3b 3b 20 6f 76 65 72 72 69 64 65 )))) ;; override
9040: 20 77 69 74 68 20 74 61 72 67 65 74 20 69 66 20 with target if
9050: 66 6f 72 63 65 64 0a 20 20 20 20 20 20 20 20 20 forced.
9060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9070: 20 20 20 20 20 20 3b 3b 20 4e 45 45 44 20 54 4f ;; NEED TO
9080: 20 45 58 50 41 4e 44 20 52 55 4e 4b 45 59 20 3d EXPAND RUNKEY =
9090: 3e 20 41 4c 4c 20 54 41 52 47 45 54 53 20 4d 41 > ALL TARGETS MA
90a0: 50 50 45 44 20 41 4e 44 20 54 48 45 4e 20 46 4f PPED AND THEN FO
90b0: 52 45 41 43 48 20 2e 2e 2e 2e 20 0a 20 20 20 20 REACH .... .
90c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90d0: 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d (for-
90e0: 65 61 63 68 0a 20 20 20 20 20 20 20 20 20 20 20 each.
90f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9100: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 61 (lambda (ta
9110: 72 67 65 74 29 0a 20 20 20 20 20 20 20 20 20 20 rget).
9120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9130: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 (print "
9140: 43 72 65 61 74 69 6e 67 20 70 6b 74 20 66 6f 72 Creating pkt for
9150: 20 72 75 6e 6b 65 79 3d 22 20 72 75 6e 6b 65 79 runkey=" runkey
9160: 20 22 20 74 61 72 67 65 74 3d 22 20 74 61 72 67 " target=" targ
9170: 65 74 20 22 20 63 6f 6e 74 6f 75 72 3d 22 20 63 et " contour=" c
9180: 6f 6e 74 6f 75 72 20 22 20 61 72 65 61 3d 22 20 ontour " area="
9190: 61 72 65 61 20 22 20 61 63 74 69 6f 6e 3d 22 20 area " action="
91a0: 61 63 74 69 6f 6e 20 22 20 74 61 67 2d 65 78 70 action " tag-exp
91b0: 72 3d 22 20 74 61 67 2d 65 78 70 72 20 22 20 6d r=" tag-expr " m
91c0: 6f 64 65 2d 70 61 74 74 3d 22 20 6d 6f 64 65 2d ode-patt=" mode-
91d0: 70 61 74 74 29 0a 20 20 20 20 20 20 20 20 20 20 patt).
91e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91f0: 20 20 20 20 20 20 20 20 28 69 66 20 28 63 61 73 (if (cas
9200: 65 20 28 6f 72 20 28 61 6e 64 20 61 63 74 69 6f e (or (and actio
9210: 6e 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f n (string->symbo
9220: 6c 20 61 63 74 69 6f 6e 29 29 20 27 6e 6f 61 63 l action)) 'noac
9230: 74 69 6f 6e 29 20 20 3b 3b 20 65 6e 73 75 72 65 tion) ;; ensure
9240: 20 77 65 20 68 61 76 65 20 74 68 65 20 6e 65 65 we have the nee
9250: 64 65 64 20 64 61 74 61 20 74 6f 20 72 75 6e 20 ded data to run
9260: 74 68 69 73 20 61 63 74 69 6f 6e 0a 20 20 20 20 this action.
9270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9290: 20 20 20 20 28 28 6e 6f 61 63 74 69 6f 6e 29 20 ((noaction)
92a0: 20 20 20 20 20 20 20 20 20 20 23 66 29 0a 20 20 #f).
92b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92d0: 20 20 20 20 20 20 28 28 72 75 6e 29 20 20 20 20 ((run)
92e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
92f0: 20 72 75 6e 6e 61 6d 65 20 72 65 61 73 6f 6e 29 runname reason)
9300: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9320: 20 20 20 20 20 20 20 20 20 20 28 28 73 79 6e 63 ((sync
9330: 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 29 20 20 sync-prepend)
9340: 28 61 6e 64 20 72 65 61 73 6f 6e 20 64 62 64 65 (and reason dbde
9350: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
9360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9370: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
9380: 73 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 se
9390: 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 #f)).
93a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
93c0: 20 69 6e 73 74 65 61 64 20 6f 66 20 75 6e 77 72 instead of unwr
93d0: 61 70 70 69 6e 67 20 74 68 65 20 72 75 6e 6b 65 apping the runke
93e0: 79 64 61 74 20 61 6c 69 73 74 2c 20 70 61 73 73 ydat alist, pass
93f0: 20 69 74 20 64 69 72 65 63 74 6c 79 20 74 6f 20 it directly to
9400: 63 72 65 61 74 65 2d 72 75 6e 2d 70 6b 74 0a 20 create-run-pkt.
9410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9430: 20 20 20 20 20 28 63 72 65 61 74 65 2d 72 75 6e (create-run
9440: 2d 70 6b 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 -pkt mtconf acti
9450: 6f 6e 20 61 72 65 61 20 72 75 6e 6b 65 79 20 74 on area runkey t
9460: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6d 6f arget runname mo
9470: 64 65 2d 70 61 74 74 0a 20 20 20 20 20 20 20 20 de-patt.
9480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 ta
94b0: 67 2d 65 78 70 72 20 70 6b 74 73 64 69 72 20 72 g-expr pktsdir r
94c0: 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 73 63 eason contour sc
94d0: 68 65 64 20 64 62 64 65 73 74 20 61 70 70 65 6e hed dbdest appen
94e0: 64 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d .
94f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9510: 20 20 20 20 20 20 20 20 20 72 75 6e 74 72 61 6e runtran
9520: 73 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 s) .
9530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9540: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
9550: 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 "ERROR: Missing
9560: 20 69 6e 66 6f 20 74 6f 20 6d 61 6b 65 20 61 20 info to make a
9570: 22 20 61 63 74 69 6f 6e 20 22 20 63 61 6c 6c 3a " action " call:
9580: 20 72 75 6e 6b 65 79 3d 22 20 72 75 6e 6b 65 79 runkey=" runkey
9590: 20 22 20 63 6f 6e 74 6f 75 72 3d 22 20 63 6f 6e " contour=" con
95a0: 74 6f 75 72 20 22 20 61 72 65 61 3d 22 20 61 72 tour " area=" ar
95b0: 65 61 20 20 22 20 74 61 67 2d 65 78 70 72 3d 22 ea " tag-expr="
95c0: 20 74 61 67 2d 65 78 70 72 20 22 20 6d 6f 64 65 tag-expr " mode
95d0: 2d 70 61 74 74 3d 22 20 6d 6f 64 65 2d 70 61 74 -patt=" mode-pat
95e0: 74 20 22 20 64 62 64 65 73 74 3d 22 20 64 62 64 t " dbdest=" dbd
95f0: 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 est).
9600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9610: 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 )).
9620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 ta
9640: 72 67 65 74 73 29 29 0a 20 20 20 20 20 20 20 20 rgets)).
9650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9660: 20 20 20 20 20 28 70 72 69 6e 74 20 22 4e 4f 54 (print "NOT
9670: 45 3a 20 73 6b 69 70 70 69 6e 67 20 22 20 72 75 E: skipping " ru
9680: 6e 6b 65 79 64 61 74 20 22 20 66 6f 72 20 61 72 nkeydat " for ar
9690: 65 61 20 5c 22 22 20 61 72 65 61 20 22 5c 22 2c ea \"" area "\",
96a0: 20 6e 6f 74 20 69 6e 20 22 20 61 72 65 61 73 29 not in " areas)
96b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
96c0: 20 20 20 20 20 20 20 20 20 20 61 6c 6c 2d 61 72 all-ar
96d0: 65 61 73 29 29 0a 09 09 20 20 20 20 72 75 6e 6b eas))... runk
96e0: 65 79 64 61 74 73 29 29 29 0a 09 20 20 20 20 20 eydats)))..
96f0: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f (let ((res (co
9700: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f nfigf:get-sectio
9710: 6e 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 29 n torun contour)
9720: 29 29 20 3b 3b 20 65 61 63 68 20 63 6f 6e 74 6f )) ;; each conto
9730: 75 72 20 2f 20 74 61 72 67 65 74 0a 09 09 20 3b ur / target... ;
9740: 3b 20 28 70 72 69 6e 74 20 22 72 65 73 3d 22 20 ; (print "res="
9750: 72 65 73 29 0a 09 09 20 72 65 73 29 29 29 29 0a res)... res)))).
9760: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b . (hash-table-k
9770: 65 79 73 20 74 6f 72 75 6e 29 29 29 29 29 29 29 eys torun)))))))
9780: 0a 0a 28 64 65 66 69 6e 65 20 28 70 6b 74 2d 3e ..(define (pkt->
9790: 63 6d 64 6c 69 6e 65 20 70 6b 74 61 29 0a 20 20 cmdline pkta).
97a0: 28 6c 65 74 20 28 28 61 63 74 69 6f 6e 20 28 6f (let ((action (o
97b0: 72 20 28 6c 6f 6f 6b 75 70 2d 61 63 74 69 6f 6e r (lookup-action
97c0: 2d 62 79 2d 6b 65 79 20 28 61 6c 69 73 74 2d 72 -by-key (alist-r
97d0: 65 66 20 27 41 20 70 6b 74 61 29 29 20 22 6e 6f ef 'A pkta)) "no
97e0: 61 63 74 69 6f 6e 22 29 29 29 0a 20 20 20 20 28 action"))). (
97f0: 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 61 20 fold (lambda (a
9800: 72 65 73 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 res).. (let*
9810: 28 28 6b 65 79 20 28 63 61 72 20 61 29 29 20 3b ((key (car a)) ;
9820: 3b 20 67 65 74 20 74 68 65 20 6b 65 79 20 6e 61 ; get the key na
9830: 6d 65 0a 09 09 20 20 20 28 76 61 6c 20 28 63 64 me... (val (cd
9840: 72 20 61 29 29 0a 09 09 20 20 20 28 70 61 72 20 r a))... (par
9850: 28 6f 72 20 28 6c 6f 6f 6b 75 70 2d 70 61 72 61 (or (lookup-para
9860: 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 29 20 20 3b m-by-key key) ;
9870: 3b 20 6e 65 65 64 20 74 6f 20 63 68 65 63 6b 20 ; need to check
9880: 61 6c 73 6f 20 69 66 20 69 74 20 69 73 20 61 20 also if it is a
9890: 73 77 69 74 63 68 0a 09 09 09 20 20 20 20 28 6c switch.... (l
98a0: 6f 6f 6b 75 70 2d 70 61 72 61 6d 2d 62 79 2d 6b ookup-param-by-k
98b0: 65 79 20 6b 65 79 20 69 6e 6c 73 74 3a 20 2a 73 ey key inlst: *s
98c0: 77 69 74 63 68 2d 6b 65 79 73 2a 29 29 29 29 0a witch-keys*)))).
98d0: 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 . ;; (print
98e0: 20 22 6b 65 79 3a 20 22 20 6b 65 79 20 22 20 76 "key: " key " v
98f0: 61 6c 3a 20 22 20 76 61 6c 20 22 20 70 61 72 3a al: " val " par:
9900: 20 22 20 70 61 72 29 0a 09 20 20 20 20 20 20 28 " par).. (
9910: 69 66 20 70 61 72 0a 09 09 20 20 28 63 6f 6e 63 if par... (conc
9920: 20 72 65 73 20 22 20 22 20 28 70 61 72 61 6d 2d res " " (param-
9930: 74 72 61 6e 73 6c 61 74 65 20 70 61 72 29 20 22 translate par) "
9940: 20 22 20 76 61 6c 29 0a 09 09 20 20 28 69 66 20 " val)... (if
9950: 28 61 6c 69 73 74 2d 72 65 66 20 6b 65 79 20 2a (alist-ref key *
9960: 61 64 64 69 74 69 6f 6e 61 6c 2d 63 61 72 64 73 additional-cards
9970: 2a 29 20 3b 3b 20 74 68 65 73 65 20 63 61 72 64 *) ;; these card
9980: 73 20 64 6f 20 6e 6f 74 20 74 72 61 6e 73 6c 61 s do not transla
9990: 74 65 20 74 6f 20 70 61 72 61 6d 65 74 65 72 73 te to parameters
99a0: 20 6f 72 20 73 77 69 74 63 68 65 73 0a 09 09 20 or switches...
99b0: 20 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 res...
99c0: 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e (begin....(prin
99d0: 74 20 22 45 52 52 4f 52 3a 20 55 6e 6b 6e 6f 77 t "ERROR: Unknow
99e0: 6e 20 6b 65 79 20 69 6e 20 70 61 63 6b 65 74 20 n key in packet
99f0: 5c 22 22 20 6b 65 79 20 22 5c 22 20 77 69 74 68 \"" key "\" with
9a00: 20 76 61 6c 75 65 20 5c 22 22 20 76 61 6c 20 22 value \"" val "
9a10: 5c 22 22 29 0a 09 09 09 72 65 73 29 29 29 29 29 \"")....res)))))
9a20: 0a 09 20 20 28 63 6f 6e 63 20 22 6d 65 67 61 74 .. (conc "megat
9a30: 65 73 74 20 22 20 28 69 66 20 28 6e 6f 74 20 28 est " (if (not (
9a40: 6d 65 6d 62 65 72 20 61 63 74 69 6f 6e 20 27 28 member action '(
9a50: 22 73 79 6e 63 22 29 29 29 0a 09 09 09 09 28 63 "sync"))).....(c
9a60: 6f 6e 63 20 61 63 74 69 6f 6e 20 22 20 22 29 0a onc action " ").
9a70: 09 09 09 09 22 22 29 29 0a 09 20 20 70 6b 74 61 ...."")).. pkta
9a80: 29 29 29 0a 0a 3b 3b 20 28 75 73 65 20 74 72 61 )))..;; (use tra
9a90: 63 65 29 28 74 72 61 63 65 20 70 6b 74 2d 3e 63 ce)(trace pkt->c
9aa0: 6d 64 6c 69 6e 65 29 0a 0a 28 64 65 66 69 6e 65 mdline)..(define
9ab0: 20 28 77 72 69 74 65 2d 70 6b 74 20 70 6b 74 73 (write-pkt pkts
9ac0: 64 69 72 20 75 75 69 64 20 70 6b 74 29 0a 20 20 dir uuid pkt).
9ad0: 28 69 66 20 70 6b 74 73 64 69 72 0a 20 20 20 20 (if pktsdir.
9ae0: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
9af0: 6f 2d 66 69 6c 65 0a 09 20 20 28 63 6f 6e 63 20 o-file.. (conc
9b00: 70 6b 74 73 64 69 72 20 22 2f 22 20 75 75 69 64 pktsdir "/" uuid
9b10: 20 22 2e 70 6b 74 22 29 0a 09 28 6c 61 6d 62 64 ".pkt")..(lambd
9b20: 61 20 28 29 0a 09 20 20 28 70 72 69 6e 74 20 70 a ().. (print p
9b30: 6b 74 29 29 29 0a 20 20 20 20 20 20 28 70 72 69 kt))). (pri
9b40: 6e 74 20 22 45 52 52 4f 52 3a 20 63 61 6e 6e 6f nt "ERROR: canno
9b50: 74 20 70 72 6f 63 65 73 73 20 63 6f 6d 6d 61 6e t process comman
9b60: 64 73 20 77 69 74 68 6f 75 74 20 61 20 70 6b 74 ds without a pkt
9b70: 73 20 64 69 72 65 63 74 6f 72 79 22 29 29 29 0a s directory"))).
9b80: 0a 3b 3b 20 63 6f 6c 6c 65 63 74 20 61 6c 6c 20 .;; collect all
9b90: 6e 65 65 64 65 64 20 64 61 74 61 20 61 6e 64 20 needed data and
9ba0: 63 72 65 61 74 65 20 72 75 6e 20 70 6b 74 73 20 create run pkts
9bb0: 66 6f 72 20 63 6f 6e 74 6f 75 72 73 20 77 69 74 for contours wit
9bc0: 68 20 63 68 61 6e 67 65 64 20 69 6e 70 75 74 73 h changed inputs
9bd0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 69 73 .;;.(define (dis
9be0: 70 61 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d patch-commands m
9bf0: 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 0a 20 tconf toppath).
9c00: 20 3b 3b 20 77 65 20 61 72 65 20 65 78 70 65 63 ;; we are expec
9c10: 74 69 6e 67 20 61 20 64 69 72 65 63 74 6f 72 79 ting a directory
9c20: 20 22 6c 6f 67 73 22 2c 20 63 68 65 63 6b 20 61 "logs", check a
9c30: 6e 64 20 63 72 65 61 74 65 20 69 74 2c 20 63 72 nd create it, cr
9c40: 65 61 74 65 20 74 68 65 20 6c 6f 67 20 69 6e 20 eate the log in
9c50: 2f 74 6d 70 20 69 66 20 6e 6f 74 20 61 62 6c 65 /tmp if not able
9c60: 20 74 6f 20 63 72 65 61 74 65 20 6c 6f 67 73 20 to create logs
9c70: 64 69 72 0a 20 20 28 6c 65 74 20 28 28 6c 6f 67 dir. (let ((log
9c80: 64 69 72 0a 09 20 28 69 66 20 28 69 66 20 28 6e dir.. (if (if (n
9c90: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 3f 20 22 ot (directory? "
9ca0: 6c 6f 67 73 22 29 29 0a 09 09 20 28 68 61 6e 64 logs"))... (hand
9cb0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
9cc0: 20 20 20 20 20 65 78 6e 0a 09 09 20 20 20 20 20 exn...
9cd0: 23 66 0a 09 09 20 20 20 28 63 72 65 61 74 65 2d #f... (create-
9ce0: 64 69 72 65 63 74 6f 72 79 20 22 6c 6f 67 73 22 directory "logs"
9cf0: 29 0a 09 09 20 20 20 23 74 29 0a 09 09 20 23 74 )... #t)... #t
9d00: 29 0a 09 20 20 20 20 20 22 6c 6f 67 73 22 0a 09 ).. "logs"..
9d10: 20 20 20 20 20 22 2f 74 6d 70 22 29 29 29 0a 20 "/tmp"))).
9d20: 20 20 20 28 77 69 74 68 2d 71 75 65 75 65 2d 64 (with-queue-d
9d30: 62 0a 20 20 20 20 20 6d 74 63 6f 6e 66 0a 20 20 b. mtconf.
9d40: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 73 (lambda (pkts
9d50: 64 69 72 73 20 70 6b 74 73 64 69 72 20 70 64 62 dirs pktsdir pdb
9d60: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ). (let* (
9d70: 28 72 67 63 6f 6e 66 64 61 74 20 28 66 69 6e 64 (rgconfdat (find
9d80: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
9d90: 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 22 (conc toppath "
9da0: 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 /runconfigs.conf
9db0: 69 67 22 29 29 29 0a 09 20 20 20 20 20 20 28 72 ig"))).. (r
9dc0: 67 63 6f 6e 66 20 20 20 20 28 63 61 72 20 72 67 gconf (car rg
9dd0: 63 6f 6e 66 64 61 74 29 29 0a 09 20 20 20 20 20 confdat))..
9de0: 20 28 61 72 65 61 73 20 20 20 20 20 28 63 6f 6e (areas (con
9df0: 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e figf:get-section
9e00: 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 22 29 mtconf "areas")
9e10: 29 0a 09 20 20 20 20 20 20 28 63 6f 6e 74 6f 75 ).. (contou
9e20: 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 rs (configf:get
9e30: 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 -section mtconf
9e40: 22 63 6f 6e 74 6f 75 72 73 22 29 29 0a 09 20 20 "contours"))..
9e50: 20 20 20 20 28 70 6b 74 73 20 20 20 20 20 20 28 (pkts (
9e60: 66 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 find-pkts pdb '(
9e70: 63 6d 64 29 20 27 28 29 29 29 0a 09 20 20 20 20 cmd) '()))..
9e80: 20 20 28 74 6f 72 75 6e 20 20 20 20 20 28 6d 61 (torun (ma
9e90: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
9ea0: 3b 3b 20 74 61 72 67 65 74 20 3d 3e 20 28 20 2e ;; target => ( .
9eb0: 2e 2e 20 69 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 .. info ... )..
9ec0: 20 20 20 20 20 28 72 67 65 6e 74 61 72 67 73 20 (rgentargs
9ed0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
9ee0: 20 72 67 63 6f 6e 66 29 29 29 20 3b 3b 20 74 68 rgconf))) ;; th
9ef0: 65 73 65 20 61 72 65 20 74 68 65 20 74 61 72 67 ese are the targ
9f00: 65 74 73 20 72 65 67 69 73 74 65 72 65 64 20 66 ets registered f
9f10: 6f 72 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 or automatically
9f20: 20 74 72 69 67 67 65 72 69 6e 67 0a 09 20 28 66 triggering.. (f
9f30: 6f 72 2d 65 61 63 68 0a 09 20 20 28 6c 61 6d 62 or-each.. (lamb
9f40: 64 61 20 28 70 6b 74 64 61 74 29 0a 09 20 20 20 da (pktdat)..
9f50: 20 28 6c 65 74 2a 20 28 28 70 6b 74 61 20 20 20 (let* ((pkta
9f60: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 70 6b (alist-ref 'apk
9f70: 74 20 70 6b 74 64 61 74 29 29 0a 09 09 20 20 20 t pktdat))...
9f80: 28 61 63 74 69 6f 6e 20 20 28 61 6c 69 73 74 2d (action (alist-
9f90: 72 65 66 20 27 41 20 70 6b 74 61 29 29 0a 09 09 ref 'A pkta))...
9fa0: 20 20 20 28 63 6d 64 6c 69 6e 65 20 28 70 6b 74 (cmdline (pkt
9fb0: 2d 3e 63 6d 64 6c 69 6e 65 20 70 6b 74 61 29 29 ->cmdline pkta))
9fc0: 0a 09 09 20 20 20 28 75 75 69 64 20 20 20 20 28 ... (uuid (
9fd0: 61 6c 69 73 74 2d 72 65 66 20 27 5a 20 70 6b 74 alist-ref 'Z pkt
9fe0: 61 29 29 0a 09 09 20 20 20 28 6c 6f 67 66 20 20 a))... (logf
9ff0: 20 20 28 63 6f 6e 63 20 6c 6f 67 64 69 72 20 22 (conc logdir "
a000: 2f 22 20 75 75 69 64 20 22 2d 72 75 6e 2e 6c 6f /" uuid "-run.lo
a010: 67 22 29 29 0a 09 09 20 20 20 28 66 75 6c 6c 63 g"))... (fullc
a020: 6d 64 20 28 63 6f 6e 63 20 22 4e 42 46 41 4b 45 md (conc "NBFAKE
a030: 5f 4c 4f 47 3d 22 20 6c 6f 67 66 20 22 20 6e 62 _LOG=" logf " nb
a040: 66 61 6b 65 20 22 20 63 6d 64 6c 69 6e 65 29 29 fake " cmdline))
a050: 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 ).. (print
a060: 22 52 55 4e 4e 49 4e 47 3a 20 22 20 66 75 6c 6c "RUNNING: " full
a070: 63 6d 64 29 0a 09 20 20 20 20 20 20 28 73 79 73 cmd).. (sys
a080: 74 65 6d 20 66 75 6c 6c 63 6d 64 29 0a 09 20 20 tem fullcmd)..
a090: 20 20 20 20 28 6d 61 72 6b 2d 70 72 6f 63 65 73 (mark-proces
a0a0: 73 65 64 20 70 64 62 20 28 6c 69 73 74 20 28 61 sed pdb (list (a
a0b0: 6c 69 73 74 2d 72 65 66 20 27 69 64 20 70 6b 74 list-ref 'id pkt
a0c0: 64 61 74 29 29 29 0a 09 20 20 20 20 20 20 28 6c dat))).. (l
a0d0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 61 63 6b et-values (((ack
a0e0: 2d 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 0a 09 -uuid ack-pkt)..
a0f0: 09 09 20 20 20 20 28 61 64 64 2d 7a 2d 63 61 72 .. (add-z-car
a100: 64 0a 09 09 09 20 20 20 20 20 28 63 6f 6e 73 74 d.... (const
a110: 72 75 63 74 2d 73 64 61 74 20 27 50 20 75 75 69 ruct-sdat 'P uui
a120: 64 0a 09 09 09 09 09 20 20 20 20 20 27 54 20 28 d...... 'T (
a130: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
a140: 6d 62 6f 6c 20 61 63 74 69 6f 6e 29 0a 09 09 09 mbol action)....
a150: 09 09 09 20 20 28 28 72 75 6e 29 20 22 72 75 6e ... ((run) "run
a160: 73 74 61 72 74 22 29 0a 09 09 09 09 09 09 20 20 start").......
a170: 28 28 73 79 6e 63 29 20 22 73 79 6e 63 73 74 61 ((sync) "syncsta
a180: 72 74 22 29 20 20 20 20 3b 3b 20 65 78 61 6d 70 rt") ;; examp
a190: 6c 65 20 6f 66 20 74 72 61 6e 73 6c 61 74 69 6e le of translatin
a1a0: 67 20 72 75 6e 20 2d 3e 20 72 75 6e 73 74 61 72 g run -> runstar
a1b0: 74 0a 09 09 09 09 09 09 20 20 28 65 6c 73 65 20 t....... (else
a1c0: 20 20 61 63 74 69 6f 6e 29 29 0a 09 09 09 09 09 action))......
a1d0: 20 20 20 20 20 27 63 20 28 61 6c 69 73 74 2d 72 'c (alist-r
a1e0: 65 66 20 27 6f 20 70 6b 74 61 29 20 3b 3b 20 54 ef 'o pkta) ;; T
a1f0: 48 49 53 20 49 53 20 57 52 4f 4e 47 21 20 53 48 HIS IS WRONG! SH
a200: 4f 55 4c 44 20 42 45 20 27 63 0a 09 09 09 09 09 OULD BE 'c......
a210: 20 20 20 20 20 27 74 20 28 61 6c 69 73 74 2d 72 't (alist-r
a220: 65 66 20 27 74 20 70 6b 74 61 29 29 29 29 29 0a ef 't pkta))))).
a230: 09 09 28 77 72 69 74 65 2d 70 6b 74 20 70 6b 74 ..(write-pkt pkt
a240: 73 64 69 72 20 61 63 6b 2d 75 75 69 64 20 61 63 sdir ack-uuid ac
a250: 6b 2d 70 6b 74 29 29 29 29 0a 09 20 20 70 6b 74 k-pkt)))).. pkt
a260: 73 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69 s)))))). .(defi
a270: 6e 65 20 28 67 65 74 2d 70 6b 74 73 2d 64 69 72 ne (get-pkts-dir
a280: 20 6d 74 63 6f 6e 66 29 0a 20 20 28 6c 65 74 20 mtconf). (let
a290: 28 28 70 6b 74 73 64 69 72 73 20 20 28 63 6f 6e ((pktsdirs (con
a2a0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
a2b0: 6e 66 20 22 73 65 74 75 70 22 20 22 70 6b 74 73 nf "setup" "pkts
a2c0: 64 69 72 73 22 29 29 0a 09 28 70 6b 74 73 64 69 dirs"))..(pktsdi
a2d0: 72 20 20 20 28 69 66 20 70 6b 74 73 64 69 72 73 r (if pktsdirs
a2e0: 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 (car (string-sp
a2f0: 6c 69 74 20 70 6b 74 73 64 69 72 73 20 22 20 22 lit pktsdirs " "
a300: 29 29 20 23 66 29 29 29 0a 20 20 20 20 70 6b 74 )) #f))). pkt
a310: 73 64 69 72 29 29 0a 0a 28 6c 65 74 20 28 28 64 sdir))..(let ((d
a320: 65 62 75 67 63 6f 6e 74 72 6f 6c 66 20 28 63 6f ebugcontrolf (co
a330: 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d nc (get-environm
a340: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
a350: 4d 45 22 29 20 22 2f 2e 6d 74 75 74 69 6c 72 63 ME") "/.mtutilrc
a360: 22 29 29 29 0a 20 20 28 69 66 20 28 66 69 6c 65 "))). (if (file
a370: 2d 65 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f -exists? debugco
a380: 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c ntrolf). (l
a390: 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c oad debugcontrol
a3a0: 66 29 29 29 0a 0a 28 69 66 20 2a 61 63 74 69 6f f)))..(if *actio
a3b0: 6e 2a 0a 20 20 20 20 28 63 61 73 65 20 28 73 74 n*. (case (st
a3c0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 2a 61 63 ring->symbol *ac
a3d0: 74 69 6f 6e 2a 29 0a 20 20 20 20 20 20 28 28 72 tion*). ((r
a3e0: 75 6e 20 72 65 6d 6f 76 65 20 72 65 72 75 6e 20 un remove rerun
a3f0: 73 65 74 2d 73 73 20 61 72 63 68 69 76 65 20 6b set-ss archive k
a400: 69 6c 6c 20 6c 69 73 74 29 0a 20 20 20 20 20 20 ill list).
a410: 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e 66 64 (let* ((mtconfd
a420: 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 at (simple-setup
a430: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a440: 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 0a 09 -start-dir")))..
a450: 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 (mtconf
a460: 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 (car mtconfdat)
a470: 29 0a 09 20 20 20 20 20 20 28 70 6b 74 73 64 69 ).. (pktsdi
a480: 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f rs (configf:loo
a490: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 kup mtconf "setu
a4a0: 70 22 20 22 70 6b 74 73 64 69 72 73 22 29 29 0a p" "pktsdirs")).
a4b0: 09 20 20 20 20 20 20 28 70 6b 74 73 64 69 72 20 . (pktsdir
a4c0: 20 20 28 69 66 20 70 6b 74 73 64 69 72 73 20 28 (if pktsdirs (
a4d0: 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 car (string-spli
a4e0: 74 20 70 6b 74 73 64 69 72 73 20 22 20 22 29 29 t pktsdirs " "))
a4f0: 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 61 64 #f)).. (ad
a500: 6a 61 72 67 73 20 20 20 28 68 61 73 68 2d 74 61 jargs (hash-ta
a510: 62 6c 65 2d 63 6f 70 79 20 61 72 67 73 3a 61 72 ble-copy args:ar
a520: 67 2d 68 61 73 68 29 29 29 0a 09 20 3b 3b 20 28 g-hash))).. ;; (
a530: 66 6f 72 2d 65 61 63 68 0a 09 20 3b 3b 20 20 28 for-each.. ;; (
a540: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 20 3b lambda (key).. ;
a550: 3b 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6d ; (if (not (m
a560: 65 6d 62 65 72 20 6b 65 79 20 2a 6c 65 67 61 6c ember key *legal
a570: 2d 70 61 72 61 6d 73 2a 29 29 0a 09 20 3b 3b 20 -params*)).. ;;
a580: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c .(hash-table-del
a590: 65 74 65 21 20 61 64 6a 61 72 67 73 20 6b 65 79 ete! adjargs key
a5a0: 29 29 29 20 3b 3b 20 77 65 20 6e 65 65 64 20 74 ))) ;; we need t
a5b0: 6f 20 64 65 6c 65 74 65 20 61 6e 79 20 70 61 72 o delete any par
a5c0: 61 6d 73 20 69 6e 74 65 6e 64 65 64 20 66 6f 72 ams intended for
a5d0: 20 6d 74 75 74 69 6c 0a 09 20 3b 3b 20 20 28 68 mtutil.. ;; (h
a5e0: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 ash-table-keys a
a5f0: 64 6a 61 72 67 73 29 29 0a 09 20 28 6c 65 74 2d djargs)).. (let-
a600: 76 61 6c 75 65 73 20 28 28 28 75 75 69 64 20 70 values (((uuid p
a610: 6b 74 29 0a 09 09 20 20 20 20 20 20 20 28 63 6f kt)... (co
a620: 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e 70 6b 74 20 mmand-line->pkt
a630: 2a 61 63 74 69 6f 6e 2a 20 61 64 6a 61 72 67 73 *action* adjargs
a640: 20 23 66 29 29 29 0a 09 20 20 20 28 77 72 69 74 #f))).. (writ
a650: 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 20 75 75 e-pkt pktsdir uu
a660: 69 64 20 70 6b 74 29 29 29 29 0a 20 20 20 20 20 id pkt)))).
a670: 20 28 28 64 69 73 70 61 74 63 68 20 69 6d 70 6f ((dispatch impo
a680: 72 74 20 72 75 6e 67 65 6e 20 70 72 6f 63 65 73 rt rungen proces
a690: 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 s). (let*
a6a0: 28 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 69 6d ((mtconfdat (sim
a6b0: 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 73 3a ple-setup (args:
a6c0: 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d get-arg "-start-
a6d0: 64 69 72 22 29 29 29 0a 09 20 20 20 20 20 20 28 dir"))).. (
a6e0: 6d 74 63 6f 6e 66 20 20 20 20 28 63 61 72 20 6d mtconf (car m
a6f0: 74 63 6f 6e 66 64 61 74 29 29 0a 09 20 20 20 20 tconfdat))..
a700: 20 20 28 74 6f 70 70 61 74 68 20 20 20 28 63 6f (toppath (co
a710: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 nfigf:lookup mtc
a720: 6f 6e 66 20 22 64 79 6e 64 61 74 22 20 22 74 6f onf "dyndat" "to
a730: 70 70 61 74 68 22 29 29 29 0a 09 20 28 63 61 73 ppath"))).. (cas
a740: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
a750: 6c 20 2a 61 63 74 69 6f 6e 2a 29 0a 09 20 20 20 l *action*)..
a760: 28 28 70 72 6f 63 65 73 73 29 20 20 28 62 65 67 ((process) (beg
a770: 69 6e 0a 09 09 09 20 28 6c 6f 61 64 2d 70 6b 74 in.... (load-pkt
a780: 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 29 0a s-to-db mtconf).
a790: 09 09 09 20 28 67 65 6e 65 72 61 74 65 2d 72 75 ... (generate-ru
a7a0: 6e 2d 70 6b 74 73 20 6d 74 63 6f 6e 66 20 74 6f n-pkts mtconf to
a7b0: 70 70 61 74 68 29 0a 09 09 09 20 28 6c 6f 61 64 ppath).... (load
a7c0: 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 6f -pkts-to-db mtco
a7d0: 6e 66 29 0a 09 09 09 20 28 64 69 73 70 61 74 63 nf).... (dispatc
a7e0: 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 6f 6e h-commands mtcon
a7f0: 66 20 74 6f 70 70 61 74 68 29 29 29 0a 09 20 20 f toppath)))..
a800: 20 28 28 69 6d 70 6f 72 74 29 20 20 20 28 6c 6f ((import) (lo
a810: 61 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 ad-pkts-to-db mt
a820: 63 6f 6e 66 29 29 20 3b 3b 20 69 6d 70 6f 72 74 conf)) ;; import
a830: 20 70 6b 74 73 0a 09 20 20 20 28 28 72 75 6e 67 pkts.. ((rung
a840: 65 6e 29 20 20 20 28 67 65 6e 65 72 61 74 65 2d en) (generate-
a850: 72 75 6e 2d 70 6b 74 73 20 6d 74 63 6f 6e 66 20 run-pkts mtconf
a860: 74 6f 70 70 61 74 68 29 29 0a 09 20 20 20 28 28 toppath)).. ((
a870: 64 69 73 70 61 74 63 68 29 20 28 64 69 73 70 61 dispatch) (dispa
a880: 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 tch-commands mtc
a890: 6f 6e 66 20 74 6f 70 70 61 74 68 29 29 29 29 29 onf toppath)))))
a8a0: 0a 20 20 20 20 20 20 3b 3b 20 6d 69 73 63 0a 20 . ;; misc.
a8b0: 20 20 20 20 20 28 28 73 68 6f 77 29 0a 20 20 20 ((show).
a8c0: 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng
a8d0: 74 68 20 72 65 6d 61 72 67 73 29 20 30 29 0a 09 th remargs) 0)..
a8e0: 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e (let* ((mtcon
a8f0: 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 fdat (simple-set
a900: 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 up (args:get-arg
a910: 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 "-start-dir")))
a920: 0a 09 09 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 ... (mtconf
a930: 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 (car mtconfdat))
a940: 0a 09 09 20 20 28 73 65 63 74 2d 64 61 74 20 28 ... (sect-dat (
a950: 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
a960: 69 6f 6e 20 6d 74 63 6f 6e 66 20 28 63 61 72 20 ion mtconf (car
a970: 72 65 6d 61 72 67 73 29 29 29 29 0a 09 20 20 20 remargs))))..
a980: 20 20 28 69 66 20 73 65 63 74 2d 64 61 74 0a 09 (if sect-dat..
a990: 09 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 . (for-each...
a9a0: 28 6c 61 6d 62 64 61 20 28 65 6e 74 72 79 29 0a (lambda (entry).
a9b0: 09 09 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 .. (if (> (le
a9c0: 6e 67 74 68 20 65 6e 74 72 79 29 20 31 29 0a 09 ngth entry) 1)..
a9d0: 09 09 28 70 72 69 6e 74 20 28 63 61 72 20 65 6e ..(print (car en
a9e0: 74 72 79 29 20 22 20 20 20 22 20 28 63 61 64 72 try) " " (cadr
a9f0: 20 65 6e 74 72 79 29 29 0a 09 09 09 28 70 72 69 entry))....(pri
aa00: 6e 74 20 28 63 61 72 20 65 6e 74 72 79 29 29 29 nt (car entry)))
aa10: 29 0a 09 09 20 20 73 65 63 74 2d 64 61 74 29 0a )... sect-dat).
aa20: 09 09 20 28 70 72 69 6e 74 20 22 4e 6f 20 73 65 .. (print "No se
aa30: 63 74 69 6f 6e 20 5c 22 22 20 28 63 61 72 20 72 ction \"" (car r
aa40: 65 6d 61 72 67 73 29 20 22 5c 22 20 66 6f 75 6e emargs) "\" foun
aa50: 64 22 29 29 29 0a 09 20 20 20 28 70 72 69 6e 74 d"))).. (print
aa60: 20 22 45 52 52 4f 52 3a 20 6c 69 73 74 20 72 65 "ERROR: list re
aa70: 71 75 69 72 65 73 20 73 65 63 74 69 6f 6e 20 70 quires section p
aa80: 61 72 61 6d 65 74 65 72 3b 20 61 72 65 61 73 2c arameter; areas,
aa90: 20 73 65 74 75 70 20 6f 72 20 63 6f 6e 74 6f 75 setup or contou
aaa0: 72 73 22 29 29 29 0a 20 20 20 20 20 20 28 28 67 rs"))). ((g
aab0: 65 6e 64 6f 74 29 0a 20 20 20 20 20 20 20 28 6c endot). (l
aac0: 65 74 2a 20 28 28 6d 74 63 6f 6e 66 64 61 74 20 et* ((mtconfdat
aad0: 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 (simple-setup (a
aae0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
aaf0: 61 72 74 2d 64 69 72 22 29 29 29 0a 09 20 20 20 art-dir")))..
ab00: 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 (mtconf (c
ab10: 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 29 0a ar mtconfdat))).
ab20: 09 20 28 77 69 74 68 2d 71 75 65 75 65 2d 64 62 . (with-queue-db
ab30: 0a 09 20 20 6d 74 63 6f 6e 66 0a 09 20 20 28 6c .. mtconf.. (l
ab40: 61 6d 62 64 61 20 28 70 6b 74 73 64 69 72 73 20 ambda (pktsdirs
ab50: 70 6b 74 73 64 69 72 20 63 6f 6e 6e 29 0a 09 20 pktsdir conn)..
ab60: 20 20 20 28 6d 61 6b 65 2d 72 65 70 6f 72 74 20 (make-report
ab70: 22 6f 75 74 2e 64 6f 74 22 20 63 6f 6e 6e 20 27 "out.dot" conn '
ab80: 28 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 28 ()))))). ((
ab90: 64 62 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 db). (if (
aba0: 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a 09 null? remargs)..
abb0: 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 (print "ERROR
abc0: 3a 20 6d 69 73 73 69 6e 67 20 73 75 62 20 63 6f : missing sub co
abd0: 6d 6d 61 6e 64 20 66 6f 72 20 64 62 20 63 6f 6d mmand for db com
abe0: 6d 61 6e 64 22 29 0a 09 20 20 20 28 6c 65 74 20 mand").. (let
abf0: 28 28 73 75 62 63 6d 64 20 28 63 61 72 20 72 65 ((subcmd (car re
ac00: 6d 61 72 67 73 29 29 29 0a 09 20 20 20 20 20 28 margs))).. (
ac10: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
ac20: 6d 62 6f 6c 20 73 75 62 63 6d 64 29 0a 09 20 20 mbol subcmd)..
ac30: 20 20 20 20 20 28 28 70 67 73 63 68 65 6d 61 29 ((pgschema)
ac40: 0a 09 09 28 6c 65 74 2a 20 28 28 69 6e 73 74 61 ...(let* ((insta
ac50: 6c 6c 2d 68 6f 6d 65 20 28 63 6f 6d 6d 6f 6e 3a ll-home (common:
ac60: 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 get-install-area
ac70: 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 63 68 ))... (sch
ac80: 65 6d 61 2d 66 69 6c 65 20 20 28 63 6f 6e 63 20 ema-file (conc
ac90: 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 install-home "/s
aca0: 68 61 72 65 2f 64 62 2f 6d 74 2d 70 67 2e 73 71 hare/db/mt-pg.sq
acb0: 6c 22 29 29 29 0a 09 09 20 20 28 69 66 20 28 66 l")))... (if (f
acc0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 63 68 65 ile-exists? sche
acd0: 6d 61 2d 66 69 6c 65 29 0a 09 09 20 20 20 20 20 ma-file)...
ace0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
acf0: 2f 62 69 6e 2f 63 61 74 20 22 20 73 63 68 65 6d /bin/cat " schem
ad00: 61 2d 66 69 6c 65 29 29 29 29 29 0a 09 20 20 20 a-file)))))..
ad10: 20 20 20 20 28 28 73 71 6c 69 74 65 33 73 63 68 ((sqlite3sch
ad20: 65 6d 61 29 0a 09 09 28 6c 65 74 2a 20 28 28 69 ema)...(let* ((i
ad30: 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 28 63 6f 6d nstall-home (com
ad40: 6d 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d mon:get-install-
ad50: 61 72 65 61 29 29 0a 09 09 20 20 20 20 20 20 20 area))...
ad60: 28 73 63 68 65 6d 61 2d 66 69 6c 65 20 20 28 63 (schema-file (c
ad70: 6f 6e 63 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 onc install-home
ad80: 20 22 2f 73 68 61 72 65 2f 64 62 2f 6d 74 2d 73 "/share/db/mt-s
ad90: 71 6c 69 74 65 33 2e 73 71 6c 22 29 29 29 0a 09 qlite3.sql")))..
ada0: 09 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 . (if (file-exi
adb0: 73 74 73 3f 20 73 63 68 65 6d 61 2d 66 69 6c 65 sts? schema-file
adc0: 29 0a 09 09 20 20 20 20 20 20 28 73 79 73 74 65 )... (syste
add0: 6d 20 28 63 6f 6e 63 20 22 2f 62 69 6e 2f 63 61 m (conc "/bin/ca
ade0: 74 20 22 20 73 63 68 65 6d 61 2d 66 69 6c 65 29 t " schema-file)
adf0: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 28 6a )))).. ((j
ae00: 75 6e 6b 29 0a 09 09 28 72 6d 74 3a 67 65 74 2d unk)...(rmt:get-
ae10: 6b 65 79 73 29 29 29 29 29 29 29 29 0a 0a 3b 3b keys))))))))..;;
ae20: 20 49 66 20 48 54 54 50 5f 48 4f 53 54 20 69 73 If HTTP_HOST is
ae30: 20 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 65 defined then we
ae40: 20 6d 75 73 74 20 62 65 20 69 6e 20 74 68 65 20 must be in the
ae50: 63 67 69 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a cgi environment.
ae60: 3b 3b 20 73 6f 20 72 75 6e 20 73 74 6d 6c 20 61 ;; so run stml a
ae70: 6e 64 20 65 78 69 74 0a 3b 3b 0a 28 69 66 20 28 nd exit.;;.(if (
ae80: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
ae90: 76 61 72 69 61 62 6c 65 20 22 48 54 54 50 5f 48 variable "HTTP_H
aea0: 4f 53 54 22 29 0a 20 20 20 20 28 62 65 67 69 6e OST"). (begin
aeb0: 0a 20 20 20 20 20 20 28 73 74 6d 6c 3a 6d 61 69 . (stml:mai
aec0: 6e 20 23 66 29 0a 20 20 20 20 20 20 28 65 78 69 n #f). (exi
aed0: 74 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 61 t)))..(if (or (a
aee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 rgs:get-arg "-re
aef0: 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 2d pl")..(args:get-
af00: 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 20 arg "-load")).
af10: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 (begin. (
af20: 69 6d 70 6f 72 74 20 65 78 74 72 61 73 29 20 3b import extras) ;
af30: 3b 20 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 6e ; might not be n
af40: 65 65 64 65 64 0a 20 20 20 20 20 20 3b 3b 20 28 eeded. ;; (
af50: 69 6d 70 6f 72 74 20 63 73 69 29 0a 20 20 20 20 import csi).
af60: 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c 69 (import readli
af70: 6e 65 29 0a 20 20 20 20 20 20 28 69 6d 70 6f 72 ne). (impor
af80: 74 20 61 70 72 6f 70 6f 73 29 0a 20 20 20 20 20 t apropos).
af90: 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 65 ;; (import (pre
afa0: 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
afb0: 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e 27 te3:)) ;; doesn'
afc0: 74 20 77 6f 72 6b 20 2e 2e 2e 0a 20 20 20 20 20 t work ....
afd0: 20 0a 20 20 20 20 20 20 28 69 6e 73 74 61 6c 6c . (install
afe0: 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 67 -history-file (g
aff0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
b000: 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 ariable "HOME")
b010: 22 2e 6d 74 75 74 69 6c 5f 68 69 73 74 6f 72 79 ".mtutil_history
b020: 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 5d ") ;; [homedir]
b030: 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c 69 [filename] [nli
b040: 6e 65 73 5d 29 0a 20 20 20 20 20 20 28 63 75 72 nes]). (cur
b050: 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 20 rent-input-port
b060: 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d 70 (make-readline-p
b070: 6f 72 74 20 22 6d 74 75 74 69 6c 3e 20 22 29 29 ort "mtutil> "))
b080: 0a 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 . (if (args
b090: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c 22 :get-arg "-repl"
b0a0: 29 0a 09 20 20 28 72 65 70 6c 29 0a 09 20 20 28 ).. (repl).. (
b0b0: 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d 61 load (args:get-a
b0c0: 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 29 29 0a rg "-load"))))).
b0d0: 0a 23 7c 0a 28 64 65 66 69 6e 65 20 6d 74 63 6f .#|.(define mtco
b0e0: 6e 66 20 28 63 61 72 20 28 73 69 6d 70 6c 65 2d nf (car (simple-
b0f0: 73 65 74 75 70 20 23 66 29 29 29 0a 28 64 65 66 setup #f))).(def
b100: 69 6e 65 20 64 61 74 20 28 77 69 74 68 2d 71 75 ine dat (with-qu
b110: 65 75 65 2d 64 62 20 6d 74 63 6f 6e 66 20 28 6c eue-db mtconf (l
b120: 61 6d 62 64 61 20 28 63 6f 6e 6e 29 28 67 65 74 ambda (conn)(get
b130: 2d 70 6b 74 73 20 63 6f 6e 6e 20 27 28 29 29 29 -pkts conn '()))
b140: 29 29 0a 28 70 70 20 28 70 6b 74 73 23 66 6c 61 )).(pp (pkts#fla
b150: 74 74 65 6e 2d 61 6c 6c 20 64 61 74 20 27 28 28 tten-all dat '((
b160: 63 6d 64 20 2e 20 28 28 70 61 72 65 6e 74 20 2e cmd . ((parent .
b170: 20 50 29 28 75 72 6c 20 2e 20 4d 29 29 29 28 72 P)(url . M)))(r
b180: 75 6e 74 79 70 65 20 2e 20 28 28 70 61 72 65 6e untype . ((paren
b190: 74 20 2e 20 50 29 29 29 29 20 27 69 64 20 27 67 t . P)))) 'id 'g
b1a0: 72 6f 75 70 2d 69 64 20 27 75 75 69 64 20 27 70 roup-id 'uuid 'p
b1b0: 61 72 65 6e 74 20 27 70 6b 74 2d 74 79 70 65 20 arent 'pkt-type
b1c0: 27 70 6b 74 20 27 70 72 6f 63 65 73 73 65 64 29 'pkt 'processed)
b1d0: 29 0a 7c 23 0a ).|#.