0000: 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 36 ; Copyright 2006
0010: 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 20 57 -2017, Matthew W
0020: 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 54 elland..;; .;; T
0030: 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 74 his file is part
0040: 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a 3b 3b of Megatest..;;
0050: 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 .;; Megates
0060: 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 61 t is free softwa
0070: 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 69 re: you can redi
0080: 73 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 2f stribute it and/
0090: 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 20 20 or modify.;;
00a0: 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 65 it under the te
00b0: 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 47 rms of the GNU G
00c0: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
00d0: 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 cense as publish
00e0: 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 68 65 ed by.;; the
00f0: 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 Free Software F
0100: 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 oundation, eithe
0110: 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 r version 3 of t
0120: 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 3b he License, or.;
0130: 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 20 6f ; (at your o
0140: 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 72 ption) any later
0150: 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b 3b version..;; .;;
0160: 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 Megatest is
0170: 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 distributed in
0180: 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 the hope that it
0190: 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c will be useful,
01a0: 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 54 48 .;; but WITH
01b0: 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 OUT ANY WARRANTY
01c0: 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 ; without even t
01d0: 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 he implied warra
01e0: 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 4d 45 nty of.;; ME
01f0: 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f 72 RCHANTABILITY or
0200: 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 50 FITNESS FOR A P
0210: 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f 53 ARTICULAR PURPOS
0220: 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b 20 20 E. See the.;;
0230: 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 GNU General P
0240: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f ublic License fo
0250: 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a r more details..
0260: 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 20 73 ;; .;; You s
0270: 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 hould have recei
0280: 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ved a copy of th
0290: 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 e GNU General Pu
02a0: 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b 3b 20 blic License.;;
02b0: 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 20 4d along with M
02c0: 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e 6f 74 egatest. If not
02d0: 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 77 , see <http://ww
02e0: 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 w.gnu.org/licens
02f0: 65 73 2f 3e 2e 0a 3b 3b 0a 0a 3b 3b 20 28 69 6e es/>..;;..;; (in
0300: 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 2e 73 63 clude "common.sc
0310: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 m").(include "me
0320: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 2e 73 gatest-version.s
0330: 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 20 6f 75 cm")..;; fake ou
0340: 74 20 72 65 61 64 6c 69 6e 65 20 75 73 61 67 65 t readline usage
0350: 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d of toplevel-com
0360: 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 28 74 6f mand.(define (to
0370: 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e 64 20 2e plevel-command .
0380: 20 61 29 20 23 66 29 0a 0a 28 75 73 65 20 73 72 a) #f)..(use sr
0390: 66 69 2d 31 20 70 6f 73 69 78 20 73 72 66 69 2d fi-1 posix srfi-
03a0: 36 39 20 72 65 61 64 6c 69 6e 65 20 3b 3b 20 20 69 readline ;;
03b0: 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 regex regex-case
03c0: 20 73 72 66 69 2d 36 39 20 61 70 72 6f 70 6f 73 srfi-69 apropos
03d0: 20 6a 73 6f 6e 20 68 74 74 70 2d 63 6c 69 65 6e json http-clien
03e0: 74 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c t directory-util
03f0: 73 20 72 70 63 20 74 79 70 65 64 2d 72 65 63 6f s rpc typed-reco
0400: 72 64 73 3b 3b 20 28 73 72 66 69 20 31 38 29 20 rds;; (srfi 18)
0410: 65 78 74 72 61 73 29 0a 20 20 20 73 72 66 69 2d extras). srfi-
0420: 31 39 20 20 73 72 66 69 2d 31 38 20 65 78 74 72 19 srfi-18 extr
0430: 61 73 20 66 6f 72 6d 61 74 20 70 6b 74 73 20 72 as format pkts r
0440: 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 0a egex regex-case.
0450: 20 20 20 20 20 28 70 72 65 66 69 78 20 64 62 69 (prefix dbi
0460: 20 64 62 69 3a 29 0a 20 20 20 20 20 28 70 72 65 dbi:). (pre
0470: 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
0480: 74 65 33 3a 29 0a 20 20 20 20 20 6e 61 6e 6f 6d te3:). nanom
0490: 73 67 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 sg)..(declare (u
04a0: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 ses common)).(de
04b0: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 72 67 clare (uses marg
04c0: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
04d0: 65 73 20 63 6f 6e 66 69 67 66 29 29 0a 3b 3b 20 es configf)).;;
04e0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 (declare (uses r
04f0: 6d 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 mt)).(declare (u
0500: 73 65 73 20 73 74 6d 6c 32 29 29 0a 28 64 65 63 ses stml2)).(dec
0510: 6c 61 72 65 20 28 75 73 65 73 20 64 75 63 74 74 lare (uses ductt
0520: 61 70 65 2d 6c 69 62 29 29 0a 0a 28 69 6d 70 6f ape-lib))..(impo
0530: 72 74 20 64 75 63 74 74 61 70 65 2d 6c 69 62 29 rt ducttape-lib)
0540: 0a 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 ..(include "mega
0550: 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 test-fossil-hash
0560: 2e 73 63 6d 22 29 0a 0a 28 69 6d 70 6f 72 74 20 .scm")..(import
0570: 73 74 6d 6c 32 29 0a 0a 3b 3b 20 73 74 75 66 66 stml2)..;; stuff
0580: 20 66 6f 72 20 74 68 65 20 6d 61 70 70 65 72 20 for the mapper
0590: 61 6e 64 20 63 68 65 63 6b 65 72 20 66 75 6e 63 and checker func
05a0: 74 69 6f 6e 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 tions.;;.(define
05b0: 20 2a 74 61 72 67 65 74 2d 6d 61 70 70 65 72 73 *target-mappers
05c0: 2a 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 * (make-hash-ta
05d0: 62 6c 65 29 29 20 0a 28 64 65 66 69 6e 65 20 2a ble)) .(define *
05e0: 72 75 6e 6e 61 6d 65 2d 6d 61 70 70 65 72 73 2a runname-mappers*
05f0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0600: 65 29 29 20 0a 28 64 65 66 69 6e 65 20 2a 61 72 e)) .(define *ar
0610: 65 61 2d 63 68 65 63 6b 65 72 73 2a 20 20 20 28 ea-checkers* (
0620: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0630: 29 20 0a 0a 28 64 65 66 69 6e 65 20 28 6d 74 75 ) ..(define (mtu
0640: 74 3a 73 74 6d 6c 2d 3e 73 74 72 69 6e 67 20 69 t:stml->string i
0650: 6e 2d 73 74 6d 6c 29 0a 20 20 28 77 69 74 68 2d n-stml). (with-
0660: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
0670: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a . (lambda ().
0680: 20 20 20 20 20 20 28 73 3a 6f 75 74 70 75 74 2d (s:output-
0690: 6e 65 77 0a 20 20 20 20 20 20 20 28 63 75 72 72 new. (curr
06a0: 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 ent-output-port)
06b0: 0a 20 20 20 20 20 20 20 69 6e 2d 73 74 6d 6c 29 . in-stml)
06c0: 29 29 29 0a 0a 3b 3b 20 68 65 6c 70 65 72 73 20 )))..;; helpers
06d0: 66 6f 72 20 6d 61 70 70 65 72 73 2f 63 68 65 63 for mappers/chec
06e0: 6b 65 72 73 0a 28 64 65 66 69 6e 65 20 28 61 64 kers.(define (ad
06f0: 64 2d 74 61 72 67 65 74 2d 6d 61 70 70 65 72 20 d-target-mapper
0700: 6e 61 6d 65 20 70 72 6f 63 29 0a 20 20 28 68 61 name proc). (ha
0710: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
0720: 61 72 67 65 74 2d 6d 61 70 70 65 72 73 2a 20 6e arget-mappers* n
0730: 61 6d 65 20 70 72 6f 63 29 29 0a 28 64 65 66 69 ame proc)).(defi
0740: 6e 65 20 28 61 64 64 2d 72 75 6e 6e 61 6d 65 2d ne (add-runname-
0750: 6d 61 70 70 65 72 20 6e 61 6d 65 20 70 72 6f 63 mapper name proc
0760: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table-
0770: 73 65 74 21 20 2a 72 75 6e 6e 61 6d 65 2d 6d 61 set! *runname-ma
0780: 70 70 65 72 73 2a 20 6e 61 6d 65 20 70 72 6f 63 ppers* name proc
0790: 29 29 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d )).(define (add-
07a0: 61 72 65 61 2d 63 68 65 63 6b 65 72 20 6e 61 6d area-checker nam
07b0: 65 20 70 72 6f 63 29 0a 20 20 28 68 61 73 68 2d e proc). (hash-
07c0: 74 61 62 6c 65 2d 73 65 74 21 20 2a 61 72 65 61 table-set! *area
07d0: 2d 63 68 65 63 6b 65 72 73 2a 20 6e 61 6d 65 20 -checkers* name
07e0: 70 72 6f 63 29 29 0a 0a 3b 3b 20 67 69 76 65 6e proc))..;; given
07f0: 20 61 20 72 75 6e 6b 65 79 2c 20 78 6c 61 74 72 a runkey, xlatr
0800: 2d 6b 65 79 20 61 6e 64 20 6f 74 68 65 72 20 69 -key and other i
0810: 6e 66 6f 20 72 65 74 75 72 6e 20 6f 6e 65 20 6f nfo return one o
0820: 66 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 3a f the following:
0830: 0a 3b 3b 20 20 20 6c 69 73 74 20 6f 66 20 74 61 .;; list of ta
0840: 72 67 65 74 73 2c 20 6e 75 6c 6c 20 6c 69 73 74 rgets, null list
0850: 20 74 6f 20 73 6b 69 70 20 70 72 6f 63 65 73 73 to skip process
0860: 69 6e 67 0a 3b 3b 20 20 20 0a 28 64 65 66 69 6e ing.;; .(defin
0870: 65 20 28 6d 61 70 2d 74 61 72 67 65 74 73 20 6d e (map-targets m
0880: 74 63 6f 6e 66 20 61 76 61 6c 2d 61 6c 69 73 74 tconf aval-alist
0890: 20 72 75 6e 6b 65 79 20 61 72 65 61 20 63 6f 6e runkey area con
08a0: 74 6f 75 72 20 23 21 6b 65 79 20 28 78 6c 61 74 tour #!key (xlat
08b0: 72 2d 6b 65 79 2d 69 6e 20 23 66 29 29 0a 20 20 r-key-in #f)).
08c0: 28 70 70 20 61 76 61 6c 2d 61 6c 69 73 74 29 0a (pp aval-alist).
08d0: 20 20 28 70 72 69 6e 74 20 22 49 6e 20 4d 61 70 (print "In Map
08e0: 2d 74 61 72 67 65 74 73 22 29 0a 20 20 28 6c 65 -targets"). (le
08f0: 74 2a 20 28 28 78 6c 61 74 72 2d 6b 65 79 20 28 t* ((xlatr-key (
0900: 6f 72 20 78 6c 61 74 72 2d 6b 65 79 2d 69 6e 0a or xlatr-key-in.
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0920: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 2d 67 65 (conf-ge
0930: 74 2f 64 65 66 61 75 6c 74 20 6d 74 63 6f 6e 66 t/default mtconf
0940: 20 61 76 61 6c 2d 61 6c 69 73 74 20 27 74 61 72 aval-alist 'tar
0950: 67 74 72 61 6e 73 29 29 29 0a 20 20 20 20 20 20 gtrans))).
0960: 20 20 20 28 70 72 6f 63 20 20 20 20 20 20 28 68 (proc (h
0970: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
0980: 66 61 75 6c 74 20 2a 74 61 72 67 65 74 2d 6d 61 fault *target-ma
0990: 70 70 65 72 73 2a 20 78 6c 61 74 72 2d 6b 65 79 ppers* xlatr-key
09a0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 70 #f))). (if p
09b0: 72 6f 63 0a 20 20 20 20 20 20 20 20 28 62 65 67 roc. (beg
09c0: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 28 70 72 in. (pr
09d0: 69 6e 74 20 22 55 73 69 6e 67 20 74 61 72 67 65 int "Using targe
09e0: 74 20 6d 61 70 70 65 72 3a 20 22 20 78 6c 61 74 t mapper: " xlat
09f0: 72 2d 6b 65 79 29 0a 20 20 20 20 20 20 20 20 20 r-key).
0a00: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
0a10: 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 65 ons. e
0a20: 78 6e 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 xn. (b
0a30: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
0a40: 20 20 28 70 72 69 6e 74 20 22 46 41 49 4c 45 44 (print "FAILED
0a50: 20 54 4f 20 52 55 4e 20 54 41 52 47 45 54 20 4d TO RUN TARGET M
0a60: 41 50 50 45 52 20 46 4f 52 20 22 20 61 72 65 61 APPER FOR " area
0a70: 20 22 2c 20 63 61 6c 6c 65 64 20 22 20 78 6c 61 ", called " xla
0a80: 74 72 2d 6b 65 79 29 0a 20 20 20 20 20 20 20 20 tr-key).
0a90: 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 20 20 (print "
0aa0: 66 75 6e 63 74 69 6f 6e 20 69 73 3a 20 22 20 28 function is: " (
0ab0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
0ac0: 65 66 61 75 6c 74 20 2a 74 61 72 67 65 74 2d 6d efault *target-m
0ad0: 61 70 70 65 72 73 2a 20 78 6c 61 74 72 2d 6b 65 appers* xlatr-ke
0ae0: 79 20 23 66 20 29 20 29 0a 20 20 20 20 20 20 20 y #f ) ).
0af0: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 6d (print " m
0b00: 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 essage: " ((cond
0b10: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
0b20: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
0b30: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 20 20 20 ssage) exn)).
0b40: 20 20 20 20 20 20 20 20 20 20 72 75 6e 6b 65 79 runkey
0b50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 72 ). (pr
0b60: 6f 63 20 72 75 6e 6b 65 79 20 61 72 65 61 20 63 oc runkey area c
0b70: 6f 6e 74 6f 75 72 29 29 29 0a 20 20 20 20 20 20 ontour))).
0b80: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
0b90: 20 20 20 28 69 66 20 78 6c 61 74 72 2d 6b 65 79 (if xlatr-key
0ba0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0bb0: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 (print "ERROR: F
0bc0: 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6e 61 ailed to find na
0bd0: 6d 65 64 20 74 61 72 67 65 74 20 74 72 61 6e 73 med target trans
0be0: 6c 61 74 6f 72 20 22 20 78 6c 61 74 72 2d 6b 65 lator " xlatr-ke
0bf0: 79 20 22 2c 20 75 73 69 6e 67 20 6f 72 69 67 69 y ", using origi
0c00: 6e 61 6c 20 74 61 72 67 65 74 2e 22 29 29 0a 20 nal target.")).
0c10: 20 20 20 20 20 20 20 20 20 60 28 2c 72 75 6e 6b `(,runk
0c20: 65 79 29 29 29 29 29 20 3b 3b 20 6e 6f 20 70 72 ey))))) ;; no pr
0c30: 6f 63 20 74 68 65 6e 20 75 73 65 20 72 75 6e 6b oc then use runk
0c40: 65 79 0a 0a 3b 3b 20 67 69 76 65 6e 20 6d 74 63 ey..;; given mtc
0c50: 6f 6e 66 20 61 6e 64 20 61 72 65 61 63 6f 6e 66 onf and areaconf
0c60: 20 65 78 74 72 61 63 74 20 61 20 74 72 61 6e 73 extract a trans
0c70: 6c 61 74 6f 72 2f 66 69 6c 74 65 72 2c 20 66 69 lator/filter, fi
0c80: 72 73 74 20 6c 6f 6f 6b 20 61 74 20 61 72 65 61 rst look at area
0c90: 63 6f 6e 66 0a 3b 3b 20 74 68 65 6e 20 69 66 20 conf.;; then if
0ca0: 6e 6f 74 20 66 6f 75 6e 64 20 6c 6f 6f 6b 20 61 not found look a
0cb0: 74 20 64 65 66 61 75 6c 74 0a 3b 3b 0a 28 64 65 t default.;;.(de
0cc0: 66 69 6e 65 20 28 63 6f 6e 66 2d 67 65 74 2f 64 fine (conf-get/d
0cd0: 65 66 61 75 6c 74 20 6d 74 63 6f 6e 66 20 61 72 efault mtconf ar
0ce0: 65 61 63 6f 6e 66 20 6b 65 79 6e 61 6d 65 20 23 eaconf keyname #
0cf0: 21 6b 65 79 20 28 64 65 66 61 75 6c 74 20 23 66 !key (default #f
0d00: 29 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 )). (let ((res
0d10: 28 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 20 6b (or (alist-ref k
0d20: 65 79 6e 61 6d 65 20 61 72 65 61 63 6f 6e 66 29 eyname areaconf)
0d30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0d40: 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 (configf:looku
0d50: 70 20 6d 74 63 6f 6e 66 20 22 64 65 66 61 75 6c p mtconf "defaul
0d60: 74 22 20 28 63 6f 6e 63 20 6b 65 79 6e 61 6d 65 t" (conc keyname
0d70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0d80: 20 20 20 20 64 65 66 61 75 6c 74 29 29 29 0a 20 default))).
0d90: 20 20 20 28 69 66 20 72 65 73 0a 20 20 20 20 20 (if res.
0da0: 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 (string->symb
0db0: 6f 6c 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 ol res).
0dc0: 72 65 73 29 29 29 0a 20 20 0a 3b 3b 20 74 68 69 res))). .;; thi
0dd0: 73 20 6e 65 65 64 73 20 73 6f 6d 65 20 74 68 6f s needs some tho
0de0: 75 67 68 74 20 72 65 67 61 72 64 69 6e 67 20 73 ught regarding s
0df0: 65 63 75 72 69 74 79 20 69 6d 70 6c 69 63 61 74 ecurity implicat
0e00: 69 6f 6e 73 2e 0a 3b 3b 0a 3b 3b 20 20 20 69 2e ions..;;.;; i.
0e10: 20 43 68 65 63 6b 20 74 68 61 74 20 6f 77 6e 65 Check that owne
0e20: 72 20 6f 66 20 74 68 65 20 66 69 6c 65 20 61 6e r of the file an
0e30: 64 20 63 61 6c 6c 69 6e 67 20 75 73 65 72 20 61 d calling user a
0e40: 72 65 20 73 61 6d 65 3f 0a 3b 3b 20 20 69 69 2e re same?.;; ii.
0e50: 20 43 68 65 63 6b 20 74 68 61 74 20 77 65 20 61 Check that we a
0e60: 72 65 20 69 6e 20 61 20 6c 65 67 61 6c 20 6d 65 re in a legal me
0e70: 67 61 74 65 73 74 20 61 72 65 61 3f 0a 3b 3b 20 gatest area?.;;
0e80: 69 69 69 2e 20 48 61 76 65 20 73 6f 6d 65 20 66 iii. Have some f
0e90: 6f 72 6d 20 6f 66 20 61 75 74 68 65 6e 74 69 63 orm of authentic
0ea0: 61 74 69 6f 6e 20 6f 72 20 72 65 63 6f 72 64 20 ation or record
0eb0: 6f 66 20 74 68 65 20 6d 64 35 73 75 6d 20 6f 72 of the md5sum or
0ec0: 20 73 69 6d 69 6c 61 72 20 6f 66 20 74 68 65 20 similar of the
0ed0: 66 69 6c 65 3f 0a 3b 3b 20 20 69 76 2e 20 55 73 file?.;; iv. Us
0ee0: 65 20 63 6f 6d 70 69 6c 65 64 20 76 65 72 73 69 e compiled versi
0ef0: 6f 6e 20 69 6e 20 70 72 65 66 65 72 65 6e 63 65 on in preference
0f00: 20 74 6f 20 2e 73 63 6d 20 76 65 72 73 69 6f 6e to .scm version
0f10: 2e 20 54 68 75 73 20 74 68 65 72 65 20 69 73 20 . Thus there is
0f20: 61 20 6d 61 6e 75 61 6c 20 22 62 6c 65 73 73 69 a manual "blessi
0f30: 6e 67 22 0a 3b 3b 20 20 20 20 20 20 72 65 71 75 ng".;; requ
0f40: 69 72 65 64 20 74 6f 20 75 73 65 20 2e 6d 74 75 ired to use .mtu
0f50: 74 69 6c 2e 73 63 6d 2e 0a 3b 3b 0a 28 69 66 20 til.scm..;;.(if
0f60: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
0f70: 73 74 73 3f 20 22 6d 65 67 61 74 65 73 74 2e 63 sts? "megatest.c
0f80: 6f 6e 66 69 67 22 29 0a 20 20 20 20 28 69 66 20 onfig"). (if
0f90: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
0fa0: 73 74 73 3f 20 22 2e 6d 74 75 74 69 6c 2e 73 6f sts? ".mtutil.so
0fb0: 22 29 0a 09 28 6c 6f 61 64 20 22 2e 6d 74 75 74 ")..(load ".mtut
0fc0: 69 6c 2e 73 6f 22 29 0a 09 28 69 66 20 28 63 6f il.so")..(if (co
0fd0: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
0fe0: 3f 20 22 2e 6d 74 75 74 69 6c 2e 73 63 6d 22 29 ? ".mtutil.scm")
0ff0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f . (lo
1000: 61 64 20 22 2e 6d 74 75 74 69 6c 2e 73 63 6d 22 ad ".mtutil.scm"
1010: 29 29 29 29 0a 0a 3b 3b 20 6d 61 69 6e 20 74 68 ))))..;; main th
1020: 72 65 65 20 74 79 70 65 73 20 6f 66 20 72 75 6e ree types of run
1030: 0a 3b 3b 20 20 22 2d 72 75 6e 22 20 20 20 20 20 .;; "-run"
1040: 20 20 20 20 3d 3e 20 69 6e 69 74 69 61 74 65 20 => initiate
1050: 61 20 72 75 6e 0a 3b 3b 20 20 22 2d 72 65 72 75 a run.;; "-reru
1060: 6e 2d 63 6c 65 61 6e 22 20 3d 3e 20 73 65 74 20 n-clean" => set
1070: 66 61 69 6c 65 64 2c 20 61 62 6f 72 74 65 64 2c failed, aborted,
1080: 20 6b 69 6c 6c 65 64 2c 20 65 74 63 2e 20 28 6e killed, etc. (n
1090: 6f 74 20 70 61 73 73 2f 66 61 69 6c 29 20 74 6f ot pass/fail) to
10a0: 20 4e 4f 54 5f 53 54 41 52 54 45 44 20 61 6e 64 NOT_STARTED and
10b0: 20 6b 69 63 6b 20 6f 66 66 20 72 75 6e 0a 3b 3b kick off run.;;
10c0: 20 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 20 20 "-rerun-all"
10d0: 20 3d 3e 20 73 65 74 20 61 6c 6c 20 74 65 73 74 => set all test
10e0: 73 20 4e 4f 54 5f 53 54 41 52 54 45 44 20 61 6e s NOT_STARTED an
10f0: 64 20 6b 69 63 6b 20 6f 66 66 20 72 75 6e 20 61 d kick off run a
1100: 67 61 69 6e 0a 0a 3b 3b 20 64 65 70 72 65 63 61 gain..;; depreca
1110: 74 65 64 2f 64 6f 20 6e 6f 74 20 75 73 65 0a 3b ted/do not use.;
1120: 3b 20 20 22 2d 72 75 6e 61 6c 6c 22 20 20 20 20 ; "-runall"
1130: 20 20 3d 3e 20 73 79 6e 6f 6e 79 6d 20 66 6f 72 => synonym for
1140: 20 72 75 6e 2c 20 64 6f 20 6e 6f 74 20 75 73 65 run, do not use
1150: 0a 3b 3b 20 20 22 2d 72 75 6e 74 65 73 74 73 22 .;; "-runtests"
1160: 20 20 20 20 3d 3e 20 73 79 6e 6f 6e 79 6d 20 66 => synonym f
1170: 6f 72 20 72 75 6e 2c 20 64 6f 20 6e 6f 74 20 75 or run, do not u
1180: 73 65 0a 0a 3b 3b 20 44 69 73 61 62 6c 65 64 20 se..;; Disabled
1190: 68 65 6c 70 20 69 74 65 6d 73 0a 3b 3b 20 20 2d help items.;; -
11a0: 72 6f 6c 6c 75 70 20 20 20 20 20 20 20 20 20 20 rollup
11b0: 20 20 20 20 20 20 20 3a 20 28 63 75 72 72 65 6e : (curren
11c0: 74 6c 79 20 64 69 73 61 62 6c 65 64 29 20 66 69 tly disabled) fi
11d0: 6c 6c 20 72 75 6e 20 28 73 65 74 20 62 79 20 3a ll run (set by :
11e0: 72 75 6e 6e 61 6d 65 29 20 20 77 69 74 68 20 6c runname) with l
11f0: 61 74 65 73 74 20 74 65 73 74 28 73 29 0a 3b 3b atest test(s).;;
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1210: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
1220: 20 70 72 69 6f 72 20 72 75 6e 73 20 77 69 74 68 prior runs with
1230: 20 73 61 6d 65 20 6b 65 79 73 0a 3b 3b 20 43 6f same keys.;; Co
1240: 6e 74 6f 75 72 20 61 63 74 69 6f 6e 73 0a 3b 3b ntour actions.;;
1250: 20 20 20 20 69 6d 70 6f 72 74 20 20 20 20 20 20 import
1260: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 69 6d : im
1270: 70 6f 72 74 20 70 6b 74 73 0a 3b 3b 20 20 20 20 port pkts.;;
1280: 64 69 73 70 61 74 63 68 20 20 20 20 20 20 20 20 dispatch
1290: 20 20 20 20 20 20 20 20 3a 20 64 69 73 70 61 74 : dispat
12a0: 63 68 20 71 75 65 75 65 64 20 72 75 6e 20 6a 6f ch queued run jo
12b0: 62 73 20 66 72 6f 6d 20 69 6d 70 6f 72 74 65 64 bs from imported
12c0: 20 70 6b 74 73 0a 3b 3b 20 20 20 20 72 75 6e 67 pkts.;; rung
12d0: 65 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 en
12e0: 20 20 20 20 3a 20 6c 6f 6f 6b 20 61 74 20 69 6e : look at in
12f0: 70 75 74 20 73 65 6e 73 65 20 6c 69 73 74 20 69 put sense list i
1300: 6e 20 5b 72 75 6e 67 65 6e 5d 20 61 6e 64 20 67 n [rungen] and g
1310: 65 6e 65 72 61 74 65 20 72 75 6e 20 70 6b 74 73 enerate run pkts
1320: 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c 70 20 28 ..(define help (
1330: 63 6f 6e 63 20 22 0a 6d 74 75 74 69 6c 2c 20 70 conc ".mtutil, p
1340: 61 72 74 20 6f 66 20 74 68 65 20 4d 65 67 61 74 art of the Megat
1350: 65 73 74 20 74 6f 6f 6c 20 73 75 69 74 65 2c 20 est tool suite,
1360: 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 documentation at
1370: 20 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 http://www.kiat
1380: 6f 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d oa.com/fossils/m
1390: 65 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 6f egatest. versio
13a0: 6e 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 n " megatest-ver
13b0: 73 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 sion ". license
13c0: 20 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 GPL, Copyright
13d0: 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 32 30 30 Matt Welland 200
13e0: 36 2d 32 30 31 37 0a 0a 55 73 61 67 65 3a 20 6d 6-2017..Usage: m
13f0: 74 75 74 69 6c 20 61 63 74 69 6f 6e 20 5b 6f 70 tutil action [op
1400: 74 69 6f 6e 73 5d 0a 20 20 2d 68 20 20 20 20 20 tions]. -h
1410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1420: 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a : this help.
1430: 20 20 2d 6d 61 6e 75 61 6c 20 20 20 20 20 20 20 -manual
1440: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 : s
1450: 68 6f 77 20 74 68 65 20 4d 65 67 61 74 65 73 74 how the Megatest
1460: 20 75 73 65 72 20 6d 61 6e 75 61 6c 0a 20 20 2d user manual. -
1470: 76 65 72 73 69 6f 6e 20 20 20 20 20 20 20 20 20 version
1480: 20 20 20 20 20 20 20 20 20 20 3a 20 70 72 69 6e : prin
1490: 74 20 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 t megatest versi
14a0: 6f 6e 20 28 63 75 72 72 65 6e 74 6c 79 20 22 20 on (currently "
14b0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
14c0: 20 22 29 0a 09 09 09 20 20 20 20 20 0a 52 75 6e ").... .Run
14d0: 20 6d 61 6e 61 67 65 6d 65 6e 74 3a 09 09 20 20 management:..
14e0: 20 20 20 0a 20 20 20 72 75 6e 20 20 20 20 20 20 . run
14f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1500: 20 3a 20 69 6e 69 74 69 61 74 65 20 6f 72 20 72 : initiate or r
1510: 65 73 75 6d 65 20 61 20 72 75 6e 2c 20 61 6c 72 esume a run, alr
1520: 65 61 64 79 20 63 6f 6d 70 6c 65 74 65 64 20 61 eady completed a
1530: 6e 64 20 69 6e 2d 70 72 6f 67 72 65 73 73 0a 20 nd in-progress.
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 te
1560: 73 74 73 20 61 72 65 20 6e 6f 74 20 61 66 66 65 sts are not affe
1570: 63 74 65 64 2e 0a 20 20 20 72 65 72 75 6e 2d 63 cted.. rerun-c
1580: 6c 65 61 6e 20 20 20 20 20 20 20 20 20 20 20 20 lean
1590: 20 20 20 3a 20 63 6c 65 61 6e 20 61 6e 64 20 72 : clean and r
15a0: 65 72 75 6e 20 61 6c 6c 20 6e 6f 74 20 63 6f 6d erun all not com
15b0: 70 6c 65 74 65 64 20 70 61 73 73 2f 66 61 69 6c pleted pass/fail
15c0: 20 74 65 73 74 73 0a 20 20 20 72 65 72 75 6e 2d tests. rerun-
15d0: 61 6c 6c 20 20 20 20 20 20 20 20 20 20 20 20 20 all
15e0: 20 20 20 20 3a 20 63 6c 65 61 6e 20 61 6e 64 20 : clean and
15f0: 72 65 72 75 6e 20 65 6e 74 69 72 65 20 72 75 6e rerun entire run
1600: 0a 20 20 20 6b 69 6c 6c 2d 72 75 6e 20 20 20 20 . kill-run
1610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1620: 6b 69 6c 6c 20 61 6c 6c 20 74 65 73 74 73 20 69 kill all tests i
1630: 6e 20 72 75 6e 0a 20 20 20 6b 69 6c 6c 2d 72 65 n run. kill-re
1640: 72 75 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 run
1650: 20 20 20 3a 20 6b 69 6c 6c 20 61 6c 6c 20 74 65 : kill all te
1660: 73 74 73 20 69 6e 20 72 75 6e 20 61 6e 64 20 72 sts in run and r
1670: 65 73 74 61 72 74 20 6e 6f 6e 2d 63 6f 6d 70 6c estart non-compl
1680: 65 74 65 64 20 74 65 73 74 73 0a 20 20 20 72 65 eted tests. re
1690: 6d 6f 76 65 20 20 20 20 20 20 20 20 20 20 20 20 move
16a0: 20 20 20 20 20 20 20 20 3a 20 72 65 6d 6f 76 65 : remove
16b0: 20 72 75 6e 73 0a 20 20 20 73 65 74 2d 73 73 20 runs. set-ss
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16d0: 20 20 20 3a 20 73 65 74 20 73 74 61 74 65 2f 73 : set state/s
16e0: 74 61 74 75 73 0a 20 20 20 61 72 63 68 69 76 65 tatus. archive
16f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1700: 20 20 20 3a 20 63 6f 6d 70 72 65 73 73 20 61 6e : compress an
1710: 64 20 6d 6f 76 65 20 74 65 73 74 20 64 61 74 61 d move test data
1720: 20 74 6f 20 61 72 63 68 69 76 65 20 64 69 73 6b to archive disk
1730: 0a 20 20 20 6b 69 6c 6c 20 20 20 20 20 20 20 20 . kill
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 :
1750: 73 74 6f 70 20 74 65 73 74 73 20 6f 72 20 65 6e stop tests or en
1760: 74 69 72 65 20 72 75 6e 73 0a 20 20 20 64 62 20 tire runs. db
1770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1780: 20 20 20 20 20 20 20 3a 20 64 61 74 61 62 61 73 : databas
1790: 65 20 75 74 69 6c 69 74 69 65 73 0a 0a 51 75 65 e utilities..Que
17a0: 72 69 65 73 3a 0a 20 20 20 73 68 6f 77 20 5b 61 ries:. show [a
17b0: 72 65 61 73 7c 63 6f 6e 74 6f 75 72 73 2e 2e 2e reas|contours...
17c0: 20 5d 20 3a 20 73 68 6f 77 20 61 72 65 61 73 2c ] : show areas,
17d0: 20 63 6f 6e 74 6f 75 72 73 20 6f 72 20 6f 74 68 contours or oth
17e0: 65 72 20 73 65 63 74 69 6f 6e 20 66 72 6f 6d 20 er section from
17f0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a megatest.config.
1800: 20 20 20 67 65 6e 64 6f 74 20 20 20 20 20 20 20 gendot
1810: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 67 : g
1820: 65 6e 65 72 61 74 65 20 61 20 67 72 61 70 68 76 enerate a graphv
1830: 69 7a 20 64 6f 74 20 66 69 6c 65 20 66 72 6f 6d iz dot file from
1840: 20 70 6b 74 73 2e 0a 0a 43 6f 6e 74 6f 75 72 20 pkts...Contour
1850: 61 63 74 69 6f 6e 73 3a 0a 20 20 20 70 72 6f 63 actions:. proc
1860: 65 73 73 20 20 20 20 20 20 20 20 20 20 20 20 20 ess
1870: 20 20 20 20 20 20 3a 20 72 75 6e 73 20 69 6d 70 : runs imp
1880: 6f 72 74 2c 20 72 75 6e 67 65 6e 20 61 6e 64 20 ort, rungen and
1890: 64 69 73 70 61 74 63 68 20 0a 20 20 20 67 6f 20 dispatch . go
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b0: 20 20 20 20 20 20 20 3a 20 72 75 6e 73 20 69 6d : runs im
18c0: 70 6f 72 74 2c 20 72 75 6e 67 65 6e 20 61 6e 64 port, rungen and
18d0: 20 64 69 73 70 61 74 63 68 20 65 76 65 72 79 20 dispatch every
18e0: 66 69 76 65 20 6d 69 6e 75 74 65 73 20 66 6f 72 five minutes for
18f0: 65 76 65 72 0a 09 09 09 20 20 20 20 20 0a 54 72 ever.... .Tr
1900: 69 67 67 65 72 20 70 72 6f 70 61 67 61 74 69 6f igger propagatio
1910: 6e 20 61 63 74 69 6f 6e 73 3a 0a 20 20 20 74 73 n actions:. ts
1920: 65 6e 64 20 61 3d 62 2c 63 3d 64 2e 2e 2e 20 20 end a=b,c=d...
1930: 20 20 20 20 20 20 20 20 3a 20 73 65 6e 64 20 74 : send t
1940: 72 69 67 67 65 72 20 69 6e 66 6f 20 74 6f 20 61 rigger info to a
1950: 6c 6c 20 72 65 63 70 69 65 6e 74 73 20 69 6e 20 ll recpients in
1960: 74 68 65 20 5b 6c 69 73 74 65 6e 65 72 73 5d 20 the [listeners]
1970: 73 65 63 74 69 6f 6e 0a 20 20 20 74 6c 69 73 74 section. tlist
1980: 65 6e 20 2d 70 6f 72 74 20 4e 20 20 20 20 20 20 en -port N
1990: 20 20 20 20 20 3a 20 6c 69 73 74 65 6e 20 66 6f : listen fo
19a0: 72 20 74 72 69 67 67 65 72 20 69 6e 66 6f 20 6f r trigger info o
19b0: 6e 20 70 6f 72 74 20 4e 0a 09 09 09 20 20 20 20 n port N....
19c0: 20 0a 53 65 6c 65 63 74 6f 72 73 20 09 09 20 20 .Selectors ..
19d0: 20 20 20 0a 20 20 2d 69 6d 6d 65 64 69 61 74 65 . -immediate
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 3a 20 61 70 70 6c 79 20 74 68 69 73 20 61 63 : apply this ac
1a00: 74 69 6f 6e 20 69 6d 6d 65 64 69 61 74 65 6c 79 tion immediately
1a10: 2c 20 64 65 66 61 75 6c 74 20 69 73 20 74 6f 20 , default is to
1a20: 71 75 65 75 65 20 75 70 20 61 63 74 69 6f 6e 73 queue up actions
1a30: 0a 20 20 2d 61 72 65 61 20 61 72 65 61 70 61 74 . -area areapat
1a40: 74 31 2c 61 72 65 61 32 2e 2e 2e 20 20 20 3a 20 t1,area2... :
1a50: 61 70 70 6c 79 20 74 68 69 73 20 61 63 74 69 6f apply this actio
1a60: 6e 20 6f 6e 6c 79 20 74 6f 20 74 68 65 20 73 70 n only to the sp
1a70: 65 63 69 66 69 65 64 20 61 72 65 61 73 0a 20 20 ecified areas.
1a80: 2d 74 61 72 67 65 74 20 6b 65 79 31 2f 6b 65 79 -target key1/key
1a90: 32 2f 2e 2e 2e 20 20 20 20 20 20 3a 20 72 75 6e 2/... : run
1aa0: 20 66 6f 72 20 6b 65 79 31 2c 20 6b 65 79 32 2c for key1, key2,
1ab0: 20 65 74 63 2e 0a 20 20 2d 74 65 73 74 2d 70 61 etc.. -test-pa
1ac0: 74 74 20 70 31 2f 70 32 2c 70 33 2f 2e 2e 2e 20 tt p1/p2,p3/...
1ad0: 20 20 20 3a 20 25 20 69 73 20 77 69 6c 64 63 61 : % is wildca
1ae0: 72 64 0a 20 20 2d 72 75 6e 2d 6e 61 6d 65 20 20 rd. -run-name
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b00: 3a 20 72 65 71 75 69 72 65 64 2c 20 6e 61 6d 65 : required, name
1b10: 20 66 6f 72 20 74 68 69 73 20 70 61 72 74 69 63 for this partic
1b20: 75 6c 61 72 20 74 65 73 74 20 72 75 6e 0a 20 20 ular test run.
1b30: 2d 63 6f 6e 74 6f 75 72 20 63 6f 6e 74 6f 75 72 -contour contour
1b40: 6e 61 6d 65 20 20 20 20 20 20 20 3a 20 72 75 6e name : run
1b50: 20 61 6c 6c 20 74 61 72 67 65 74 73 20 66 6f 72 all targets for
1b60: 20 63 6f 6e 74 6f 75 72 6e 61 6d 65 2c 20 72 65 contourname, re
1b70: 71 75 69 72 65 73 20 2d 72 75 6e 2d 6e 61 6d 65 quires -run-name
1b80: 2c 20 2d 74 61 72 67 65 74 0a 20 20 2d 73 74 61 , -target. -sta
1b90: 74 65 2d 73 74 61 74 75 73 20 63 2f 70 2c 63 2f te-status c/p,c/
1ba0: 66 20 20 20 20 20 20 3a 20 53 70 65 63 69 66 79 f : Specify
1bb0: 20 61 20 6c 69 73 74 20 6f 66 20 73 74 61 74 65 a list of state
1bc0: 20 61 6e 64 20 73 74 61 74 75 73 20 70 61 74 74 and status patt
1bd0: 65 72 6e 73 0a 20 20 2d 74 61 67 2d 65 78 70 72 erns. -tag-expr
1be0: 20 74 61 67 31 2c 74 61 67 32 25 2c 2e 2e 20 20 tag1,tag2%,..
1bf0: 20 20 3a 20 73 65 6c 65 63 74 20 74 65 73 74 73 : select tests
1c00: 20 77 69 74 68 20 74 61 67 73 20 6d 61 74 63 68 with tags match
1c10: 69 6e 67 20 65 78 70 72 65 73 73 69 6f 6e 0a 20 ing expression.
1c20: 20 2d 6d 6f 64 65 2d 70 61 74 74 20 6b 65 79 20 -mode-patt key
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c 6f : lo
1c40: 61 64 20 74 65 73 74 70 61 74 74 20 66 72 6f 6d ad testpatt from
1c50: 20 3c 6b 65 79 3e 20 69 6e 20 72 75 6e 63 6f 6e <key> in runcon
1c60: 66 69 67 73 20 69 6e 73 74 65 61 64 20 6f 66 20 figs instead of
1c70: 64 65 66 61 75 6c 74 20 54 45 53 54 50 41 54 54 default TESTPATT
1c80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ca0: 69 66 20 2d 74 65 73 74 70 61 74 74 20 61 6e 64 if -testpatt and
1cb0: 20 2d 74 61 67 65 78 70 72 20 61 72 65 20 6e 6f -tagexpr are no
1cc0: 74 20 73 70 65 63 69 66 69 65 64 0a 20 20 2d 6e t specified. -n
1cd0: 65 77 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 ew state/status
1ce0: 20 20 20 20 20 20 20 20 20 3a 20 73 70 65 63 69 : speci
1cf0: 66 79 20 6e 65 77 20 73 74 61 74 65 2f 73 74 61 fy new state/sta
1d00: 74 75 73 20 66 6f 72 20 73 65 74 2d 73 73 0a 09 tus for set-ss..
1d10: 09 09 20 20 20 20 20 0a 4d 69 73 63 20 09 09 09 .. .Misc ...
1d20: 20 20 20 20 20 0a 20 20 2d 73 74 61 72 74 2d 64 . -start-d
1d30: 69 72 20 70 61 74 68 20 20 20 20 20 20 20 20 20 ir path
1d40: 20 20 20 3a 20 73 77 69 74 63 68 20 74 6f 20 74 : switch to t
1d50: 68 69 73 20 64 69 72 65 63 74 6f 72 79 20 62 65 his directory be
1d60: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 6d 74 75 fore running mtu
1d70: 74 69 6c 0a 20 20 2d 73 65 74 2d 76 61 72 73 20 til. -set-vars
1d80: 56 31 3d 31 2c 56 32 3d 32 20 20 20 20 20 20 20 V1=1,V2=2
1d90: 20 3a 20 41 64 64 20 65 6e 76 69 72 6f 6e 6d 65 : Add environme
1da0: 6e 74 20 76 61 72 69 61 62 6c 65 73 20 74 6f 20 nt variables to
1db0: 61 20 72 75 6e 20 4e 42 2f 2f 20 74 68 65 73 65 a run NB// these
1dc0: 20 61 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 are.
1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1de0: 20 20 20 20 20 20 20 20 6f 76 65 72 77 72 69 74 overwrit
1df0: 74 65 6e 20 62 79 20 76 61 6c 75 65 73 20 73 65 ten by values se
1e00: 74 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 t in config file
1e10: 73 2e 0a 20 20 2d 6c 6f 67 20 6c 6f 67 66 69 6c s.. -log logfil
1e20: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e
1e30: 3a 20 73 65 6e 64 20 73 74 64 6f 75 74 20 61 6e : send stdout an
1e40: 64 20 73 74 64 65 72 72 20 74 6f 20 6c 6f 67 66 d stderr to logf
1e50: 69 6c 65 0a 20 20 2d 72 65 70 6c 20 20 20 20 20 ile. -repl
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 3a 20 73 74 61 72 74 20 61 20 72 65 70 6c 20 : start a repl
1e80: 28 75 73 65 66 75 6c 20 66 6f 72 20 65 78 74 65 (useful for exte
1e90: 6e 64 69 6e 67 20 6d 65 67 61 74 65 73 74 29 0a nding megatest).
1ea0: 20 20 2d 6c 6f 61 64 20 66 69 6c 65 2e 73 63 6d -load file.scm
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6c : l
1ec0: 6f 61 64 20 61 6e 64 20 72 75 6e 20 66 69 6c 65 oad and run file
1ed0: 2e 73 63 6d 0a 20 20 2d 64 65 62 75 67 20 4e 7c .scm. -debug N|
1ee0: 4e 2c 4d 2c 4f 2e 2e 2e 20 20 20 20 20 20 20 20 N,M,O...
1ef0: 20 20 3a 20 65 6e 61 62 6c 65 20 64 65 62 75 67 : enable debug
1f00: 20 6d 65 73 73 61 67 65 73 20 30 2d 4e 20 6f 72 messages 0-N or
1f10: 20 4e 20 61 6e 64 20 4d 20 61 6e 64 20 4f 20 2e N and M and O .
1f20: 2e 2e 0a 20 20 2d 6c 69 73 74 2d 70 6b 74 2d 6b ... -list-pkt-k
1f30: 65 79 73 20 20 20 20 20 20 20 20 20 20 20 20 20 eys
1f40: 3a 20 6c 69 73 74 20 61 6c 6c 20 70 6b 74 20 6b : list all pkt k
1f50: 65 79 73 0a 09 09 09 20 20 20 20 20 0a 55 74 69 eys.... .Uti
1f60: 6c 69 74 79 09 09 09 20 20 20 20 20 0a 20 64 62 lity... . db
1f70: 20 70 67 73 63 68 65 6d 61 20 20 20 20 20 20 20 pgschema
1f80: 20 20 20 20 20 20 20 20 20 20 3a 20 65 6d 69 74 : emit
1f90: 20 70 6f 73 74 67 72 65 73 71 6c 20 73 63 68 65 postgresql sche
1fa0: 6d 61 3b 20 64 6f 20 5c 22 6d 74 75 74 69 6c 20 ma; do \"mtutil
1fb0: 64 62 20 70 67 73 63 68 65 6d 61 20 7c 20 70 73 db pgschema | ps
1fc0: 71 6c 20 2d 64 20 6d 79 64 62 5c 22 0a 20 67 61 ql -d mydb\". ga
1fd0: 74 68 65 72 64 62 20 5b 70 72 6f 70 61 67 61 74 therdb [propagat
1fe0: 65 5d 20 20 20 20 20 20 20 20 3a 20 67 61 74 68 e] : gath
1ff0: 65 72 20 64 62 73 20 66 72 6f 6d 20 61 6c 6c 20 er dbs from all
2000: 61 72 65 61 73 20 69 6e 74 6f 20 2f 74 6d 70 2f areas into /tmp/
2010: 24 55 53 45 52 5f 6d 65 67 61 74 65 73 74 2f 61 $USER_megatest/a
2020: 6c 6c 64 62 73 2c 0a 20 20 20 20 20 20 20 20 20 lldbs,.
2030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2040: 20 20 20 20 20 20 6f 70 74 69 6f 6e 61 6c 6c 79 optionally
2050: 20 70 72 6f 70 61 67 61 74 65 20 74 68 65 20 64 propagate the d
2060: 61 74 61 20 74 6f 20 6d 65 67 61 74 65 73 74 32 ata to megatest2
2070: 2e 30 20 66 6f 72 6d 61 74 0a 20 0a 0a 45 78 61 .0 format. ..Exa
2080: 6d 70 6c 65 73 3a 0a 0a 23 20 53 74 61 72 74 20 mples:..# Start
2090: 61 20 6d 65 67 61 74 65 73 74 20 72 75 6e 20 69 a megatest run i
20a0: 6e 20 74 68 65 20 61 72 65 61 20 5c 22 6d 79 74 n the area \"myt
20b0: 65 73 74 73 5c 22 0a 6d 74 75 74 69 6c 20 72 75 ests\".mtutil ru
20c0: 6e 20 2d 61 72 65 61 20 6d 79 74 65 73 74 73 20 n -area mytests
20d0: 2d 74 61 72 67 65 74 20 76 31 2e 36 33 2f 61 61 -target v1.63/aa
20e0: 33 65 20 2d 6d 6f 64 65 2d 70 61 74 74 20 4d 59 3e -mode-patt MY
20f0: 50 41 54 54 20 2d 74 61 67 2d 65 78 70 72 20 71 PATT -tag-expr q
2100: 75 69 63 6b 0a 0a 23 20 53 74 61 72 74 20 61 20 uick..# Start a
2110: 63 6f 6e 74 6f 75 72 0a 6d 74 75 74 69 6c 20 72 contour.mtutil r
2120: 75 6e 20 2d 63 6f 6e 74 6f 75 72 20 71 75 69 63 un -contour quic
2130: 6b 20 2d 74 61 72 67 65 74 20 76 31 2e 36 33 2f k -target v1.63/
2140: 61 61 33 65 20 0a 0a 43 61 6c 6c 65 64 20 61 73 aa3e ..Called as
2150: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
2160: 73 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 sperse (argv) "
2170: 22 29 20 22 0a 56 65 72 73 69 6f 6e 20 22 20 6d ") ".Version " m
2180: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 egatest-version
2190: 22 2c 20 62 75 69 6c 74 20 66 72 6f 6d 20 22 20 ", built from "
21a0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
21b0: 68 61 73 68 20 29 29 0a 0a 3b 3b 20 61 72 67 73 hash ))..;; args
21c0: 20 61 6e 64 20 70 6b 74 20 6b 65 79 20 73 70 65 and pkt key spe
21d0: 63 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 61 cs.;;.(define *a
21e0: 72 67 2d 6b 65 79 73 2a 0a 20 20 3b 3b 20 75 73 rg-keys*. ;; us
21f0: 65 64 20 6b 65 79 73 0a 20 20 3b 3b 20 20 20 20 ed keys. ;;
2200: 61 20 20 2d 20 61 63 74 69 6f 6e 0a 20 20 27 28 a - action. '(
2210: 0a 20 20 20 20 28 22 2d 61 72 65 61 22 20 20 20 . ("-area"
2220: 20 20 20 20 20 20 20 20 20 2e 20 47 29 20 3b 3b . G) ;;
2230: 20 6d 61 70 73 20 74 6f 20 67 72 6f 75 70 0a 20 maps to group.
2240: 20 20 20 28 22 2d 63 6f 6e 74 6f 75 72 22 20 20 ("-contour"
2250: 20 20 20 20 20 20 20 2e 20 63 29 0a 20 20 20 20 . c).
2260: 28 22 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 ("-append-config
2270: 22 20 20 20 2e 20 64 29 0a 20 20 20 20 28 22 2d " . d). ("-
2280: 73 74 61 74 65 22 20 20 20 20 20 20 20 20 20 20 state"
2290: 20 2e 20 65 29 0a 20 20 20 20 28 22 2d 69 74 65 . e). ("-ite
22a0: 6d 2d 70 61 74 74 22 20 20 20 20 20 20 20 2e 20 m-patt" .
22b0: 69 29 0a 20 20 20 20 28 22 2d 73 79 6e 63 2d 74 i). ("-sync-t
22c0: 6f 22 20 20 20 20 20 20 20 20 20 2e 20 6b 29 0a o" . k).
22d0: 20 20 20 20 28 22 2d 6e 65 77 22 20 20 20 20 20 ("-new"
22e0: 20 20 20 20 20 20 20 20 2e 20 6c 29 20 3b 3b 20 . l) ;;
22f0: 6c 20 28 73 65 65 20 62 65 6c 6f 77 29 20 69 73 l (see below) is
2300: 20 6e 65 77 2d 73 73 0a 20 20 20 20 28 22 2d 72 new-ss. ("-r
2310: 75 6e 2d 6e 61 6d 65 22 20 20 20 20 20 20 20 20 un-name"
2320: 2e 20 6e 29 0a 20 20 20 20 28 22 2d 6d 6f 64 65 . n). ("-mode
2330: 2d 70 61 74 74 22 20 20 20 20 20 20 20 2e 20 6f -patt" . o
2340: 29 0a 20 20 20 20 28 22 2d 74 65 73 74 2d 70 61 ). ("-test-pa
2350: 74 74 22 20 20 20 20 20 20 20 2e 20 70 29 20 20 tt" . p)
2360: 3b 3b 20 69 64 65 61 2c 20 65 6e 68 61 6e 63 65 ;; idea, enhance
2370: 20 6d 61 72 67 73 20 28 22 2d 74 65 73 74 2d 70 margs ("-test-p
2380: 61 74 74 22 20 22 2d 74 65 73 74 70 61 74 74 22 att" "-testpatt"
2390: 29 20 3d 3e 20 79 69 65 6c 64 73 20 6f 6e 65 20 ) => yields one
23a0: 76 61 6c 75 65 20 69 6e 20 22 2d 74 65 73 74 2d value in "-test-
23b0: 70 61 74 74 22 0a 20 20 20 20 28 22 2d 73 74 61 patt". ("-sta
23c0: 74 75 73 22 20 20 20 20 20 20 20 20 20 20 2e 20 tus" .
23d0: 73 29 0a 20 20 20 20 28 22 2d 74 61 72 67 65 74 s). ("-target
23e0: 22 20 20 20 20 20 20 20 20 20 20 2e 20 74 29 0a " . t).
23f0: 20 20 20 20 28 22 2d 72 65 71 74 61 72 67 22 20 ("-reqtarg"
2400: 20 20 20 20 20 20 20 20 2e 20 52 29 0a 0a 20 20 . R)..
2410: 20 20 28 22 2d 74 61 67 2d 65 78 70 72 22 20 20 ("-tag-expr"
2420: 20 20 20 20 20 20 2e 20 78 29 0a 20 20 20 20 3b . x). ;
2430: 3b 20 6d 69 73 63 0a 20 20 20 20 28 22 2d 64 65 ; misc. ("-de
2440: 62 75 67 22 20 20 20 20 20 20 20 20 20 20 20 2e bug" .
2450: 20 23 66 29 20 20 3b 3b 20 66 6f 72 20 2a 76 65 #f) ;; for *ve
2460: 72 62 6f 73 69 74 79 2a 20 3e 20 32 0a 20 20 20 rbosity* > 2.
2470: 20 28 22 2d 6c 6f 61 64 22 20 20 20 20 20 20 20 ("-load"
2480: 20 20 20 20 20 2e 20 23 66 29 20 20 3b 3b 20 6c . #f) ;; l
2490: 6f 61 64 20 61 6e 64 20 65 78 65 63 74 75 74 65 oad and exectute
24a0: 20 61 20 73 63 68 65 6d 65 20 66 69 6c 65 0a 20 a scheme file.
24b0: 20 20 20 28 22 2d 6c 6f 67 22 20 20 20 20 20 20 ("-log"
24c0: 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 20 . #f).
24d0: 20 28 22 2d 6f 76 65 72 72 69 64 65 2d 75 73 65 ("-override-use
24e0: 72 22 20 20 20 2e 20 23 66 29 0a 20 20 20 20 28 r" . #f). (
24f0: 22 2d 6d 73 67 22 20 20 20 20 20 20 20 20 20 20 "-msg"
2500: 20 20 20 2e 20 4d 29 0a 20 20 20 20 28 22 2d 73 . M). ("-s
2510: 74 61 72 74 2d 64 69 72 22 20 20 20 20 20 20 20 tart-dir"
2520: 2e 20 53 29 0a 20 20 20 20 28 22 2d 73 65 74 2d . S). ("-set-
2530: 76 61 72 73 22 20 20 20 20 20 20 20 20 2e 20 76 vars" . v
2540: 29 0a 20 20 20 20 28 22 2d 63 6f 6e 66 69 67 22 ). ("-config"
2550: 20 20 20 20 20 20 20 20 20 20 2e 20 68 29 0a 20 . h).
2560: 20 20 20 28 22 2d 74 69 6d 65 2d 6f 75 74 22 20 ("-time-out"
2570: 20 20 20 20 20 20 20 2e 20 75 29 0a 20 20 20 20 . u).
2580: 28 22 2d 61 72 63 68 69 76 65 22 20 20 20 20 20 ("-archive"
2590: 20 20 20 20 2e 20 62 29 0a 20 20 20 20 29 29 0a . b). )).
25a0: 28 64 65 66 69 6e 65 20 2a 73 77 69 74 63 68 2d (define *switch-
25b0: 6b 65 79 73 2a 0a 20 20 27 28 0a 20 20 20 20 28 keys*. '(. (
25c0: 22 2d 68 22 20 20 20 20 20 20 20 20 20 20 20 20 "-h"
25d0: 20 20 20 2e 20 23 66 29 0a 20 20 20 20 28 22 2d . #f). ("-
25e0: 68 65 6c 70 22 20 20 20 20 20 20 20 20 20 20 20 help"
25f0: 20 2e 20 23 66 29 0a 20 20 20 20 28 22 2d 2d 68 . #f). ("--h
2600: 65 6c 70 22 20 20 20 20 20 20 20 20 20 20 20 2e elp" .
2610: 20 23 66 29 0a 20 20 20 20 28 22 2d 6d 61 6e 75 #f). ("-manu
2620: 61 6c 22 20 20 20 20 20 20 20 20 20 20 2e 20 23 al" . #
2630: 66 29 0a 20 20 20 20 28 22 2d 76 65 72 73 69 6f f). ("-versio
2640: 6e 22 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 n" . #f)
2650: 0a 20 20 20 20 3b 3b 20 6d 69 73 63 09 20 20 20 . ;; misc.
2660: 20 20 20 20 20 0a 20 20 20 20 28 22 2d 72 65 70 . ("-rep
2670: 6c 22 20 20 20 20 20 20 20 20 20 20 20 20 2e 20 l" .
2680: 23 66 29 0a 20 20 20 20 28 22 2d 69 6d 6d 65 64 #f). ("-immed
2690: 69 61 74 65 22 20 20 20 20 20 20 20 2e 20 49 29 iate" . I)
26a0: 0a 20 20 20 20 28 22 2d 70 72 65 63 6c 65 61 6e . ("-preclean
26b0: 22 20 20 20 20 20 20 20 20 2e 20 72 29 0a 20 20 " . r).
26c0: 20 20 28 22 2d 70 72 65 70 65 6e 64 2d 63 6f 6e ("-prepend-con
26d0: 74 6f 75 72 22 20 2e 20 77 29 0a 20 20 20 20 28 tour" . w). (
26e0: 22 2d 66 6f 72 63 65 22 20 20 20 20 20 20 20 20 "-force"
26f0: 20 20 20 2e 20 46 29 0a 20 20 20 20 28 22 2d 6c . F). ("-l
2700: 69 73 74 2d 70 6b 74 2d 6b 65 79 73 22 20 20 20 ist-pkt-keys"
2710: 2e 20 23 66 29 0a 20 20 20 20 29 29 0a 0a 3b 3b . #f). ))..;;
2720: 20 61 6c 69 73 74 20 74 6f 20 6d 61 70 20 61 63 alist to map ac
2730: 74 69 6f 6e 73 20 74 6f 20 6f 6c 64 20 6d 65 67 tions to old meg
2740: 61 74 65 73 74 20 63 6f 6d 6d 61 6e 64 73 0a 28 atest commands.(
2750: 64 65 66 69 6e 65 20 2a 61 63 74 69 6f 6e 2d 6b define *action-k
2760: 65 79 73 2a 0a 20 20 27 28 28 72 75 6e 20 20 20 eys*. '((run
2770: 20 20 20 20 20 20 2e 20 22 2d 72 75 6e 22 29 0a . "-run").
2780: 20 20 20 20 28 72 65 72 75 6e 2d 63 6c 65 61 6e (rerun-clean
2790: 20 2e 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e . "-rerun-clean
27a0: 22 29 0a 20 20 20 20 28 72 65 72 75 6e 2d 61 6c "). (rerun-al
27b0: 6c 20 20 20 2e 20 22 2d 72 65 72 75 6e 2d 61 6c l . "-rerun-al
27c0: 6c 22 29 0a 20 20 20 20 28 6b 69 6c 6c 2d 72 75 l"). (kill-ru
27d0: 6e 20 20 20 20 2e 20 22 2d 6b 69 6c 6c 2d 72 75 n . "-kill-ru
27e0: 6e 73 22 29 0a 20 20 20 20 28 6b 69 6c 6c 2d 72 ns"). (kill-r
27f0: 65 72 75 6e 20 20 2e 20 22 2d 6b 69 6c 6c 2d 72 erun . "-kill-r
2800: 65 72 75 6e 22 29 0a 20 20 20 20 28 6c 6f 63 6b erun"). (lock
2810: 20 20 20 20 20 20 20 20 2e 20 22 2d 6c 6f 63 6b . "-lock
2820: 22 29 0a 20 20 20 20 28 75 6e 6c 6f 63 6b 20 20 "). (unlock
2830: 20 20 20 20 2e 20 22 2d 75 6e 6c 6f 63 6b 22 29 . "-unlock")
2840: 0a 20 20 20 20 28 73 79 6e 63 20 20 20 20 20 20 . (sync
2850: 20 20 2e 20 22 22 29 0a 20 20 20 20 28 61 72 63 . ""). (arc
2860: 68 69 76 65 20 20 20 20 20 2e 20 22 22 29 0a 20 hive . "").
2870: 20 20 20 28 73 65 74 2d 73 73 20 20 20 20 20 20 (set-ss
2880: 2e 20 22 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 . "-set-state-st
2890: 61 74 75 73 22 29 0a 20 20 20 20 28 72 65 6d 6f atus"). (remo
28a0: 76 65 20 20 20 20 20 20 2e 20 22 2d 72 65 6d 6f ve . "-remo
28b0: 76 65 2d 72 75 6e 73 22 29 29 29 0a 0a 3b 3b 20 ve-runs")))..;;
28c0: 6d 61 6e 75 61 6c 6c 79 20 6b 65 65 70 20 74 68 manually keep th
28d0: 69 73 20 6c 69 73 74 20 75 70 64 61 74 65 64 20 is list updated
28e0: 66 72 6f 6d 20 74 68 65 20 6b 65 79 73 20 74 6f from the keys to
28f0: 0a 3b 3b 20 74 68 65 20 63 61 73 65 20 2a 61 63 .;; the case *ac
2900: 74 69 6f 6e 2a 20 6e 65 61 72 20 74 68 65 20 65 tion* near the e
2910: 6e 64 20 6f 66 20 74 68 69 73 20 66 69 6c 65 2e nd of this file.
2920: 0a 28 64 65 66 69 6e 65 20 2a 6f 74 68 65 72 2d .(define *other-
2930: 61 63 74 69 6f 6e 73 2a 0a 20 20 27 28 72 75 6e actions*. '(run
2940: 20 72 65 6d 6f 76 65 20 72 65 72 75 6e 20 73 65 remove rerun se
2950: 74 2d 73 73 20 61 72 63 68 69 76 65 20 6b 69 6c t-ss archive kil
2960: 6c 20 6c 69 73 74 0a 09 64 69 73 70 61 74 63 68 l list..dispatch
2970: 20 69 6d 70 6f 72 74 20 72 75 6e 67 65 6e 20 70 import rungen p
2980: 72 6f 63 65 73 73 0a 09 73 68 6f 77 20 67 65 6e rocess..show gen
2990: 64 6f 74 20 64 62 20 74 73 65 6e 64 20 74 6c 69 dot db tsend tli
29a0: 73 74 65 6e 29 29 0a 0a 3b 3b 20 43 61 72 64 20 sten))..;; Card
29b0: 74 79 70 65 73 3a 0a 3b 3b 0a 3b 3b 20 41 20 61 types:.;;.;; A a
29c0: 63 74 69 6f 6e 0a 3b 3b 20 55 20 75 73 65 72 6e ction.;; U usern
29d0: 61 6d 65 20 28 55 6e 69 78 29 0a 3b 3b 20 44 20 ame (Unix).;; D
29e0: 74 69 6d 65 73 74 61 6d 70 0a 3b 3b 20 54 20 63 timestamp.;; T c
29f0: 61 72 64 20 74 79 70 65 0a 0a 3b 3b 20 61 20 73 ard type..;; a s
2a00: 75 6d 6d 61 72 79 20 6c 69 73 74 20 6f 66 20 75 ummary list of u
2a10: 73 65 64 20 63 61 72 64 20 74 79 70 65 73 20 66 sed card types f
2a20: 6f 72 20 68 65 6c 70 69 6e 67 20 74 6f 20 6e 6f or helping to no
2a30: 74 20 61 63 63 69 64 65 6e 74 61 6c 6c 79 20 72 t accidentally r
2a40: 65 2d 75 73 65 20 74 68 65 6d 0a 3b 3b 0a 3b 3b e-use them.;;.;;
2a50: 20 41 44 47 49 4d 53 54 55 5a 61 62 63 64 65 66 ADGIMSTUZabcdef
2a60: 67 68 69 6b 6c 6e 6f 70 72 73 74 75 76 77 78 0a ghiklnoprstuvwx.
2a70: 0a 3b 3b 20 75 74 69 6c 69 74 61 72 69 61 6e 20 .;; utilitarian
2a80: 61 6c 69 73 74 20 66 6f 72 20 73 74 61 6e 64 61 alist for standa
2a90: 72 64 20 63 61 72 64 73 0a 3b 3b 0a 28 64 65 66 rd cards.;;.(def
2aa0: 69 6e 65 20 2a 61 64 64 69 74 69 6f 6e 61 6c 2d ine *additional-
2ab0: 63 61 72 64 73 2a 0a 20 20 27 28 0a 20 20 20 20 cards*. '(.
2ac0: 3b 3b 20 53 74 61 6e 64 61 72 64 20 43 61 72 64 ;; Standard Card
2ad0: 73 0a 20 20 20 20 28 41 20 20 2e 20 61 63 74 69 s. (A . acti
2ae0: 6f 6e 20 20 20 20 29 0a 20 20 20 20 28 44 20 20 on ). (D
2af0: 2e 20 74 69 6d 65 73 74 61 6d 70 20 29 0a 20 20 . timestamp ).
2b00: 20 20 28 54 20 20 2e 20 63 61 72 64 74 79 70 65 (T . cardtype
2b10: 20 20 29 0a 20 20 20 20 28 55 20 20 2e 20 75 73 ). (U . us
2b20: 65 72 20 20 20 20 20 20 29 20 3b 3b 20 75 73 65 er ) ;; use
2b30: 72 6e 61 6d 65 0a 20 20 20 20 28 5a 20 20 2e 20 rname. (Z .
2b40: 73 68 61 72 31 73 75 6d 20 20 29 0a 0a 20 20 20 shar1sum )..
2b50: 20 3b 3b 20 45 78 74 72 61 73 0a 20 20 20 20 28 ;; Extras. (
2b60: 61 20 20 2e 20 72 75 6e 6b 65 79 20 20 20 20 29 a . runkey )
2b70: 20 3b 3b 20 6e 65 65 64 65 64 20 66 6f 72 20 6d ;; needed for m
2b80: 61 74 63 68 69 6e 67 20 75 70 20 70 6b 74 73 20 atching up pkts
2b90: 77 69 74 68 20 74 61 72 67 65 74 20 64 65 72 69 with target deri
2ba0: 76 65 64 20 66 72 6f 6d 20 72 75 6e 6b 65 79 0a ved from runkey.
2bb0: 20 20 20 20 3b 3b 20 28 6c 20 20 2e 20 6e 65 77 ;; (l . new
2bc0: 2d 73 73 20 20 20 20 29 20 3b 3b 20 6e 65 77 20 -ss ) ;; new
2bd0: 73 74 61 74 65 2f 73 74 61 74 75 73 0a 20 20 20 state/status.
2be0: 20 28 62 20 20 2e 20 62 72 61 6e 63 68 20 20 20 (b . branch
2bf0: 20 29 20 3b 3b 20 72 65 70 6f 73 69 74 6f 72 79 ) ;; repository
2c00: 20 62 72 61 6e 63 68 20 6f 72 20 74 61 67 20 28 branch or tag (
2c10: 66 6f 73 73 69 6c 20 6f 72 20 67 69 74 29 0a 20 fossil or git).
2c20: 20 20 20 28 66 20 20 2e 20 75 72 6c 20 20 20 20 (f . url
2c30: 20 20 20 29 20 3b 3b 20 72 65 70 6f 73 69 74 6f ) ;; reposito
2c40: 72 79 20 55 52 4c 20 28 65 2e 67 2e 20 66 6f 73 ry URL (e.g. fos
2c50: 73 69 6c 20 6f 72 20 67 69 74 29 0a 20 20 20 20 sil or git).
2c60: 28 67 20 20 2e 20 63 6c 6f 6e 65 20 20 20 20 20 (g . clone
2c70: 29 20 3b 3b 20 65 78 69 73 74 69 6e 67 20 63 6c ) ;; existing cl
2c80: 6f 6e 65 20 61 72 65 61 20 28 63 61 63 68 65 64 one area (cached
2c90: 20 69 6e 20 2f 74 6d 70 29 0a 20 20 20 20 29 29 in /tmp). ))
2ca0: 0a 0a 3b 3b 20 69 6e 6c 73 74 20 69 73 20 61 6e ..;; inlst is an
2cb0: 20 61 6c 74 65 72 6e 61 74 69 76 65 20 69 6e 70 alternative inp
2cc0: 75 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c ut.;;.(define (l
2cd0: 6f 6f 6b 75 70 2d 70 61 72 61 6d 2d 62 79 2d 6b ookup-param-by-k
2ce0: 65 79 20 6b 65 79 20 23 21 6b 65 79 20 28 69 6e ey key #!key (in
2cf0: 6c 73 74 20 23 66 29 29 0a 20 20 28 66 6f 6c 64 lst #f)). (fold
2d00: 20 28 6c 61 6d 62 64 61 20 28 61 20 72 65 73 29 (lambda (a res)
2d10: 0a 09 20 20 28 69 66 20 28 65 71 3f 20 28 63 64 .. (if (eq? (cd
2d20: 72 20 61 29 20 6b 65 79 29 0a 09 20 20 20 20 20 r a) key)..
2d30: 20 28 63 61 72 20 61 29 0a 09 20 20 20 20 20 20 (car a)..
2d40: 72 65 73 29 29 0a 09 23 66 0a 09 28 6f 72 20 69 res))..#f..(or i
2d50: 6e 6c 73 74 20 2a 61 72 67 2d 6b 65 79 73 2a 29 nlst *arg-keys*)
2d60: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 6f 6f ))..(define (loo
2d70: 6b 75 70 2d 61 63 74 69 6f 6e 2d 62 79 2d 6b 65 kup-action-by-ke
2d80: 79 20 6b 65 79 29 0a 20 20 28 61 6c 69 73 74 2d y key). (alist-
2d90: 72 65 66 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ref (string->sym
2da0: 62 6f 6c 20 6b 65 79 29 20 2a 61 63 74 69 6f 6e bol key) *action
2db0: 2d 6b 65 79 73 2a 29 29 0a 0a 28 64 65 66 69 6e -keys*))..(defin
2dc0: 65 20 28 73 77 69 7a 7a 6c 65 2d 61 6c 69 73 74 e (swizzle-alist
2dd0: 20 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 6c 61 lst). (map (la
2de0: 6d 62 64 61 20 28 78 29 28 63 6f 6e 73 20 28 63 mbda (x)(cons (c
2df0: 64 72 20 78 29 28 63 61 72 20 78 29 29 29 20 6c dr x)(car x))) l
2e00: 73 74 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d st))..;;========
2e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
2e50: 3b 20 20 55 20 54 20 49 20 4c 20 53 0a 3b 3b 3d ; U T I L S.;;=
2e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ea0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 69 76 65 6e 20 =====..;; given
2eb0: 61 20 6d 74 75 74 69 6c 20 70 61 72 61 6d 2c 20 a mtutil param,
2ec0: 72 65 74 75 72 6e 20 74 68 65 20 6f 6c 64 20 6d return the old m
2ed0: 65 67 61 74 65 73 74 20 65 71 75 69 76 61 6c 65 egatest equivale
2ee0: 6e 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6d nt.;;.(define (m
2ef0: 65 67 61 74 65 73 74 2d 70 61 72 61 6d 2d 3e 6d egatest-param->m
2f00: 74 75 74 69 6c 2d 70 61 72 61 6d 20 70 61 72 61 tutil-param para
2f10: 6d 29 0a 20 20 28 6c 65 74 2a 20 28 28 6d 61 70 m). (let* ((map
2f20: 70 69 6e 67 2d 61 6c 69 73 74 20 28 63 6f 6d 6d ping-alist (comm
2f30: 6f 6e 3a 67 65 74 2d 70 61 72 61 6d 2d 6d 61 70 on:get-param-map
2f40: 70 69 6e 67 20 66 6c 61 76 6f 72 3a 20 27 73 77 ping flavor: 'sw
2f50: 69 74 63 68 2d 73 79 6d 62 6f 6c 29 29 29 0a 20 itch-symbol))).
2f60: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 28 73 (alist-ref (s
2f70: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 70 61 tring->symbol pa
2f80: 72 61 6d 29 20 6d 61 70 70 69 6e 67 2d 61 6c 69 ram) mapping-ali
2f90: 73 74 20 65 71 3f 20 70 61 72 61 6d 29 0a 20 20 st eq? param).
2fa0: 20 20 70 61 72 61 6d 29 29 0a 0a 28 64 65 66 69 param))..(defi
2fb0: 6e 65 20 76 61 6c 2d 3e 61 6c 69 73 74 20 63 6f ne val->alist co
2fc0: 6d 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 29 mmon:val->alist)
2fd0: 0a 0a 28 64 65 66 69 6e 65 20 28 70 75 73 68 2d ..(define (push-
2fe0: 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 run-spec torun c
2ff0: 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 20 73 70 ontour runkey sp
3000: 65 63 29 0a 20 20 28 63 6f 6e 66 69 67 66 3a 73 ec). (configf:s
3010: 65 63 74 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 ection-var-set!
3020: 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 torun contour ru
3030: 6e 6b 65 79 0a 09 09 09 20 20 20 20 28 63 6f 6e nkey.... (con
3040: 73 20 73 70 65 63 0a 09 09 09 09 20 20 28 6f 72 s spec..... (or
3050: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
3060: 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 torun contour r
3070: 75 6e 6b 65 79 29 0a 09 09 09 09 20 20 20 20 20 unkey).....
3080: 20 27 28 29 29 29 29 29 0a 0a 28 64 65 66 69 6e '()))))..(defin
3090: 65 20 28 66 6f 73 73 69 6c 3a 63 6c 6f 6e 65 2d e (fossil:clone-
30a0: 6f 72 2d 73 79 6e 63 20 75 72 6c 20 6e 61 6d 65 or-sync url name
30b0: 20 64 65 73 74 2d 64 69 72 29 0a 20 20 28 6c 65 dest-dir). (le
30c0: 74 20 28 28 74 61 72 67 2d 66 69 6c 65 20 28 63 t ((targ-file (c
30d0: 6f 6e 63 20 64 65 73 74 2d 64 69 72 20 22 2f 22 onc dest-dir "/"
30e0: 20 6e 61 6d 65 29 29 29 20 3b 3b 20 64 6f 20 6e name))) ;; do n
30f0: 6f 74 20 66 6f 72 63 65 20 75 73 61 67 65 20 6f ot force usage o
3100: 66 20 2e 66 6f 73 73 69 6c 20 65 78 74 65 6e 73 f .fossil extens
3110: 69 6f 6e 0a 20 20 20 20 28 68 61 6e 64 6c 65 2d ion. (handle-
3120: 65 78 63 65 70 74 69 6f 6e 73 0a 09 65 78 6e 0a exceptions..exn.
3130: 09 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 .(print "ERROR:
3140: 66 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 failed to create
3150: 20 64 69 72 65 63 74 6f 72 79 20 22 20 64 65 73 directory " des
3160: 74 2d 64 69 72 20 22 20 6d 65 73 73 61 67 65 3a t-dir " message:
3170: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
3180: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
3190: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
31a0: 65 78 6e 29 29 0a 20 20 20 20 20 20 28 63 72 65 exn)). (cre
31b0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 64 65 ate-directory de
31c0: 73 74 2d 64 69 72 20 23 74 29 29 0a 20 20 20 20 st-dir #t)).
31d0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
31e0: 6e 73 0a 09 65 78 6e 0a 09 28 70 72 69 6e 74 20 ns..exn..(print
31f0: 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 74 "ERROR: failed t
3200: 6f 20 63 6c 6f 6e 65 20 6f 72 20 73 79 6e 63 20 o clone or sync
3210: 31 6f 73 73 69 6c 20 22 20 75 72 6c 20 22 20 6d 1ossil " url " m
3220: 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 essage: " ((cond
3230: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
3240: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
3250: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 20 20 20 ssage) exn)).
3260: 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 (if (common:f
3270: 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 61 72 67 ile-exists? targ
3280: 2d 66 69 6c 65 29 0a 09 20 20 28 73 79 73 74 65 -file).. (syste
3290: 6d 20 28 63 6f 6e 63 20 22 66 6f 73 73 69 6c 20 m (conc "fossil
32a0: 70 75 6c 6c 20 2d 2d 6f 6e 63 65 20 22 20 75 72 pull --once " ur
32b0: 6c 20 22 20 2d 52 20 22 20 74 61 72 67 2d 66 69 l " -R " targ-fi
32c0: 6c 65 29 29 0a 09 20 20 28 73 79 73 74 65 6d 20 le)).. (system
32d0: 28 63 6f 6e 63 20 22 66 6f 73 73 69 6c 20 63 6c (conc "fossil cl
32e0: 6f 6e 65 20 22 20 75 72 6c 20 22 20 22 20 74 61 one " url " " ta
32f0: 72 67 2d 66 69 6c 65 29 29 0a 09 20 20 29 29 29 rg-file)).. )))
3300: 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 6f 73 73 )..(define (foss
3310: 69 6c 3a 6c 61 73 74 2d 63 68 61 6e 67 65 2d 6e il:last-change-n
3320: 6f 64 65 2d 61 6e 64 2d 74 69 6d 65 20 66 6f 73 ode-and-time fos
3330: 73 69 6c 73 2d 64 69 72 20 66 6f 73 73 69 6c 2d sils-dir fossil-
3340: 6e 61 6d 65 20 62 72 61 6e 63 68 29 0a 20 20 28 name branch). (
3350: 6c 65 74 2a 20 28 28 66 6f 73 73 69 6c 2d 66 69 let* ((fossil-fi
3360: 6c 65 20 20 20 28 63 6f 6e 63 20 66 6f 73 73 69 le (conc fossi
3370: 6c 73 2d 64 69 72 20 22 2f 22 20 66 6f 73 73 69 ls-dir "/" fossi
3380: 6c 2d 6e 61 6d 65 29 29 0a 09 20 28 74 69 6d 65 l-name)).. (time
3390: 6c 69 6e 65 2d 70 6f 72 74 20 28 69 66 20 28 66 line-port (if (f
33a0: 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 73 3f ile-read-access?
33b0: 20 66 6f 73 73 69 6c 2d 66 69 6c 65 29 0a 09 09 fossil-file)...
33c0: 09 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 . (handle-exc
33d0: 65 70 74 69 6f 6e 73 0a 09 09 09 09 65 78 6e 0a eptions.....exn.
33e0: 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 20 ....(begin.....
33f0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
3400: 66 61 69 6c 65 64 20 74 6f 20 67 65 74 20 74 69 failed to get ti
3410: 6d 65 6c 69 6e 65 20 66 72 6f 6d 20 22 20 66 6f meline from " fo
3420: 73 73 69 6c 2d 66 69 6c 65 20 22 20 6d 65 73 73 ssil-file " mess
3430: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
3440: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
3450: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
3460: 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 20 20 ge) exn)).....
3470: 23 66 29 0a 09 09 09 20 20 20 20 20 20 28 6f 70 #f).... (op
3480: 65 6e 2d 69 6e 70 75 74 2d 70 69 70 65 20 28 63 en-input-pipe (c
3490: 6f 6e 63 20 22 66 6f 73 73 69 6c 20 74 69 6d 65 onc "fossil time
34a0: 6c 69 6e 65 20 2d 74 20 63 69 20 2d 57 20 30 20 line -t ci -W 0
34b0: 2d 6e 20 30 20 2d 52 20 22 20 66 6f 73 73 69 6c -n 0 -R " fossil
34c0: 2d 66 69 6c 65 29 29 29 0a 09 09 09 20 20 20 20 -file)))....
34d0: 23 66 29 29 0a 09 20 28 67 65 74 2d 6c 69 6e 65 #f)).. (get-line
34e0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
34f0: 0a 09 09 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 .... (handle-ex
3500: 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 20 20 ceptions....
3510: 20 20 65 78 6e 0a 09 09 09 20 20 20 20 20 20 28 exn.... (
3520: 62 65 67 69 6e 0a 09 09 09 09 28 70 72 69 6e 74 begin.....(print
3530: 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 "ERROR: failed
3540: 74 6f 20 72 65 61 64 20 66 72 6f 6d 20 66 69 6c to read from fil
3550: 65 20 22 20 66 6f 73 73 69 6c 2d 66 69 6c 65 20 e " fossil-file
3560: 22 20 6d 65 73 73 61 67 65 3a 20 22 20 20 28 28 " message: " ((
3570: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
3580: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
3590: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
35a0: 0a 09 09 09 09 23 66 29 0a 09 09 09 20 20 20 20 .....#f)....
35b0: 28 72 65 61 64 2d 6c 69 6e 65 20 74 69 6d 65 6c (read-line timel
35c0: 69 6e 65 2d 70 6f 72 74 29 29 29 29 0a 09 20 28 ine-port)))).. (
35d0: 64 61 74 65 2d 72 78 20 20 20 20 20 20 20 28 72 date-rx (r
35e0: 65 67 65 78 70 20 22 5e 3d 3d 3d 20 28 5c 5c 53 egexp "^=== (\\S
35f0: 2b 29 20 3d 3d 3d 24 22 29 29 0a 09 20 28 6e 6f +) ===$")).. (no
3600: 64 65 2d 72 78 20 20 20 20 20 20 20 28 72 65 67 de-rx (reg
3610: 65 78 70 20 22 5e 28 5c 5c 53 2b 29 20 5c 5c 5b exp "^(\\S+) \\[
3620: 28 5c 5c 53 2b 29 5c 5c 5d 2e 2a 5c 5c 28 2e 2a (\\S+)\\].*\\(.*
3630: 74 61 67 73 3a 5c 5c 73 2b 28 5b 5e 5c 5c 29 5d tags:\\s+([^\\)]
3640: 2b 29 5c 5c 29 24 22 29 29 29 0a 20 20 20 20 28 +)\\)$"))). (
3650: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 let loop ((inl (
3660: 67 65 74 2d 6c 69 6e 65 29 29 0a 09 20 20 20 20 get-line))..
3670: 20 20 20 28 64 61 74 65 20 23 66 29 0a 09 20 20 (date #f)..
3680: 20 20 20 20 20 28 6e 6f 64 65 20 23 66 29 0a 09 (node #f)..
3690: 20 20 20 20 20 20 20 28 74 69 6d 65 20 23 66 29 (time #f)
36a0: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond.
36b0: 20 20 20 20 20 28 28 61 6e 64 20 64 61 74 65 20 ((and date
36c0: 74 69 6d 65 20 6e 6f 64 65 29 20 3b 3b 20 68 61 time node) ;; ha
36d0: 76 65 20 61 6c 6c 2c 20 72 65 74 75 72 6e 20 27 ve all, return '
36e0: 65 6d 0a 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 em..(close-input
36f0: 2d 70 6f 72 74 20 74 69 6d 65 6c 69 6e 65 2d 70 -port timeline-p
3700: 6f 72 74 29 0a 09 28 76 61 6c 75 65 73 20 28 63 ort)..(values (c
3710: 6f 6d 6d 6f 6e 3a 64 61 74 65 2d 74 69 6d 65 2d ommon:date-time-
3720: 3e 73 65 63 6f 6e 64 73 20 28 63 6f 6e 63 20 64 >seconds (conc d
3730: 61 74 65 20 22 20 22 20 74 69 6d 65 29 29 20 6e ate " " time)) n
3740: 6f 64 65 29 29 0a 20 20 20 20 20 20 20 28 28 61 ode)). ((a
3750: 6e 64 20 69 6e 6c 20 28 6e 6f 74 20 28 65 6f 66 nd inl (not (eof
3760: 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 29 29 20 -object? inl)))
3770: 3b 3b 20 68 61 76 65 20 61 20 6c 69 6e 65 20 74 ;; have a line t
3780: 6f 20 70 72 6f 63 65 73 73 0a 09 28 72 65 67 65 o process..(rege
3790: 78 2d 63 61 73 65 20 69 6e 6c 0a 09 20 20 28 64 x-case inl.. (d
37a0: 61 74 65 2d 72 78 20 28 20 5f 20 6e 65 77 64 61 ate-rx ( _ newda
37b0: 74 65 20 29 20 28 6c 6f 6f 70 20 28 67 65 74 2d te ) (loop (get-
37c0: 6c 69 6e 65 29 20 6e 65 77 64 61 74 65 20 6e 6f line) newdate no
37d0: 64 65 20 74 69 6d 65 29 29 0a 09 20 20 3b 3b 20 de time)).. ;;
37e0: 32 32 3a 34 37 3a 34 38 20 5b 61 30 32 34 64 39 22:47:48 [a024d9
37f0: 65 36 30 66 5d 20 41 64 64 65 64 20 2a 75 73 65 e60f] Added *use
3800: 72 2d 68 61 73 68 2d 64 61 74 61 2a 20 2d 20 61 r-hash-data* - a
3810: 20 67 6c 6f 62 61 6c 20 74 68 61 74 20 63 61 6e global that can
3820: 20 62 65 20 75 73 65 64 20 69 6e 20 2d 72 65 70 be used in -rep
3830: 6c 20 61 6e 64 20 23 7b 73 63 68 65 6d 65 20 2e l and #{scheme .
3840: 2e 2e 7d 20 63 61 6c 6c 73 20 62 79 20 74 68 65 ..} calls by the
3850: 20 65 6e 64 20 75 73 65 72 20 28 75 73 65 72 3a end user (user:
3860: 20 6d 61 74 74 20 74 61 67 73 3a 20 76 31 2e 36 matt tags: v1.6
3870: 33 29 0a 09 20 20 28 6e 6f 64 65 2d 72 78 20 28 3).. (node-rx (
3880: 20 5f 20 6e 65 77 74 69 6d 65 20 6e 65 77 6e 6f _ newtime newno
3890: 64 65 20 61 6c 6c 74 61 67 73 20 29 0a 09 09 20 de alltags )...
38a0: 20 20 28 6c 65 74 20 28 28 74 61 67 73 20 28 73 (let ((tags (s
38b0: 74 72 69 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c tring-split-fiel
38c0: 64 73 20 22 2c 5c 5c 73 2a 22 20 61 6c 6c 74 61 ds ",\\s*" allta
38d0: 67 73 20 23 3a 69 6e 66 69 78 29 29 29 0a 09 09 gs #:infix)))...
38e0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 74 61 67 (print "tag
38f0: 73 3a 20 22 20 74 61 67 73 29 0a 09 09 20 20 20 s: " tags)...
3900: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 62 72 (if (member br
3910: 61 6e 63 68 20 74 61 67 73 29 0a 09 09 09 20 28 anch tags).... (
3920: 6c 6f 6f 70 20 28 67 65 74 2d 6c 69 6e 65 29 20 loop (get-line)
3930: 64 61 74 65 20 6e 65 77 6e 6f 64 65 20 6e 65 77 date newnode new
3940: 74 69 6d 65 29 0a 09 09 09 20 28 6c 6f 6f 70 20 time).... (loop
3950: 28 67 65 74 2d 6c 69 6e 65 29 20 64 61 74 65 20 (get-line) date
3960: 6e 6f 64 65 20 74 69 6d 65 29 29 29 29 0a 09 20 node time))))..
3970: 20 28 65 6c 73 65 20 3b 3b 20 68 61 76 65 20 73 (else ;; have s
3980: 6f 6d 65 20 75 6e 72 65 63 6f 67 6e 69 73 65 64 ome unrecognised
3990: 20 6a 75 6e 6b 3f 20 73 70 69 74 20 6f 75 74 20 junk? spit out
39a0: 65 72 72 6f 72 20 6d 65 73 73 61 67 65 0a 09 20 error message..
39b0: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
39c0: 20 66 6f 73 73 69 6c 20 74 69 6d 65 6c 69 6e 65 fossil timeline
39d0: 20 72 65 74 75 72 6e 65 64 20 75 6e 72 65 63 6f returned unreco
39e0: 67 6e 69 73 61 62 6c 65 20 6a 75 6e 6b 20 5c 22 gnisable junk \"
39f0: 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 20 20 20 " inl "\"")..
3a00: 28 6c 6f 6f 70 20 28 67 65 74 2d 6c 69 6e 65 29 (loop (get-line)
3a10: 20 64 61 74 65 20 6e 6f 64 65 20 74 69 6d 65 29 date node time)
3a20: 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 ))). (else
3a30: 20 3b 3b 20 6e 6f 20 6d 6f 72 65 20 64 61 74 61 ;; no more data
3a40: 74 20 61 6e 64 20 6c 61 73 74 20 6e 6f 64 65 20 t and last node
3a50: 6f 6e 20 62 72 61 6e 63 68 20 6e 6f 74 20 66 6f on branch not fo
3a60: 75 6e 64 0a 09 28 63 6c 6f 73 65 2d 69 6e 70 75 und..(close-inpu
3a70: 74 2d 70 6f 72 74 20 74 69 6d 65 6c 69 6e 65 2d t-port timeline-
3a80: 70 6f 72 74 29 0a 09 28 76 61 6c 75 65 73 20 20 port)..(values
3a90: 28 63 6f 6d 6d 6f 6e 3a 64 61 74 65 2d 74 69 6d (common:date-tim
3aa0: 65 2d 3e 73 65 63 6f 6e 64 73 20 28 63 6f 6e 63 e->seconds (conc
3ab0: 20 64 61 74 65 20 22 20 22 20 74 69 6d 65 29 29 date " " time))
3ac0: 20 6e 6f 64 65 29 29 29 29 29 29 0a 0a 3b 3b 3d node))))))..;;=
3ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b10: 3d 3d 3d 3d 3d 0a 3b 3b 20 47 4c 4f 42 41 4c 53 =====.;; GLOBALS
3b20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 66 69 =========..;; fi
3b70: 72 73 74 20 74 6f 6b 65 6e 20 69 73 20 6f 75 72 rst token is our
3b80: 20 61 63 74 69 6f 6e 2c 20 62 75 74 20 6f 6e 6c action, but onl
3b90: 79 20 69 66 20 6e 6f 20 6c 65 61 64 69 6e 67 20 y if no leading
3ba0: 64 61 73 68 0a 28 64 65 66 69 6e 65 20 2a 61 63 dash.(define *ac
3bb0: 74 69 6f 6e 2a 20 28 69 66 20 28 61 6e 64 20 28 tion* (if (and (
3bc0: 3e 20 28 6c 65 6e 67 74 68 20 28 61 72 67 76 29 > (length (argv)
3bd0: 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 1).
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3bf0: 6e 6f 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 not (string-matc
3c00: 68 20 22 5e 5c 5c 2d 2e 2a 22 20 28 63 61 64 72 h "^\\-.*" (cadr
3c10: 20 28 61 72 67 76 29 29 29 29 29 0a 09 09 20 20 (argv)))))...
3c20: 20 20 20 28 63 61 64 72 20 28 61 72 67 76 29 29 (cadr (argv))
3c30: 0a 09 09 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b ... #f))..;;
3c40: 20 70 72 6f 63 65 73 73 20 61 72 67 75 6d 65 6e process argumen
3c50: 74 73 2c 20 65 78 74 72 61 63 74 20 73 77 69 74 ts, extract swit
3c60: 63 68 65 73 20 61 6e 64 20 70 61 72 61 6d 65 74 ches and paramet
3c70: 65 72 73 20 66 69 72 73 74 0a 28 64 65 66 69 6e ers first.(defin
3c80: 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a e remargs (args:
3c90: 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 69 66 get-args ... (if
3ca0: 20 2a 61 63 74 69 6f 6e 2a 20 28 63 64 72 20 28 *action* (cdr (
3cb0: 61 72 67 76 29 29 20 28 61 72 67 76 29 29 20 3b argv)) (argv)) ;
3cc0: 3b 20 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 ; args:get-args
3cd0: 64 75 6d 70 73 20 66 69 72 73 74 20 69 6e 20 61 dumps first in a
3ce0: 72 67 76 20 6c 69 73 74 20 28 74 68 65 20 70 72 rgv list (the pr
3cf0: 6f 67 72 61 6d 20 6e 61 6d 65 29 0a 09 09 20 28 ogram name)... (
3d00: 6d 61 70 20 63 61 72 20 2a 61 72 67 2d 6b 65 79 map car *arg-key
3d10: 73 2a 29 0a 09 09 20 28 6d 61 70 20 63 61 72 20 s*)... (map car
3d20: 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a 29 0a 09 *switch-keys*)..
3d30: 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a . args:arg-hash.
3d40: 09 09 20 30 29 29 0a 0a 3b 3b 20 68 61 6e 64 6c .. 0))..;; handl
3d50: 65 20 72 65 71 75 65 73 74 73 20 66 6f 72 20 68 e requests for h
3d60: 65 6c 70 0a 3b 3b 0a 28 69 66 20 28 6f 72 20 28 elp.;;.(if (or (
3d70: 6d 65 6d 62 65 72 20 2a 61 63 74 69 6f 6e 2a 20 member *action*
3d80: 27 28 22 2d 68 22 20 22 2d 68 65 6c 70 22 20 22 '("-h" "-help" "
3d90: 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 29 29 help" "--help"))
3da0: 0a 09 28 61 72 67 73 3a 61 6e 79 2d 64 65 66 69 ..(args:any-defi
3db0: 6e 65 64 3f 20 22 2d 68 22 20 22 2d 68 65 6c 70 ned? "-h" "-help
3dc0: 22 20 22 2d 2d 68 65 6c 70 22 29 29 0a 20 20 20 " "--help")).
3dd0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
3de0: 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 rint help).
3df0: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 28 64 65 (exit 1)))..(de
3e00: 66 69 6e 65 20 28 70 72 69 6e 74 2d 70 6b 74 2d fine (print-pkt-
3e10: 6b 65 79 73 20 69 6e 6c 73 74 29 0a 20 20 28 66 keys inlst). (f
3e20: 6f 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 or-each. (lamb
3e30: 64 61 20 28 70 29 0a 20 20 20 20 20 28 6c 65 74 da (p). (let
3e40: 20 28 28 73 77 20 28 63 61 72 20 70 29 29 0a 20 ((sw (car p)).
3e50: 20 20 20 20 20 20 20 20 20 20 28 63 20 20 28 63 (c (c
3e60: 64 72 20 70 29 29 29 0a 20 20 20 20 20 20 20 28 dr p))). (
3e70: 70 72 69 6e 74 20 28 6f 72 20 63 20 22 6e 2f 61 print (or c "n/a
3e80: 22 29 20 22 5c 74 22 20 73 77 29 29 29 0a 20 20 ") "\t" sw))).
3e90: 20 69 6e 6c 73 74 29 29 0a 0a 28 64 65 66 69 6e inlst))..(defin
3ea0: 65 20 28 70 72 69 6e 74 2d 64 75 70 6c 69 63 61 e (print-duplica
3eb0: 74 65 2d 6b 65 79 73 20 2e 20 61 6c 6c 29 0a 20 te-keys . all).
3ec0: 20 28 6c 65 74 20 28 28 63 61 72 64 2d 68 61 73 (let ((card-has
3ed0: 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 h (make-hash-tab
3ee0: 6c 65 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 le))). (for-e
3ef0: 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ach. (lambda
3f00: 20 28 6c 73 74 29 0a 20 20 20 20 20 20 20 28 66 (lst). (f
3f10: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 20 20 20 or-each.
3f20: 28 6c 61 6d 62 64 61 20 28 63 61 72 64 2d 73 70 (lambda (card-sp
3f30: 65 63 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c ec). (l
3f40: 65 74 20 28 28 6b 20 28 63 64 72 20 63 61 72 64 et ((k (cdr card
3f50: 2d 73 70 65 63 29 29 29 0a 20 20 20 20 20 20 20 -spec))).
3f60: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
3f70: 63 61 72 64 2d 73 70 65 63 3a 20 22 20 63 61 72 card-spec: " car
3f80: 64 2d 73 70 65 63 20 22 2c 20 6b 3a 20 22 20 6b d-spec ", k: " k
3f90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 ). (i
3fa0: 66 20 6b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d f k (hash-table-
3fb0: 73 65 74 21 20 63 61 72 64 2d 68 61 73 68 20 6b set! card-hash k
3fc0: 20 28 2b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (+ (hash-table-
3fd0: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 61 72 64 ref/default card
3fe0: 2d 68 61 73 68 20 6b 20 30 29 20 31 29 29 29 29 -hash k 0) 1))))
3ff0: 29 0a 20 20 20 20 20 20 20 20 6c 73 74 29 29 0a ). lst)).
4000: 20 20 20 20 20 61 6c 6c 29 0a 20 20 20 20 28 66 all). (f
4010: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la
4020: 6d 62 64 61 20 28 6b 29 0a 20 20 20 20 20 20 20 mbda (k).
4030: 28 69 66 20 28 3e 20 28 68 61 73 68 2d 74 61 62 (if (> (hash-tab
4040: 6c 65 2d 72 65 66 20 63 61 72 64 2d 68 61 73 68 le-ref card-hash
4050: 20 6b 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 k) 1).
4060: 20 20 28 70 72 69 6e 74 20 6b 20 22 5c 74 22 20 (print k "\t"
4070: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
4080: 63 61 72 64 2d 68 61 73 68 20 6b 29 29 29 29 0a card-hash k)))).
4090: 20 20 20 20 20 28 73 6f 72 74 20 28 68 61 73 68 (sort (hash
40a0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 63 61 72 64 -table-keys card
40b0: 2d 68 61 73 68 29 20 28 6c 61 6d 62 64 61 20 28 -hash) (lambda (
40c0: 61 20 62 29 28 3e 3d 20 28 68 61 73 68 2d 74 61 a b)(>= (hash-ta
40d0: 62 6c 65 2d 72 65 66 20 63 61 72 64 2d 68 61 73 ble-ref card-has
40e0: 68 20 61 29 28 68 61 73 68 2d 74 61 62 6c 65 2d h a)(hash-table-
40f0: 72 65 66 20 63 61 72 64 2d 68 61 73 68 20 62 29 ref card-hash b)
4100: 29 29 29 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 )))). ))..(de
4110: 66 69 6e 65 20 28 70 72 69 6e 74 2d 70 6b 74 2d fine (print-pkt-
4120: 6b 65 79 2d 69 6e 66 6f 29 0a 20 20 28 70 72 69 key-info). (pri
4130: 6e 74 20 22 41 72 67 75 6d 65 6e 74 20 6b 65 79 nt "Argument key
4140: 73 22 29 0a 20 20 28 70 72 69 6e 74 2d 70 6b 74 s"). (print-pkt
4150: 2d 6b 65 79 73 20 2a 61 72 67 2d 6b 65 79 73 2a -keys *arg-keys*
4160: 29 0a 20 20 28 70 72 69 6e 74 20 22 5c 6e 53 77 ). (print "\nSw
4170: 69 74 63 68 20 6b 65 79 73 22 29 0a 20 20 28 70 itch keys"). (p
4180: 72 69 6e 74 2d 70 6b 74 2d 6b 65 79 73 20 2a 73 rint-pkt-keys *s
4190: 77 69 74 63 68 2d 6b 65 79 73 2a 29 0a 20 20 28 witch-keys*). (
41a0: 70 72 69 6e 74 20 22 5c 6e 41 63 74 69 6f 6e 20 print "\nAction
41b0: 6b 65 79 73 22 29 0a 20 20 28 70 72 69 6e 74 2d keys"). (print-
41c0: 70 6b 74 2d 6b 65 79 73 20 2a 61 63 74 69 6f 6e pkt-keys *action
41d0: 2d 6b 65 79 73 2a 29 0a 20 20 28 70 72 69 6e 74 -keys*). (print
41e0: 20 22 5c 6e 41 64 64 69 74 69 6f 6e 61 6c 20 63 "\nAdditional c
41f0: 61 72 64 73 22 29 0a 20 20 28 70 72 69 6e 74 2d ards"). (print-
4200: 70 6b 74 2d 6b 65 79 73 20 28 73 77 69 7a 7a 6c pkt-keys (swizzl
4210: 65 2d 61 6c 69 73 74 20 2a 61 64 64 69 74 69 6f e-alist *additio
4220: 6e 61 6c 2d 63 61 72 64 73 2a 29 29 0a 20 20 28 nal-cards*)). (
4230: 70 72 69 6e 74 20 22 5c 6e 44 75 70 6c 69 63 61 print "\nDuplica
4240: 74 65 20 6b 65 79 73 22 29 0a 20 20 28 70 72 69 te keys"). (pri
4250: 6e 74 2d 64 75 70 6c 69 63 61 74 65 2d 6b 65 79 nt-duplicate-key
4260: 73 20 2a 61 72 67 2d 6b 65 79 73 2a 20 2a 73 77 s *arg-keys* *sw
4270: 69 74 63 68 2d 6b 65 79 73 2a 20 2a 61 63 74 69 itch-keys* *acti
4280: 6f 6e 2d 6b 65 79 73 2a 20 28 73 77 69 7a 7a 6c on-keys* (swizzl
4290: 65 2d 61 6c 69 73 74 20 2a 61 64 64 69 74 69 6f e-alist *additio
42a0: 6e 61 6c 2d 63 61 72 64 73 2a 29 29 0a 20 20 28 nal-cards*)). (
42b0: 70 72 69 6e 74 20 22 5c 6e 45 6e 64 20 6f 66 20 print "\nEnd of
42c0: 72 65 70 6f 72 74 2e 22 29 0a 20 20 29 0a 0a 3b report."). )..;
42d0: 3b 20 6c 69 73 74 20 70 61 63 6b 65 74 20 6b 65 ; list packet ke
42e0: 79 73 0a 3b 3b 0a 28 69 66 20 28 61 72 67 73 3a ys.;;.(if (args:
42f0: 67 65 74 2d 61 72 67 20 22 2d 6c 69 73 74 2d 70 get-arg "-list-p
4300: 6b 74 2d 6b 65 79 73 22 29 0a 20 20 20 20 28 62 kt-keys"). (b
4310: 65 67 69 6e 20 28 70 72 69 6e 74 2d 70 6b 74 2d egin (print-pkt-
4320: 6b 65 79 2d 69 6e 66 6f 29 28 65 78 69 74 20 30 key-info)(exit 0
4330: 29 29 29 0a 0a 3b 3b 20 28 70 72 69 6e 74 20 22 )))..;; (print "
4340: 2a 61 63 74 69 6f 6e 2a 3a 20 22 20 2a 61 63 74 *action*: " *act
4350: 69 6f 6e 2a 29 0a 0a 3b 3b 20 28 6c 65 74 2d 76 ion*)..;; (let-v
4360: 61 6c 75 65 73 20 28 28 28 75 75 69 64 20 70 6b alues (((uuid pk
4370: 74 29 0a 3b 3b 20 09 20 20 20 20 20 20 28 63 6f t).;; . (co
4380: 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e 70 6b 74 20 mmand-line->pkt
4390: 23 66 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 #f args:arg-hash
43a0: 29 29 29 0a 3b 3b 20 20 20 28 70 72 69 6e 74 20 ))).;; (print
43b0: 70 6b 74 29 29 0a 0a 3b 3b 20 41 64 64 20 61 72 pkt))..;; Add ar
43c0: 67 73 20 74 68 61 74 20 75 73 65 20 72 65 6d 61 gs that use rema
43d0: 72 67 73 20 68 65 72 65 0a 3b 3b 0a 28 69 66 20 rgs here.;;.(if
43e0: 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (and (not (null?
43f0: 20 72 65 6d 61 72 67 73 29 29 0a 09 20 28 6e 6f remargs)).. (no
4400: 74 20 28 6f 72 0a 09 20 20 20 20 20 20 20 28 61 t (or.. (a
4410: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
4420: 6e 73 74 65 70 22 29 0a 09 20 20 20 20 20 20 20 nstep")..
4430: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4440: 65 6e 76 63 61 70 22 29 0a 09 20 20 20 20 20 20 envcap")..
4450: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
4460: 2d 65 6e 76 64 65 6c 74 61 22 29 0a 09 20 20 20 -envdelta")..
4470: 20 20 20 20 28 6d 65 6d 62 65 72 20 2a 61 63 74 (member *act
4480: 69 6f 6e 2a 20 27 28 22 64 62 22 20 22 74 73 65 ion* '("db" "tse
4490: 6e 64 22 20 22 74 6c 69 73 74 65 6e 22 29 29 20 nd" "tlisten"))
44a0: 20 20 3b 3b 20 76 65 72 79 20 6c 6f 6f 73 65 20 ;; very loose
44b0: 63 68 65 63 6b 73 20 6f 6e 20 64 62 20 61 6e 64 checks on db and
44c0: 20 74 73 65 6e 64 2f 6c 69 73 74 65 6e 0a 09 20 tsend/listen..
44d0: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 2a 61 (equal? *a
44e0: 63 74 69 6f 6e 2a 20 22 73 68 6f 77 22 29 20 20 ction* "show")
44f0: 20 20 3b 3b 20 6a 75 73 74 20 6b 65 65 70 20 67 ;; just keep g
4500: 6f 69 6e 67 20 69 66 20 6c 69 73 74 0a 09 20 20 oing if list..
4510: 20 20 20 20 20 29 29 29 0a 20 20 20 20 28 64 65 ))). (de
4520: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
4530: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
4540: 6f 72 74 2a 20 22 55 6e 72 65 63 6f 67 6e 69 73 ort* "Unrecognis
4550: 65 64 20 61 72 67 75 6d 65 6e 74 73 3a 20 22 20 ed arguments: "
4560: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
4570: 72 73 65 20 28 69 66 20 28 6c 69 73 74 3f 20 72 rse (if (list? r
4580: 65 6d 61 72 67 73 29 20 72 65 6d 61 72 67 73 20 emargs) remargs
4590: 28 61 72 67 76 29 29 20 20 22 20 22 29 29 29 0a (argv)) " "))).
45a0: 0a 28 69 66 20 28 6f 72 20 28 61 72 67 73 3a 61 .(if (or (args:a
45b0: 6e 79 3f 20 22 2d 68 22 20 22 68 65 6c 70 22 20 ny? "-h" "help"
45c0: 22 2d 68 65 6c 70 22 20 22 2d 2d 68 65 6c 70 22 "-help" "--help"
45d0: 29 0a 09 28 6d 65 6d 62 65 72 20 2a 61 63 74 69 )..(member *acti
45e0: 6f 6e 2a 20 27 28 22 2d 68 22 20 22 2d 68 65 6c on* '("-h" "-hel
45f0: 70 22 20 22 2d 2d 68 65 6c 70 22 20 22 68 65 6c p" "--help" "hel
4600: 70 22 29 29 29 0a 20 20 20 20 28 62 65 67 69 6e p"))). (begin
4610: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 . (print he
4620: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 20 lp). (exit
4630: 31 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 1)))..;;========
4640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
4680: 3b 20 4e 61 6e 6f 6d 73 67 20 74 72 61 6e 73 70 ; Nanomsg transp
4690: 6f 72 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ort.;;==========
46a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
46e0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 65 6e efine-inline (en
46f0: 63 6f 64 65 20 64 61 74 61 29 0a 20 20 28 77 69 code data). (wi
4700: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 th-output-to-str
4710: 69 6e 67 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 ing. (lambda
4720: 28 29 0a 20 20 20 20 20 20 28 77 72 69 74 65 20 (). (write
4730: 64 61 74 61 29 29 29 29 0a 0a 28 64 65 66 69 6e data))))..(defin
4740: 65 2d 69 6e 6c 69 6e 65 20 28 64 65 63 6f 64 65 e-inline (decode
4750: 20 64 61 74 61 29 0a 20 20 28 77 69 74 68 2d 69 data). (with-i
4760: 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 nput-from-string
4770: 0a 20 20 20 20 20 20 64 61 74 61 0a 20 20 20 20 . data.
4780: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
4790: 20 28 72 65 61 64 29 29 29 29 0a 0a 28 64 65 66 (read))))..(def
47a0: 69 6e 65 20 28 69 73 2d 70 6f 72 74 2d 69 6e 2d ine (is-port-in-
47b0: 75 73 65 20 70 6f 72 74 2d 6e 75 6d 29 0a 20 28 use port-num). (
47c0: 6c 65 74 2a 20 28 28 72 65 74 20 23 66 29 29 0a let* ((ret #f)).
47d0: 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 (let-values
47e0: 20 28 28 28 69 6e 70 20 6f 75 70 20 70 69 64 29 (((inp oup pid)
47f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4800: 20 28 70 72 6f 63 65 73 73 20 22 6e 65 74 73 74 (process "netst
4810: 61 74 22 20 28 6c 69 73 74 20 20 22 2d 74 75 6c at" (list "-tul
4820: 70 6e 22 20 29 29 29 29 0a 20 20 20 20 20 20 28 pn" )))). (
4830: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 let loop ((inl (
4840: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 29 read-line inp)))
4850: 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f . (if (no
4860: 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 t (eof-object? i
4870: 6e 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 nl)).
4880: 20 28 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 (begin .
4890: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 (if (st
48a0: 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 ring-search (reg
48b0: 65 78 70 20 28 63 6f 6e 63 20 22 3a 22 20 70 6f exp (conc ":" po
48c0: 72 74 2d 6e 75 6d 29 29 20 69 6e 6c 29 0a 20 20 rt-num)) inl).
48d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
48e0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
48f0: 20 20 20 20 20 20 20 3b 28 70 72 69 6e 74 20 22 ;(print "
4900: 4f 75 74 70 75 74 3a 20 22 20 20 69 6e 6c 29 0a Output: " inl).
4910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4920: 20 20 28 73 65 74 21 20 72 65 74 20 20 23 74 29 (set! ret #t)
4930: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4940: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l
4950: 69 6e 65 20 69 6e 70 29 29 29 29 29 29 29 0a 72 ine inp))))))).r
4960: 65 74 29 29 0a 0a 3b 3b 73 74 61 72 74 20 61 20 et))..;;start a
4970: 73 65 72 76 65 72 2c 20 72 65 74 75 72 6e 73 20 server, returns
4980: 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 3b the connection.;
4990: 3b 0a 28 64 65 66 69 6e 65 20 28 73 74 61 72 74 ;.(define (start
49a0: 2d 6e 6e 2d 73 65 72 76 65 72 20 70 6f 72 74 6e -nn-server portn
49b0: 75 6d 20 29 0a 20 20 28 6c 65 74 20 28 28 72 65 um ). (let ((re
49c0: 70 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 27 72 65 p (nn-socket 're
49d0: 70 29 29 29 0a 20 20 20 20 28 68 61 6e 64 6c 65 p))). (handle
49e0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 -exceptions.
49f0: 20 65 78 6e 0a 20 20 20 20 20 28 6c 65 74 20 28 exn. (let (
4a00: 28 65 6d 73 67 20 28 28 63 6f 6e 64 69 74 69 6f (emsg ((conditio
4a10: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
4a20: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
4a30: 65 29 20 65 78 6e 29 29 29 0a 20 20 20 20 20 20 e) exn))).
4a40: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
4a50: 46 61 69 6c 65 64 20 74 6f 20 73 74 61 72 74 20 Failed to start
4a60: 73 65 72 76 65 72 20 5c 22 22 20 65 6d 73 67 20 server \"" emsg
4a70: 22 5c 22 22 29 0a 20 20 20 20 20 20 20 28 65 78 "\""). (ex
4a80: 69 74 20 31 29 29 0a 20 20 20 20 20 20 0a 20 20 it 1)). .
4a90: 20 20 20 28 6e 6e 2d 62 69 6e 64 20 72 65 70 20 (nn-bind rep
4aa0: 28 63 6f 6e 63 20 22 74 63 70 3a 2f 2f 2a 3a 22 (conc "tcp://*:"
4ab0: 20 70 6f 72 74 6e 75 6d 29 29 29 0a 20 20 20 20 portnum))).
4ac0: 72 65 70 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rep))..(define (
4ad0: 63 61 6e 2d 75 73 65 72 2d 6b 69 6c 6c 2d 6c 69 can-user-kill-li
4ae0: 73 74 6e 65 72 20 75 73 65 72 2d 69 6e 66 6f 20 stner user-info
4af0: 61 74 74 72 69 62 29 0a 20 20 28 6c 65 74 2a 20 attrib). (let*
4b00: 28 28 63 6f 6e 74 61 63 74 73 20 28 61 6c 69 73 ((contacts (alis
4b10: 74 2d 72 65 66 20 27 63 6f 6e 74 61 63 74 20 61 t-ref 'contact a
4b20: 74 74 72 69 62 29 29 0a 20 20 20 20 20 20 20 20 ttrib)).
4b30: 20 28 75 73 65 72 2d 69 64 20 28 63 61 64 64 64 (user-id (caddd
4b40: 72 20 28 63 64 72 20 75 73 65 72 2d 69 6e 66 6f r (cdr user-info
4b50: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 ))). (re
4b60: 74 20 23 66 29 20 20 0a 20 20 20 20 20 20 20 20 t #f) .
4b70: 20 28 63 6f 6e 74 61 63 74 2d 6c 69 73 74 20 28 (contact-list (
4b80: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6e string-split con
4b90: 74 61 63 74 73 20 22 2c 22 29 29 29 20 0a 20 20 tacts ","))) .
4ba0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each.
4bb0: 20 20 28 6c 61 6d 62 64 61 20 28 61 64 6d 69 6e (lambda (admin
4bc0: 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 73 ). (if (s
4bd0: 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 20 tring-contains
4be0: 75 73 65 72 2d 69 64 20 28 63 61 72 20 28 73 74 user-id (car (st
4bf0: 72 69 6e 67 2d 73 70 6c 69 74 20 61 64 6d 69 6e ring-split admin
4c00: 20 22 40 22 29 29 29 0a 20 20 20 20 20 20 20 20 "@"))).
4c10: 20 28 73 65 74 21 20 72 65 74 20 23 74 29 29 29 (set! ret #t)))
4c20: 20 20 0a 20 20 20 20 63 6f 6e 74 61 63 74 2d 6c . contact-l
4c30: 69 73 74 29 0a 20 20 20 72 65 74 29 29 0a 0a 3b ist). ret))..;
4c40: 3b 20 6f 70 65 6e 20 63 6f 6e 6e 65 63 74 69 6f ; open connectio
4c50: 6e 20 74 6f 20 73 65 72 76 65 72 2c 20 73 65 6e n to server, sen
4c60: 64 20 6d 65 73 73 61 67 65 2c 20 63 6c 6f 73 65 d message, close
4c70: 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 3b 3b 0a 28 connection.;;.(
4c80: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 73 65 6e define (open-sen
4c90: 64 2d 63 6c 6f 73 65 2d 6e 6e 20 68 6f 73 74 2d d-close-nn host-
4ca0: 70 6f 72 74 20 6d 73 67 20 61 74 74 72 69 62 20 port msg attrib
4cb0: 23 21 6b 65 79 20 28 74 69 6d 65 6f 75 74 20 33 #!key (timeout 3
4cc0: 29 20 29 20 3b 3b 20 64 65 66 61 75 6c 74 20 74 ) ) ;; default t
4cd0: 69 6d 65 6f 75 74 20 69 73 20 33 20 73 65 63 6f imeout is 3 seco
4ce0: 6e 64 73 0a 20 20 28 6c 65 74 20 28 28 72 65 71 nds. (let ((req
4cf0: 20 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 27 72 65 (nn-socket 're
4d00: 71 29 29 0a 20 20 20 20 20 20 20 20 28 75 72 69 q)). (uri
4d10: 20 20 28 63 6f 6e 63 20 22 74 63 70 3a 2f 2f 22 (conc "tcp://"
4d20: 20 68 6f 73 74 2d 70 6f 72 74 29 29 0a 20 20 20 host-port)).
4d30: 20 20 20 20 20 28 72 65 73 20 20 23 66 29 0a 20 (res #f).
4d40: 20 20 20 20 20 20 20 28 63 6f 6e 74 61 63 74 73 (contacts
4d50: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 63 6f 6e (alist-ref 'con
4d60: 74 61 63 74 20 61 74 74 72 69 62 29 29 0a 20 20 tact attrib)).
4d70: 20 20 20 20 20 20 28 6d 6f 64 65 20 28 61 6c 69 (mode (ali
4d80: 73 74 2d 72 65 66 20 27 6d 6f 64 65 20 61 74 74 st-ref 'mode att
4d90: 72 69 62 29 29 29 20 0a 20 20 20 20 28 68 61 6e rib))) . (han
4da0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
4db0: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 28 6c 65 exn. (le
4dc0: 74 20 28 28 65 6d 73 67 20 28 28 63 6f 6e 64 69 t ((emsg ((condi
4dd0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
4de0: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
4df0: 73 61 67 65 29 20 65 78 6e 29 29 29 0a 20 20 20 sage) exn))).
4e00: 20 20 20 20 3b 3b 20 53 65 6e 64 20 6e 6f 74 69 ;; Send noti
4e10: 66 69 63 61 74 69 6f 6e 20 20 20 20 20 20 20 0a fication .
4e20: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 (print "E
4e30: 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 RROR: Failed to
4e40: 63 6f 6e 6e 65 63 74 20 2f 20 73 65 6e 64 20 74 connect / send t
4e50: 6f 20 22 20 75 72 69 20 22 20 6d 65 73 73 61 67 o " uri " messag
4e60: 65 20 77 61 73 20 5c 22 22 20 65 6d 73 67 20 22 e was \"" emsg "
4e70: 5c 22 22 20 29 0a 20 20 20 20 20 20 20 20 20 28 \"" ). (
4e80: 69 66 20 28 65 71 75 61 6c 3f 20 6d 6f 64 65 20 if (equal? mode
4e90: 22 70 72 6f 64 75 63 74 69 6f 6e 22 29 0a 20 20 "production").
4ea0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
4eb0: 6e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n .
4ec0: 28 70 72 69 6e 74 20 22 20 53 65 6e 64 69 6e 67 (print " Sending
4ed0: 20 65 6d 61 69 6c 20 74 6f 20 63 6f 6e 74 61 63 email to contac
4ee0: 74 73 20 3a 20 22 20 63 6f 6e 74 61 63 74 73 20 ts : " contacts
4ef0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
4f00: 6c 65 74 20 28 28 65 6d 61 69 6c 2d 62 6f 64 79 let ((email-body
4f10: 20 28 6d 74 75 74 3a 73 74 6d 6c 2d 3e 73 74 72 (mtut:stml->str
4f20: 69 6e 67 20 28 73 3a 62 6f 64 79 0a 09 09 09 09 ing (s:body.....
4f30: 09 09 09 09 09 09 28 73 3a 70 20 28 63 6f 6e 63 ......(s:p (conc
4f40: 20 22 57 65 20 63 6f 75 6c 64 20 6e 6f 74 20 73 "We could not s
4f50: 65 6e 64 20 6d 65 73 73 61 67 65 73 20 74 6f 20 end messages to
4f60: 74 68 65 20 73 65 72 76 65 72 20 6f 6e 20 22 20 the server on "
4f70: 75 72 69 20 22 2e 22 20 20 22 50 6c 65 61 73 65 uri "." "Please
4f80: 20 63 68 65 63 6b 20 69 66 20 74 68 65 20 6c 69 check if the li
4f90: 73 74 6e 65 72 20 69 73 20 72 75 6e 6e 69 6e 67 stner is running
4fa0: 2e 20 49 74 20 69 73 20 70 6f 73 73 69 62 6c 65 . It is possible
4fb0: 20 74 68 61 74 20 74 68 65 20 68 6f 73 74 20 69 that the host i
4fc0: 73 20 6f 76 65 72 6c 6f 61 64 65 64 20 64 75 65 s overloaded due
4fd0: 20 74 6f 20 77 68 69 63 68 20 69 74 20 6d 61 79 to which it may
4fe0: 20 74 61 6b 65 20 74 6f 6f 20 6c 6f 6e 67 20 74 take too long t
4ff0: 6f 20 72 65 73 70 6f 6e 64 2e 20 5c 6e 20 43 6f o respond. \n Co
5000: 6e 74 61 63 74 20 79 6f 75 72 20 73 79 73 74 65 ntact your syste
5010: 6d 20 61 64 6d 69 6e 73 74 72 61 74 6f 72 20 69 m adminstrator i
5020: 66 20 73 65 72 76 65 72 20 6c 6f 61 64 20 69 73 f server load is
5030: 20 68 69 67 68 2e 22 20 28 73 3a 62 72 29 22 20 high." (s:br)"
5040: 54 68 61 6e 6b 20 59 6f 75 20 22 29 20 29 29 29 Thank You ") )))
5050: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5060: 28 73 65 6e 64 6d 61 69 6c 20 28 73 74 72 69 6e (sendmail (strin
5070: 67 2d 6a 6f 69 6e 20 28 73 74 72 69 6e 67 2d 73 g-join (string-s
5080: 70 6c 69 74 20 63 6f 6e 74 61 63 74 73 20 22 3b plit contacts ";
5090: 22 20 29 29 20 28 63 6f 6e 63 20 22 5b 4c 69 73 " )) (conc "[Lis
50a0: 74 6e 65 72 20 45 72 72 6f 72 5d 20 46 69 6c 65 tner Error] File
50b0: 64 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 d to connect to
50c0: 6c 69 73 74 6e 65 72 20 6f 6e 20 22 20 75 72 69 listner on " uri
50d0: 29 20 65 6d 61 69 6c 2d 62 6f 64 79 20 20 75 73 ) email-body us
50e0: 65 5f 68 74 6d 6c 3a 20 23 74 29 29 29 0a 20 20 e_html: #t))).
50f0: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e (prin
5100: 74 20 22 20 6d 6f 64 65 20 3a 20 22 20 6d 6f 64 t " mode : " mod
5110: 65 20 22 20 4e 6f 74 20 73 65 6e 64 69 6e 67 20 e " Not sending
5120: 61 6e 79 20 65 6d 61 69 6c 73 22 20 29 29 0a 20 any emails" )).
5130: 20 20 20 20 20 20 23 66 29 0a 20 20 20 20 20 28 #f). (
5140: 6e 6e 2d 63 6f 6e 6e 65 63 74 20 72 65 71 20 75 nn-connect req u
5150: 72 69 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 ri). (print
5160: 22 43 6f 6e 6e 65 63 74 65 64 20 74 6f 20 74 68 "Connected to th
5170: 65 20 73 65 72 76 65 72 20 22 20 29 0a 20 20 20 e server " ).
5180: 20 20 28 6e 6e 2d 73 65 6e 64 20 72 65 71 20 6d (nn-send req m
5190: 73 67 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 sg). (print
51a0: 22 52 65 71 75 65 73 74 20 53 65 6e 74 22 29 20 "Request Sent")
51b0: 20 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 . (let* ((t
51c0: 68 31 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 h1 (make-thread
51d0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
51e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
5200: 74 20 28 28 72 65 73 70 20 28 6e 6e 2d 72 65 63 t ((resp (nn-rec
5210: 76 20 72 65 71 29 29 29 0a 20 20 20 20 20 20 20 v req))).
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5230: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6e 2d (nn-
5240: 63 6c 6f 73 65 20 72 65 71 29 0a 20 20 20 20 20 close req).
5250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
5270: 65 74 21 20 72 65 73 20 28 69 66 20 28 65 71 75 et! res (if (equ
5280: 61 6c 3f 20 72 65 73 70 20 22 6f 6b 22 29 0a 20 al? resp "ok").
5290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 23 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 #t.
52d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52f0: 20 20 20 20 23 66 29 29 29 29 0a 20 20 20 20 20 #f)))).
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5310: 20 20 20 20 20 20 20 20 20 20 22 72 65 63 76 20 "recv
5320: 74 68 72 65 61 64 22 29 29 0a 20 20 20 20 20 20 thread")).
5330: 20 20 20 20 20 20 28 74 68 32 20 28 6d 61 6b 65 (th2 (make
5340: 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 -thread (lambda
5350: 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ().
5360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5370: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
5380: 21 20 74 69 6d 65 6f 75 74 29 0a 20 20 20 20 20 ! timeout).
5390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53a0: 20 20 20 20 20 20 20 20 20 20 20 28 74 68 72 65 (thre
53b0: 61 64 2d 74 65 72 6d 69 6e 61 74 65 21 20 74 68 ad-terminate! th
53c0: 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1)).
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53e0: 20 22 74 69 6d 65 72 20 74 68 72 65 61 64 22 29 "timer thread")
53f0: 29 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 )). (threa
5400: 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 20 20 d-start! th1).
5410: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 (thread-sta
5420: 72 74 21 20 74 68 32 29 0a 20 20 20 20 20 20 20 rt! th2).
5430: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
5440: 31 29 0a 20 20 20 20 20 20 20 72 65 73 29 29 29 1). res)))
5450: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e )..(define (open
5460: 2d 73 65 6e 64 2d 72 65 63 65 69 76 65 2d 6e 6e -send-receive-nn
5470: 20 68 6f 73 74 2d 70 6f 72 74 20 6d 73 67 20 61 host-port msg a
5480: 74 74 72 69 62 20 23 21 6b 65 79 20 28 74 69 6d ttrib #!key (tim
5490: 65 6f 75 74 20 33 29 20 29 20 3b 3b 20 64 65 66 eout 3) ) ;; def
54a0: 61 75 6c 74 20 74 69 6d 65 6f 75 74 20 69 73 20 ault timeout is
54b0: 33 20 73 65 63 6f 6e 64 73 0a 20 20 28 6c 65 74 3 seconds. (let
54c0: 20 28 28 72 65 71 20 20 28 6e 6e 2d 73 6f 63 6b ((req (nn-sock
54d0: 65 74 20 27 72 65 71 29 29 0a 20 20 20 20 20 20 et 'req)).
54e0: 20 20 28 75 72 69 20 20 28 63 6f 6e 63 20 22 74 (uri (conc "t
54f0: 63 70 3a 2f 2f 22 20 68 6f 73 74 2d 70 6f 72 74 cp://" host-port
5500: 29 29 0a 20 20 20 20 20 20 20 20 28 72 65 73 20 )). (res
5510: 20 23 66 29 0a 20 20 20 20 20 20 20 20 28 63 6f #f). (co
5520: 6e 74 61 63 74 73 20 28 61 6c 69 73 74 2d 72 65 ntacts (alist-re
5530: 66 20 27 63 6f 6e 74 61 63 74 20 61 74 74 72 69 f 'contact attri
5540: 62 29 29 0a 20 20 20 20 20 20 20 20 28 6d 6f 64 b)). (mod
5550: 65 20 28 61 6c 69 73 74 2d 72 65 66 20 27 6d 6f e (alist-ref 'mo
5560: 64 65 20 61 74 74 72 69 62 29 29 29 20 0a 20 20 de attrib))) .
5570: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
5580: 69 6f 6e 73 0a 20 20 20 20 20 65 78 6e 0a 20 20 ions. exn.
5590: 20 20 20 28 6c 65 74 20 28 28 65 6d 73 67 20 28 (let ((emsg (
55a0: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
55b0: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
55c0: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
55d0: 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 53 65 6e )). ;; Sen
55e0: 64 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 20 20 d notification
55f0: 20 20 20 20 0a 20 20 20 20 20 20 20 28 70 72 69 . (pri
5600: 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 nt "ERROR: Faile
5610: 64 20 74 6f 20 63 6f 6e 6e 65 63 74 20 2f 20 73 d to connect / s
5620: 65 6e 64 20 74 6f 20 22 20 75 72 69 20 22 20 6d end to " uri " m
5630: 65 73 73 61 67 65 20 77 61 73 20 5c 22 22 20 65 essage was \"" e
5640: 6d 73 67 20 22 5c 22 22 20 29 0a 20 20 20 20 20 msg "\"" ).
5650: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
5660: 6d 6f 64 65 20 22 70 72 6f 64 75 63 74 69 6f 6e mode "production
5670: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
5680: 28 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 20 (begin .
5690: 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 53 65 (print " Se
56a0: 6e 64 69 6e 67 20 65 6d 61 69 6c 20 74 6f 20 63 nding email to c
56b0: 6f 6e 74 61 63 74 73 20 3a 20 22 20 63 6f 6e 74 ontacts : " cont
56c0: 61 63 74 73 20 29 0a 20 20 20 20 20 20 20 20 20 acts ).
56d0: 20 20 20 20 28 6c 65 74 20 28 28 65 6d 61 69 6c (let ((email
56e0: 2d 62 6f 64 79 20 28 6d 74 75 74 3a 73 74 6d 6c -body (mtut:stml
56f0: 2d 3e 73 74 72 69 6e 67 20 28 73 3a 62 6f 64 79 ->string (s:body
5700: 0a 09 09 09 09 09 09 09 09 09 09 28 73 3a 70 20 ...........(s:p
5710: 28 63 6f 6e 63 20 22 57 65 20 63 6f 75 6c 64 20 (conc "We could
5720: 6e 6f 74 20 73 65 6e 64 20 6d 65 73 73 61 67 65 not send message
5730: 73 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 20 s to the server
5740: 6f 6e 20 22 20 75 72 69 20 22 2e 22 20 20 22 50 on " uri "." "P
5750: 6c 65 61 73 65 20 63 68 65 63 6b 20 69 66 20 74 lease check if t
5760: 68 65 20 6c 69 73 74 6e 65 72 20 69 73 20 72 75 he listner is ru
5770: 6e 6e 69 6e 67 2e 20 49 74 20 69 73 20 70 6f 73 nning. It is pos
5780: 73 69 62 6c 65 20 74 68 61 74 20 74 68 65 20 68 sible that the h
5790: 6f 73 74 20 69 73 20 6f 76 65 72 6c 6f 61 64 65 ost is overloade
57a0: 64 20 64 75 65 20 74 6f 20 77 68 69 63 68 20 69 d due to which i
57b0: 74 20 6d 61 79 20 74 61 6b 65 20 74 6f 6f 20 6c t may take too l
57c0: 6f 6e 67 20 74 6f 20 72 65 73 70 6f 6e 64 2e 20 ong to respond.
57d0: 5c 6e 20 43 6f 6e 74 61 63 74 20 79 6f 75 72 20 \n Contact your
57e0: 73 79 73 74 65 6d 20 61 64 6d 69 6e 73 74 72 61 system adminstra
57f0: 74 6f 72 20 69 66 20 73 65 72 76 65 72 20 6c 6f tor if server lo
5800: 61 64 20 69 73 20 68 69 67 68 2e 22 20 28 73 3a ad is high." (s:
5810: 62 72 29 22 20 54 68 61 6e 6b 20 59 6f 75 20 22 br)" Thank You "
5820: 29 20 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ) ))))).
5830: 20 20 20 20 20 28 73 65 6e 64 6d 61 69 6c 20 28 (sendmail (
5840: 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 28 73 74 72 string-join (str
5850: 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6e 74 61 63 ing-split contac
5860: 74 73 20 22 3b 22 20 29 29 20 28 63 6f 6e 63 20 ts ";" )) (conc
5870: 22 5b 4c 69 73 74 6e 65 72 20 45 72 72 6f 72 5d "[Listner Error]
5880: 20 46 69 6c 65 64 20 74 6f 20 63 6f 6e 6e 65 63 Filed to connec
5890: 74 20 74 6f 20 6c 69 73 74 6e 65 72 20 6f 6e 20 t to listner on
58a0: 22 20 75 72 69 29 20 65 6d 61 69 6c 2d 62 6f 64 " uri) email-bod
58b0: 79 20 20 75 73 65 5f 68 74 6d 6c 3a 20 23 74 29 y use_html: #t)
58c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
58d0: 28 70 72 69 6e 74 20 22 20 6d 6f 64 65 20 3a 20 (print " mode :
58e0: 22 20 6d 6f 64 65 20 22 20 4e 6f 74 20 73 65 6e " mode " Not sen
58f0: 64 69 6e 67 20 61 6e 79 20 65 6d 61 69 6c 73 22 ding any emails"
5900: 20 29 29 0a 20 20 20 20 20 20 20 23 66 29 0a 20 )). #f).
5910: 20 20 20 20 28 6e 6e 2d 63 6f 6e 6e 65 63 74 20 (nn-connect
5920: 72 65 71 20 75 72 69 29 0a 20 20 20 20 20 28 70 req uri). (p
5930: 72 69 6e 74 20 22 43 6f 6e 6e 65 63 74 65 64 20 rint "Connected
5940: 74 6f 20 74 68 65 20 73 65 72 76 65 72 20 22 20 to the server "
5950: 29 0a 20 20 20 20 20 28 6e 6e 2d 73 65 6e 64 20 ). (nn-send
5960: 72 65 71 20 6d 73 67 29 0a 20 20 20 20 20 28 70 req msg). (p
5970: 72 69 6e 74 20 22 52 65 71 75 65 73 74 20 53 65 rint "Request Se
5980: 6e 74 22 29 20 20 0a 20 20 20 20 20 3b 3b 20 72 nt") . ;; r
5990: 65 63 65 69 76 65 20 63 6f 64 65 20 68 65 72 65 eceive code here
59a0: 0a 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 28 . ;;(print (
59b0: 6e 6e 2d 72 65 63 76 20 72 65 71 29 29 0a 20 20 nn-recv req)).
59c0: 20 20 20 28 6c 65 74 2a 20 28 28 74 68 31 20 20 (let* ((th1
59d0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 (make-thread (la
59e0: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda ().
59f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a00: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
5a10: 72 65 73 70 20 28 6e 6e 2d 72 65 63 76 20 72 65 resp (nn-recv re
5a20: 71 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 q))).
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a40: 20 20 20 20 20 20 20 20 28 6e 6e 2d 63 6c 6f 73 (nn-clos
5a50: 65 20 72 65 71 29 0a 20 20 20 20 20 20 20 20 20 e req).
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a70: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
5a80: 20 72 65 73 70 29 0a 20 20 20 20 20 20 20 20 20 resp).
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5aa0: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
5ab0: 72 65 73 20 28 69 66 20 28 65 71 75 61 6c 3f 20 res (if (equal?
5ac0: 72 65 73 70 20 22 6f 6b 22 29 0a 20 20 20 20 20 resp "ok").
5ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5af0: 20 20 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 #t.
5b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b30: 23 66 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f)))).
5b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b50: 20 20 20 20 20 20 22 72 65 63 76 20 74 68 72 65 "recv thre
5b60: 61 64 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 ad")).
5b70: 20 20 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 (th2 (make-thr
5b80: 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 ead (lambda ().
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5bb0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 74 69 thread-sleep! ti
5bc0: 6d 65 6f 75 74 29 0a 20 20 20 20 20 20 20 20 20 meout).
5bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5be0: 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 74 (thread-t
5bf0: 65 72 6d 69 6e 61 74 65 21 20 74 68 31 29 29 0a erminate! th1)).
5c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 74 69 "ti
5c20: 6d 65 72 20 74 68 72 65 61 64 22 29 29 29 0a 20 mer thread"))).
5c30: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 (thread-st
5c40: 61 72 74 21 20 74 68 31 29 0a 20 20 20 20 20 20 art! th1).
5c50: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
5c60: 74 68 32 29 0a 20 20 20 20 20 20 20 28 74 68 72 th2). (thr
5c70: 65 61 64 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 20 ead-join! th1).
5c80: 20 20 20 20 20 20 72 65 73 29 29 29 29 0a 0a 3b res))))..;
5c90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5cd0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 75 6e 73 0a =======.;; Runs.
5ce0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5d20: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 6d 61 6b ========..;; mak
5d30: 65 20 61 20 72 75 6e 6e 61 6d 65 0a 3b 3b 0a 28 e a runname.;;.(
5d40: 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 72 75 6e define (make-run
5d50: 6e 61 6d 65 20 70 72 65 20 70 6f 73 74 29 0a 20 name pre post).
5d60: 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 0a 20 20 (time->string.
5d70: 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d (seconds->local-
5d80: 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 65 time (current-se
5d90: 63 6f 6e 64 73 29 29 20 22 25 59 77 25 56 2e 25 conds)) "%Yw%V.%
5da0: 77 2d 25 48 25 4d 22 29 29 0a 0a 3b 3b 20 63 6f w-%H%M"))..;; co
5db0: 6c 6c 65 63 74 2c 20 74 72 61 6e 73 6c 61 74 65 llect, translate
5dc0: 2c 20 63 6f 6c 6c 61 74 65 20 61 6e 64 20 61 73 , collate and as
5dd0: 73 65 6d 62 6c 65 20 61 20 70 6b 74 20 66 72 6f semble a pkt fro
5de0: 6d 20 74 68 65 20 63 6f 6d 6d 61 6e 64 2d 6c 69 m the command-li
5df0: 6e 65 0a 3b 3b 0a 3b 3b 20 73 63 68 65 64 20 3d ne.;;.;; sched =
5e00: 3e 20 66 6f 72 63 65 20 74 68 65 20 72 75 6e 20 > force the run
5e10: 73 74 61 72 74 20 74 69 6d 65 20 74 6f 20 62 65 start time to be
5e20: 20 72 65 63 6f 72 64 65 64 20 61 73 20 73 63 68 recorded as sch
5e30: 65 64 20 55 6e 69 78 0a 3b 3b 20 65 70 6f 63 68 ed Unix.;; epoch
5e40: 2e 20 54 68 69 73 20 61 6c 69 67 6e 73 20 74 69 . This aligns ti
5e50: 6d 65 73 20 70 72 6f 70 65 72 6c 79 20 66 6f 72 mes properly for
5e60: 20 74 72 69 67 67 65 72 73 20 69 6e 20 73 6f 6d triggers in som
5e70: 65 20 63 61 73 65 73 2e 0a 3b 3b 0a 3b 3b 20 20 e cases..;;.;;
5e80: 65 78 74 72 61 2d 64 61 74 20 66 6f 72 6d 61 74 extra-dat format
5e90: 20 69 73 20 28 20 27 78 20 78 76 61 6c 20 27 79 is ( 'x xval 'y
5ea0: 20 79 76 61 6c 20 2e 2e 2e 2e 20 29 0a 3b 3b 0a yval .... ).;;.
5eb0: 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d 61 6e 64 (define (command
5ec0: 2d 6c 69 6e 65 2d 3e 70 6b 74 20 61 63 74 69 6f -line->pkt actio
5ed0: 6e 20 61 72 67 73 2d 61 6c 69 73 74 20 73 63 68 n args-alist sch
5ee0: 65 64 2d 69 6e 20 23 21 6b 65 79 20 28 65 78 74 ed-in #!key (ext
5ef0: 72 61 2d 64 61 74 20 27 28 29 29 28 61 72 65 61 ra-dat '())(area
5f00: 2d 70 61 74 68 20 23 66 29 28 6e 65 77 2d 73 73 -path #f)(new-ss
5f10: 20 23 66 29 29 0a 20 20 20 28 6c 65 74 2a 20 28 #f)). (let* (
5f20: 28 73 63 68 65 64 20 20 20 20 20 28 63 6f 6e 64 (sched (cond
5f30: 0a 09 09 20 20 20 20 20 28 28 76 65 63 74 6f 72 ... ((vector
5f40: 3f 20 73 63 68 65 64 2d 69 6e 29 28 6c 6f 63 61 ? sched-in)(loca
5f50: 6c 2d 74 69 6d 65 2d 3e 73 65 63 6f 6e 64 73 20 l-time->seconds
5f60: 73 63 68 65 64 2d 69 6e 29 29 20 3b 3b 20 77 65 sched-in)) ;; we
5f70: 20 72 65 63 69 65 76 65 64 20 61 20 74 69 6d 65 recieved a time
5f80: 0a 09 09 20 20 20 20 20 28 28 6e 75 6d 62 65 72 ... ((number
5f90: 3f 20 73 63 68 65 64 2d 69 6e 29 20 73 63 68 65 ? sched-in) sche
5fa0: 64 2d 69 6e 29 0a 09 09 20 20 20 20 20 28 65 6c d-in)... (el
5fb0: 73 65 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d se (current-
5fc0: 73 65 63 6f 6e 64 73 29 29 29 29 0a 20 20 20 28 seconds)))). (
5fd0: 75 73 65 72 20 20 28 69 66 20 28 61 6e 64 20 61 user (if (and a
5fe0: 72 67 73 2d 61 6c 69 73 74 20 28 68 61 73 68 2d rgs-alist (hash-
5ff0: 74 61 62 6c 65 3f 20 61 72 67 73 2d 61 6c 69 73 table? args-alis
6000: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
6010: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
6020: 66 2f 64 65 66 61 75 6c 74 20 61 72 67 73 2d 61 f/default args-a
6030: 6c 69 73 74 20 22 2d 6f 76 65 72 72 69 64 65 2d list "-override-
6040: 75 73 65 72 22 20 28 63 75 72 72 65 6e 74 2d 75 user" (current-u
6050: 73 65 72 2d 6e 61 6d 65 29 29 0a 09 09 09 09 09 ser-name))......
6060: 09 20 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 . (current-user
6070: 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 20 20 20 -name))).
6080: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 20 ..
6090: 28 61 72 67 73 2d 64 61 74 61 20 28 69 66 20 61 (args-data (if a
60a0: 72 67 73 2d 61 6c 69 73 74 0a 09 09 09 28 69 66 rgs-alist....(if
60b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 61 72 (hash-table? ar
60c0: 67 73 2d 61 6c 69 73 74 29 20 3b 3b 20 73 65 72 gs-alist) ;; ser
60d0: 69 6f 75 73 6c 79 3f 0a 09 09 09 20 20 20 20 28 iously?.... (
60e0: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
60f0: 74 20 61 72 67 73 2d 61 6c 69 73 74 29 0a 09 09 t args-alist)...
6100: 09 20 20 20 20 61 72 67 73 2d 61 6c 69 73 74 29 . args-alist)
6110: 0a 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ....(hash-table-
6120: 3e 61 6c 69 73 74 20 61 72 67 73 3a 61 72 67 2d >alist args:arg-
6130: 68 61 73 68 29 29 29 20 3b 3b 20 69 66 20 6e 6f hash))) ;; if no
6140: 20 61 72 67 73 2d 61 6c 69 73 74 20 74 68 65 6e args-alist then
6150: 20 77 65 20 61 73 73 75 6d 65 20 74 68 69 73 20 we assume this
6160: 69 73 20 61 20 63 61 6c 6c 20 64 72 69 76 65 6e is a call driven
6170: 20 64 69 72 65 63 74 6c 79 20 62 79 20 63 6f 6d directly by com
6180: 6d 61 6e 64 6c 69 6e 65 0a 09 20 28 61 6c 6c 64 mandline.. (alld
6190: 61 74 20 20 20 20 28 61 70 70 6c 79 20 61 70 70 at (apply app
61a0: 65 6e 64 0a 09 09 09 20 20 20 28 6c 69 73 74 20 end.... (list
61b0: 27 41 20 61 63 74 69 6f 6e 0a 09 09 09 09 20 27 'A action..... '
61c0: 55 20 75 73 65 72 0a 09 09 09 09 20 27 44 20 73 U user..... 'D s
61d0: 63 68 65 64 29 0a 09 09 09 20 20 20 28 69 66 20 ched).... (if
61e0: 61 72 65 61 2d 70 61 74 68 0a 09 09 09 20 20 20 area-path....
61f0: 20 20 20 20 28 6c 69 73 74 20 27 53 20 61 72 65 (list 'S are
6200: 61 2d 70 61 74 68 29 20 3b 3b 20 74 68 65 20 61 a-path) ;; the a
6210: 72 65 61 2d 70 61 74 68 20 69 73 20 6d 61 70 70 rea-path is mapp
6220: 65 64 20 74 6f 20 74 68 65 20 73 74 61 72 74 2d ed to the start-
6230: 64 69 72 0a 09 09 09 20 20 20 20 20 20 20 27 28 dir.... '(
6240: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
6260: 66 20 28 6c 69 73 74 3f 20 65 78 74 72 61 2d 64 f (list? extra-d
6270: 61 74 29 0a 09 09 09 20 20 20 20 20 20 20 65 78 at).... ex
6280: 74 72 61 2d 64 61 74 0a 09 09 09 20 20 20 20 20 tra-dat....
6290: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 28 64 (begin..... (d
62a0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
62b0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
62c0: 22 45 52 52 4f 52 3a 20 63 6f 6d 6d 61 6e 64 2d "ERROR: command-
62d0: 6c 69 6e 65 2d 3e 70 6b 74 20 72 65 63 65 69 76 line->pkt receiv
62e0: 65 64 20 62 61 64 20 65 78 74 72 61 2d 64 61 74 ed bad extra-dat
62f0: 20 22 20 65 78 74 72 61 2d 64 61 74 29 0a 09 09 " extra-dat)...
6300: 09 09 20 27 28 29 29 29 0a 09 09 09 20 20 20 28 .. '())).... (
6310: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
6320: 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 70 61 .... (let* ((pa
6330: 72 61 6d 20 28 63 61 72 20 78 29 29 0a 09 09 09 ram (car x))....
6340: 09 09 20 28 76 61 6c 75 65 20 28 63 64 72 20 78 .. (value (cdr x
6350: 29 29 0a 09 09 09 09 09 20 28 70 6d 65 74 61 20 ))...... (pmeta
6360: 28 61 73 73 6f 63 20 70 61 72 61 6d 20 2a 61 72 (assoc param *ar
6370: 67 2d 6b 65 79 73 2a 29 29 20 20 20 20 3b 3b 20 g-keys*)) ;;
6380: 74 72 61 6e 73 6c 61 74 65 20 74 68 65 20 63 61 translate the ca
6390: 72 64 20 6b 65 79 20 74 6f 20 61 20 6d 65 67 61 rd key to a mega
63a0: 74 65 73 74 20 73 77 69 74 63 68 20 6f 72 20 70 test switch or p
63b0: 61 72 61 6d 65 74 65 72 0a 09 09 09 09 09 20 28 arameter...... (
63c0: 73 6d 65 74 61 20 28 61 73 73 6f 63 20 70 61 72 smeta (assoc par
63d0: 61 6d 20 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a am *switch-keys*
63e0: 29 29 20 3b 3b 20 66 69 72 73 74 20 6c 6f 6f 6b )) ;; first look
63f0: 75 70 20 74 68 65 20 6b 65 79 20 69 6e 20 61 72 up the key in ar
6400: 67 2d 6b 65 79 73 20 6f 72 20 73 77 69 74 63 68 g-keys or switch
6410: 2d 6b 65 79 73 0a 09 09 09 09 09 20 28 6d 65 74 -keys...... (met
6420: 61 20 20 28 69 66 20 28 6f 72 20 70 6d 65 74 61 a (if (or pmeta
6430: 20 73 6d 65 74 61 29 0a 09 09 09 09 09 09 20 20 smeta).......
6440: 20 20 28 63 64 72 20 28 6f 72 20 70 6d 65 74 61 (cdr (or pmeta
6450: 20 73 6d 65 74 61 29 29 20 20 20 3b 3b 20 66 6f smeta)) ;; fo
6460: 75 6e 64 20 69 74 3f 0a 09 09 09 09 09 09 20 20 und it?.......
6470: 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 #f))).
6480: 20 20 20 28 69 66 20 6d 65 74 61 20 20 20 20 20 (if meta
6490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64a0: 3b 3b 20 63 6f 6e 73 74 72 75 63 74 20 74 68 65 ;; construct the
64b0: 20 73 77 69 74 63 68 2f 70 61 72 61 6d 20 70 61 switch/param pa
64c0: 69 72 2e 0a 09 09 09 09 09 28 6c 69 73 74 20 6d ir.......(list m
64d0: 65 74 61 20 76 61 6c 75 65 29 0a 09 09 09 09 09 eta value)......
64e0: 27 28 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 '()))).
64f0: 20 0a 09 09 09 09 28 66 69 6c 74 65 72 20 63 64 .....(filter cd
6500: 72 20 61 72 67 73 2d 64 61 74 61 29 29 29 29 29 r args-data)))))
6510: 0a 20 20 20 20 28 70 72 69 6e 74 20 20 22 41 6c . (print "Al
6520: 6c 64 61 74 3a 20 22 20 61 6c 6c 64 61 74 20 20 ldat: " alldat
6530: 29 20 3b 3b 44 6f 20 6e 6f 74 20 72 65 6d 6f 76 ) ;;Do not remov
6540: 65 2e 20 54 68 69 73 20 69 73 20 75 65 73 65 64 e. This is uesed
6550: 20 62 79 20 6f 74 68 65 72 20 61 70 70 6c 69 63 by other applic
6560: 61 74 69 6f 6e 73 20 74 6f 20 63 61 6c 63 75 6c ations to calcul
6570: 61 74 65 20 7a 20 63 61 72 64 20 0a 20 20 20 20 ate z card .
6580: 3b 28 65 78 69 74 29 0a 20 20 20 20 28 61 64 64 ;(exit). (add
6590: 2d 7a 2d 63 61 72 64 0a 20 20 20 20 20 28 61 70 -z-card. (ap
65a0: 70 6c 79 20 63 6f 6e 73 74 72 75 63 74 2d 73 64 ply construct-sd
65b0: 61 74 20 61 6c 6c 64 61 74 29 29 29 29 0a 0a 28 at alldat))))..(
65c0: 64 65 66 69 6e 65 20 28 73 69 6d 70 6c 65 2d 73 define (simple-s
65d0: 65 74 75 70 20 73 74 61 72 74 2d 64 69 72 2d 69 etup start-dir-i
65e0: 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 n). (let* ((sta
65f0: 72 74 2d 64 69 72 20 28 6f 72 20 73 74 61 72 74 rt-dir (or start
6600: 2d 64 69 72 2d 69 6e 20 22 2e 22 29 29 0a 09 20 -dir-in "."))..
6610: 28 6d 74 63 6f 6e 66 69 67 20 20 28 6f 72 20 28 (mtconfig (or (
6620: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
6630: 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 onfig") "megates
6640: 74 2e 63 6f 6e 66 69 67 22 29 29 0a 09 20 28 6d t.config")).. (m
6650: 74 63 6f 6e 66 64 61 74 20 28 66 69 6e 64 2d 61 tconfdat (find-a
6660: 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 20 nd-read-config
6670: 20 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 73 65 ;; NB// se
6680: 74 73 20 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 ts MT_RUN_AREA_H
6690: 4f 4d 45 20 61 73 20 73 69 64 65 20 65 66 66 65 OME as side effe
66a0: 63 74 0a 09 09 20 20 20 20 20 6d 74 63 6f 6e 66 ct... mtconf
66b0: 69 67 0a 09 09 20 20 20 20 20 3b 3b 20 65 6e 76 ig... ;; env
66c0: 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d iron-patt: "env-
66d0: 6f 76 65 72 72 69 64 65 22 0a 09 09 20 20 20 20 override"...
66e0: 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 given-toppath:
66f0: 73 74 61 72 74 2d 64 69 72 0a 09 09 20 20 20 20 start-dir...
6700: 20 3b 3b 20 70 61 74 68 65 6e 76 76 61 72 3a 20 ;; pathenvvar:
6710: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
6720: 45 22 0a 09 09 20 20 20 20 20 29 29 0a 09 20 28 E"... )).. (
6730: 6d 74 63 6f 6e 66 20 20 20 20 28 69 66 20 6d 74 mtconf (if mt
6740: 63 6f 6e 66 64 61 74 20 28 63 61 72 20 6d 74 63 confdat (car mtc
6750: 6f 6e 66 64 61 74 29 20 23 66 29 29 29 0a 20 20 onfdat) #f))).
6760: 20 20 3b 3b 20 77 65 20 73 65 74 20 73 6f 6d 65 ;; we set some
6770: 20 64 79 6e 61 6d 69 63 20 64 61 74 61 20 69 6e dynamic data in
6780: 20 61 20 73 65 63 74 69 6f 6e 20 63 61 6c 6c 65 a section calle
6790: 64 20 22 73 63 72 61 74 63 68 64 61 74 61 22 0a d "scratchdata".
67a0: 20 20 20 20 28 69 66 20 6d 74 63 6f 6e 66 0a 09 (if mtconf..
67b0: 28 62 65 67 69 6e 0a 09 20 20 28 63 6f 6e 66 69 (begin.. (confi
67c0: 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 2d 73 gf:section-var-s
67d0: 65 74 21 20 6d 74 63 6f 6e 66 20 22 73 63 72 61 et! mtconf "scra
67e0: 74 63 68 64 61 74 22 20 22 74 6f 70 70 61 74 68 tchdat" "toppath
67f0: 22 20 73 74 61 72 74 2d 64 69 72 29 29 29 0a 20 " start-dir))).
6800: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 4f ;; (print "TO
6810: 50 50 41 54 48 3a 20 22 20 28 63 6f 6e 66 69 67 PPATH: " (config
6820: 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 f:lookup mtconf
6830: 22 73 63 72 61 74 63 68 64 61 74 22 20 22 74 6f "scratchdat" "to
6840: 70 70 61 74 68 22 29 29 0a 20 20 20 20 6d 74 63 ppath")). mtc
6850: 6f 6e 66 64 61 74 29 29 0a 0a 3b 3b 3d 3d 3d 3d onfdat))..;;====
6860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68a0: 3d 3d 0a 3b 3b 20 41 72 65 61 73 0a 3b 3b 3d 3d ==.;; Areas.;;==
68b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
68f0: 3d 3d 3d 3d 0a 0a 3b 3b 20 6c 6f 6f 6b 20 66 6f ====..;; look fo
6900: 72 20 61 72 65 61 73 3d 61 31 2c 61 32 2c 61 33 r areas=a1,a2,a3
6910: 20 4f 52 20 61 72 65 61 66 6e 3d 73 6f 6d 65 66 OR areafn=somef
6920: 75 6e 63 6e 61 6d 65 0a 3b 3b 0a 28 64 65 66 69 uncname.;;.(defi
6930: 6e 65 20 28 76 61 6c 2d 61 6c 69 73 74 2d 3e 61 ne (val-alist->a
6940: 72 65 61 73 20 76 61 6c 2d 61 6c 69 73 74 29 0a reas val-alist).
6950: 20 20 28 6c 65 74 20 28 28 61 72 65 61 73 2d 73 (let ((areas-s
6960: 74 72 69 6e 67 20 20 20 28 61 6c 69 73 74 2d 72 tring (alist-r
6970: 65 66 20 27 61 72 65 61 73 20 20 76 61 6c 2d 61 ef 'areas val-a
6980: 6c 69 73 74 29 29 0a 09 28 61 72 65 61 73 2d 70 list))..(areas-p
6990: 72 6f 63 6e 61 6d 65 20 28 61 6c 69 73 74 2d 72 rocname (alist-r
69a0: 65 66 20 27 61 72 65 61 66 6e 20 76 61 6c 2d 61 ef 'areafn val-a
69b0: 6c 69 73 74 29 29 29 0a 20 20 20 20 28 69 66 20 list))). (if
69c0: 61 72 65 61 73 2d 70 72 6f 63 6e 61 6d 65 20 3b areas-procname ;
69d0: 3b 20 61 72 65 61 73 2d 70 72 6f 63 6e 61 6d 65 ; areas-procname
69e0: 20 74 61 6b 65 20 70 72 65 63 65 64 65 6e 63 65 take precedence
69f0: 0a 09 61 72 65 61 73 2d 70 72 6f 63 6e 61 6d 65 ..areas-procname
6a00: 0a 09 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 ..(string-split
6a10: 28 6f 72 20 61 72 65 61 73 2d 73 74 72 69 6e 67 (or areas-string
6a20: 20 22 22 29 20 22 2c 22 29 29 29 29 0a 0a 3b 3b "") ","))))..;;
6a30: 20 61 72 65 61 20 20 20 2d 20 74 68 65 20 63 75 area - the cu
6a40: 72 72 65 6e 74 20 61 72 65 61 20 75 6e 64 65 72 rrent area under
6a50: 20 63 6f 6e 73 69 64 65 72 61 74 69 6f 6e 0a 3b consideration.;
6a60: 3b 20 61 72 65 61 73 20 20 2d 20 74 68 65 20 6c ; areas - the l
6a70: 69 73 74 20 6f 66 20 61 6c 6c 6f 77 65 64 20 61 ist of allowed a
6a80: 72 65 61 73 20 66 72 6f 6d 20 74 68 65 20 63 6f reas from the co
6a90: 6e 74 6f 75 72 20 73 70 65 63 20 2d 4f 52 2d 0a ntour spec -OR-.
6aa0: 3b 3b 20 20 20 20 20 20 20 20 20 20 69 66 20 69 ;; if i
6ab0: 74 20 69 73 20 61 20 73 74 72 69 6e 67 20 74 68 t is a string th
6ac0: 65 6e 20 69 74 20 69 73 20 74 68 65 20 66 75 6e en it is the fun
6ad0: 63 74 69 6f 6e 20 74 6f 20 75 73 65 20 74 6f 0a ction to use to.
6ae0: 3b 3b 20 20 20 20 20 20 20 20 20 20 6c 6f 6f 6b ;; look
6af0: 75 70 20 69 6e 20 2a 61 72 65 61 2d 63 68 65 63 up in *area-chec
6b00: 6b 65 72 73 2a 0a 3b 3b 0a 28 64 65 66 69 6e 65 kers*.;;.(define
6b10: 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 (area-allowed?
6b20: 61 72 65 61 20 61 72 65 61 73 20 72 75 6e 6b 65 area areas runke
6b30: 79 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 y contour mode-p
6b40: 61 74 74 29 0a 20 20 3b 3b 28 70 72 69 6e 74 20 att). ;;(print
6b50: 22 41 72 65 61 73 3a 20 22 20 61 72 65 61 73 29 "Areas: " areas)
6b60: 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e 6f . (cond. ((no
6b70: 74 20 61 72 65 61 73 29 20 23 74 29 20 3b 3b 20 t areas) #t) ;;
6b80: 6e 6f 20 73 70 65 63 0a 20 20 20 28 28 73 74 72 no spec. ((str
6b90: 69 6e 67 3f 20 61 72 65 61 73 29 20 3b 3b 20 0a ing? areas) ;; .
6ba0: 20 20 20 20 28 6c 65 74 20 28 28 63 68 65 63 6b (let ((check
6bb0: 2d 66 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d -fn (hash-table-
6bc0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 61 72 65 ref/default *are
6bd0: 61 2d 63 68 65 63 6b 65 72 73 2a 20 28 73 74 72 a-checkers* (str
6be0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 72 65 61 ing->symbol area
6bf0: 73 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 s) #f))). (
6c00: 69 66 20 63 68 65 63 6b 2d 66 6e 0a 09 20 20 28 if check-fn.. (
6c10: 63 68 65 63 6b 2d 66 6e 20 61 72 65 61 20 72 75 check-fn area ru
6c20: 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 nkey contour mod
6c30: 65 2d 70 61 74 74 29 0a 09 20 20 23 66 29 29 29 e-patt).. #f)))
6c40: 0a 20 20 20 28 28 6c 69 73 74 3f 20 61 72 65 61 . ((list? area
6c50: 73 29 28 6d 65 6d 62 65 72 20 61 72 65 61 20 61 s)(member area a
6c60: 72 65 61 73 29 29 0a 20 20 20 28 65 6c 73 65 20 reas)). (else
6c70: 23 66 29 29 29 20 3b 3b 20 73 68 6f 75 6c 64 6e #f))) ;; shouldn
6c80: 27 74 20 67 65 74 20 68 65 72 65 20 0a 0a 28 64 't get here ..(d
6c90: 65 66 69 6e 65 20 28 67 65 74 2d 61 72 65 61 2d efine (get-area-
6ca0: 6e 61 6d 65 73 20 6d 74 63 6f 6e 66 29 0a 20 20 names mtconf).
6cb0: 28 6d 61 70 20 63 61 72 20 28 63 6f 6e 66 69 67 (map car (config
6cc0: 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 f:get-section mt
6cd0: 63 6f 6e 66 20 22 61 72 65 61 73 22 29 29 29 0a conf "areas"))).
6ce0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 50 6b 74 =========.;; Pkt
6d30: 73 20 66 6f 72 20 72 65 6d 6f 74 65 20 63 6f 6e s for remote con
6d40: 74 72 6f 6c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d trol.;;=========
6d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
6d90: 3b 20 4e 45 45 44 20 54 49 4d 45 53 54 41 4d 50 ; NEED TIMESTAMP
6da0: 20 4f 4e 20 50 4b 54 53 20 66 6f 72 20 65 66 66 ON PKTS for eff
6db0: 69 63 69 65 6e 74 20 6c 6f 61 64 69 6e 67 20 6f icient loading o
6dc0: 66 20 70 61 63 6b 65 74 73 20 69 6e 74 6f 20 64 f packets into d
6dd0: 62 2e 0a 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 b....;; make a r
6de0: 75 6e 20 72 65 71 75 65 73 74 20 70 6b 74 20 66 un request pkt f
6df0: 72 6f 6d 20 62 61 73 69 63 20 64 61 74 61 2c 20 rom basic data,
6e00: 74 68 69 73 20 73 65 72 69 6f 75 73 6c 79 20 6e this seriously n
6e10: 65 65 64 73 20 74 6f 20 62 65 20 72 65 66 61 63 eeds to be refac
6e20: 74 6f 72 65 64 0a 3b 3b 20 20 20 69 2e 20 54 61 tored.;; i. Ta
6e30: 6b 65 20 74 68 65 20 63 6f 64 65 20 74 68 61 74 ke the code that
6e40: 20 62 75 69 6c 64 73 20 74 68 65 20 69 6e 66 6f builds the info
6e50: 20 74 6f 20 73 75 62 6d 69 74 20 74 6f 20 63 72 to submit to cr
6e60: 65 61 74 65 2d 72 75 6e 2d 70 6b 74 20 61 6e 64 eate-run-pkt and
6e70: 20 68 61 76 65 20 69 74 0a 3b 3b 20 20 20 20 20 have it.;;
6e80: 20 67 65 6e 65 72 61 74 65 20 74 68 65 20 70 6b generate the pk
6e90: 74 20 6b 65 79 73 20 64 69 72 65 63 74 6c 79 2e t keys directly.
6ea0: 0a 3b 3b 20 20 69 69 2e 20 50 61 73 73 20 74 68 .;; ii. Pass th
6eb0: 65 20 70 6b 74 20 6b 65 79 73 20 61 6e 64 20 76 e pkt keys and v
6ec0: 61 6c 75 65 73 20 74 6f 20 74 68 69 73 20 70 72 alues to this pr
6ed0: 6f 63 20 61 6e 64 20 67 6f 20 66 72 6f 6d 20 74 oc and go from t
6ee0: 68 65 72 65 2e 0a 3b 3b 20 69 69 69 2e 20 4d 61 here..;; iii. Ma
6ef0: 79 62 65 20 68 61 76 65 20 61 6e 20 61 62 73 74 ybe have an abst
6f00: 72 61 63 74 69 6f 6e 20 61 6c 69 73 74 20 77 69 raction alist wi
6f10: 74 68 20 6d 65 61 6e 69 6e 67 66 75 6c 20 6e 61 th meaningful na
6f20: 6d 65 73 20 66 6f 72 20 74 68 65 20 70 6b 74 20 mes for the pkt
6f30: 6b 65 79 73 0a 3b 3b 0a 3b 3b 20 4f 76 65 72 72 keys.;;.;; Overr
6f40: 69 64 65 20 74 68 65 20 72 75 6e 20 73 74 61 72 ide the run star
6f50: 74 20 74 69 6d 65 20 72 65 63 6f 72 64 20 77 69 t time record wi
6f60: 74 68 20 73 63 68 65 64 2e 20 55 73 75 61 6c 6c th sched. Usuall
6f70: 79 20 23 66 20 69 73 20 66 69 6e 65 2e 0a 3b 3b y #f is fine..;;
6f80: 20 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 .(define (creat
6f90: 65 2d 72 75 6e 2d 70 6b 74 20 6d 74 63 6f 6e 66 e-run-pkt mtconf
6fa0: 20 61 63 74 69 6f 6e 20 61 72 65 61 20 72 75 6e action area run
6fb0: 6b 65 79 20 74 61 72 67 65 74 20 72 75 6e 6e 61 key target runna
6fc0: 6d 65 20 6d 6f 64 65 2d 70 61 74 74 20 0a 20 20 me mode-patt .
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 20 20 20 20 20 74 61 67 2d 65 78 70 72 20 70 tag-expr p
6ff0: 6b 74 73 64 69 72 20 72 65 61 73 6f 6e 20 63 6f ktsdir reason co
7000: 6e 74 6f 75 72 20 73 63 68 65 64 20 64 62 64 65 ntour sched dbde
7010: 73 74 20 61 70 70 65 6e 64 2d 63 6f 6e 66 0a 20 st append-conf.
7020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7030: 20 20 20 20 20 20 20 72 75 6e 74 72 61 6e 73 29 runtrans)
7040: 0a 20 20 28 6c 65 74 2a 20 28 28 67 6f 6f 64 2d . (let* ((good-
7050: 76 61 6c 20 20 20 28 6c 61 6d 62 64 61 20 28 69 val (lambda (i
7060: 6e 76 61 6c 29 28 61 6e 64 20 69 6e 76 61 6c 20 nval)(and inval
7070: 28 73 74 72 69 6e 67 3f 20 69 6e 76 61 6c 29 28 (string? inval)(
7080: 6e 6f 74 20 28 73 74 72 69 6e 67 2d 6e 75 6c 6c not (string-null
7090: 3f 20 69 6e 76 61 6c 29 29 29 29 29 0a 09 20 28 ? inval))))).. (
70a0: 61 72 65 61 2d 64 61 74 20 20 20 28 63 6f 6d 6d area-dat (comm
70b0: 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 28 6f on:val->alist (o
70c0: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
70d0: 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 22 p mtconf "areas"
70e0: 20 61 72 65 61 29 20 22 22 29 29 29 0a 09 20 28 area) ""))).. (
70f0: 61 72 65 61 2d 70 61 74 68 20 20 28 61 6c 69 73 area-path (alis
7100: 74 2d 72 65 66 20 27 70 61 74 68 20 20 20 20 20 t-ref 'path
7110: 20 61 72 65 61 2d 64 61 74 29 29 0a 09 20 3b 3b area-dat)).. ;;
7120: 20 28 61 72 65 61 2d 78 6c 61 74 72 20 28 61 6c (area-xlatr (al
7130: 69 73 74 2d 72 65 66 20 27 74 61 72 67 74 72 61 ist-ref 'targtra
7140: 6e 73 20 61 72 65 61 2d 64 61 74 29 29 0a 20 20 ns area-dat)).
7150: 20 20 20 20 20 20 20 3b 3b 20 28 78 6c 61 74 72 ;; (xlatr
7160: 2d 6b 65 79 20 20 28 69 66 20 61 72 65 61 2d 78 -key (if area-x
7170: 6c 61 74 72 20 28 73 74 72 69 6e 67 2d 3e 73 79 latr (string->sy
7180: 6d 62 6f 6c 20 61 72 65 61 2d 78 6c 61 74 72 29 mbol area-xlatr)
7190: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 28 #f)). (
71a0: 6e 65 77 2d 72 75 6e 6e 61 6d 65 20 28 6c 65 74 new-runname (let
71b0: 2a 20 28 28 63 61 6c 6c 6e 61 6d 65 20 28 69 66 * ((callname (if
71c0: 20 28 73 74 72 69 6e 67 3f 20 72 75 6e 74 72 61 (string? runtra
71d0: 6e 73 29 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 ns)(string->symb
71e0: 6f 6c 20 72 75 6e 74 72 61 6e 73 29 20 23 66 29 ol runtrans) #f)
71f0: 29 0a 09 09 09 20 20 20 20 20 28 6d 61 70 70 65 ).... (mappe
7200: 72 20 20 20 28 69 66 20 63 61 6c 6c 6e 61 6d 65 r (if callname
7210: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
7220: 2f 64 65 66 61 75 6c 74 20 2a 72 75 6e 6e 61 6d /default *runnam
7230: 65 2d 6d 61 70 70 65 72 73 2a 20 63 61 6c 6c 6e e-mappers* calln
7240: 61 6d 65 20 23 66 29 20 23 66 29 29 29 0a 09 09 ame #f) #f)))...
7250: 09 3b 3b 20 28 70 72 69 6e 74 20 22 63 61 6c 6c .;; (print "call
7260: 6e 61 6d 65 3d 22 20 63 61 6c 6c 6e 61 6d 65 20 name=" callname
7270: 22 20 72 75 6e 74 72 61 6e 73 3d 22 20 72 75 6e " runtrans=" run
7280: 74 72 61 6e 73 20 22 20 6d 61 70 70 65 72 3d 22 trans " mapper="
7290: 20 6d 61 70 70 65 72 29 0a 09 09 09 28 69 66 20 mapper)....(if
72a0: 28 61 6e 64 20 63 61 6c 6c 6e 61 6d 65 0a 09 09 (and callname...
72b0: 09 09 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 .. (not (equal?
72c0: 63 61 6c 6c 6e 61 6d 65 20 22 61 75 74 6f 22 29 callname "auto")
72d0: 29 0a 09 09 09 09 20 28 6e 6f 74 20 6d 61 70 70 )..... (not mapp
72e0: 65 72 29 29 0a 09 09 09 20 20 20 20 28 70 72 69 er)).... (pri
72f0: 6e 74 20 22 4e 6f 20 6d 61 70 70 65 72 20 22 20 nt "No mapper "
7300: 63 61 6c 6c 6e 61 6d 65 20 22 20 66 6f 72 20 61 callname " for a
7310: 72 65 61 20 22 20 61 72 65 61 20 22 20 75 73 69 rea " area " usi
7320: 6e 67 20 22 20 63 61 6c 6c 6e 61 6d 65 20 22 20 ng " callname "
7330: 61 73 20 74 68 65 20 72 75 6e 6e 61 6d 65 22 29 as the runname")
7340: 29 0a 09 09 09 28 69 66 20 6d 61 70 70 65 72 0a )....(if mapper.
7350: 09 09 09 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 ... (handle-e
7360: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 65 78 xceptions.....ex
7370: 6e 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 n.....(begin....
7380: 09 20 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 . (print-call-c
7390: 68 61 69 6e 29 0a 09 09 09 09 20 20 28 70 72 69 hain)..... (pri
73a0: 6e 74 20 22 46 41 49 4c 45 44 20 54 4f 20 52 55 nt "FAILED TO RU
73b0: 4e 20 52 55 4e 4e 41 4d 45 20 4d 41 50 50 45 52 N RUNNAME MAPPER
73c0: 20 22 20 63 61 6c 6c 6e 61 6d 65 20 22 20 46 4f " callname " FO
73d0: 52 20 41 52 45 41 20 22 20 61 72 65 61 29 0a 09 R AREA " area)..
73e0: 09 09 09 20 20 28 70 72 69 6e 74 20 22 20 6d 65 ... (print " me
73f0: 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 ssage: " ((condi
7400: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
7410: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
7420: 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 sage) exn)).....
7430: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 20 20 runname)....
7440: 20 20 20 20 28 70 72 69 6e 74 20 22 28 6d 61 70 (print "(map
7450: 70 65 72 20 22 20 28 73 74 72 69 6e 67 2d 69 6e per " (string-in
7460: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c
7470: 6f 6e 63 20 28 6c 69 73 74 20 72 75 6e 6b 65 79 onc (list runkey
7480: 20 72 75 6e 6e 61 6d 65 20 61 72 65 61 20 61 72 runname area ar
7490: 65 61 2d 70 61 74 68 20 72 65 61 73 6f 6e 20 63 ea-path reason c
74a0: 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 ontour mode-patt
74b0: 29 29 20 22 2c 20 22 29 20 22 29 22 29 0a 09 09 )) ", ") ")")...
74c0: 09 20 20 20 20 20 20 28 6d 61 70 70 65 72 20 72 . (mapper r
74d0: 75 6e 6b 65 79 20 72 75 6e 6e 61 6d 65 20 61 72 unkey runname ar
74e0: 65 61 20 61 72 65 61 2d 70 61 74 68 20 72 65 61 ea area-path rea
74f0: 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 65 son contour mode
7500: 2d 70 61 74 74 29 29 0a 09 09 09 20 20 20 20 28 -patt)).... (
7510: 63 61 73 65 20 63 61 6c 6c 6e 61 6d 65 0a 09 09 case callname...
7520: 09 20 20 20 20 20 20 28 28 61 75 74 6f 20 23 66 . ((auto #f
7530: 29 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 20 20 ) runname)....
7540: 20 20 20 20 28 65 6c 73 65 20 20 20 72 75 6e 74 (else runt
7550: 72 61 6e 73 29 29 29 29 29 0a 09 20 28 6e 65 77 rans))))).. (new
7560: 2d 74 61 72 67 65 74 20 20 20 20 20 74 61 72 67 -target targ
7570: 65 74 29 20 3b 3b 20 49 20 62 65 6c 69 65 76 65 et) ;; I believe
7580: 20 77 65 20 77 69 6c 6c 20 77 61 6e 74 20 74 61 we will want ta
7590: 72 67 65 74 20 6d 61 6e 69 70 75 6c 61 74 69 6f rget manipulatio
75a0: 6e 20 68 65 72 65 20 2e 2e 20 28 6d 61 70 2d 74 n here .. (map-t
75b0: 61 72 67 65 74 73 20 78 6c 61 74 72 2d 6b 65 79 argets xlatr-key
75c0: 20 72 75 6e 6b 65 79 20 61 72 65 61 20 63 6f 6e runkey area con
75d0: 74 6f 75 72 29 29 0a 09 20 28 61 63 74 75 61 6c tour)).. (actual
75e0: 2d 61 63 74 69 6f 6e 20 20 28 69 66 20 61 63 74 -action (if act
75f0: 69 6f 6e 0a 09 09 09 20 20 20 20 20 28 69 66 20 ion.... (if
7600: 28 65 71 75 61 6c 3f 20 61 63 74 69 6f 6e 20 22 (equal? action "
7610: 73 79 6e 63 2d 70 72 65 70 65 6e 64 22 29 0a 09 sync-prepend")..
7620: 09 09 09 20 22 73 79 6e 63 22 0a 09 09 09 09 20 ... "sync".....
7630: 61 63 74 69 6f 6e 29 0a 09 09 09 20 20 20 20 20 action)....
7640: 22 72 75 6e 22 29 29 29 20 3b 3b 20 74 68 69 73 "run"))) ;; this
7650: 20 68 61 73 20 67 6f 74 74 65 6e 20 61 20 62 69 has gotten a bi
7660: 74 20 75 67 6c 79 2e 20 4e 65 65 64 20 61 20 66 t ugly. Need a f
7670: 75 6e 63 74 69 6f 6e 20 74 6f 20 68 61 6e 64 6c unction to handl
7680: 65 20 61 63 74 69 6f 6e 73 20 70 72 6f 63 65 73 e actions proces
7690: 73 69 6e 67 2e 0a 20 20 20 20 3b 3b 20 73 6f 6d sing.. ;; som
76a0: 65 20 68 61 63 6b 73 20 74 6f 20 72 65 6d 6f 76 e hacks to remov
76b0: 65 20 73 77 69 74 63 68 65 73 20 6e 6f 74 20 6e e switches not n
76c0: 65 65 64 65 64 20 69 6e 20 63 65 72 74 61 69 6e eeded in certain
76d0: 20 63 61 73 65 73 0a 20 20 20 20 28 63 61 73 65 cases. (case
76e0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
76f0: 20 28 6f 72 20 61 63 74 69 6f 6e 20 22 72 75 6e (or action "run
7700: 22 29 29 0a 20 20 20 20 20 20 28 28 73 79 6e 63 ")). ((sync
7710: 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 29 0a 20 sync-prepend).
7720: 20 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 2d (set! new-
7730: 74 61 72 67 65 74 20 23 66 29 0a 20 20 20 20 20 target #f).
7740: 20 20 28 73 65 74 21 20 72 75 6e 61 6d 65 20 20 (set! runame
7750: 20 20 20 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 #f))). ;;
7760: 28 70 72 69 6e 74 20 22 61 72 65 61 2d 70 61 74 (print "area-pat
7770: 68 3a 20 22 20 61 72 65 61 2d 70 61 74 68 20 22 h: " area-path "
7780: 20 6f 72 69 67 2d 74 61 72 67 65 74 3a 20 22 20 orig-target: "
7790: 72 75 6e 6b 65 79 20 22 20 6e 65 77 2d 74 61 72 runkey " new-tar
77a0: 67 65 74 3a 20 22 20 6e 65 77 2d 74 61 72 67 65 get: " new-targe
77b0: 74 29 0a 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 t). (let-valu
77c0: 65 73 20 28 28 28 75 75 69 64 20 70 6b 74 29 0a es (((uuid pkt).
77d0: 09 09 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e .. (command-lin
77e0: 65 2d 3e 70 6b 74 0a 09 09 20 20 20 61 63 74 75 e->pkt... actu
77f0: 61 6c 2d 61 63 74 69 6f 6e 0a 09 09 20 20 20 28 al-action... (
7800: 61 70 70 65 6e 64 20 0a 09 09 20 20 20 20 60 28 append ... `(
7810: 28 22 2d 73 74 61 72 74 2d 64 69 72 22 20 20 2e ("-start-dir" .
7820: 20 2c 61 72 65 61 2d 70 61 74 68 29 0a 09 09 20 ,area-path)...
7830: 20 20 20 20 20 3b 3b 28 22 2d 6d 73 67 22 20 20 ;;("-msg"
7840: 20 20 20 20 20 20 2e 20 2c 72 65 61 73 6f 6e 29 . ,reason)
7850: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7860: 20 20 20 20 20 20 20 28 22 2d 6d 73 67 22 20 20 ("-msg"
7870: 20 20 20 20 20 20 2e 20 2c 22 53 63 72 69 70 74 . ,"Script
7880: 2d 74 72 69 67 67 65 72 65 64 22 29 0a 09 09 20 -triggered")...
7890: 20 20 20 20 20 28 22 2d 63 6f 6e 74 6f 75 72 22 ("-contour"
78a0: 20 20 20 20 2e 20 2c 63 6f 6e 74 6f 75 72 29 29 . ,contour))
78b0: 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f 64 ... (if (good
78c0: 2d 76 61 6c 20 6e 65 77 2d 72 75 6e 6e 61 6d 65 -val new-runname
78d0: 29 20 60 28 28 22 2d 72 75 6e 2d 6e 61 6d 65 22 ) `(("-run-name"
78e0: 20 20 20 20 20 20 2e 20 2c 6e 65 77 2d 72 75 6e . ,new-run
78f0: 6e 61 6d 65 29 29 20 27 28 29 29 0a 09 09 20 20 name)) '())...
7900: 20 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c 20 (if (good-val
7910: 6e 65 77 2d 74 61 72 67 65 74 29 20 20 60 28 28 new-target) `((
7920: 22 2d 74 61 72 67 65 74 22 20 20 20 20 20 20 20 "-target"
7930: 20 2e 20 2c 6e 65 77 2d 74 61 72 67 65 74 29 29 . ,new-target))
7940: 20 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 '())... (if
7950: 20 28 67 6f 6f 64 2d 76 61 6c 20 61 72 65 61 29 (good-val area)
7960: 20 20 20 20 20 20 20 20 60 28 28 22 2d 61 72 65 `(("-are
7970: 61 22 20 20 20 20 20 20 20 20 20 20 2e 20 2c 61 a" . ,a
7980: 72 65 61 29 29 20 20 20 20 20 20 20 20 27 28 29 rea)) '()
7990: 29 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f )... (if (goo
79a0: 64 2d 76 61 6c 20 6d 6f 64 65 2d 70 61 74 74 29 d-val mode-patt)
79b0: 20 20 20 60 28 28 22 2d 6d 6f 64 65 2d 70 61 74 `(("-mode-pat
79c0: 74 22 20 20 20 20 20 2e 20 2c 6d 6f 64 65 2d 70 t" . ,mode-p
79d0: 61 74 74 29 29 20 20 20 27 28 29 29 0a 09 09 20 att)) '())...
79e0: 20 20 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c (if (good-val
79f0: 20 74 61 67 2d 65 78 70 72 29 20 20 20 20 60 28 tag-expr) `(
7a00: 28 22 2d 74 61 67 2d 65 78 70 72 22 20 20 20 20 ("-tag-expr"
7a10: 20 20 2e 20 2c 74 61 67 2d 65 78 70 72 29 29 20 . ,tag-expr))
7a20: 20 20 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 '())... (i
7a30: 66 20 28 67 6f 6f 64 2d 76 61 6c 20 64 62 64 65 f (good-val dbde
7a40: 73 74 29 20 20 20 20 20 20 60 28 28 22 2d 73 79 st) `(("-sy
7a50: 6e 63 2d 74 6f 22 20 20 20 20 20 20 20 2e 20 2c nc-to" . ,
7a60: 64 62 64 65 73 74 29 29 20 20 20 20 20 20 27 28 dbdest)) '(
7a70: 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f ))... (if (go
7a80: 6f 64 2d 76 61 6c 20 61 70 70 65 6e 64 2d 63 6f od-val append-co
7a90: 6e 66 29 20 60 28 28 22 2d 61 70 70 65 6e 64 2d nf) `(("-append-
7aa0: 63 6f 6e 66 69 67 22 20 2e 20 2c 61 70 70 65 6e config" . ,appen
7ab0: 64 2d 63 6f 6e 66 29 29 20 27 28 29 29 0a 09 09 d-conf)) '())...
7ac0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
7ad0: 61 63 74 69 6f 6e 20 22 73 79 6e 63 2d 70 72 65 action "sync-pre
7ae0: 70 65 6e 64 22 29 20 27 28 28 22 2d 70 72 65 70 pend") '(("-prep
7af0: 65 6e 64 2d 63 6f 6e 74 6f 75 72 22 20 2e 20 22 end-contour" . "
7b00: 20 22 29 29 20 20 20 27 28 29 29 0a 09 09 20 20 ")) '())...
7b10: 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 6d (if (not (or m
7b20: 6f 64 65 2d 70 61 74 74 20 74 61 67 2d 65 78 70 ode-patt tag-exp
7b30: 72 29 29 0a 09 09 09 60 28 28 22 2d 74 65 73 74 r))....`(("-test
7b40: 70 61 74 74 22 20 20 2e 20 22 25 22 29 29 0a 09 patt" . "%"))..
7b50: 09 09 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 ..'())... (if
7b60: 20 28 6f 72 20 28 6e 6f 74 20 61 63 74 69 6f 6e (or (not action
7b70: 29 0a 09 09 09 20 20 20 20 28 65 71 75 61 6c 3f ).... (equal?
7b80: 20 61 63 74 69 6f 6e 20 22 72 75 6e 22 29 29 0a action "run")).
7b90: 09 09 09 60 28 28 22 2d 70 72 65 63 6c 65 61 6e ...`(("-preclean
7ba0: 22 20 20 2e 20 22 20 22 29 0a 09 09 09 20 20 28 " . " ").... (
7bb0: 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 20 2e 20 22 "-rerun-all" . "
7bc0: 20 22 29 29 20 20 20 20 20 20 3b 3b 20 69 66 20 ")) ;; if
7bd0: 72 75 6e 20 77 65 20 2a 61 6c 77 61 79 73 2a 20 run we *always*
7be0: 77 61 6e 74 20 70 72 65 63 6c 65 61 6e 20 73 65 want preclean se
7bf0: 74 2c 20 75 73 65 20 73 69 6e 67 6c 65 20 73 70 t, use single sp
7c00: 61 63 65 20 61 73 20 70 6c 61 63 65 68 6f 6c 64 ace as placehold
7c10: 65 72 0a 09 09 09 27 28 29 29 0a 09 09 20 20 20 er....'())...
7c20: 20 29 0a 09 09 20 20 20 73 63 68 65 64 0a 20 20 )... sched.
7c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c40: 20 65 78 74 72 61 2d 64 61 74 3a 20 60 28 61 20 extra-dat: `(a
7c50: 2c 72 75 6e 6b 65 79 29 20 20 3b 3b 20 77 65 20 ,runkey) ;; we
7c60: 6e 65 65 64 20 74 68 65 20 72 75 6e 20 6b 65 79 need the run key
7c70: 20 66 6f 72 20 6d 61 72 6b 69 6e 67 20 74 68 65 for marking the
7c80: 20 72 75 6e 20 61 73 20 6c 61 75 6e 63 68 65 64 run as launched
7c90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7ca0: 20 20 20 20 29 29 29 0a 20 20 20 20 20 20 28 77 ))). (w
7cb0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
7cc0: 6c 65 0a 09 20 20 28 63 6f 6e 63 20 70 6b 74 73 le.. (conc pkts
7cd0: 64 69 72 20 22 2f 22 20 75 75 69 64 20 22 2e 70 dir "/" uuid ".p
7ce0: 6b 74 22 29 0a 09 28 6c 61 6d 62 64 61 20 28 29 kt")..(lambda ()
7cf0: 0a 09 20 20 28 70 72 69 6e 74 20 70 6b 74 29 29 .. (print pkt))
7d00: 29 29 29 29 0a 0a 3b 3b 20 28 75 73 65 20 74 72 ))))..;; (use tr
7d10: 61 63 65 29 28 74 72 61 63 65 20 63 72 65 61 74 ace)(trace creat
7d20: 65 2d 72 75 6e 2d 70 6b 74 29 0a 28 64 65 66 69 e-run-pkt).(defi
7d30: 6e 65 20 28 63 6f 6e 74 61 69 6e 73 20 6c 69 73 ne (contains lis
7d40: 74 20 78 29 20 28 63 6f 6e 64 20 28 28 6e 75 6c t x) (cond ((nul
7d50: 6c 3f 20 6c 69 73 74 29 20 23 66 29 20 28 28 65 l? list) #f) ((e
7d60: 71 3f 20 28 63 61 72 20 6c 69 73 74 29 20 78 29 q? (car list) x)
7d70: 20 23 74 29 20 28 65 6c 73 65 20 28 63 6f 6e 74 #t) (else (cont
7d80: 61 69 6e 73 20 28 63 64 72 20 6c 69 73 74 29 20 ains (cdr list)
7d90: 78 29 29 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 x))))..;; collec
7da0: 74 20 61 6c 6c 20 6e 65 65 64 65 64 20 64 61 74 t all needed dat
7db0: 61 20 61 6e 64 20 63 72 65 61 74 65 20 72 75 6e a and create run
7dc0: 20 70 6b 74 73 20 66 6f 72 20 63 6f 6e 74 6f 75 pkts for contou
7dd0: 72 73 20 77 69 74 68 20 63 68 61 6e 67 65 64 20 rs with changed
7de0: 69 6e 70 75 74 73 0a 3b 3b 0a 28 64 65 66 69 6e inputs.;;.(defin
7df0: 65 20 28 67 65 6e 65 72 61 74 65 2d 72 75 6e 2d e (generate-run-
7e00: 70 6b 74 73 20 6d 74 63 6f 6e 66 20 74 6f 70 70 pkts mtconf topp
7e10: 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 73 74 ath). (let ((st
7e20: 64 2d 72 75 6e 6e 61 6d 65 20 28 63 6f 6e 63 20 d-runname (conc
7e30: 22 73 63 68 65 64 22 20 20 28 74 69 6d 65 2d 3e "sched" (time->
7e40: 73 74 72 69 6e 67 20 28 73 65 63 6f 6e 64 73 2d string (seconds-
7e50: 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 28 63 75 72 >local-time (cur
7e60: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 22 rent-seconds)) "
7e70: 25 4d 25 48 25 64 22 29 29 29 0a 20 20 20 20 20 %M%H%d"))).
7e80: 20 20 20 28 70 61 63 6b 65 74 73 2d 67 65 6e 65 (packets-gene
7e90: 72 61 74 65 64 20 30 29 29 0a 20 20 20 20 28 63 rated 0)). (c
7ea0: 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 71 75 65 75 65 ommon:with-queue
7eb0: 2d 64 62 0a 20 20 20 20 20 6d 74 63 6f 6e 66 0a -db. mtconf.
7ec0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6b (lambda (pk
7ed0: 74 73 64 69 72 73 20 70 6b 74 73 64 69 72 20 70 tsdirs pktsdir p
7ee0: 64 62 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a db). (let*
7ef0: 20 28 28 72 67 63 6f 6e 66 64 61 74 20 28 66 69 ((rgconfdat (fi
7f00: 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 nd-and-read-conf
7f10: 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 ig (conc toppath
7f20: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
7f30: 6e 66 69 67 22 29 29 29 0a 09 20 20 20 20 20 20 nfig")))..
7f40: 28 72 67 63 6f 6e 66 20 20 20 20 28 63 61 72 20 (rgconf (car
7f50: 72 67 63 6f 6e 66 64 61 74 29 29 0a 09 20 20 20 rgconfdat))..
7f60: 20 20 20 28 61 6c 6c 2d 61 72 65 61 73 20 28 6d (all-areas (m
7f70: 61 70 20 63 61 72 20 28 63 6f 6e 66 69 67 66 3a ap car (configf:
7f80: 67 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f get-section mtco
7f90: 6e 66 20 22 61 72 65 61 73 22 29 29 29 0a 09 20 nf "areas")))..
7fa0: 20 20 20 20 20 28 63 6f 6e 74 6f 75 72 73 20 20 (contours
7fb0: 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 (configf:get-sec
7fc0: 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 63 6f 6e tion mtconf "con
7fd0: 74 6f 75 72 73 22 29 29 0a 09 20 20 20 20 20 20 tours"))..
7fe0: 28 74 6f 72 75 6e 20 20 20 20 20 28 6d 61 6b 65 (torun (make
7ff0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
8000: 20 74 61 72 67 65 74 20 3d 3e 20 28 20 2e 2e 2e target => ( ...
8010: 20 69 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 20 20 info ... )..
8020: 20 20 20 28 72 67 65 6e 74 61 72 67 73 20 28 68 (rgentargs (h
8030: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
8040: 67 63 6f 6e 66 29 29 29 20 3b 3b 20 74 68 65 73 gconf))) ;; thes
8050: 65 20 61 72 65 20 74 68 65 20 74 61 72 67 65 74 e are the target
8060: 73 20 72 65 67 69 73 74 65 72 65 64 20 66 6f 72 s registered for
8070: 20 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 74 automatically t
8080: 72 69 67 67 65 72 69 6e 67 0a 0a 09 20 3b 3b 28 riggering... ;;(
8090: 70 72 69 6e 74 20 22 72 67 65 6e 74 61 72 67 73 print "rgentargs
80a0: 3a 20 22 20 72 67 65 6e 74 61 72 67 73 29 0a 09 : " rgentargs)..
80b0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 28 (for-each.. (
80c0: 6c 61 6d 62 64 61 20 28 72 75 6e 6b 65 79 29 0a lambda (runkey).
80d0: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 . (let* ((key
80e0: 64 61 74 73 20 20 20 28 63 6f 6e 66 69 67 66 3a dats (configf:
80f0: 67 65 74 2d 73 65 63 74 69 6f 6e 20 72 67 63 6f get-section rgco
8100: 6e 66 20 72 75 6e 6b 65 79 29 29 29 0a 09 20 20 nf runkey)))..
8110: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 (for-each..
8120: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 (lambda (s
8130: 65 6e 73 65 29 20 3b 3b 20 74 68 65 73 65 20 61 ense) ;; these a
8140: 72 65 20 74 68 65 20 73 65 6e 73 65 20 72 75 6c re the sense rul
8150: 65 73 0a 09 09 20 28 6c 65 74 2a 20 28 28 6b 65 es... (let* ((ke
8160: 79 20 20 20 20 20 20 20 20 28 63 61 72 20 73 65 y (car se
8170: 6e 73 65 29 29 0a 09 09 09 28 76 61 6c 20 20 20 nse))....(val
8180: 20 20 20 20 20 28 63 61 64 72 20 73 65 6e 73 65 (cadr sense
8190: 29 29 0a 09 09 09 28 6b 65 79 70 61 72 74 73 20 ))....(keyparts
81a0: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
81b0: 6b 65 79 20 22 3a 22 29 29 20 3b 3b 20 63 6f 6e key ":")) ;; con
81c0: 74 6f 75 72 3a 72 75 6c 65 74 79 70 65 3a 61 63 tour:ruletype:ac
81d0: 74 69 6f 6e 3a 6f 70 74 69 6f 6e 61 6c 0a 09 09 tion:optional...
81e0: 09 28 63 6f 6e 74 6f 75 72 20 20 20 20 28 63 61 .(contour (ca
81f0: 72 20 6b 65 79 70 61 72 74 73 29 29 0a 09 09 09 r keyparts))....
8200: 28 6c 65 6e 2d 6b 65 79 20 20 20 20 28 6c 65 6e (len-key (len
8210: 67 74 68 20 6b 65 79 70 61 72 74 73 29 29 0a 09 gth keyparts))..
8220: 09 09 28 72 75 6c 65 74 79 70 65 20 20 20 28 69 ..(ruletype (i
8230: 66 20 28 3e 20 6c 65 6e 2d 6b 65 79 20 31 29 28 f (> len-key 1)(
8240: 63 61 64 72 20 6b 65 79 70 61 72 74 73 29 20 23 cadr keyparts) #
8250: 66 29 29 0a 09 09 09 28 61 63 74 69 6f 6e 20 20 f))....(action
8260: 20 20 20 28 69 66 20 28 3e 20 6c 65 6e 2d 6b 65 (if (> len-ke
8270: 79 20 32 29 28 63 61 64 64 72 20 6b 65 79 70 61 y 2)(caddr keypa
8280: 72 74 73 29 20 23 66 29 29 0a 09 09 09 28 6f 70 rts) #f))....(op
8290: 74 69 6f 6e 61 6c 20 20 20 28 69 66 20 28 3e 20 tional (if (>
82a0: 6c 65 6e 2d 6b 65 79 20 33 29 28 63 61 64 64 64 len-key 3)(caddd
82b0: 72 20 6b 65 79 70 61 72 74 73 29 20 23 66 29 29 r keyparts) #f))
82c0: 0a 09 09 09 3b 3b 20 28 76 61 6c 2d 6c 69 73 74 ....;; (val-list
82d0: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
82e0: 2d 66 69 65 6c 64 73 20 22 3b 5c 5c 73 2a 22 20 -fields ";\\s*"
82f0: 76 61 6c 20 23 3a 69 6e 66 69 78 29 29 20 3b 3b val #:infix)) ;;
8300: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 76 (string-split v
8310: 61 6c 29 29 20 3b 3b 20 72 75 6e 6e 61 6d 65 2d al)) ;; runname-
8320: 72 75 6c 65 20 70 61 72 61 6d 73 0a 09 09 09 28 rule params....(
8330: 76 61 6c 2d 61 6c 69 73 74 20 20 28 63 6f 6d 6d val-alist (comm
8340: 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 76 61 on:val->alist va
8350: 6c 29 29 0a 09 09 09 28 72 75 6e 6e 61 6d 65 20 l))....(runname
8360: 20 20 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 (make-runname
8370: 20 22 22 20 22 22 29 29 0a 09 09 09 28 72 75 6e "" ""))....(run
8380: 74 72 61 6e 73 20 20 20 28 61 6c 69 73 74 2d 72 trans (alist-r
8390: 65 66 20 27 72 75 6e 74 72 61 6e 73 20 76 61 6c ef 'runtrans val
83a0: 2d 61 6c 69 73 74 29 29 0a 0a 09 09 09 3b 3b 20 -alist)).....;;
83b0: 74 68 65 73 65 20 6d 61 79 20 6f 72 20 6d 61 79 these may or may
83c0: 20 6e 6f 74 20 62 65 20 64 65 66 69 6e 65 64 20 not be defined
83d0: 61 6e 64 20 6e 6f 74 20 61 6c 6c 20 61 72 65 20 and not all are
83e0: 75 73 65 64 20 69 6e 20 65 61 63 68 20 68 61 6e used in each han
83f0: 64 6c 65 72 20 74 79 70 65 20 69 6e 20 74 68 65 dler type in the
8400: 20 63 61 73 65 20 62 65 6c 6f 77 0a 09 09 09 28 case below....(
8410: 72 75 6e 2d 6e 61 6d 65 20 20 20 28 61 6c 69 73 run-name (alis
8420: 74 2d 72 65 66 20 27 72 75 6e 2d 6e 61 6d 65 20 t-ref 'run-name
8430: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 val-alist))....(
8440: 74 61 72 67 65 74 20 20 20 20 20 28 61 6c 69 73 target (alis
8450: 74 2d 72 65 66 20 27 74 61 72 67 65 74 20 20 20 t-ref 'target
8460: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 val-alist))....(
8470: 63 72 6f 6e 74 61 62 20 20 20 20 28 61 6c 69 73 crontab (alis
8480: 74 2d 72 65 66 20 27 63 72 6f 6e 20 20 20 20 20 t-ref 'cron
8490: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 val-alist))....(
84a0: 61 72 65 61 73 20 20 20 20 20 20 28 76 61 6c 2d areas (val-
84b0: 61 6c 69 73 74 2d 3e 61 72 65 61 73 20 20 20 20 alist->areas
84c0: 76 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 61 val-alist)) ;; a
84d0: 72 65 61 73 20 63 61 6e 20 62 65 20 61 20 73 69 reas can be a si
84e0: 6e 67 6c 65 20 73 74 72 69 6e 67 20 28 61 20 72 ngle string (a r
84f0: 65 66 65 72 65 6e 63 65 20 74 6f 20 63 61 6c 6c eference to call
8500: 20 61 6e 20 61 72 65 61 73 20 66 75 6e 63 74 69 an areas functi
8510: 6f 6e 29 2c 20 6f 72 20 61 20 6c 69 73 74 20 6f on), or a list o
8520: 66 20 61 72 65 61 20 6e 61 6d 65 73 2e 0a 09 09 f area names....
8530: 09 28 64 62 64 65 73 74 20 20 20 20 20 28 61 6c .(dbdest (al
8540: 69 73 74 2d 72 65 66 20 27 64 62 64 65 73 74 20 ist-ref 'dbdest
8550: 20 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 val-alist))...
8560: 09 28 61 70 70 65 6e 64 63 6f 6e 66 20 28 61 6c .(appendconf (al
8570: 69 73 74 2d 72 65 66 20 27 61 70 70 65 6e 64 63 ist-ref 'appendc
8580: 6f 6e 66 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a onf val-alist)).
8590: 09 09 09 28 66 69 6c 65 2d 67 6c 6f 62 73 20 28 ...(file-globs (
85a0: 61 6c 69 73 74 2d 72 65 66 20 27 67 6c 6f 62 20 alist-ref 'glob
85b0: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 0a val-alist)).....
85c0: 09 09 09 28 72 75 6e 73 74 61 72 74 73 20 20 28 ...(runstarts (
85d0: 66 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 find-pkts pdb '(
85e0: 72 75 6e 73 74 61 72 74 29 20 60 28 28 63 20 2e runstart) `((c .
85f0: 20 2c 63 6f 6e 74 6f 75 72 29 0a 09 09 09 09 09 ,contour)......
8600: 09 09 09 20 28 74 20 2e 20 2c 72 75 6e 6b 65 79 ... (t . ,runkey
8610: 29 29 29 29 0a 09 09 09 28 72 73 70 6b 74 73 20 ))))....(rspkts
8620: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
8630: 70 6b 74 2d 61 6c 69 73 74 73 20 72 75 6e 73 74 pkt-alists runst
8640: 61 72 74 73 29 29 0a 09 09 09 3b 3b 20 73 74 61 arts))....;; sta
8650: 72 74 74 69 6d 65 73 20 69 73 20 66 6f 72 20 72 rttimes is for r
8660: 75 6e 20 73 74 61 72 74 20 74 69 6d 65 73 20 61 un start times a
8670: 6e 64 20 69 73 20 75 73 65 64 20 74 6f 20 6b 6e nd is used to kn
8680: 6f 77 20 77 68 65 6e 20 74 68 65 20 6c 61 73 74 ow when the last
8690: 20 72 75 6e 20 77 61 73 20 6c 61 75 6e 63 68 65 run was launche
86a0: 64 0a 09 09 09 28 73 74 61 72 74 74 69 6d 65 73 d....(starttimes
86b0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 6b 74 (common:get-pkt
86c0: 2d 74 69 6d 65 73 20 72 73 70 6b 74 73 29 29 20 -times rspkts))
86d0: 3b 3b 20 73 6f 72 74 20 62 79 20 61 67 65 20 28 ;; sort by age (
86e0: 79 6f 75 6e 67 65 73 74 20 66 69 72 73 74 29 20 youngest first)
86f0: 61 6e 64 20 64 65 6c 65 74 65 20 64 75 70 6c 69 and delete dupli
8700: 63 61 74 65 73 20 62 79 20 74 61 72 67 65 74 0a cates by target.
8710: 09 09 09 28 6c 61 73 74 2d 72 75 6e 20 20 20 28 ...(last-run (
8720: 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 74 if (null? startt
8730: 69 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 29 20 imes) ;; if '()
8740: 74 68 65 6e 20 69 74 20 68 61 73 20 6e 65 76 65 then it has neve
8750: 72 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c 73 65 r been run, else
8760: 20 67 65 74 20 74 68 65 20 6d 61 78 0a 09 09 09 get the max....
8770: 09 09 30 0a 09 09 09 09 09 28 61 70 70 6c 79 20 ..0......(apply
8780: 6d 61 78 20 28 6d 61 70 20 63 64 72 20 73 74 61 max (map cdr sta
8790: 72 74 74 69 6d 65 73 29 29 29 29 0a 09 09 09 3b rttimes))))....;
87a0: 3b 20 73 79 6e 63 74 69 6d 65 73 20 69 73 20 66 ; synctimes is f
87b0: 6f 72 20 66 69 67 75 72 69 6e 67 20 6f 75 74 20 or figuring out
87c0: 74 68 65 20 6c 61 73 74 20 74 69 6d 65 20 61 20 the last time a
87d0: 73 79 6e 63 20 77 61 73 20 64 6f 6e 65 0a 09 09 sync was done...
87e0: 09 28 73 79 6e 63 73 74 61 72 74 73 20 28 66 69 .(syncstarts (fi
87f0: 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 73 79 nd-pkts pdb '(sy
8800: 6e 63 73 74 61 72 74 29 20 27 28 29 29 29 20 3b ncstart) '())) ;
8810: 3b 20 6e 6f 20 71 75 61 6c 69 66 69 65 72 73 2c ; no qualifiers,
8820: 20 61 20 73 79 6e 63 20 64 6f 65 73 20 61 6c 6c a sync does all
8830: 20 74 61 72 65 74 73 20 65 74 63 2e 0a 09 09 09 tarets etc.....
8840: 28 73 73 70 6b 74 73 20 20 20 20 20 20 20 28 63 (sspkts (c
8850: 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 6b 74 2d 61 6c ommon:get-pkt-al
8860: 69 73 74 73 20 73 79 6e 63 73 74 61 72 74 73 29 ists syncstarts)
8870: 29 0a 09 09 09 28 73 79 6e 63 74 69 6d 65 73 20 )....(synctimes
8880: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 (common:get-p
8890: 6b 74 2d 74 69 6d 65 73 20 20 73 73 70 6b 74 73 kt-times sspkts
88a0: 29 29 0a 09 09 09 28 6c 61 73 74 2d 73 79 6e 63 ))....(last-sync
88b0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 79 6e (if (null? syn
88c0: 63 74 69 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 ctimes) ;; if '(
88d0: 29 20 74 68 65 6e 20 69 74 20 68 61 73 20 6e 65 ) then it has ne
88e0: 76 65 72 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c ver been run, el
88f0: 73 65 20 67 65 74 20 74 68 65 20 6d 61 78 0a 09 se get the max..
8900: 09 09 09 09 30 0a 09 09 09 09 09 28 61 70 70 6c ....0......(appl
8910: 79 20 6d 61 78 20 28 6d 61 70 20 63 64 72 20 73 y max (map cdr s
8920: 79 6e 63 74 69 6d 65 73 29 29 29 29 0a 09 09 09 ynctimes))))....
8930: 29 0a 0a 09 09 20 20 20 28 6c 65 74 20 28 28 64 ).... (let ((d
8940: 65 6c 74 61 20 28 6c 61 6d 62 64 61 20 28 78 29 elta (lambda (x)
8950: 0a 09 09 09 09 20 20 28 72 6f 75 6e 64 20 28 2f ..... (round (/
8960: 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (- (current-sec
8970: 6f 6e 64 73 29 20 78 29 20 36 30 29 29 29 29 29 onds) x) 60)))))
8980: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 . (i
8990: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
89a0: 22 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 "-target").
89b0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
89c0: 74 72 69 6e 67 3d 20 28 61 72 67 73 3a 67 65 74 tring= (args:get
89d0: 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 20 -arg "-target")
89e0: 72 75 6e 6b 65 79 29 0a 09 09 20 20 20 20 20 20 runkey)...
89f0: 20 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 (begin (print "
8a00: 72 75 6e 6b 65 79 3a 20 22 20 72 75 6e 6b 65 79 runkey: " runkey
8a10: 20 22 2c 20 72 75 6c 65 74 79 70 65 3a 20 22 20 ", ruletype: "
8a20: 72 75 6c 65 74 79 70 65 20 22 2c 20 61 63 74 69 ruletype ", acti
8a30: 6f 6e 3a 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 on: " action ",
8a40: 6c 61 73 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 last-run: " last
8a50: 2d 72 75 6e 20 22 20 74 69 6d 65 20 73 69 6e 63 -run " time sinc
8a60: 65 3b 20 6c 61 73 74 2d 72 75 6e 3a 20 22 20 28 e; last-run: " (
8a70: 64 65 6c 74 61 20 6c 61 73 74 2d 72 75 6e 29 20 delta last-run)
8a80: 22 2c 20 6c 61 73 74 2d 73 79 6e 63 3a 20 22 20 ", last-sync: "
8a90: 28 64 65 6c 74 61 20 6c 61 73 74 2d 73 79 6e 63 (delta last-sync
8aa0: 29 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 ))...
8ab0: 20 20 20 28 70 72 69 6e 74 20 22 76 61 6c 2d 61 (print "val-a
8ac0: 6c 69 73 74 3d 22 20 76 61 6c 2d 61 6c 69 73 74 list=" val-alist
8ad0: 20 22 20 72 75 6e 74 72 61 6e 73 3d 22 20 72 75 " runtrans=" ru
8ae0: 6e 74 72 61 6e 73 29 29 0a 20 20 20 20 20 20 20 ntrans)).
8af0: 20 20 20 20 20 20 20 20 28 69 66 20 23 66 20 28 (if #f (
8b00: 70 72 69 6e 74 20 22 73 6b 69 70 70 69 6e 67 3a print "skipping:
8b10: 20 22 20 72 75 6e 6b 65 79 29 29 29 0a 09 09 20 " runkey)))...
8b20: 20 20 20 20 20 20 28 62 65 67 69 6e 20 28 70 72 (begin (pr
8b30: 69 6e 74 20 22 72 75 6e 6b 65 79 3a 20 22 20 72 int "runkey: " r
8b40: 75 6e 6b 65 79 20 22 2c 20 72 75 6c 65 74 79 70 unkey ", ruletyp
8b50: 65 3a 20 22 20 72 75 6c 65 74 79 70 65 20 22 2c e: " ruletype ",
8b60: 20 61 63 74 69 6f 6e 3a 20 22 20 61 63 74 69 6f action: " actio
8b70: 6e 20 22 2c 20 6c 61 73 74 2d 72 75 6e 3a 20 22 n ", last-run: "
8b80: 20 6c 61 73 74 2d 72 75 6e 20 22 20 74 69 6d 65 last-run " time
8b90: 20 73 69 6e 63 65 3b 20 6c 61 73 74 2d 72 75 6e since; last-run
8ba0: 3a 20 22 20 28 64 65 6c 74 61 20 6c 61 73 74 2d : " (delta last-
8bb0: 72 75 6e 29 20 22 2c 20 6c 61 73 74 2d 73 79 6e run) ", last-syn
8bc0: 63 3a 20 22 20 28 64 65 6c 74 61 20 6c 61 73 74 c: " (delta last
8bd0: 2d 73 79 6e 63 29 29 0a 09 09 20 20 20 20 20 20 -sync))...
8be0: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 (print "
8bf0: 76 61 6c 2d 61 6c 69 73 74 3d 22 20 76 61 6c 2d val-alist=" val-
8c00: 61 6c 69 73 74 20 22 20 72 75 6e 74 72 61 6e 73 alist " runtrans
8c10: 3d 22 20 72 75 6e 74 72 61 6e 73 29 29 0a 20 20 =" runtrans)).
8c20: 20 20 20 20 20 20 20 20 20 29 29 0a 0a 09 09 20 ))....
8c30: 20 20 0a 09 09 20 20 20 3b 3b 20 6c 6f 6f 6b 20 ... ;; look
8c40: 69 6e 20 72 75 6e 73 74 61 72 74 73 20 66 6f 72 in runstarts for
8c50: 20 6d 61 74 63 68 69 6e 67 20 72 75 6e 73 20 62 matching runs b
8c60: 79 20 74 61 72 67 65 74 20 61 6e 64 20 63 6f 6e y target and con
8c70: 74 6f 75 72 0a 09 09 20 20 20 3b 3b 20 67 65 74 tour... ;; get
8c80: 20 74 68 65 20 74 69 6d 65 73 74 61 6d 70 20 66 the timestamp f
8c90: 6f 72 20 77 68 65 6e 20 74 68 61 74 20 72 75 6e or when that run
8ca0: 20 73 74 61 72 74 65 64 20 61 6e 64 20 70 61 73 started and pas
8cb0: 73 20 69 74 0a 09 09 20 20 20 3b 3b 20 74 6f 20 s it... ;; to
8cc0: 74 68 65 20 72 75 6c 65 20 6c 6f 67 69 63 20 68 the rule logic h
8cd0: 65 72 65 20 77 68 65 72 65 20 22 72 75 6c 65 74 ere where "rulet
8ce0: 79 70 65 22 20 77 69 6c 6c 20 62 65 20 61 70 70 ype" will be app
8cf0: 6c 69 65 64 0a 09 09 20 20 20 3b 3b 20 69 66 20 lied... ;; if
8d00: 69 74 20 63 6f 6d 65 73 20 62 61 63 6b 20 22 63 it comes back "c
8d10: 68 61 6e 67 65 64 22 20 74 68 65 6e 20 70 72 6f hanged" then pro
8d20: 63 65 65 64 20 74 6f 20 72 65 67 69 73 74 65 72 ceed to register
8d30: 20 74 68 65 20 72 75 6e 73 0a 09 09 20 20 20 0a the runs... .
8d40: 09 09 20 20 20 28 63 61 73 65 20 28 73 74 72 69 .. (case (stri
8d50: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 72 ng->symbol (or r
8d60: 75 6c 65 74 79 70 65 20 22 6e 6f 2d 73 75 63 68 uletype "no-such
8d70: 2d 72 75 6c 65 22 29 29 0a 0a 09 09 20 20 20 20 -rule"))....
8d80: 20 28 28 6e 6f 2d 73 75 63 68 2d 72 75 6c 65 29 ((no-such-rule)
8d90: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
8da0: 6e 6f 20 73 75 63 68 20 72 75 6c 65 20 66 6f 72 no such rule for
8db0: 20 22 20 73 65 6e 73 65 29 29 0a 0a 09 09 20 20 " sense))....
8dc0: 20 20 20 3b 3b 20 48 61 6e 64 6c 65 20 63 72 6f ;; Handle cro
8dd0: 6e 74 61 62 20 6c 69 6b 65 20 72 75 6c 65 73 0a ntab like rules.
8de0: 09 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 .. ;;...
8df0: 20 28 28 73 63 68 65 64 75 6c 65 64 29 0a 09 09 ((scheduled)...
8e00: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
8e10: 61 6c 69 73 74 2d 72 65 66 20 27 63 72 6f 6e 20 alist-ref 'cron
8e20: 76 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 67 val-alist)) ;; g
8e30: 6f 74 74 61 20 68 61 76 65 20 63 72 6f 6e 20 73 otta have cron s
8e40: 70 65 63 0a 09 09 09 20 20 28 70 72 69 6e 74 20 pec.... (print
8e50: 22 45 52 52 4f 52 3a 20 62 61 64 20 73 65 6e 73 "ERROR: bad sens
8e60: 65 20 73 70 65 63 20 5c 22 22 20 28 73 74 72 69 e spec \"" (stri
8e70: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 ng-intersperse s
8e80: 65 6e 73 65 20 22 20 22 29 20 22 5c 22 20 70 61 ense " ") "\" pa
8e90: 72 61 6d 73 3a 20 22 20 76 61 6c 2d 61 6c 69 73 rams: " val-alis
8ea0: 74 29 0a 09 09 09 20 20 28 6c 65 74 2a 20 28 0a t).... (let* (.
8eb0: 09 09 09 09 20 3b 3b 20 28 61 63 74 69 6f 6e 20 .... ;; (action
8ec0: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 63 (alist-ref 'ac
8ed0: 74 69 6f 6e 20 20 20 76 61 6c 2d 61 6c 69 73 74 tion val-alist
8ee0: 29 29 0a 09 09 09 09 20 28 63 72 6f 6e 2d 73 61 ))..... (cron-sa
8ef0: 66 65 2d 73 74 72 69 6e 67 20 28 73 74 72 69 6e fe-string (strin
8f00: 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 73 74 72 g-translate (str
8f10: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
8f20: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 72 (string-split cr
8f30: 6f 6e 74 61 62 29 20 22 2d 22 29 20 22 2a 22 20 ontab) "-") "*"
8f40: 22 58 22 29 29 0a 09 09 09 09 20 28 72 75 6e 6e "X"))..... (runn
8f50: 61 6d 65 20 20 73 74 64 2d 72 75 6e 6e 61 6d 65 ame std-runname
8f60: 29 29 20 3b 3b 20 28 63 6f 6e 63 20 22 73 63 68 )) ;; (conc "sch
8f70: 65 64 22 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e ed" (time->strin
8f80: 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 g (seconds->loca
8f90: 6c 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d l-time (current-
8fa0: 73 65 63 6f 6e 64 73 29 29 20 22 25 4d 25 48 25 seconds)) "%M%H%
8fb0: 64 22 29 29 29 29 29 0a 09 09 09 20 20 20 20 3b d"))))).... ;
8fc0: 3b 20 28 70 72 69 6e 74 20 22 6c 61 73 74 2d 72 ; (print "last-r
8fd0: 75 6e 3a 20 22 20 6c 61 73 74 2d 72 75 6e 20 22 un: " last-run "
8fe0: 20 6e 65 65 64 2d 72 75 6e 3a 20 22 20 6e 65 65 need-run: " nee
8ff0: 64 2d 72 75 6e 29 0a 09 09 09 20 20 20 20 3b 3b d-run).... ;;
9000: 20 28 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 09 (if need-run...
9010: 09 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 . (case (stri
9020: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f ng->symbol actio
9030: 6e 29 0a 09 09 09 20 20 20 20 20 20 28 28 73 79 n).... ((sy
9040: 6e 63 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 29 nc sync-prepend)
9050: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
9060: 63 6f 6d 6d 6f 6e 3a 65 78 74 65 6e 64 65 64 2d common:extended-
9070: 63 72 6f 6e 20 63 72 6f 6e 74 61 62 20 23 66 20 cron crontab #f
9080: 6c 61 73 74 2d 73 79 6e 63 29 0a 09 09 09 09 20 last-sync).....
9090: 20 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 (push-run-spec
90a0: 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 torun contour r
90b0: 75 6e 6b 65 79 0a 09 09 09 09 09 09 20 20 60 28 unkey....... `(
90c0: 28 6d 65 73 73 61 67 65 20 2e 20 2c 28 63 6f 6e (message . ,(con
90d0: 63 20 72 75 6c 65 74 79 70 65 20 22 3a 73 79 6e c ruletype ":syn
90e0: 63 2d 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 74 c-" cron-safe-st
90f0: 72 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 20 ring)).......
9100: 20 28 61 63 74 69 6f 6e 20 20 2e 20 2c 61 63 74 (action . ,act
9110: 69 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 20 28 ion)....... (
9120: 64 62 64 65 73 74 20 20 2e 20 2c 64 62 64 65 73 dbdest . ,dbdes
9130: 74 29 0a 09 09 09 09 09 09 20 20 20 20 28 61 70 t)....... (ap
9140: 70 65 6e 64 20 20 2e 20 2c 61 70 70 65 6e 64 63 pend . ,appendc
9150: 6f 6e 66 29 0a 09 09 09 09 09 09 20 20 20 20 28 onf)....... (
9160: 61 72 65 61 73 20 20 20 2e 20 2c 61 72 65 61 73 areas . ,areas
9170: 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 ))))).... (
9180: 28 72 75 6e 29 0a 09 09 09 20 20 20 20 20 20 20 (run)....
9190: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 65 78 74 65 (if (common:exte
91a0: 6e 64 65 64 2d 63 72 6f 6e 20 63 72 6f 6e 74 61 nded-cron cronta
91b0: 62 20 23 66 20 6c 61 73 74 2d 72 75 6e 29 0a 09 b #f last-run)..
91c0: 09 09 09 20 20 20 28 70 75 73 68 2d 72 75 6e 2d ... (push-run-
91d0: 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f spec torun conto
91e0: 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 09 ur runkey.......
91f0: 20 20 60 28 28 6d 65 73 73 61 67 65 20 20 2e 20 `((message .
9200: 2c 28 63 6f 6e 63 20 72 75 6c 65 74 79 70 65 20 ,(conc ruletype
9210: 22 3a 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 74 ":" cron-safe-st
9220: 72 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 20 ring)).......
9230: 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 (runname . ,ru
9240: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 20 20 20 nname).......
9250: 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 (runtrans . ,ru
9260: 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 20 ntrans).......
9270: 20 20 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 (action . ,a
9280: 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 ction).......
9290: 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 (areas . ,ar
92a0: 65 61 73 29 0a 09 09 09 09 09 09 20 20 20 20 28 eas)....... (
92b0: 74 61 72 67 65 74 20 20 20 2e 20 2c 74 61 72 67 target . ,targ
92c0: 65 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 et))))).
92d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92e0: 20 20 20 20 20 20 28 28 72 65 6d 6f 76 65 29 0a ((remove).
92f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9310: 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f push-run-spec to
9320: 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b run contour runk
9330: 65 79 0a 09 09 09 09 09 09 20 20 60 28 28 6d 65 ey....... `((me
9340: 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 ssage . ,(conc
9350: 72 75 6c 65 74 79 70 65 20 22 3a 22 20 63 72 6f ruletype ":" cro
9360: 6e 2d 73 61 66 65 2d 73 74 72 69 6e 67 29 29 0a n-safe-string)).
9370: 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 6e 61 ...... (runna
9380: 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a me . ,runname).
9390: 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 74 72 ...... (runtr
93a0: 61 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 ans . ,runtrans)
93b0: 0a 09 09 09 09 09 09 20 20 20 20 28 61 63 74 69 ....... (acti
93c0: 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a on . ,action).
93d0: 09 09 09 09 09 09 20 20 20 20 28 61 72 65 61 73 ...... (areas
93e0: 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 . ,areas)...
93f0: 09 09 09 09 20 20 20 20 28 74 61 72 67 65 74 20 .... (target
9400: 20 20 2e 20 2c 74 61 72 67 65 74 29 29 29 29 0a . ,target)))).
9410: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 0a 09 ... (else..
9420: 09 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 .. (print
9430: 22 45 52 52 4f 52 3a 20 61 63 74 69 6f 6e 20 5c "ERROR: action \
9440: 22 22 20 61 63 74 69 6f 6e 20 22 5c 22 20 68 61 "" action "\" ha
9450: 73 20 6e 6f 20 73 63 68 65 64 75 6c 65 64 20 68 s no scheduled h
9460: 61 6e 64 6c 65 72 22 29 0a 09 09 09 20 20 20 20 andler")....
9470: 20 20 20 29 29 29 29 29 0a 0a 0a 09 09 20 20 20 ))))).....
9480: 20 20 3b 3b 20 73 63 72 69 70 74 20 62 61 73 65 ;; script base
9490: 64 20 73 65 6e 73 6f 72 73 0a 09 09 20 20 20 20 d sensors...
94a0: 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 73 63 72 ;;... ((scr
94b0: 69 70 74 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 ipt)... ;;
94c0: 73 79 6e 74 61 78 20 69 73 20 61 20 6c 69 74 74 syntax is a litt
94d0: 6c 65 20 64 69 66 66 65 72 65 6e 74 20 68 65 72 le different her
94e0: 65 2e 20 49 74 20 69 73 20 61 20 6c 69 73 74 20 e. It is a list
94f0: 6f 66 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 72 of commands to r
9500: 75 6e 2c 20 22 73 63 72 69 70 74 6e 61 6d 65 20 un, "scriptname
9510: 3d 20 65 78 74 72 61 5f 70 61 72 61 6d 65 74 65 = extra_paramete
9520: 72 73 3b 73 63 72 69 70 74 6e 61 6d 65 20 3d 20 rs;scriptname =
9530: 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 3b 3b 20 ..."... ;;
9540: 77 68 65 72 65 20 73 63 72 69 70 74 6e 61 6d 65 where scriptname
9550: 20 6d 61 79 20 62 65 20 72 65 70 65 61 74 65 64 may be repeated
9560: 20 6d 75 6c 74 69 70 6c 65 20 74 69 6d 65 73 2e multiple times.
9570: 20 54 68 65 20 73 63 72 69 70 74 20 6d 75 73 74 The script must
9580: 20 72 65 74 75 72 6e 20 75 6e 69 78 2d 65 70 6f return unix-epo
9590: 63 68 20 6f 66 20 6c 61 73 74 20 63 68 61 6e 67 ch of last chang
95a0: 65 2c 20 6e 65 77 2d 74 61 72 67 65 74 2d 6e 61 e, new-target-na
95b0: 6d 65 20 61 6e 64 20 6e 65 77 2d 72 75 6e 2d 6e me and new-run-n
95c0: 61 6d 65 0a 09 09 20 20 20 20 20 20 3b 3b 20 74 ame... ;; t
95d0: 68 65 20 73 63 72 69 70 74 20 69 73 20 63 61 6c he script is cal
95e0: 6c 65 64 20 6c 69 6b 65 20 74 68 69 73 3a 20 20 led like this:
95f0: 73 63 72 69 70 74 6e 61 6d 65 20 63 6f 6e 74 6f scriptname conto
9600: 75 72 20 72 75 6e 6b 65 79 20 73 74 64 2d 72 75 ur runkey std-ru
9610: 6e 6e 61 6d 65 20 61 63 74 69 6f 6e 20 65 78 74 nname action ext
9620: 72 61 5f 70 61 72 61 6d 31 20 65 78 74 72 61 5f ra_param1 extra_
9630: 70 61 72 61 6d 32 20 2e 2e 2e 0a 09 09 20 20 20 param2 ......
9640: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 (for-each...
9650: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
9660: 6d 64 29 0a 09 09 09 20 28 70 72 69 6e 74 20 22 md).... (print "
9670: 63 6d 64 3a 20 22 20 63 6d 64 29 0a 09 09 09 20 cmd: " cmd)....
9680: 28 6c 65 74 2a 20 28 28 73 63 72 69 70 74 20 28 (let* ((script (
9690: 63 61 72 20 63 6d 64 29 29 0a 09 09 09 09 28 70 car cmd)).....(p
96a0: 61 72 61 6d 73 20 28 63 64 72 20 63 6d 64 29 29 arams (cdr cmd))
96b0: 0a 09 09 09 09 28 63 6d 64 20 20 20 20 28 63 6f .....(cmd (co
96c0: 6e 63 20 73 63 72 69 70 74 20 22 20 22 20 63 6f nc script " " co
96d0: 6e 74 6f 75 72 20 22 20 22 20 72 75 6e 6b 65 79 ntour " " runkey
96e0: 20 22 20 22 20 73 74 64 2d 72 75 6e 6e 61 6d 65 " " std-runname
96f0: 20 22 20 22 20 61 63 74 69 6f 6e 20 22 20 22 20 " " action " "
9700: 70 61 72 61 6d 73 29 29 0a 09 09 09 09 28 72 65 params)).....(re
9710: 73 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 s (handle-exc
9720: 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 20 20 20 eptions......
9730: 20 65 78 6e 0a 09 09 09 09 09 20 20 20 20 23 66 exn...... #f
9740: 0a 09 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 ...... (print "
9750: 52 75 6e 6e 69 6e 67 20 22 20 63 6d 64 29 0a 09 Running " cmd)..
9760: 09 09 09 09 20 20 28 77 69 74 68 2d 69 6e 70 75 .... (with-inpu
9770: 74 2d 66 72 6f 6d 2d 70 69 70 65 20 63 6d 64 20 t-from-pipe cmd
9780: 72 65 61 64 2d 6c 69 6e 65 73 29 29 29 29 0a 09 read-lines))))..
9790: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 72 65 .. (if (and re
97a0: 73 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 s (not (null? re
97b0: 73 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 s))).... (
97c0: 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 20 20 let* ((parts
97d0: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
97e0: 20 28 63 61 72 20 72 65 73 29 29 29 20 3b 3b 0a (car res))) ;;.
97f0: 09 09 09 09 20 20 20 20 20 20 28 72 65 6d 2d 6c .... (rem-l
9800: 69 6e 65 73 20 20 20 28 63 64 72 20 72 65 73 29 ines (cdr res)
9810: 29 0a 09 09 09 09 20 20 20 20 20 20 28 6e 75 6d )..... (num
9820: 2d 70 61 72 74 73 20 20 20 28 6c 65 6e 67 74 68 -parts (length
9830: 20 70 61 72 74 73 29 29 0a 09 09 09 09 20 20 20 parts)).....
9840: 20 20 20 28 6c 61 73 74 2d 63 68 61 6e 67 65 20 (last-change
9850: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
9860: 28 69 66 20 28 3e 20 6e 75 6d 2d 70 61 72 74 73 (if (> num-parts
9870: 20 30 29 28 63 61 72 20 70 61 72 74 73 29 20 22 0)(car parts) "
9880: 61 62 63 22 29 29 29 20 20 3b 3b 20 66 6f 72 63 abc"))) ;; forc
9890: 65 20 6e 6f 20 72 75 6e 20 69 66 20 6e 6f 74 20 e no run if not
98a0: 61 20 6e 75 6d 62 65 72 20 72 65 74 75 72 6e 65 a number returne
98b0: 64 0a 09 09 09 09 20 20 20 20 20 20 28 6e 65 77 d..... (new
98c0: 2d 74 61 72 67 65 74 20 20 28 69 66 20 28 3e 20 -target (if (>
98d0: 6e 75 6d 2d 70 61 72 74 73 20 31 29 0a 09 09 09 num-parts 1)....
98e0: 09 09 09 20 20 20 20 20 20 20 28 63 61 64 72 20 ... (cadr
98f0: 70 61 72 74 73 29 0a 09 09 09 09 09 09 20 20 20 parts).......
9900: 20 20 20 20 72 75 6e 6b 65 79 29 29 0a 09 09 09 runkey))....
9910: 09 20 20 20 20 20 20 28 6e 65 77 2d 72 75 6e 6e . (new-runn
9920: 61 6d 65 20 28 69 66 20 28 3e 20 6e 75 6d 2d 70 ame (if (> num-p
9930: 61 72 74 73 20 32 29 0a 09 09 09 09 09 09 20 20 arts 2).......
9940: 20 20 20 20 20 28 63 61 64 64 72 20 70 61 72 74 (caddr part
9950: 73 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 s).......
9960: 73 74 64 2d 72 75 6e 6e 61 6d 65 29 29 0a 09 09 std-runname))...
9970: 09 09 20 20 20 20 20 20 28 6d 65 73 73 61 67 65 .. (message
9980: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
9990: 72 65 6d 2d 6c 69 6e 65 73 29 0a 09 09 09 09 09 rem-lines)......
99a0: 09 20 20 20 20 20 20 20 63 6d 64 0a 09 09 09 09 . cmd.....
99b0: 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 .. (string
99c0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 6d -intersperse rem
99d0: 2d 6c 69 6e 65 73 20 22 2d 22 29 29 29 0a 09 09 -lines "-")))...
99e0: 09 09 20 20 20 20 20 20 28 6e 65 65 64 2d 72 75 .. (need-ru
99f0: 6e 20 20 20 20 28 3e 20 6c 61 73 74 2d 63 68 61 n (> last-cha
9a00: 6e 67 65 20 6c 61 73 74 2d 72 75 6e 29 29 29 0a nge last-run))).
9a10: 09 09 09 09 20 28 70 72 69 6e 74 20 22 6c 61 73 .... (print "las
9a20: 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 2d 72 75 t-run: " last-ru
9a30: 6e 20 22 20 6e 65 65 64 2d 72 75 6e 3a 20 22 20 n " need-run: "
9a40: 6e 65 65 64 2d 72 75 6e 29 0a 09 09 09 09 20 28 need-run)..... (
9a50: 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 09 09 09 if need-run.....
9a60: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 (let* ((key
9a70: 2d 6d 73 67 20 20 20 20 60 28 28 6d 65 73 73 61 -msg `((messa
9a80: 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c ge . ,(conc rul
9a90: 65 74 79 70 65 20 22 3a 22 20 6d 65 73 73 61 67 etype ":" messag
9aa0: 65 29 29 0a 09 09 09 09 09 09 09 20 20 28 72 75 e))........ (ru
9ab0: 6e 6e 61 6d 65 20 20 2e 20 2c 6e 65 77 2d 72 75 nname . ,new-ru
9ac0: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 20 20 nname)........
9ad0: 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e (runtrans . ,run
9ae0: 74 72 61 6e 73 29 0a 09 09 09 09 09 09 09 20 20 trans)........
9af0: 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 (action . ,act
9b00: 69 6f 6e 29 0a 09 09 09 09 09 09 09 20 20 28 61 ion)........ (a
9b10: 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 73 reas . ,areas
9b20: 29 0a 09 09 09 09 09 09 09 20 20 3b 3b 28 74 61 )........ ;;(ta
9b30: 72 67 65 74 20 20 20 2e 20 2c 28 6c 69 73 74 20 rget . ,(list
9b40: 6e 65 77 2d 74 61 72 67 65 74 29 29 20 3b 3b 20 new-target)) ;;
9b50: 6f 76 65 72 72 69 64 69 6e 67 20 77 69 74 68 20 overriding with
9b60: 72 65 73 75 6c 74 20 66 72 6f 6d 20 72 75 6e 69 result from runi
9b70: 6e 67 20 74 68 65 20 73 63 72 69 70 74 0a 20 20 ng the script.
9b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9bb0: 20 20 20 20 20 20 20 20 29 29 29 0a 09 09 09 09 ))).....
9bc0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 6b (print "k
9bd0: 65 79 2d 6d 73 67 3a 20 22 20 6b 65 79 2d 6d 73 ey-msg: " key-ms
9be0: 67 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 70 g)..... (p
9bf0: 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 ush-run-spec tor
9c00: 75 6e 20 63 6f 6e 74 6f 75 72 0a 09 09 09 09 09 un contour......
9c10: 09 20 20 20 20 20 20 28 69 66 20 6f 70 74 69 6f . (if optio
9c20: 6e 61 6c 20 20 3b 3b 20 77 65 20 6e 65 65 64 20 nal ;; we need
9c30: 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 64 69 to be able to di
9c40: 66 66 65 72 65 6e 74 69 61 74 65 20 73 61 6d 65 fferentiate same
9c50: 20 63 6f 6e 74 6f 75 72 2c 20 64 69 66 66 65 72 contour, differ
9c60: 65 6e 74 20 62 65 68 61 76 69 6f 72 2e 20 0a 09 ent behavior. ..
9c70: 09 09 09 09 09 09 20 20 28 63 6f 6e 63 20 72 75 ...... (conc ru
9c80: 6e 6b 65 79 20 22 3a 22 20 6f 70 74 69 6f 6e 61 nkey ":" optiona
9c90: 6c 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 4e 4f 54 l) ;; NOTE: NOT
9ca0: 20 43 4f 4d 50 4c 45 54 45 4c 59 20 49 4d 50 4c COMPLETELY IMPL
9cb0: 45 4d 45 4e 54 45 44 2e 20 44 4f 20 4e 4f 54 20 EMENTED. DO NOT
9cc0: 55 53 45 0a 09 09 09 09 09 09 09 20 20 72 75 6e USE........ run
9cd0: 6b 65 79 29 0a 09 09 09 09 09 09 20 20 20 20 20 key).......
9ce0: 20 6b 65 79 2d 6d 73 67 29 29 29 29 29 29 29 0a key-msg))))))).
9cf0: 09 09 20 20 20 20 20 20 20 76 61 6c 2d 61 6c 69 .. val-ali
9d00: 73 74 29 29 20 3b 3b 20 69 74 65 72 61 74 65 20 st)) ;; iterate
9d10: 6f 76 65 72 20 74 68 65 20 70 61 72 61 6d 20 73 over the param s
9d20: 70 6c 69 74 20 62 79 20 3b 5c 73 2a 0a 0a 09 09 plit by ;\s*....
9d30: 20 20 20 20 20 3b 3b 20 73 63 72 69 70 74 20 62 ;; script b
9d40: 61 73 65 64 20 73 65 6e 73 6f 72 73 0a 09 09 20 ased sensors...
9d50: 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 ;;... ((
9d60: 61 72 65 61 2d 73 63 72 69 70 74 29 0a 09 09 20 area-script)...
9d70: 20 20 20 20 20 3b 3b 20 73 79 6e 74 61 78 20 69 ;; syntax i
9d80: 73 20 61 20 6c 69 74 74 6c 65 20 64 69 66 66 65 s a little diffe
9d90: 72 65 6e 74 20 68 65 72 65 2e 20 49 74 20 69 73 rent here. It is
9da0: 20 61 20 6c 69 73 74 20 6f 66 20 63 6f 6d 6d 61 a list of comma
9db0: 6e 64 73 20 74 6f 20 72 75 6e 2c 20 22 73 63 72 nds to run, "scr
9dc0: 69 70 74 6e 61 6d 65 20 3d 20 65 78 74 72 61 5f iptname = extra_
9dd0: 70 61 72 61 6d 65 74 65 72 73 3b 73 63 72 69 70 parameters;scrip
9de0: 74 6e 61 6d 65 20 3d 20 2e 2e 2e 22 0a 09 09 20 tname = ..."...
9df0: 20 20 20 20 20 3b 3b 20 77 68 65 72 65 20 73 63 ;; where sc
9e00: 72 69 70 74 6e 61 6d 65 20 6d 61 79 20 62 65 20 riptname may be
9e10: 72 65 70 65 61 74 65 64 20 6d 75 6c 74 69 70 6c repeated multipl
9e20: 65 20 74 69 6d 65 73 2e 20 54 68 65 20 73 63 72 e times. The scr
9e30: 69 70 74 20 6d 75 73 74 20 72 65 74 75 72 6e 20 ipt must return
9e40: 75 6e 69 78 2d 65 70 6f 63 68 20 6f 66 20 6c 61 unix-epoch of la
9e50: 73 74 20 63 68 61 6e 67 65 2c 20 6e 65 77 2d 74 st change, new-t
9e60: 61 72 67 65 74 2d 6e 61 6d 65 20 61 6e 64 20 6e arget-name and n
9e70: 65 77 2d 72 75 6e 2d 6e 61 6d 65 0a 09 09 20 20 ew-run-name...
9e80: 20 20 20 20 3b 3b 20 74 68 65 20 73 63 72 69 70 ;; the scrip
9e90: 74 20 69 73 20 63 61 6c 6c 65 64 20 6c 69 6b 65 t is called like
9ea0: 20 74 68 69 73 3a 20 20 73 63 72 69 70 74 6e 61 this: scriptna
9eb0: 6d 65 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 me contour runke
9ec0: 79 20 73 74 64 2d 72 75 6e 6e 61 6d 65 20 61 63 y std-runname ac
9ed0: 74 69 6f 6e 20 65 78 74 72 61 5f 70 61 72 61 6d tion extra_param
9ee0: 31 20 65 78 74 72 61 5f 70 61 72 61 6d 32 20 2e 1 extra_param2 .
9ef0: 2e 2e 0a 09 09 20 20 20 20 20 20 28 66 6f 72 2d ..... (for-
9f00: 65 61 63 68 0a 09 09 20 20 20 20 20 20 20 28 6c each... (l
9f10: 61 6d 62 64 61 20 28 63 6d 64 29 0a 09 09 09 20 ambda (cmd)....
9f20: 3b 3b 28 70 72 69 6e 74 20 22 63 6d 64 3a 20 22 ;;(print "cmd: "
9f30: 20 63 6d 64 29 0a 20 20 20 20 20 20 20 20 20 20 cmd).
9f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
9f50: 3b 28 70 72 69 6e 74 20 22 41 72 65 61 73 3a 20 ;(print "Areas:
9f60: 22 20 61 6c 6c 2d 61 72 65 61 73 29 0a 20 20 20 " all-areas).
9f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f80: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
9f90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9fa0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
9fb0: 62 64 61 20 28 61 72 65 61 29 20 0a 20 20 20 20 bda (area) .
9fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fd0: 20 20 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e ;;(prin
9fe0: 74 20 22 41 72 65 61 3a 20 22 20 61 72 65 61 29 t "Area: " area)
9ff0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
a010: 28 70 72 69 6e 74 20 22 54 61 72 67 65 74 3a 20 (print "Target:
a020: 22 20 72 75 6e 6b 65 79 29 0a 20 20 20 20 20 20 " runkey).
a030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a040: 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 ;;(print
a050: 22 4f 52 3a 20 22 20 28 6f 72 20 28 73 74 72 69 "OR: " (or (stri
a060: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 69 66 20 28 ng->number (if (
a070: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d configf:lookup m
a080: 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 6d tconf "setup" "m
a090: 61 78 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 ax_packets_per_r
a0a0: 75 6e 22 29 20 28 63 6f 6e 66 69 67 66 3a 6c 6f un") (configf:lo
a0b0: 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 okup mtconf "set
a0c0: 75 70 22 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 up" "max_packets
a0d0: 5f 70 65 72 5f 72 75 6e 22 29 20 22 31 30 30 30 _per_run") "1000
a0e0: 30 22 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 0" )))).
a0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a100: 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 50 ;;(print "P
a110: 61 63 6b 65 74 73 20 67 65 6e 65 72 61 74 65 64 ackets generated
a120: 3a 20 22 20 70 61 63 6b 65 74 73 2d 67 65 6e 65 : " packets-gene
a130: 72 61 74 65 64 29 0a 20 20 20 20 20 20 20 20 20 rated).
a140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a150: 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 43 6f ;;(print "Co
a160: 6d 70 61 72 69 73 6f 6e 3a 20 22 20 28 3c 20 70 mparison: " (< p
a170: 61 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 65 64 ackets-generated
a180: 20 34 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 4)).
a190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a1a0: 20 20 3b 3b 28 70 72 69 6e 74 20 22 46 75 6c 6c ;;(print "Full
a1b0: 20 43 6f 6d 70 61 72 69 73 6f 6e 3a 20 22 20 0a Comparison: " .
a1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
a1e0: 20 20 28 61 6e 64 20 28 3c 20 70 61 63 6b 65 74 (and (< packet
a1f0: 73 2d 67 65 6e 65 72 61 74 65 64 20 28 6f 72 20 s-generated (or
a200: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
a210: 28 69 66 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (if (configf:loo
a220: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 kup mtconf "setu
a230: 70 22 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f p" "max_packets_
a240: 70 65 72 5f 72 75 6e 22 29 20 28 63 6f 6e 66 69 per_run") (confi
a250: 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 gf:lookup mtconf
a260: 20 22 73 65 74 75 70 22 20 22 6d 61 78 5f 70 61 "setup" "max_pa
a270: 63 6b 65 74 73 5f 70 65 72 5f 72 75 6e 22 29 20 ckets_per_run")
a280: 22 31 30 30 30 30 22 20 29 29 20 31 30 30 30 30 "10000" )) 10000
a290: 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 )) .
a2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2b0: 20 20 3b 3b 20 20 20 20 20 20 20 20 28 69 66 20 ;; (if
a2c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a2d0: 74 61 72 67 65 74 22 29 20 0a 20 20 20 20 20 20 target") .
a2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2f0: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
a300: 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e (if (strin
a310: 67 3d 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 g= (args:get-arg
a320: 20 22 2d 74 61 72 67 65 74 22 29 20 72 75 6e 6b "-target") runk
a330: 65 79 29 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 ey) (area-allowe
a340: 64 3f 20 61 72 65 61 20 22 61 72 65 61 2d 6e 65 d? area "area-ne
a350: 65 64 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 eds-to-be-run" r
a360: 75 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 unkey contour #f
a370: 29 20 23 66 29 20 0a 20 20 20 20 20 20 20 20 20 ) #f) .
a380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a390: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
a3a0: 20 20 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 (area-allowed
a3b0: 3f 20 61 72 65 61 20 22 61 72 65 61 2d 6e 65 65 ? area "area-nee
a3c0: 64 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 75 ds-to-be-run" ru
a3d0: 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 29 nkey contour #f)
a3e0: 29 29 29 0a 09 09 09 20 20 20 20 3b 3b 28 70 72 ))).... ;;(pr
a3f0: 69 6e 74 20 22 41 72 65 61 20 41 6c 6c 6f 77 65 int "Area Allowe
a400: 64 3a 20 22 20 28 61 72 65 61 2d 61 6c 6c 6f 77 d: " (area-allow
a410: 65 64 3f 20 61 72 65 61 20 22 61 72 65 61 2d 6e ed? area "area-n
a420: 65 65 64 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 eeds-to-be-run"
a430: 72 75 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 runkey contour #
a440: 66 29 29 0a 3b 41 64 64 20 63 6f 64 65 20 74 6f f)).;Add code to
a450: 20 63 68 65 63 6b 20 77 68 65 74 68 65 72 20 61 check whether a
a460: 72 65 61 20 69 73 20 76 61 6c 69 64 0a 09 09 09 rea is valid....
a470: 20 20 20 20 20 28 69 66 20 0a 20 20 20 20 20 20 (if .
a480: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
a490: 54 68 69 73 20 63 6f 64 65 20 63 68 65 63 6b 73 This code checks
a4a0: 20 77 68 65 74 68 65 72 20 74 68 65 20 74 61 72 whether the tar
a4b0: 67 65 74 20 68 61 73 20 62 65 65 6e 20 70 61 73 get has been pas
a4c0: 73 65 64 20 69 6e 20 76 69 61 20 61 72 67 75 6d sed in via argum
a4d0: 65 6e 74 2c 20 61 6e 64 20 6f 6e 6c 79 20 72 75 ent, and only ru
a4e0: 6e 73 20 74 68 65 20 73 70 65 63 69 66 69 65 64 ns the specified
a4f0: 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 target.
a500: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
a510: 28 3c 20 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 (< packets-gener
a520: 61 74 65 64 20 28 6f 72 20 28 73 74 72 69 6e 67 ated (or (string
a530: 2d 3e 6e 75 6d 62 65 72 20 28 69 66 20 28 63 6f ->number (if (co
a540: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 nfigf:lookup mtc
a550: 6f 6e 66 20 22 73 65 74 75 70 22 20 22 6d 61 78 onf "setup" "max
a560: 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 75 6e _packets_per_run
a570: 22 29 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b ") (configf:look
a580: 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 up mtconf "setup
a590: 22 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f 70 " "max_packets_p
a5a0: 65 72 5f 72 75 6e 22 29 20 22 31 30 30 30 30 22 er_run") "10000"
a5b0: 20 29 29 20 31 30 30 30 30 29 29 20 20 0a 20 20 )) 10000)) .
a5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5d0: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
a5e0: 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 get-arg "-target
a5f0: 22 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ") .
a600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a610: 28 69 66 20 28 73 74 72 69 6e 67 3d 20 28 61 72 (if (string= (ar
a620: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
a630: 67 65 74 22 29 20 72 75 6e 6b 65 79 29 20 28 61 get") runkey) (a
a640: 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 72 65 rea-allowed? are
a650: 61 20 22 61 72 65 61 2d 6e 65 65 64 73 2d 74 6f a "area-needs-to
a660: 2d 62 65 2d 72 75 6e 22 20 72 75 6e 6b 65 79 20 -be-run" runkey
a670: 63 6f 6e 74 6f 75 72 20 23 66 29 20 23 66 29 20 contour #f) #f)
a680: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a6a0: 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 (area-allowed?
a6b0: 61 72 65 61 20 22 61 72 65 61 2d 6e 65 65 64 73 area "area-needs
a6c0: 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 75 6e 6b -to-be-run" runk
a6d0: 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 29 29 29 ey contour #f)))
a6e0: 0a 20 20 20 20 20 20 20 0a 09 09 09 20 20 20 20 . ....
a6f0: 20 28 6c 65 74 2a 20 28 28 73 63 72 69 70 74 20 (let* ((script
a700: 28 63 61 72 20 63 6d 64 29 29 0a 09 09 09 09 28 (car cmd)).....(
a710: 70 61 72 61 6d 73 20 28 63 64 72 20 63 6d 64 29 params (cdr cmd)
a720: 29 0a 09 09 09 09 28 63 6d 64 20 20 20 20 28 63 ).....(cmd (c
a730: 6f 6e 63 20 73 63 72 69 70 74 20 22 20 22 20 63 onc script " " c
a740: 6f 6e 74 6f 75 72 20 22 20 22 20 61 72 65 61 20 ontour " " area
a750: 22 20 22 20 72 75 6e 6b 65 79 20 22 20 22 20 73 " " runkey " " s
a760: 74 64 2d 72 75 6e 6e 61 6d 65 20 22 20 22 20 61 td-runname " " a
a770: 63 74 69 6f 6e 20 22 20 22 20 70 61 72 61 6d 73 ction " " params
a780: 29 29 0a 09 09 09 09 28 72 65 73 20 20 20 20 28 )).....(res (
a790: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
a7a0: 73 0a 09 09 09 09 09 20 20 20 20 65 78 6e 0a 09 s...... exn..
a7b0: 09 09 09 09 20 20 20 20 23 66 0a 09 09 09 09 09 .... #f......
a7c0: 20 20 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 6e (print "Runnin
a7d0: 67 20 22 20 63 6d 64 29 0a 09 09 09 09 09 20 20 g " cmd)......
a7e0: 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d (with-input-from
a7f0: 2d 70 69 70 65 20 63 6d 64 20 72 65 61 64 2d 6c -pipe cmd read-l
a800: 69 6e 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 ines))).
a810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a820: 20 20 20 20 20 20 20 20 28 63 76 61 6c 20 20 20 (cval
a830: 20 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 (or (configf
a840: 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 :lookup mtconf "
a850: 63 6f 6e 74 6f 75 72 73 22 20 63 6f 6e 74 6f 75 contours" contou
a860: 72 29 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 r) "")).
a870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a880: 20 20 20 20 20 20 20 20 28 63 76 61 6c 2d 61 6c (cval-al
a890: 69 73 74 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c 2d ist (common:val-
a8a0: 3e 61 6c 69 73 74 20 63 76 61 6c 29 29 20 20 20 >alist cval))
a8b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8c0: 20 20 3b 3b 20 42 45 57 41 52 45 20 2e 2e 2e 20 ;; BEWARE ...
a8d0: 4e 4f 54 20 74 68 65 20 73 61 6d 65 20 76 61 6c NOT the same val
a8e0: 2d 61 6c 69 73 74 20 61 73 20 61 62 6f 76 65 21 -alist as above!
a8f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a910: 20 3b 3b 28 61 72 65 61 73 20 20 20 20 20 20 28 ;;(areas (
a920: 76 61 6c 2d 61 6c 69 73 74 2d 3e 61 72 65 61 73 val-alist->areas
a930: 20 63 76 61 6c 2d 61 6c 69 73 74 29 29 0a 20 20 cval-alist)).
a940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
a960: 65 6c 65 63 74 6f 72 20 20 20 28 61 6c 69 73 74 elector (alist
a970: 2d 72 65 66 20 27 73 65 6c 65 63 74 6f 72 20 63 -ref 'selector c
a980: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 20 20 20 20 val-alist)).
a990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 6f 64 (mod
a9b0: 65 2d 74 61 67 20 20 20 28 61 6e 64 20 73 65 6c e-tag (and sel
a9c0: 65 63 74 6f 72 20 28 73 74 72 69 6e 67 2d 73 70 ector (string-sp
a9d0: 6c 69 74 2d 66 69 65 6c 64 73 20 22 2f 22 20 73 lit-fields "/" s
a9e0: 65 6c 65 63 74 6f 72 20 23 3a 69 6e 66 69 78 29 elector #:infix)
a9f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
aa00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa10: 20 20 20 28 6d 6f 64 65 2d 70 61 74 74 20 20 28 (mode-patt (
aa20: 61 6e 64 20 6d 6f 64 65 2d 74 61 67 20 28 69 66 and mode-tag (if
aa30: 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 6d 6f (eq? (length mo
aa40: 64 65 2d 74 61 67 29 20 32 29 28 63 61 64 72 20 de-tag) 2)(cadr
aa50: 6d 6f 64 65 2d 74 61 67 29 20 23 66 29 29 29 0a mode-tag) #f))).
aa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa80: 28 74 61 67 2d 65 78 70 72 20 20 20 28 61 6e 64 (tag-expr (and
aa90: 20 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 28 6e mode-tag (if (n
aaa0: 75 6c 6c 3f 20 6d 6f 64 65 2d 74 61 67 29 20 23 ull? mode-tag) #
aab0: 66 20 28 63 61 72 20 6d 6f 64 65 2d 74 61 67 29 f (car mode-tag)
aac0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
aad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aae0: 20 20 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 ).... (if
aaf0: 28 61 6e 64 20 72 65 73 20 28 6e 6f 74 20 28 6e (and res (not (n
ab00: 75 6c 6c 3f 20 72 65 73 29 29 29 0a 09 09 09 20 ull? res)))....
ab10: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 (let* ((pa
ab20: 72 74 73 20 20 20 20 20 20 20 28 73 74 72 69 6e rts (strin
ab30: 67 2d 73 70 6c 69 74 20 28 63 61 72 20 72 65 73 g-split (car res
ab40: 29 29 29 20 3b 3b 0a 09 09 09 09 20 20 20 20 20 ))) ;;.....
ab50: 20 28 72 65 6d 2d 6c 69 6e 65 73 20 20 20 28 63 (rem-lines (c
ab60: 64 72 20 72 65 73 29 29 0a 09 09 09 09 20 20 20 dr res)).....
ab70: 20 20 20 28 6e 75 6d 2d 70 61 72 74 73 20 20 20 (num-parts
ab80: 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 29 0a (length parts)).
ab90: 09 09 09 09 20 20 20 20 20 20 28 6c 61 73 74 2d .... (last-
aba0: 63 68 61 6e 67 65 20 28 73 74 72 69 6e 67 2d 3e change (string->
abb0: 6e 75 6d 62 65 72 20 28 69 66 20 28 3e 20 6e 75 number (if (> nu
abc0: 6d 2d 70 61 72 74 73 20 30 29 28 63 61 72 20 70 m-parts 0)(car p
abd0: 61 72 74 73 29 20 22 61 62 63 22 29 29 29 20 20 arts) "abc")))
abe0: 3b 3b 20 66 6f 72 63 65 20 6e 6f 20 72 75 6e 20 ;; force no run
abf0: 69 66 20 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 if not a number
ac00: 72 65 74 75 72 6e 65 64 0a 09 09 09 09 20 20 20 returned.....
ac10: 20 20 20 28 6e 65 77 2d 74 61 72 67 65 74 20 20 (new-target
ac20: 28 69 66 20 28 3e 20 6e 75 6d 2d 70 61 72 74 73 (if (> num-parts
ac30: 20 31 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 1).......
ac40: 20 28 63 61 64 72 20 70 61 72 74 73 29 0a 09 09 (cadr parts)...
ac50: 09 09 09 09 20 20 20 20 20 20 20 72 75 6e 6b 65 .... runke
ac60: 79 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 6e y))..... (n
ac70: 65 77 2d 72 75 6e 6e 61 6d 65 20 28 69 66 20 28 ew-runname (if (
ac80: 3e 20 6e 75 6d 2d 70 61 72 74 73 20 32 29 0a 09 > num-parts 2)..
ac90: 09 09 09 09 09 20 20 20 20 20 20 20 28 63 61 64 ..... (cad
aca0: 64 72 20 70 61 72 74 73 29 0a 09 09 09 09 09 09 dr parts).......
acb0: 20 20 20 20 20 20 20 73 74 64 2d 72 75 6e 6e 61 std-runna
acc0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 me)).
acd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 .
ace0: 20 20 20 20 28 61 72 65 61 2d 70 6b 74 73 20 20 (area-pkts
acf0: 28 66 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 (find-pkts pdb '
ad00: 28 72 75 6e 73 74 61 72 74 29 20 60 28 28 63 20 (runstart) `((c
ad10: 2e 20 2c 63 6f 6e 74 6f 75 72 29 0a 20 20 20 20 . ,contour).
ad20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad60: 20 20 20 20 20 20 20 20 20 20 20 28 74 20 2e 20 (t .
ad70: 2c 72 75 6e 6b 65 79 29 0a 20 20 20 20 20 20 20 ,runkey).
ad80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ada0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
adb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
adc0: 20 20 20 20 20 20 20 20 28 47 20 2e 20 2c 61 72 (G . ,ar
add0: 65 61 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 ea )))).
ade0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
adf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
ae00: 75 6e 73 74 61 72 74 73 20 28 66 69 6c 74 65 72 unstarts (filter
ae10: 20 28 6c 61 6d 62 64 61 20 28 6d 79 2d 70 6b 74 (lambda (my-pkt
ae20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
ae30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae40: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 ;;(
ae50: 70 72 69 6e 74 20 6d 79 2d 70 6b 74 29 0a 20 20 print my-pkt).
ae60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae80: 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 63 (not (c
ae90: 6f 6e 74 61 69 6e 73 20 28 6d 61 70 0a 20 20 20 ontains (map.
aea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aeb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aec0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
aed0: 62 64 61 20 28 63 29 0a 20 20 20 20 20 20 20 20 bda (c).
aee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af00: 20 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 ;;(print
af10: 20 22 43 3a 20 22 20 63 20 22 50 4b 54 3a 20 22 "C: " c "PKT: "
af20: 20 6d 79 2d 70 6b 74 29 20 0a 20 20 20 20 20 20 my-pkt) .
af30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af50: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
af60: 28 28 63 74 79 70 65 20 28 63 61 72 20 63 29 29 ((ctype (car c))
af70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
af80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afa0: 20 20 20 20 20 20 20 20 28 72 78 20 28 63 64 72 (rx (cdr
afb0: 20 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c)).
afc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afe0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 66 ;;(f
aff0: 6f 6f 32 20 28 70 72 69 6e 74 20 22 43 74 79 70 oo2 (print "Ctyp
b000: 65 3a 20 22 20 63 74 79 70 65 20 22 20 52 58 3a e: " ctype " RX:
b010: 20 22 20 72 78 29 29 0a 20 20 20 20 20 20 20 20 " rx)).
b020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
b050: 70 6b 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 pkt (alist-ref '
b060: 70 6b 74 20 6d 79 2d 70 6b 74 29 29 0a 20 20 20 pkt my-pkt)).
b070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0a0: 20 20 20 20 28 61 70 6b 74 20 28 70 6b 74 2d 3e (apkt (pkt->
b0b0: 61 6c 69 73 74 20 70 6b 74 29 29 0a 20 20 20 20 alist pkt)).
b0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0f0: 20 20 20 28 63 64 61 74 20 28 61 6c 69 73 74 2d (cdat (alist-
b100: 72 65 66 20 63 74 79 70 65 20 61 70 6b 74 29 29 ref ctype apkt))
b110: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b140: 20 20 20 28 69 66 20 72 78 0a 20 20 20 20 20 20 (if rx.
b150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b170: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
b180: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 74 22 string-match "t"
b190: 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 (symbol->string
b1a0: 20 63 74 79 70 65 29 20 29 0a 20 20 20 20 20 20 ctype) ).
b1b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1d0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
b1e0: 6e 20 28 69 66 20 23 66 20 28 70 72 69 6e 74 20 n (if #f (print
b1f0: 22 52 58 3a 20 22 20 72 78 20 22 20 43 44 41 54 "RX: " rx " CDAT
b200: 3a 20 22 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e : " (string-join
b210: 20 28 74 61 6b 65 20 28 73 74 72 69 6e 67 2d 73 (take (string-s
b220: 70 6c 69 74 20 63 64 61 74 20 22 2f 22 29 20 33 plit cdat "/") 3
b230: 29 20 22 2f 22 29 29 29 20 28 69 66 20 63 64 61 ) "/"))) (if cda
b240: 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 t (string-match
b250: 72 78 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 rx (string-join
b260: 28 74 61 6b 65 20 28 73 74 72 69 6e 67 2d 73 70 (take (string-sp
b270: 6c 69 74 20 63 64 61 74 20 22 2f 22 29 20 33 29 lit cdat "/") 3)
b280: 20 22 2f 22 29 29 20 23 66 29 29 0a 20 20 20 20 "/")) #f)).
b290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
b2c0: 67 69 6e 20 28 69 66 20 23 66 20 28 70 72 69 6e gin (if #f (prin
b2d0: 74 20 22 52 58 3a 20 22 20 72 78 20 22 20 43 44 t "RX: " rx " CD
b2e0: 41 54 3a 20 22 20 63 64 61 74 29 29 20 28 69 66 AT: " cdat)) (if
b2f0: 20 63 64 61 74 20 28 73 74 72 69 6e 67 2d 6d 61 cdat (string-ma
b300: 74 63 68 20 72 78 20 63 64 61 74 29 20 23 66 29 tch rx cdat) #f)
b310: 29 29 20 23 66 29 0a 0a 20 20 20 20 20 20 20 20 )) #f)..
b320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b340: 20 20 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 )).
b350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b370: 20 20 20 20 60 28 28 63 20 2e 20 2c 63 6f 6e 74 `((c . ,cont
b380: 6f 75 72 29 20 28 74 20 2e 20 2c 72 75 6e 6b 65 our) (t . ,runke
b390: 79 29 20 28 47 20 2e 20 2c 61 72 65 61 29 29 29 y) (G . ,area)))
b3a0: 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f))).
b3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
b3d0: 72 65 61 2d 70 6b 74 73 29 29 0a 0a 20 20 20 20 rea-pkts))..
b3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b400: 20 20 3b 3b 28 74 65 73 74 20 28 70 70 20 72 75 ;;(test (pp ru
b410: 6e 73 74 61 72 74 73 29 29 0a 20 20 20 20 20 20 nstarts)).
b420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b430: 20 20 09 20 20 20 20 20 20 28 72 73 70 6b 74 73 . (rspkts
b440: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
b450: 2d 70 6b 74 2d 61 6c 69 73 74 73 20 72 75 6e 73 -pkt-alists runs
b460: 74 61 72 74 73 29 29 0a 20 20 20 20 20 20 20 20 tarts)).
b470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b480: 09 20 20 20 20 20 20 3b 3b 20 73 74 61 72 74 74 . ;; startt
b490: 69 6d 65 73 20 69 73 20 66 6f 72 20 72 75 6e 20 imes is for run
b4a0: 73 74 61 72 74 20 74 69 6d 65 73 20 61 6e 64 20 start times and
b4b0: 69 73 20 75 73 65 64 20 74 6f 20 6b 6e 6f 77 20 is used to know
b4c0: 77 68 65 6e 20 74 68 65 20 6c 61 73 74 20 72 75 when the last ru
b4d0: 6e 20 77 61 73 20 6c 61 75 6e 63 68 65 64 0a 20 n was launched.
b4e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4f0: 20 20 20 20 20 20 20 09 20 20 20 20 20 20 28 73 . (s
b500: 74 61 72 74 74 69 6d 65 73 20 28 63 6f 6d 6d 6f tarttimes (commo
b510: 6e 3a 67 65 74 2d 70 6b 74 2d 74 69 6d 65 73 20 n:get-pkt-times
b520: 72 73 70 6b 74 73 29 29 20 3b 3b 20 73 6f 72 74 rspkts)) ;; sort
b530: 20 62 79 20 61 67 65 20 28 79 6f 75 6e 67 65 73 by age (younges
b540: 74 20 66 69 72 73 74 29 20 61 6e 64 20 64 65 6c t first) and del
b550: 65 74 65 20 64 75 70 6c 69 63 61 74 65 73 20 62 ete duplicates b
b560: 79 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 y target.
b570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b580: 20 09 20 20 20 20 20 20 28 6c 61 73 74 2d 72 75 . (last-ru
b590: 6e 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 n (if (null? s
b5a0: 74 61 72 74 74 69 6d 65 73 29 20 3b 3b 20 69 66 tarttimes) ;; if
b5b0: 20 27 28 29 20 74 68 65 6e 20 69 74 20 68 61 73 '() then it has
b5c0: 20 6e 65 76 65 72 20 62 65 65 6e 20 72 75 6e 2c never been run,
b5d0: 20 65 6c 73 65 20 67 65 74 20 74 68 65 20 6d 61 else get the ma
b5e0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
b5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b600: 20 20 20 20 20 20 20 20 20 20 20 20 30 0a 20 20 0.
b610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b630: 20 20 20 20 20 20 28 61 70 70 6c 79 20 6d 61 78 (apply max
b640: 20 28 6d 61 70 20 63 64 72 20 73 74 61 72 74 74 (map cdr startt
b650: 69 6d 65 73 29 29 29 29 0a 0a 20 20 20 20 20 20 imes))))..
b660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
b680: 3b 20 28 6c 61 73 74 2d 72 75 6e 20 20 39 29 20 ; (last-run 9)
b690: 3b 3b 20 49 20 74 68 69 6e 6b 20 77 65 20 63 61 ;; I think we ca
b6a0: 6e 20 64 6f 20 61 20 6d 6f 72 65 20 76 61 6c 69 n do a more vali
b6b0: 64 20 63 61 6c 63 75 6c 61 74 69 6f 6e 20 66 6f d calculation fo
b6c0: 72 20 74 68 69 73 20 62 61 73 65 64 20 6f 6e 20 r this based on
b6d0: 74 68 65 20 72 75 6e 20 73 74 61 72 74 65 64 20 the run started
b6e0: 70 61 63 6b 65 74 73 20 66 6f 72 20 74 68 69 73 packets for this
b6f0: 20 70 61 72 74 69 63 75 6c 61 72 20 61 72 65 61 particular area
b700: 20 61 6e 64 20 74 61 72 67 65 74 0a 20 20 20 20 and target.
b710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b730: 20 20 28 72 65 61 73 6f 6e 20 22 41 72 65 61 2d (reason "Area-
b740: 73 63 72 69 70 74 2d 74 72 69 67 67 65 72 65 64 script-triggered
b750: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
b760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b770: 20 20 20 20 20 20 20 20 20 3b 3b 28 6d 6f 64 65 ;;(mode
b780: 2d 70 61 74 74 20 23 66 29 0a 20 20 20 20 20 20 -patt #f).
b790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b7a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b7b0: 3b 3b 28 74 61 67 2d 65 78 70 72 20 23 66 29 0a ;;(tag-expr #f).
b7c0: 09 09 09 09 20 20 20 20 20 20 28 73 63 68 65 64 .... (sched
b7d0: 20 23 66 29 0a 09 09 09 09 20 20 20 20 20 20 28 #f)..... (
b7e0: 6d 65 73 73 61 67 65 20 20 20 20 20 28 69 66 20 message (if
b7f0: 28 6e 75 6c 6c 3f 20 72 65 6d 2d 6c 69 6e 65 73 (null? rem-lines
b800: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 63 )....... c
b810: 6d 64 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 md.......
b820: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
b830: 72 73 65 20 72 65 6d 2d 6c 69 6e 65 73 20 22 2d rse rem-lines "-
b840: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 ")))..... (
b850: 6e 65 65 64 2d 72 75 6e 20 20 20 20 28 3e 20 6c need-run (> l
b860: 61 73 74 2d 63 68 61 6e 67 65 20 6c 61 73 74 2d ast-change last-
b870: 72 75 6e 29 29 29 0a 09 09 09 09 20 28 70 72 69 run)))..... (pri
b880: 6e 74 20 22 6c 61 73 74 2d 63 68 61 6e 67 65 3a nt "last-change:
b890: 20 22 20 6c 61 73 74 2d 63 68 61 6e 67 65 20 22 " last-change "
b8a0: 20 6c 61 73 74 2d 72 75 6e 3a 20 22 20 6c 61 73 last-run: " las
b8b0: 74 2d 72 75 6e 20 22 20 6e 65 65 64 2d 72 75 6e t-run " need-run
b8c0: 3a 20 22 20 6e 65 65 64 2d 72 75 6e 29 0a 09 09 : " need-run)...
b8d0: 09 09 20 28 69 66 20 6e 65 65 64 2d 72 75 6e 0a .. (if need-run.
b8e0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
b8f0: 28 6b 65 79 2d 6d 73 67 20 20 20 20 60 28 28 6d (key-msg `((m
b900: 65 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 essage . ,(conc
b910: 20 72 75 6c 65 74 79 70 65 20 22 3a 22 20 6d 65 ruletype ":" me
b920: 73 73 61 67 65 29 29 0a 09 09 09 09 09 09 09 20 ssage))........
b930: 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 6e 65 (runname . ,ne
b940: 77 2d 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 w-runname)......
b950: 09 09 20 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 .. (runtrans .
b960: 2c 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 ,runtrans)......
b970: 09 09 20 20 28 61 63 74 69 6f 6e 20 20 20 2e 20 .. (action .
b980: 2c 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 09 ,action)........
b990: 20 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 (areas . ,a
b9a0: 72 65 61 29 0a 09 09 09 09 09 09 09 20 20 3b 3b rea)........ ;;
b9b0: 28 74 61 72 67 65 74 20 20 20 2e 20 2c 28 6c 69 (target . ,(li
b9c0: 73 74 20 6e 65 77 2d 74 61 72 67 65 74 29 29 20 st new-target))
b9d0: 3b 3b 20 6f 76 65 72 72 69 64 69 6e 67 20 77 69 ;; overriding wi
b9e0: 74 68 20 72 65 73 75 6c 74 20 66 72 6f 6d 20 72 th result from r
b9f0: 75 6e 69 6e 67 20 74 68 65 20 73 63 72 69 70 74 uning the script
ba00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ba10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba30: 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 09 09 ))...
ba40: 09 09 09 09 09 28 61 76 61 6c 20 20 20 20 20 20 .....(aval
ba50: 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
ba60: 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 okup mtconf "are
ba70: 61 73 22 20 61 72 65 61 29 20 22 22 29 29 0a 20 as" area) "")).
ba80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
baa0: 20 20 20 09 09 09 28 61 76 61 6c 2d 61 6c 69 73 ...(aval-alis
bab0: 74 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c 2d 3e 61 t (common:val->a
bac0: 6c 69 73 74 20 61 76 61 6c 29 29 0a 0a 09 09 09 list aval)).....
bad0: 09 09 09 09 28 74 61 72 67 65 74 73 20 28 6d 61 ....(targets (ma
bae0: 70 2d 74 61 72 67 65 74 73 20 6d 74 63 6f 6e 66 p-targets mtconf
baf0: 20 61 76 61 6c 2d 61 6c 69 73 74 20 72 75 6e 6b aval-alist runk
bb00: 65 79 20 61 72 65 61 20 63 6f 6e 74 6f 75 72 29 ey area contour)
bb10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
bb20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb30: 20 20 20 20 20 20 20 20 20 20 20 28 70 70 20 74 (pp t
bb40: 61 72 67 65 74 73 29 0a 09 09 09 09 20 20 20 20 argets).....
bb50: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
bb60: 61 6d 62 64 61 20 28 74 61 72 67 65 74 29 20 0a ambda (target) .
bb70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bba0: 20 20 20 20 20 28 63 72 65 61 74 65 2d 72 75 6e (create-run
bbb0: 2d 70 6b 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 -pkt mtconf acti
bbc0: 6f 6e 20 61 72 65 61 20 72 75 6e 6b 65 79 20 74 on area runkey t
bbd0: 61 72 67 65 74 20 6e 65 77 2d 72 75 6e 6e 61 6d arget new-runnam
bbe0: 65 20 6d 6f 64 65 2d 70 61 74 74 0a 20 20 20 20 e mode-patt.
bbf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc20: 20 20 74 61 67 2d 65 78 70 72 20 70 6b 74 73 64 tag-expr pktsd
bc30: 69 72 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 ir reason contou
bc40: 72 20 73 63 68 65 64 20 64 62 64 65 73 74 20 61 r sched dbdest a
bc50: 70 70 65 6e 64 0a 20 20 20 20 20 20 20 20 20 20 ppend.
bc60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc80: 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 74 runt
bc90: 72 61 6e 73 29 0a 20 20 20 20 20 20 20 20 20 20 rans).
bca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcc0: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
bcd0: 20 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 packets-generat
bce0: 65 64 20 28 2b 20 70 61 63 6b 65 74 73 2d 67 65 ed (+ packets-ge
bcf0: 6e 65 72 61 74 65 64 20 31 29 29 0a 20 20 20 20 nerated 1)).
bd00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 20 )
bd30: 74 61 72 67 65 74 73 29 0a 09 09 09 09 09 3b 3b targets)......;;
bd40: 20 41 64 64 20 66 69 6c 74 65 72 20 66 6f 72 20 Add filter for
bd50: 74 61 72 67 65 74 73 0a 0a 20 20 20 20 20 20 20 targets..
bd60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd80: 3b 3b 28 63 72 65 61 74 65 2d 72 75 6e 2d 70 6b ;;(create-run-pk
bd90: 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f 6e 20 t mtconf action
bda0: 61 72 65 61 20 72 75 6e 6b 65 79 20 74 61 72 67 area runkey targ
bdb0: 65 74 20 72 75 6e 6e 61 6d 65 0a 20 20 20 20 20 et runname.
bdc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bdd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bde0: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ;;
bdf0: 20 20 20 70 6b 74 73 64 69 72 20 72 65 61 73 6f pktsdir reaso
be00: 6e 20 63 6f 6e 74 6f 75 72 20 64 62 64 65 73 74 n contour dbdest
be10: 20 61 70 70 65 6e 64 0a 20 20 20 20 20 20 20 20 append.
be20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
be40: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
be50: 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 20 20 runtrans).....
be60: 20 20 20 20 20 28 70 72 69 6e 74 20 22 6b 65 79 (print "key
be70: 2d 6d 73 67 3a 20 22 20 6b 65 79 2d 6d 73 67 29 -msg: " key-msg)
be80: 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 28 70 ..... ;;(p
be90: 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 ush-run-spec tor
bea0: 75 6e 20 63 6f 6e 74 6f 75 72 0a 09 09 09 09 3b un contour.....;
beb0: 3b 09 09 20 20 20 20 20 20 28 69 66 20 6f 70 74 ;.. (if opt
bec0: 69 6f 6e 61 6c 20 20 3b 3b 20 77 65 20 6e 65 65 ional ;; we nee
bed0: 64 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 d to be able to
bee0: 64 69 66 66 65 72 65 6e 74 69 61 74 65 20 73 61 differentiate sa
bef0: 6d 65 20 63 6f 6e 74 6f 75 72 2c 20 64 69 66 66 me contour, diff
bf00: 65 72 65 6e 74 20 62 65 68 61 76 69 6f 72 2e 20 erent behavior.
bf10: 0a 09 09 09 09 3b 3b 09 09 09 20 20 28 63 6f 6e .....;;... (con
bf20: 63 20 72 75 6e 6b 65 79 20 22 3a 22 20 6f 70 74 c runkey ":" opt
bf30: 69 6f 6e 61 6c 29 20 20 3b 3b 20 4e 4f 54 45 3a ional) ;; NOTE:
bf40: 20 4e 4f 54 20 43 4f 4d 50 4c 45 54 45 4c 59 20 NOT COMPLETELY
bf50: 49 4d 50 4c 45 4d 45 4e 54 45 44 2e 20 44 4f 20 IMPLEMENTED. DO
bf60: 4e 4f 54 20 55 53 45 0a 09 09 09 09 3b 3b 09 09 NOT USE.....;;..
bf70: 09 20 20 72 75 6e 6b 65 79 29 0a 09 09 09 09 3b . runkey).....;
bf80: 3b 09 09 20 20 20 20 20 20 6b 65 79 2d 6d 73 67 ;.. key-msg
bf90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
bfa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfb0: 20 20 20 20 20 20 20 20 20 29 29 29 29 29 20 0a ))))) .
bfc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfe0: 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 70 (if (>= p
bff0: 61 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 65 64 ackets-generated
c000: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
c010: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
c020: 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 mtconf "setup"
c030: 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f 70 65 72 "max_packets_per
c040: 5f 72 75 6e 22 29 29 29 20 28 70 72 69 6e 74 20 _run"))) (print
c050: 22 53 6b 69 70 70 69 6e 67 20 61 72 65 61 3a 20 "Skipping area:
c060: 22 20 61 72 65 61 20 22 20 61 6e 64 20 74 61 72 " area " and tar
c070: 67 65 74 3a 20 22 20 72 75 6e 6b 65 79 20 22 20 get: " runkey "
c080: 64 75 65 20 74 6f 20 70 61 63 6b 65 74 73 2d 67 due to packets-g
c090: 65 6e 65 72 61 74 65 64 3a 20 22 20 70 61 63 6b enerated: " pack
c0a0: 65 74 73 2d 67 65 6e 65 72 61 74 65 64 20 22 20 ets-generated "
c0b0: 68 69 67 68 65 72 20 74 68 61 6e 20 22 20 28 63 higher than " (c
c0c0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 onfigf:lookup mt
c0d0: 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 6d 61 conf "setup" "ma
c0e0: 78 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 75 x_packets_per_ru
c0f0: 6e 22 29 29 29 29 20 20 20 20 0a 0a 20 20 20 20 n")))) ..
c100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c110: 20 20 20 29 20 28 66 69 6c 74 65 72 20 28 6c 61 ) (filter (la
c120: 6d 62 64 61 20 28 78 29 20 28 69 66 20 28 6e 6f mbda (x) (if (no
c130: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
c140: 22 2d 61 72 65 61 22 29 29 20 23 74 20 28 69 66 "-area")) #t (if
c150: 20 28 73 74 72 69 6e 67 3d 20 78 20 28 61 72 67 (string= x (arg
c160: 73 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 65 61 s:get-arg "-area
c170: 22 29 29 20 23 74 20 23 66 29 29 29 20 61 6c 6c ")) #t #f))) all
c180: 2d 61 72 65 61 73 29 29 0a 09 09 20 20 20 20 20 -areas))...
c190: 20 20 29 20 76 61 6c 2d 61 6c 69 73 74 29 29 20 ) val-alist))
c1a0: 3b 3b 20 69 74 65 72 61 74 65 20 6f 76 65 72 20 ;; iterate over
c1b0: 74 68 65 20 70 61 72 61 6d 20 73 70 6c 69 74 20 the param split
c1c0: 62 79 20 3b 5c 73 2a 0a 0a 09 09 20 20 20 20 20 by ;\s*....
c1d0: 3b 3b 20 66 6f 73 73 69 6c 20 73 63 6d 20 62 61 ;; fossil scm ba
c1e0: 73 65 64 20 74 72 69 67 67 65 72 73 0a 09 09 20 sed triggers...
c1f0: 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 ;;... ((
c200: 66 6f 73 73 69 6c 29 0a 09 09 20 20 20 20 20 20 fossil)...
c210: 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 (for-each...
c220: 20 20 20 28 6c 61 6d 62 64 61 20 28 66 73 70 65 (lambda (fspe
c230: 63 29 0a 09 09 09 20 28 70 72 69 6e 74 20 22 66 c).... (print "f
c240: 73 70 65 63 3a 20 22 20 66 73 70 65 63 29 0a 09 spec: " fspec)..
c250: 09 09 20 28 6c 65 74 2a 20 28 28 75 72 6c 20 20 .. (let* ((url
c260: 20 20 20 20 20 20 20 28 73 79 6d 62 6f 6c 2d 3e (symbol->
c270: 73 74 72 69 6e 67 20 28 63 61 72 20 66 73 70 65 string (car fspe
c280: 63 29 29 29 20 3b 3b 20 54 48 49 53 20 43 4f 55 c))) ;; THIS COU
c290: 4c 44 20 42 45 20 54 52 4f 55 42 4c 45 2e 20 41 LD BE TROUBLE. A
c2a0: 64 64 20 6f 70 74 69 6f 6e 20 74 6f 20 72 65 61 dd option to rea
c2b0: 64 69 6e 67 20 6c 69 6e 65 20 74 6f 20 72 65 74 ding line to ret
c2c0: 75 72 6e 20 61 73 20 73 74 72 69 6e 67 2e 0a 09 urn as string...
c2d0: 09 09 09 28 62 72 61 6e 63 68 20 20 20 20 20 20 ...(branch
c2e0: 28 63 64 72 20 66 73 70 65 63 29 29 0a 09 09 09 (cdr fspec))....
c2f0: 09 28 75 72 6c 2d 69 73 2d 66 69 6c 65 20 28 73 .(url-is-file (s
c300: 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 28 2f tring-match "^(/
c310: 7c 66 69 6c 65 3a 29 2e 2a 24 22 20 75 72 6c 29 |file:).*$" url)
c320: 29 0a 09 09 09 09 28 66 6e 61 6d 65 20 20 20 20 ).....(fname
c330: 20 20 20 28 63 6f 6e 63 20 28 63 6f 6d 6d 6f 6e (conc (common
c340: 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 65 20 75 :get-signature u
c350: 72 6c 29 20 22 2e 66 6f 73 73 69 6c 22 29 29 0a rl) ".fossil")).
c360: 09 09 09 09 28 66 64 69 72 20 20 20 20 20 20 20 ....(fdir
c370: 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 (conc "/tmp/" (
c380: 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d current-user-nam
c390: 65 29 20 22 2f 6d 74 75 74 69 6c 5f 63 61 63 68 e) "/mtutil_cach
c3a0: 65 22 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 e"))).... ;; (
c3b0: 69 66 20 28 6e 6f 74 20 75 72 6c 2d 69 73 2d 66 if (not url-is-f
c3c0: 69 6c 65 29 20 3b 3b 20 6e 65 65 64 20 74 6f 20 ile) ;; need to
c3d0: 73 79 6e 63 20 66 69 72 73 74 20 2d 2d 2d 20 66 sync first --- f
c3e0: 6f 72 20 6e 6f 77 2c 20 63 6c 6f 6e 65 20 27 65 or now, clone 'e
c3f0: 6d 20 61 6c 6c 2e 0a 09 09 09 20 20 20 28 66 6f m all..... (fo
c400: 73 73 69 6c 3a 63 6c 6f 6e 65 2d 6f 72 2d 73 79 ssil:clone-or-sy
c410: 6e 63 20 75 72 6c 20 66 6e 61 6d 65 20 66 64 69 nc url fname fdi
c420: 72 29 20 3b 3b 20 29 0a 09 09 09 20 20 20 28 6c r) ;; ).... (l
c430: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 64 61 74 et-values (((dat
c440: 65 74 69 6d 65 20 6e 6f 64 65 29 0a 09 09 09 09 etime node).....
c450: 09 20 28 66 6f 73 73 69 6c 3a 6c 61 73 74 2d 63 . (fossil:last-c
c460: 68 61 6e 67 65 2d 6e 6f 64 65 2d 61 6e 64 2d 74 hange-node-and-t
c470: 69 6d 65 20 66 64 69 72 20 66 6e 61 6d 65 20 62 ime fdir fname b
c480: 72 61 6e 63 68 29 29 29 0a 09 09 09 20 20 20 20 ranch)))....
c490: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 (if (null? star
c4a0: 74 74 69 6d 65 73 29 0a 09 09 09 09 20 28 70 75 ttimes)..... (pu
c4b0: 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 sh-run-spec toru
c4c0: 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 n contour runkey
c4d0: 0a 09 09 09 09 09 09 60 28 28 6d 65 73 73 61 67 .......`((messag
c4e0: 65 20 20 2e 20 2c 28 63 6f 6e 63 20 22 66 6f 73 e . ,(conc "fos
c4f0: 73 69 6c 3a 22 20 62 72 61 6e 63 68 20 22 2d 6e sil:" branch "-n
c500: 65 76 65 72 72 75 6e 22 29 29 0a 09 09 09 09 09 everrun"))......
c510: 09 20 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c . (runname . ,
c520: 28 63 6f 6e 63 20 72 75 6e 6e 61 6d 65 20 22 2d (conc runname "-
c530: 22 20 6e 6f 64 65 29 29 0a 09 09 09 09 09 09 20 " node)).......
c540: 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 (runtrans . ,ru
c550: 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 20 ntrans).......
c560: 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 (areas . ,are
c570: 61 73 29 0a 09 09 09 09 09 09 20 20 3b 3b 20 28 as)....... ;; (
c580: 74 61 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b target . ,runk
c590: 65 79 29 0a 09 09 09 09 09 09 20 20 28 61 63 74 ey)....... (act
c5a0: 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 ion . ,action)
c5b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c5e0: 20 20 20 29 29 0a 09 09 09 09 20 28 69 66 20 28 ))..... (if (
c5f0: 3e 20 64 61 74 65 74 69 6d 65 20 6c 61 73 74 2d > datetime last-
c600: 72 75 6e 29 20 3b 3b 20 63 68 61 6e 67 65 20 74 run) ;; change t
c610: 69 6d 65 20 69 73 20 67 72 65 61 74 65 72 20 74 ime is greater t
c620: 68 61 6e 20 6c 61 73 74 2d 72 75 6e 20 74 69 6d han last-run tim
c630: 65 0a 09 09 09 09 20 20 20 20 20 28 70 75 73 68 e..... (push
c640: 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 -run-spec torun
c650: 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 contour runkey..
c660: 09 09 09 09 09 20 20 20 20 60 28 28 6d 65 73 73 ..... `((mess
c670: 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 22 66 age . ,(conc "f
c680: 6f 73 73 69 6c 3a 22 20 62 72 61 6e 63 68 20 22 ossil:" branch "
c690: 2d 22 20 6e 6f 64 65 29 29 0a 09 09 09 09 09 09 -" node)).......
c6a0: 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 (runname
c6b0: 2e 20 2c 28 63 6f 6e 63 20 72 75 6e 6e 61 6d 65 . ,(conc runname
c6c0: 20 22 2d 22 20 6e 6f 64 65 29 29 0a 09 09 09 09 "-" node)).....
c6d0: 09 09 20 20 20 20 20 20 28 72 75 6e 74 72 61 6e .. (runtran
c6e0: 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a 09 s . ,runtrans)..
c6f0: 09 09 09 09 09 20 20 20 20 20 20 28 61 72 65 61 ..... (area
c700: 73 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 s . ,areas)..
c710: 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 74 ..... ;; (t
c720: 61 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b 65 arget . ,runke
c730: 79 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 y)....... (
c740: 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 action . ,acti
c750: 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 on).......
c760: 28 62 72 61 6e 63 68 20 20 20 2e 20 2c 62 72 61 (branch . ,bra
c770: 6e 63 68 29 0a 09 09 09 09 09 09 20 20 20 20 20 nch).......
c780: 20 28 75 72 6c 20 20 20 20 20 20 2e 20 2c 75 72 (url . ,ur
c790: 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 l)....... (
c7a0: 63 6c 6f 6e 65 20 20 20 20 2e 20 2c 28 63 6f 6e clone . ,(con
c7b0: 63 20 66 64 69 72 20 22 2f 22 20 66 6e 61 6d 65 c fdir "/" fname
c7c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
c7d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c7f0: 20 20 20 20 20 20 20 20 20 29 29 29 29 0a 09 09 ))))...
c800: 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 47 6f . (print "Go
c810: 74 20 64 61 74 65 74 69 6d 65 3d 22 20 64 61 74 t datetime=" dat
c820: 65 74 69 6d 65 20 22 20 6e 6f 64 65 3d 22 20 6e etime " node=" n
c830: 6f 64 65 29 29 29 29 0a 09 09 20 20 20 20 20 20 ode))))...
c840: 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 0a 09 09 val-alist))....
c850: 20 20 20 20 20 3b 3b 20 73 65 6e 73 6f 72 20 6c ;; sensor l
c860: 6f 6f 6b 69 6e 67 20 66 6f 72 20 6f 6e 65 20 6f ooking for one o
c870: 72 20 6d 6f 72 65 20 66 69 6c 65 73 20 6e 65 77 r more files new
c880: 65 72 20 74 68 61 6e 20 72 65 66 65 72 65 6e 63 er than referenc
c890: 65 0a 09 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 e... ;;...
c8a0: 20 20 20 28 28 66 69 6c 65 20 66 69 6c 65 2d 6f ((file file-o
c8b0: 72 29 20 3b 3b 20 6f 6e 65 20 6f 72 20 6d 6f 72 r) ;; one or mor
c8c0: 65 20 66 69 6c 65 73 20 6d 75 73 74 20 62 65 20 e files must be
c8d0: 6e 65 77 65 72 20 74 68 61 6e 20 74 68 65 20 72 newer than the r
c8e0: 65 66 65 72 65 6e 63 65 0a 09 09 20 20 20 20 20 eference...
c8f0: 20 28 6c 65 74 2a 20 28 28 79 6f 75 6e 67 65 73 (let* ((younges
c900: 74 64 61 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 tdat (common:get
c910: 2d 79 6f 75 6e 67 65 73 74 20 28 63 6f 6d 6d 6f -youngest (commo
c920: 6e 3a 62 61 73 68 2d 67 6c 6f 62 20 66 69 6c 65 n:bash-glob file
c930: 2d 67 6c 6f 62 73 29 29 29 0a 09 09 09 20 20 20 -globs)))....
c940: 20 20 28 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 (youngestmod (
c950: 63 61 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 car youngestdat)
c960: 29 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 ))....;; (print
c970: 22 79 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 22 20 "youngestmod: "
c980: 79 6f 75 6e 67 65 73 74 6d 6f 64 20 22 20 73 74 youngestmod " st
c990: 61 72 74 74 69 6d 65 73 3a 20 22 20 73 74 61 72 arttimes: " star
c9a0: 74 74 69 6d 65 73 29 0a 09 09 09 28 69 66 20 28 ttimes)....(if (
c9b0: 6e 75 6c 6c 3f 20 73 74 61 72 74 74 69 6d 65 73 null? starttimes
c9c0: 29 20 3b 3b 20 74 68 69 73 20 74 61 72 67 65 74 ) ;; this target
c9d0: 20 68 61 73 20 6e 65 76 65 72 20 62 65 65 6e 20 has never been
c9e0: 72 75 6e 0a 09 09 09 20 20 20 20 28 70 75 73 68 run.... (push
c9f0: 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 -run-spec torun
ca00: 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 contour runkey..
ca10: 09 09 09 09 20 20 20 60 28 28 6d 65 73 73 61 67 .... `((messag
ca20: 65 20 20 2e 20 22 66 69 6c 65 3a 6e 65 76 65 72 e . "file:never
ca30: 72 75 6e 22 29 0a 09 09 09 09 09 20 20 20 20 20 run")......
ca40: 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 (action . ,act
ca50: 69 6f 6e 29 0a 09 09 09 09 09 20 20 20 20 20 28 ion)...... (
ca60: 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e 74 runtrans . ,runt
ca70: 72 61 6e 73 29 0a 09 09 09 09 09 20 20 20 20 20 rans)......
ca80: 3b 3b 20 28 74 61 72 67 65 74 20 20 20 2e 20 2c ;; (target . ,
ca90: 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 20 20 20 runkey)......
caa0: 20 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 (areas . ,a
cab0: 72 65 61 73 29 0a 09 09 09 09 09 20 20 20 20 20 reas)......
cac0: 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e (runname . ,run
cad0: 6e 61 6d 65 29 29 29 0a 09 09 09 3b 3b 20 28 66 name)))....;; (f
cae0: 6f 72 2d 65 61 63 68 0a 09 09 09 3b 3b 20 20 28 or-each....;; (
caf0: 6c 61 6d 62 64 61 20 28 73 74 61 72 74 74 69 6d lambda (starttim
cb00: 65 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 e) ;; look at th
cb10: 65 20 74 69 6d 65 20 74 68 65 20 6c 61 73 74 20 e time the last
cb20: 72 75 6e 20 77 61 73 20 6b 69 63 6b 65 64 20 6f run was kicked o
cb30: 66 66 20 66 6f 72 20 74 68 69 73 20 63 6f 6e 74 ff for this cont
cb40: 6f 75 72 0a 09 09 09 3b 3b 20 20 20 20 28 69 66 our....;; (if
cb50: 20 28 3e 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 (> youngestmod
cb60: 28 63 64 72 20 73 74 61 72 74 74 69 6d 65 29 29 (cdr starttime))
cb70: 0a 09 09 09 3b 3b 20 09 20 20 20 28 62 65 67 69 ....;; . (begi
cb80: 6e 0a 09 09 09 3b 3b 20 09 20 20 20 20 20 28 70 n....;; . (p
cb90: 72 69 6e 74 20 22 73 74 61 72 74 74 69 6d 65 20 rint "starttime
cba0: 79 6f 75 6e 67 65 72 20 74 68 61 6e 20 79 6f 75 younger than you
cbb0: 6e 67 65 73 74 6d 6f 64 3a 20 22 20 73 74 61 72 ngestmod: " star
cbc0: 74 74 69 6d 65 20 22 20 59 6f 75 6e 67 65 73 74 ttime " Youngest
cbd0: 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d mod: " youngestm
cbe0: 6f 64 29 0a 09 09 09 20 20 20 20 28 69 66 20 28 od).... (if (
cbf0: 3e 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 6c 61 > youngestmod la
cc00: 73 74 2d 72 75 6e 29 0a 09 09 09 09 28 70 75 73 st-run).....(pus
cc10: 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e h-run-spec torun
cc20: 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a contour runkey.
cc30: 09 09 09 09 09 20 20 20 20 20 20 20 60 28 28 6d ..... `((m
cc40: 65 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 essage . ,(conc
cc50: 20 72 75 6c 65 74 79 70 65 20 22 3a 22 20 28 63 ruletype ":" (c
cc60: 61 64 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 adr youngestdat)
cc70: 29 29 0a 09 09 09 09 09 09 20 28 61 63 74 69 6f ))....... (actio
cc80: 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a 09 n . ,action)..
cc90: 09 09 09 09 09 20 3b 3b 20 28 74 61 72 67 65 74 ..... ;; (target
cca0: 20 20 20 2e 20 2c 72 75 6e 6b 65 79 29 0a 09 09 . ,runkey)...
ccb0: 09 09 09 09 20 28 72 75 6e 74 72 61 6e 73 20 2e .... (runtrans .
ccc0: 20 2c 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 ,runtrans).....
ccd0: 09 09 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c .. (areas . ,
cce0: 61 72 65 61 73 29 0a 09 09 09 09 09 09 20 28 72 areas)....... (r
ccf0: 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 unname . ,runna
cd00: 6d 65 29 0a 09 09 09 09 09 09 20 29 29 29 29 29 me)....... )))))
cd10: 29 0a 0a 09 09 20 20 20 20 20 3b 3b 20 61 6c 6c ).... ;; all
cd20: 20 67 6c 6f 62 62 65 64 20 66 69 6c 65 73 20 6d globbed files m
cd30: 75 73 74 20 62 65 20 6e 65 77 65 72 20 74 68 61 ust be newer tha
cd40: 6e 20 74 68 65 20 72 65 66 65 72 65 6e 63 65 0a n the reference.
cd50: 09 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 .. ;;...
cd60: 20 28 28 66 69 6c 65 2d 61 6e 64 29 20 3b 3b 20 ((file-and) ;;
cd70: 61 6c 6c 20 66 69 6c 65 73 20 6d 75 73 74 20 62 all files must b
cd80: 65 20 6e 65 77 65 72 20 74 68 61 6e 20 74 68 65 e newer than the
cd90: 20 72 65 66 65 72 65 6e 63 65 0a 09 09 20 20 20 reference...
cda0: 20 20 20 28 6c 65 74 2a 20 28 28 79 6f 75 6e 67 (let* ((young
cdb0: 65 73 74 64 61 74 20 28 63 6f 6d 6d 6f 6e 3a 67 estdat (common:g
cdc0: 65 74 2d 79 6f 75 6e 67 65 73 74 20 66 69 6c 65 et-youngest file
cdd0: 2d 67 6c 6f 62 73 29 29 0a 09 09 09 20 20 20 20 -globs))....
cde0: 20 28 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 63 (youngestmod (c
cdf0: 61 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 29 ar youngestdat))
ce00: 0a 09 09 09 20 20 20 20 20 28 73 75 63 63 65 73 .... (succes
ce10: 73 20 20 20 20 20 23 74 29 29 20 3b 3b 20 61 6e s #t)) ;; an
ce20: 79 20 63 61 73 65 73 20 6f 66 20 6e 6f 74 20 74 y cases of not t
ce30: 72 75 65 2c 20 73 65 74 20 66 6c 61 67 20 74 6f rue, set flag to
ce40: 20 23 66 20 66 6f 72 20 41 4e 44 0a 09 09 09 3b #f for AND....;
ce50: 3b 20 28 70 72 69 6e 74 20 22 79 6f 75 6e 67 65 ; (print "younge
ce60: 73 74 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 stmod: " younges
ce70: 74 6d 6f 64 20 22 20 73 74 61 72 74 74 69 6d 65 tmod " starttime
ce80: 73 3a 20 22 20 73 74 61 72 74 74 69 6d 65 73 29 s: " starttimes)
ce90: 0a 09 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 73 ....(if (null? s
cea0: 74 61 72 74 74 69 6d 65 73 29 20 3b 3b 20 74 68 tarttimes) ;; th
ceb0: 69 73 20 74 61 72 67 65 74 20 68 61 73 20 6e 65 is target has ne
cec0: 76 65 72 20 62 65 65 6e 20 72 75 6e 0a 09 09 09 ver been run....
ced0: 20 20 20 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 (push-run-sp
cee0: 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 ec torun contour
cef0: 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 20 20 20 runkey......
cf00: 60 28 28 6d 65 73 73 61 67 65 20 20 2e 20 22 66 `((message . "f
cf10: 69 6c 65 3a 6e 65 76 65 72 72 75 6e 22 29 0a 09 ile:neverrun")..
cf20: 09 09 09 09 20 20 20 20 20 28 72 75 6e 6e 61 6d .... (runnam
cf30: 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 e . ,runname)..
cf40: 09 09 09 09 20 20 20 20 20 28 72 75 6e 74 72 61 .... (runtra
cf50: 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a ns . ,runtrans).
cf60: 09 09 09 09 09 20 20 20 20 20 28 61 72 65 61 73 ..... (areas
cf70: 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 . ,areas)...
cf80: 09 09 09 20 20 20 20 20 3b 3b 20 28 74 61 72 67 ... ;; (targ
cf90: 65 74 20 20 20 2e 20 2c 72 75 6e 6b 65 79 29 0a et . ,runkey).
cfa0: 09 09 09 09 09 20 20 20 20 20 28 61 63 74 69 6f ..... (actio
cfb0: 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 29 29 n . ,action)))
cfc0: 0a 09 09 09 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 .... ;; NB//
cfd0: 49 20 74 68 69 6e 6b 20 74 68 69 73 20 69 73 20 I think this is
cfe0: 77 72 6f 6e 67 2e 20 49 74 20 73 68 6f 75 6c 64 wrong. It should
cff0: 20 62 65 20 6c 6f 6f 6b 69 6e 67 20 61 74 20 6c be looking at l
d000: 61 73 74 2d 72 75 6e 20 6f 6e 6c 79 2e 0a 09 09 ast-run only....
d010: 09 20 20 20 20 28 69 66 20 28 3e 20 79 6f 75 6e . (if (> youn
d020: 67 65 73 74 6d 6f 64 20 6c 61 73 74 2d 72 75 6e gestmod last-run
d030: 29 20 3b 3b 20 57 41 49 54 21 21 20 53 68 6f 75 ) ;; WAIT!! Shou
d040: 6c 64 6e 27 74 20 66 69 6c 65 2d 61 6e 64 20 62 ldn't file-and b
d050: 65 20 6c 6f 6f 6b 69 6e 67 20 61 74 20 74 68 65 e looking at the
d060: 20 2a 6f 6c 64 65 73 74 2a 20 66 69 6c 65 20 28 *oldest* file (
d070: 74 68 75 73 20 61 6c 6c 20 61 72 65 20 79 6f 75 thus all are you
d080: 6e 67 65 72 20 74 68 61 6e 20 2e 2e 2e 29 0a 09 nger than ...)..
d090: 09 09 09 0a 09 09 09 09 3b 3b 20 09 09 09 20 20 ........;; ...
d0a0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 (for-each.....
d0b0: 3b 3b 20 09 09 09 20 20 20 20 20 28 6c 61 6d 62 ;; ... (lamb
d0c0: 64 61 20 28 73 74 61 72 74 74 69 6d 65 29 20 3b da (starttime) ;
d0d0: 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 69 ; look at the ti
d0e0: 6d 65 20 74 68 65 20 6c 61 73 74 20 72 75 6e 20 me the last run
d0f0: 77 61 73 20 6b 69 63 6b 65 64 20 6f 66 66 20 66 was kicked off f
d100: 6f 72 20 74 68 69 73 20 63 6f 6e 74 6f 75 72 0a or this contour.
d110: 09 09 09 09 3b 3b 20 09 09 09 20 20 20 20 20 20 ....;; ...
d120: 20 28 69 66 20 28 3c 20 79 6f 75 6e 67 65 73 74 (if (< youngest
d130: 6d 6f 64 20 28 63 64 72 20 73 74 61 72 74 74 69 mod (cdr startti
d140: 6d 65 29 29 0a 09 09 09 09 3b 3b 20 09 09 09 09 me)).....;; ....
d150: 20 20 20 28 73 65 74 21 20 73 75 63 63 65 73 73 (set! success
d160: 20 23 66 29 29 29 0a 09 09 09 09 3b 3b 20 09 09 #f))).....;; ..
d170: 09 20 20 20 20 20 73 74 61 72 74 74 69 6d 65 73 . starttimes
d180: 29 29 0a 09 09 09 09 3b 3b 20 09 09 09 28 69 66 )).....;; ...(if
d190: 20 73 75 63 63 65 73 73 0a 09 09 09 09 3b 3b 20 success.....;;
d1a0: 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
d1b0: 09 09 3b 3b 20 09 09 09 20 20 20 20 20 20 28 70 ..;; ... (p
d1c0: 72 69 6e 74 20 22 73 74 61 72 74 74 69 6d 65 20 rint "starttime
d1d0: 79 6f 75 6e 67 65 72 20 74 68 61 6e 20 79 6f 75 younger than you
d1e0: 6e 67 65 73 74 6d 6f 64 3a 20 22 20 73 74 61 72 ngestmod: " star
d1f0: 74 74 69 6d 65 20 22 20 59 6f 75 6e 67 65 73 74 ttime " Youngest
d200: 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d mod: " youngestm
d210: 6f 64 29 0a 09 09 09 09 28 70 75 73 68 2d 72 75 od).....(push-ru
d220: 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e n-spec torun con
d230: 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 tour runkey.....
d240: 09 20 20 20 20 20 20 20 60 28 28 6d 65 73 73 61 . `((messa
d250: 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c ge . ,(conc rul
d260: 65 74 79 70 65 20 22 3a 22 20 28 63 61 64 72 20 etype ":" (cadr
d270: 79 6f 75 6e 67 65 73 74 64 61 74 29 29 29 0a 09 youngestdat)))..
d280: 09 09 09 09 09 20 28 72 75 6e 6e 61 6d 65 20 20 ..... (runname
d290: 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 . ,runname).....
d2a0: 09 09 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c .. (runtrans . ,
d2b0: 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 runtrans).......
d2c0: 20 3b 3b 20 28 74 61 72 67 65 74 20 20 20 2e 20 ;; (target .
d2d0: 2c 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 09 20 ,runkey).......
d2e0: 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 (areas . ,are
d2f0: 61 73 29 0a 09 09 09 09 09 09 20 28 61 63 74 69 as)....... (acti
d300: 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a on . ,action).
d310: 09 09 09 09 09 09 20 29 29 29 29 29 29 0a 09 09 ...... ))))))...
d320: 20 20 20 20 20 28 65 6c 73 65 20 28 70 72 69 6e (else (prin
d330: 74 20 22 45 52 52 4f 52 3a 20 75 6e 72 65 63 6f t "ERROR: unreco
d340: 67 6e 69 73 65 64 20 72 75 6c 65 20 5c 22 22 20 gnised rule \""
d350: 72 75 6c 65 74 79 70 65 29 29 29 29 29 0a 09 20 ruletype)))))..
d360: 20 20 20 20 20 20 6b 65 79 64 61 74 73 29 29 29 keydats)))
d370: 20 3b 3b 20 73 65 6e 73 65 20 72 75 6c 65 73 0a ;; sense rules.
d380: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b . (hash-table-k
d390: 65 79 73 20 72 67 63 6f 6e 66 29 29 0a 09 20 0a eys rgconf)).. .
d3a0: 09 20 3b 3b 20 6e 6f 77 20 68 61 76 65 20 74 6f . ;; now have to
d3b0: 20 72 75 6e 20 70 6f 70 75 6c 61 74 65 64 0a 09 run populated..
d3c0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 28 6c (for-each.. (l
d3d0: 61 6d 62 64 61 20 28 63 6f 6e 74 6f 75 72 29 0a ambda (contour).
d3e0: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 63 76 61 . (let* ((cva
d3f0: 6c 20 20 20 20 20 20 20 28 6f 72 20 28 63 6f 6e l (or (con
d400: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
d410: 6e 66 20 22 63 6f 6e 74 6f 75 72 73 22 20 63 6f nf "contours" co
d420: 6e 74 6f 75 72 29 20 22 22 29 29 0a 09 09 20 20 ntour) ""))...
d430: 20 28 63 76 61 6c 2d 61 6c 69 73 74 20 28 63 6f (cval-alist (co
d440: 6d 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 mmon:val->alist
d450: 63 76 61 6c 29 29 20 20 20 20 20 20 20 20 20 20 cval))
d460: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 42 45 ;; BE
d470: 57 41 52 45 20 2e 2e 2e 20 4e 4f 54 20 74 68 65 WARE ... NOT the
d480: 20 73 61 6d 65 20 76 61 6c 2d 61 6c 69 73 74 20 same val-alist
d490: 61 73 20 61 62 6f 76 65 21 0a 09 09 20 20 20 28 as above!... (
d4a0: 61 72 65 61 73 20 20 20 20 20 20 28 76 61 6c 2d areas (val-
d4b0: 61 6c 69 73 74 2d 3e 61 72 65 61 73 20 63 76 61 alist->areas cva
d4c0: 6c 2d 61 6c 69 73 74 29 29 0a 09 09 20 20 20 28 l-alist))... (
d4d0: 73 65 6c 65 63 74 6f 72 20 20 20 28 61 6c 69 73 selector (alis
d4e0: 74 2d 72 65 66 20 27 73 65 6c 65 63 74 6f 72 20 t-ref 'selector
d4f0: 63 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 20 cval-alist))...
d500: 20 20 28 6d 6f 64 65 2d 74 61 67 20 20 20 28 61 (mode-tag (a
d510: 6e 64 20 73 65 6c 65 63 74 6f 72 20 28 73 74 72 nd selector (str
d520: 69 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c 64 73 ing-split-fields
d530: 20 22 2f 22 20 73 65 6c 65 63 74 6f 72 20 23 3a "/" selector #:
d540: 69 6e 66 69 78 29 29 29 0a 09 09 20 20 20 28 6d infix)))... (m
d550: 6f 64 65 2d 70 61 74 74 20 20 28 61 6e 64 20 6d ode-patt (and m
d560: 6f 64 65 2d 74 61 67 20 28 69 66 20 28 65 71 3f ode-tag (if (eq?
d570: 20 28 6c 65 6e 67 74 68 20 6d 6f 64 65 2d 74 61 (length mode-ta
d580: 67 29 20 32 29 28 63 61 64 72 20 6d 6f 64 65 2d g) 2)(cadr mode-
d590: 74 61 67 29 20 23 66 29 29 29 0a 09 09 20 20 20 tag) #f)))...
d5a0: 28 74 61 67 2d 65 78 70 72 20 20 20 28 61 6e 64 (tag-expr (and
d5b0: 20 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 28 6e mode-tag (if (n
d5c0: 75 6c 6c 3f 20 6d 6f 64 65 2d 74 61 67 29 20 23 ull? mode-tag) #
d5d0: 66 20 28 63 61 72 20 6d 6f 64 65 2d 74 61 67 29 f (car mode-tag)
d5e0: 29 29 29 29 0a 09 20 20 20 20 20 20 28 70 72 69 )))).. (pri
d5f0: 6e 74 20 22 63 6f 6e 74 6f 75 72 3a 20 22 20 63 nt "contour: " c
d600: 6f 6e 74 6f 75 72 20 22 20 61 72 65 61 73 3d 22 ontour " areas="
d610: 20 61 72 65 61 73 20 22 20 63 76 61 6c 3d 22 20 areas " cval="
d620: 63 76 61 6c 29 0a 09 20 20 20 20 20 20 28 66 6f cval).. (fo
d630: 72 2d 65 61 63 68 0a 09 20 20 20 20 20 20 20 28 r-each.. (
d640: 6c 61 6d 62 64 61 20 28 72 75 6e 6b 65 79 64 61 lambda (runkeyda
d650: 74 73 65 74 29 20 0a 09 09 20 3b 3b 20 28 70 72 tset) ... ;; (pr
d660: 69 6e 74 20 22 72 75 6e 6b 65 79 64 61 74 73 65 int "runkeydatse
d670: 74 3a 20 22 29 28 70 70 20 72 75 6e 6b 65 79 64 t: ")(pp runkeyd
d680: 61 74 73 65 74 29 0a 09 09 20 28 6c 65 74 20 28 atset)... (let (
d690: 28 72 75 6e 6b 65 79 20 20 20 20 20 28 63 61 72 (runkey (car
d6a0: 20 72 75 6e 6b 65 79 64 61 74 73 65 74 29 29 0a runkeydatset)).
d6b0: 09 09 20 20 20 20 20 20 20 28 72 75 6e 6b 65 79 .. (runkey
d6c0: 64 61 74 73 20 28 63 61 64 72 20 72 75 6e 6b 65 dats (cadr runke
d6d0: 79 64 61 74 73 65 74 29 29 0a 20 20 20 20 20 20 ydatset)).
d6e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d6f0: 20 29 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 )... (for-eac
d700: 68 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 h... (lambda
d710: 28 72 75 6e 6b 65 79 64 61 74 29 0a 09 09 20 20 (runkeydat)...
d720: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 (for-each...
d730: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
d740: 61 72 65 61 29 0a 09 09 09 20 28 69 66 20 28 61 area).... (if (a
d750: 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 72 65 rea-allowed? are
d760: 61 20 61 72 65 61 73 20 72 75 6e 6b 65 79 20 63 a areas runkey c
d770: 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 ontour mode-patt
d780: 29 20 3b 3b 20 69 73 20 74 68 69 73 20 61 72 65 ) ;; is this are
d790: 61 20 74 6f 20 62 65 20 68 61 6e 64 6c 65 64 20 a to be handled
d7a0: 28 66 72 6f 6d 20 61 72 65 61 73 3d 61 2c 62 2c (from areas=a,b,
d7b0: 63 20 4f 52 20 75 73 69 6e 67 20 61 72 65 61 66 c OR using areaf
d7c0: 6e 3d 61 62 63 66 6e 20 61 6e 64 20 2a 61 72 65 n=abcfn and *are
d7d0: 61 2d 63 68 65 63 6b 73 2a 20 2e 2e 2e 29 0a 20 a-checks* ...).
d7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d7f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
d800: 2a 20 28 28 61 76 61 6c 20 20 20 20 20 20 20 28 * ((aval (
d810: 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b or (configf:look
d820: 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 up mtconf "areas
d830: 22 20 61 72 65 61 29 20 22 22 29 29 0a 20 20 20 " area) "")).
d840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d860: 20 28 61 76 61 6c 2d 61 6c 69 73 74 20 28 63 6f (aval-alist (co
d870: 6d 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 mmon:val->alist
d880: 61 76 61 6c 29 29 0a 20 20 20 20 20 20 20 20 20 aval)).
d890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d8a0: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 6e (runn
d8b0: 61 6d 65 20 20 20 20 28 61 6c 69 73 74 2d 72 65 ame (alist-re
d8c0: 66 20 27 72 75 6e 6e 61 6d 65 20 72 75 6e 6b 65 f 'runname runke
d8d0: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
d8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d8f0: 20 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 74 (runt
d900: 72 61 6e 73 20 20 20 28 61 6c 69 73 74 2d 72 65 rans (alist-re
d910: 66 20 27 72 75 6e 74 72 61 6e 73 20 72 75 6e 6b f 'runtrans runk
d920: 65 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 eydat)).
d930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d940: 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 .
d950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d970: 20 28 72 65 61 73 6f 6e 20 20 20 20 20 28 61 6c (reason (al
d980: 69 73 74 2d 72 65 66 20 27 6d 65 73 73 61 67 65 ist-ref 'message
d990: 20 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 runkeydat)).
d9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9c0: 20 28 73 63 68 65 64 20 20 20 20 20 20 28 61 6c (sched (al
d9d0: 69 73 74 2d 72 65 66 20 27 73 63 68 65 64 20 20 ist-ref 'sched
d9e0: 20 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 runkeydat)).
d9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da10: 20 28 61 63 74 69 6f 6e 20 20 20 20 20 28 61 6c (action (al
da20: 69 73 74 2d 72 65 66 20 27 61 63 74 69 6f 6e 20 ist-ref 'action
da30: 20 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 runkeydat)).
da40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da60: 20 28 64 62 64 65 73 74 20 20 20 20 20 28 61 6c (dbdest (al
da70: 69 73 74 2d 72 65 66 20 27 64 62 64 65 73 74 20 ist-ref 'dbdest
da80: 20 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 runkeydat)).
da90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dab0: 20 28 61 70 70 65 6e 64 20 20 20 20 20 28 61 6c (append (al
dac0: 69 73 74 2d 72 65 66 20 27 61 70 70 65 6e 64 20 ist-ref 'append
dad0: 20 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 runkeydat)).
dae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db00: 20 28 74 61 72 67 65 74 73 20 20 20 20 3b 3b 28 (targets ;;(
db10: 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 20 27 74 or (alist-ref 't
db20: 61 72 67 65 74 20 20 72 75 6e 6b 65 79 64 61 74 arget runkeydat
db30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
db40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db60: 20 20 20 20 20 20 28 6d 61 70 2d 74 61 72 67 65 (map-targe
db70: 74 73 20 6d 74 63 6f 6e 66 20 61 76 61 6c 2d 61 ts mtconf aval-a
db80: 6c 69 73 74 20 72 75 6e 6b 65 79 20 61 72 65 61 list runkey area
db90: 20 63 6f 6e 74 6f 75 72 29 29 29 20 3b 3b 20 6f contour))) ;; o
dba0: 76 65 72 72 69 64 65 20 77 69 74 68 20 74 61 72 verride with tar
dbb0: 67 65 74 20 69 66 20 66 6f 72 63 65 64 0a 20 20 get if forced.
dbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dbe0: 20 20 3b 3b 28 74 61 72 67 65 74 73 20 20 20 20 ;;(targets
dbf0: 28 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 20 27 (or (alist-ref '
dc00: 74 61 72 67 65 74 20 20 72 75 6e 6b 65 79 64 61 target runkeyda
dc10: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
dc20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dc30: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
dc40: 20 20 20 20 20 20 20 20 20 28 6d 61 70 2d 74 61 (map-ta
dc50: 72 67 65 74 73 20 6d 74 63 6f 6e 66 20 61 76 61 rgets mtconf ava
dc60: 6c 2d 61 6c 69 73 74 20 72 75 6e 6b 65 79 20 61 l-alist runkey a
dc70: 72 65 61 20 63 6f 6e 74 6f 75 72 29 29 29 29 20 rea contour))))
dc80: 3b 3b 20 6f 76 65 72 72 69 64 65 20 77 69 74 68 ;; override with
dc90: 20 74 61 72 67 65 74 20 69 66 20 66 6f 72 63 65 target if force
dca0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
dcb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dcc0: 20 3b 3b 20 4e 45 45 44 20 54 4f 20 45 58 50 41 ;; NEED TO EXPA
dcd0: 4e 44 20 52 55 4e 4b 45 59 20 3d 3e 20 41 4c 4c ND RUNKEY => ALL
dce0: 20 54 41 52 47 45 54 53 20 4d 41 50 50 45 44 20 TARGETS MAPPED
dcf0: 41 4e 44 20 54 48 45 4e 20 46 4f 52 45 41 43 48 AND THEN FOREACH
dd00: 20 2e 2e 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 .... .
dd10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd20: 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 ;;(print "
dd30: 54 61 72 67 65 74 73 3a 20 22 20 74 61 72 67 65 Targets: " targe
dd40: 74 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ts).
dd50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd60: 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 61 6c 69 ;;(print "ali
dd70: 73 74 3a 20 22 20 28 61 6c 69 73 74 2d 72 65 66 st: " (alist-ref
dd80: 20 27 74 61 72 67 65 74 20 72 75 6e 6b 65 79 64 'target runkeyd
dd90: 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 at)).
dda0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ddb0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
ddc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ddd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
dde0: 61 6d 62 64 61 20 28 74 61 72 67 65 74 29 0a 20 ambda (target).
ddf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de10: 20 28 70 72 69 6e 74 20 22 43 72 65 61 74 69 6e (print "Creatin
de20: 67 20 70 6b 74 20 66 6f 72 20 72 75 6e 6b 65 79 g pkt for runkey
de30: 3d 22 20 72 75 6e 6b 65 79 20 22 20 74 61 72 67 =" runkey " targ
de40: 65 74 3d 22 20 74 61 72 67 65 74 20 22 20 63 6f et=" target " co
de50: 6e 74 6f 75 72 3d 22 20 63 6f 6e 74 6f 75 72 20 ntour=" contour
de60: 22 20 61 72 65 61 3d 22 20 61 72 65 61 20 22 20 " area=" area "
de70: 61 63 74 69 6f 6e 3d 22 20 61 63 74 69 6f 6e 20 action=" action
de80: 22 20 74 61 67 2d 65 78 70 72 3d 22 20 74 61 67 " tag-expr=" tag
de90: 2d 65 78 70 72 20 22 20 6d 6f 64 65 2d 70 61 74 -expr " mode-pat
dea0: 74 3d 22 20 6d 6f 64 65 2d 70 61 74 74 29 0a 20 t=" mode-patt).
deb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ded0: 20 28 69 66 20 28 63 61 73 65 20 28 6f 72 20 28 (if (case (or (
dee0: 61 6e 64 20 61 63 74 69 6f 6e 20 28 73 74 72 69 and action (stri
def0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f ng->symbol actio
df00: 6e 29 29 20 27 6e 6f 61 63 74 69 6f 6e 29 20 20 n)) 'noaction)
df10: 3b 3b 20 65 6e 73 75 72 65 20 77 65 20 68 61 76 ;; ensure we hav
df20: 65 20 74 68 65 20 6e 65 65 64 65 64 20 64 61 74 e the needed dat
df30: 61 20 74 6f 20 72 75 6e 20 74 68 69 73 20 61 63 a to run this ac
df40: 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 20 20 tion.
df50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e ((n
df70: 6f 61 63 74 69 6f 6e 29 20 20 20 20 20 20 20 20 oaction)
df80: 20 20 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 #f).
df90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dfa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
dfb0: 28 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 (run)
dfc0: 20 20 20 20 20 28 61 6e 64 20 72 75 6e 6e 61 6d (and runnam
dfd0: 65 20 72 65 61 73 6f 6e 29 29 0a 20 20 20 20 20 e reason)).
dfe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e000: 20 20 20 28 28 73 79 6e 63 20 73 79 6e 63 2d 70 ((sync sync-p
e010: 72 65 70 65 6e 64 29 20 20 28 61 6e 64 20 72 65 repend) (and re
e020: 61 73 6f 6e 20 64 62 64 65 73 74 29 29 0a 20 20 ason dbdest)).
e030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e050: 20 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 (else
e060: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 #f))
e070: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e090: 20 20 20 20 20 20 20 3b 3b 20 69 6e 73 74 65 61 ;; instea
e0a0: 64 20 6f 66 20 75 6e 77 72 61 70 70 69 6e 67 20 d of unwrapping
e0b0: 74 68 65 20 72 75 6e 6b 65 79 64 61 74 20 61 6c the runkeydat al
e0c0: 69 73 74 2c 20 70 61 73 73 20 69 74 20 64 69 72 ist, pass it dir
e0d0: 65 63 74 6c 79 20 74 6f 20 63 72 65 61 74 65 2d ectly to create-
e0e0: 72 75 6e 2d 70 6b 74 0a 20 20 20 20 20 20 20 20 run-pkt.
e0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
e110: 72 65 61 74 65 2d 72 75 6e 2d 70 6b 74 20 6d 74 reate-run-pkt mt
e120: 63 6f 6e 66 20 61 63 74 69 6f 6e 20 61 72 65 61 conf action area
e130: 20 72 75 6e 6b 65 79 20 74 61 72 67 65 74 20 72 runkey target r
e140: 75 6e 6e 61 6d 65 20 6d 6f 64 65 2d 70 61 74 74 unname mode-patt
e150: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e180: 20 20 20 20 20 20 20 74 61 67 2d 65 78 70 72 20 tag-expr
e190: 70 6b 74 73 64 69 72 20 72 65 61 73 6f 6e 20 63 pktsdir reason c
e1a0: 6f 6e 74 6f 75 72 20 73 63 68 65 64 20 64 62 64 ontour sched dbd
e1b0: 65 73 74 20 61 70 70 65 6e 64 20 0a 20 20 20 20 est append .
e1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1f0: 20 20 72 75 6e 74 72 61 6e 73 29 20 0a 20 20 20 runtrans) .
e200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e220: 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 (print "ERROR
e230: 3a 20 4d 69 73 73 69 6e 67 20 69 6e 66 6f 20 74 : Missing info t
e240: 6f 20 6d 61 6b 65 20 61 20 22 20 61 63 74 69 6f o make a " actio
e250: 6e 20 22 20 63 61 6c 6c 3a 20 72 75 6e 6b 65 79 n " call: runkey
e260: 3d 22 20 72 75 6e 6b 65 79 20 22 20 63 6f 6e 74 =" runkey " cont
e270: 6f 75 72 3d 22 20 63 6f 6e 74 6f 75 72 20 22 20 our=" contour "
e280: 61 72 65 61 3d 22 20 61 72 65 61 20 20 22 20 74 area=" area " t
e290: 61 67 2d 65 78 70 72 3d 22 20 74 61 67 2d 65 78 ag-expr=" tag-ex
e2a0: 70 72 20 22 20 6d 6f 64 65 2d 70 61 74 74 3d 22 pr " mode-patt="
e2b0: 20 6d 6f 64 65 2d 70 61 74 74 20 22 20 64 62 64 mode-patt " dbd
e2c0: 65 73 74 3d 22 20 64 62 64 65 73 74 29 0a 20 20 est=" dbdest).
e2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2f0: 20 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 )).
e300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e310: 20 20 20 20 20 20 20 74 61 72 67 65 74 73 29 29 targets))
e320: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
e340: 72 69 6e 74 20 22 4e 4f 54 45 3a 20 73 6b 69 70 rint "NOTE: skip
e350: 70 69 6e 67 20 22 20 72 75 6e 6b 65 79 64 61 74 ping " runkeydat
e360: 20 22 20 66 6f 72 20 61 72 65 61 20 5c 22 22 20 " for area \""
e370: 61 72 65 61 20 22 5c 22 2c 20 6e 6f 74 20 69 6e area "\", not in
e380: 20 22 20 61 72 65 61 73 29 29 29 0a 20 20 20 20 " areas))).
e390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e3a0: 20 20 20 61 6c 6c 2d 61 72 65 61 73 29 29 0a 09 all-areas))..
e3b0: 09 20 20 20 20 72 75 6e 6b 65 79 64 61 74 73 29 . runkeydats)
e3c0: 29 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 20 )).. (let
e3d0: 28 28 72 65 73 20 28 63 6f 6e 66 69 67 66 3a 67 ((res (configf:g
e3e0: 65 74 2d 73 65 63 74 69 6f 6e 20 74 6f 72 75 6e et-section torun
e3f0: 20 63 6f 6e 74 6f 75 72 29 29 29 20 3b 3b 20 65 contour))) ;; e
e400: 61 63 68 20 63 6f 6e 74 6f 75 72 20 2f 20 74 61 ach contour / ta
e410: 72 67 65 74 0a 09 09 20 3b 3b 20 28 70 72 69 6e rget... ;; (prin
e420: 74 20 22 72 65 73 3d 22 20 72 65 73 29 0a 09 09 t "res=" res)...
e430: 20 72 65 73 29 29 29 29 0a 09 20 20 28 68 61 73 res)))).. (has
e440: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 6f 72 h-table-keys tor
e450: 75 6e 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 un)))))))..(defi
e460: 6e 65 20 28 70 6b 74 2d 3e 63 6d 64 6c 69 6e 65 ne (pkt->cmdline
e470: 20 70 6b 74 61 29 0a 20 20 28 6c 65 74 2a 20 28 pkta). (let* (
e480: 28 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 2d 61 (param-mapping-a
e490: 6c 69 73 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 list (common:get
e4a0: 2d 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 20 66 -param-mapping f
e4b0: 6c 61 76 6f 72 3a 20 27 73 77 69 74 63 68 2d 73 lavor: 'switch-s
e4c0: 79 6d 62 6f 6c 29 29 0a 20 20 20 20 20 20 20 20 ymbol)).
e4d0: 20 28 61 63 74 69 6f 6e 20 20 20 20 20 20 20 20 (action
e4e0: 28 6f 72 20 28 6c 6f 6f 6b 75 70 2d 61 63 74 69 (or (lookup-acti
e4f0: 6f 6e 2d 62 79 2d 6b 65 79 20 28 61 6c 69 73 74 on-by-key (alist
e500: 2d 72 65 66 20 27 41 20 70 6b 74 61 29 29 20 22 -ref 'A pkta)) "
e510: 6e 6f 61 63 74 69 6f 6e 22 29 29 0a 09 20 28 61 noaction")).. (a
e520: 63 74 69 6f 6e 2d 70 61 72 61 6d 20 20 28 63 61 ction-param (ca
e530: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
e540: 6f 6c 20 61 63 74 69 6f 6e 29 0a 20 20 20 20 20 ol action).
e550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e560: 20 20 20 20 20 28 28 2d 73 65 74 2d 73 74 61 74 ((-set-stat
e570: 65 2d 73 74 61 74 75 73 29 20 28 63 6f 6e 63 20 e-status) (conc
e580: 28 61 6c 69 73 74 2d 72 65 66 20 27 6c 20 70 6b (alist-ref 'l pk
e590: 74 61 29 20 22 20 22 29 29 0a 20 20 20 20 20 20 ta) " ")).
e5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e5b0: 20 20 20 20 28 65 6c 73 65 20 22 22 29 29 29 29 (else ""))))
e5c0: 0a 20 20 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 . (fold (lamb
e5d0: 64 61 20 28 61 20 72 65 73 29 0a 09 20 20 20 20 da (a res)..
e5e0: 28 6c 65 74 2a 20 28 28 6b 65 79 20 28 63 61 72 (let* ((key (car
e5f0: 20 61 29 29 20 3b 3b 20 67 65 74 20 74 68 65 20 a)) ;; get the
e600: 6b 65 79 20 6e 61 6d 65 0a 09 09 20 20 20 28 76 key name... (v
e610: 61 6c 20 28 63 64 72 20 61 29 29 0a 09 09 20 20 al (cdr a))...
e620: 20 28 70 61 72 20 28 6f 72 20 28 6c 6f 6f 6b 75 (par (or (looku
e630: 70 2d 70 61 72 61 6d 2d 62 79 2d 6b 65 79 20 6b p-param-by-key k
e640: 65 79 29 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 ey) ;; need to
e650: 63 68 65 63 6b 20 61 6c 73 6f 20 69 66 20 69 74 check also if it
e660: 20 69 73 20 61 20 73 77 69 74 63 68 0a 09 09 09 is a switch....
e670: 20 20 20 20 28 6c 6f 6f 6b 75 70 2d 70 61 72 61 (lookup-para
e680: 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 20 69 6e 6c m-by-key key inl
e690: 73 74 3a 20 2a 73 77 69 74 63 68 2d 6b 65 79 73 st: *switch-keys
e6a0: 2a 29 29 29 29 0a 09 20 20 20 20 20 20 28 70 72 *)))).. (pr
e6b0: 69 6e 74 20 22 6b 65 79 3a 20 22 20 6b 65 79 20 int "key: " key
e6c0: 22 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 70 " val: " val " p
e6d0: 61 72 3a 20 22 20 70 61 72 29 0a 09 20 20 20 20 ar: " par)..
e6e0: 20 20 3b 3b 28 69 66 20 28 61 6e 64 20 70 61 72 ;;(if (and par
e6f0: 20 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 20 (not (string=
e700: 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 (symbol->string
e710: 6b 65 79 29 20 22 47 22 29 29 29 0a 09 20 20 20 key) "G")))..
e720: 20 20 20 28 69 66 20 28 61 6e 64 20 70 61 72 29 (if (and par)
e730: 0a 09 09 20 20 28 63 6f 6e 63 20 72 65 73 20 22 ... (conc res "
e740: 20 22 20 28 61 6c 69 73 74 2d 72 65 66 20 28 73 " (alist-ref (s
e750: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 70 61 tring->symbol pa
e760: 72 29 20 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 r) param-mapping
e770: 2d 61 6c 69 73 74 20 65 71 3f 20 70 61 72 29 20 -alist eq? par)
e780: 22 20 22 20 76 61 6c 29 0a 09 09 20 20 28 69 66 " " val)... (if
e790: 20 28 61 6c 69 73 74 2d 72 65 66 20 6b 65 79 20 (alist-ref key
e7a0: 2a 61 64 64 69 74 69 6f 6e 61 6c 2d 63 61 72 64 *additional-card
e7b0: 73 2a 29 20 3b 3b 20 74 68 65 73 65 20 63 61 72 s*) ;; these car
e7c0: 64 73 20 64 6f 20 6e 6f 74 20 74 72 61 6e 73 6c ds do not transl
e7d0: 61 74 65 20 74 6f 20 70 61 72 61 6d 65 74 65 72 ate to parameter
e7e0: 73 20 6f 72 20 73 77 69 74 63 68 65 73 0a 09 09 s or switches...
e7f0: 20 20 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 res...
e800: 20 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 (begin....(pri
e810: 6e 74 20 22 45 52 52 4f 52 3a 20 55 6e 6b 6e 6f nt "ERROR: Unkno
e820: 77 6e 20 6b 65 79 20 69 6e 20 70 61 63 6b 65 74 wn key in packet
e830: 20 5c 22 22 20 6b 65 79 20 22 5c 22 20 77 69 74 \"" key "\" wit
e840: 68 20 76 61 6c 75 65 20 5c 22 22 20 76 61 6c 20 h value \"" val
e850: 22 5c 22 22 29 0a 09 09 09 72 65 73 29 29 29 29 "\"")....res))))
e860: 29 0a 09 20 20 28 63 6f 6e 63 20 22 6d 65 67 61 ).. (conc "mega
e870: 74 65 73 74 20 22 20 28 69 66 20 28 6e 6f 74 20 test " (if (not
e880: 28 6d 65 6d 62 65 72 20 61 63 74 69 6f 6e 20 27 (member action '
e890: 28 22 73 79 6e 63 22 29 29 29 0a 09 09 09 09 28 ("sync"))).....(
e8a0: 63 6f 6e 63 20 61 63 74 69 6f 6e 20 22 20 22 20 conc action " "
e8b0: 61 63 74 69 6f 6e 2d 70 61 72 61 6d 29 0a 09 09 action-param)...
e8c0: 09 09 22 22 29 20 28 69 66 20 28 6d 65 6d 62 65 .."") (if (membe
e8d0: 72 20 61 63 74 69 6f 6e 20 27 28 22 2d 72 75 6e r action '("-run
e8e0: 22 20 22 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 " "-rerun-clean"
e8f0: 20 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 20 22 2d "-rerun-all" "-
e900: 6b 69 6c 6c 2d 72 65 72 75 6e 22 29 29 0a 20 20 kill-rerun")).
e910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e940: 20 20 20 20 20 20 22 2d 72 65 72 75 6e 20 44 45 "-rerun DE
e950: 41 44 2c 41 42 4f 52 54 2c 4b 49 4c 4c 45 44 22 AD,ABORT,KILLED"
e960: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e990: 20 20 20 20 20 20 20 20 20 22 22 29 29 0a 09 20 ""))..
e9a0: 20 70 6b 74 61 29 29 29 0a 0a 3b 3b 20 28 75 73 pkta)))..;; (us
e9b0: 65 20 74 72 61 63 65 29 28 74 72 61 63 65 20 70 e trace)(trace p
e9c0: 6b 74 2d 3e 63 6d 64 6c 69 6e 65 29 0a 0a 28 64 kt->cmdline)..(d
e9d0: 65 66 69 6e 65 20 28 77 72 69 74 65 2d 70 6b 74 efine (write-pkt
e9e0: 20 70 6b 74 73 64 69 72 20 75 75 69 64 20 70 6b pktsdir uuid pk
e9f0: 74 29 0a 20 20 28 69 66 20 70 6b 74 73 64 69 72 t). (if pktsdir
ea00: 0a 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 . (with-out
ea10: 70 75 74 2d 74 6f 2d 66 69 6c 65 0a 09 20 20 28 put-to-file.. (
ea20: 63 6f 6e 63 20 70 6b 74 73 64 69 72 20 22 2f 22 conc pktsdir "/"
ea30: 20 75 75 69 64 20 22 2e 70 6b 74 22 29 0a 09 28 uuid ".pkt")..(
ea40: 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 28 70 72 lambda ().. (pr
ea50: 69 6e 74 20 70 6b 74 29 29 29 0a 20 20 20 20 20 int pkt))).
ea60: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
ea70: 63 61 6e 6e 6f 74 20 70 72 6f 63 65 73 73 20 63 cannot process c
ea80: 6f 6d 6d 61 6e 64 73 20 77 69 74 68 6f 75 74 20 ommands without
ea90: 61 20 70 6b 74 73 20 64 69 72 65 63 74 6f 72 79 a pkts directory
eaa0: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ")))..(define (c
eab0: 68 65 63 6b 2d 69 66 2d 6d 6f 64 65 70 61 74 74 heck-if-modepatt
eac0: 2d 64 65 66 69 6e 65 64 20 20 70 6b 74 61 20 6e -defined pkta n
ead0: 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b otification-hook
eae0: 20 70 6b 74 66 69 6c 65 29 0a 20 20 28 6c 65 74 pktfile). (let
eaf0: 2a 20 28 28 73 74 61 72 74 2d 64 69 72 20 28 61 * ((start-dir (a
eb00: 6c 69 73 74 2d 72 65 66 20 27 53 20 70 6b 74 61 list-ref 'S pkta
eb10: 29 29 0a 09 20 28 74 61 72 67 65 74 20 28 6f 72 )).. (target (or
eb20: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 52 20 70 (alist-ref 'R p
eb30: 6b 74 61 29 20 28 61 6c 69 73 74 2d 72 65 66 20 kta) (alist-ref
eb40: 27 74 20 70 6b 74 61 29 29 29 0a 09 20 28 70 61 't pkta))).. (pa
eb50: 74 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 6f tt (alist-ref 'o
eb60: 20 70 6b 74 61 29 29 0a 09 20 28 75 75 69 64 20 pkta)).. (uuid
eb70: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 5a (alist-ref 'Z
eb80: 20 70 6b 74 61 29 29 0a 09 20 28 63 6d 64 20 28 pkta)).. (cmd (
eb90: 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 20 2d conc "megatest -
eba0: 73 68 6f 77 2d 72 75 6e 63 6f 6e 66 69 67 20 2d show-runconfig -
ebb0: 74 61 72 67 65 74 20 22 20 74 61 72 67 65 74 20 target " target
ebc0: 22 20 2d 73 74 61 72 74 2d 64 69 72 20 22 20 73 " -start-dir " s
ebd0: 74 61 72 74 2d 64 69 72 29 29 0a 09 20 28 72 65 tart-dir)).. (re
ebe0: 73 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 s (handle-exc
ebf0: 65 70 74 69 6f 6e 73 0a 09 09 20 20 65 78 6e 0a eptions... exn.
ec00: 09 09 20 20 23 66 0a 09 09 20 20 28 70 72 69 6e .. #f... (prin
ec10: 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 63 6d 64 t "Running " cmd
ec20: 29 0a 09 09 20 20 28 77 69 74 68 2d 69 6e 70 75 )... (with-inpu
ec30: 74 2d 66 72 6f 6d 2d 70 69 70 65 20 63 6d 64 20 t-from-pipe cmd
ec40: 72 65 61 64 2d 6c 69 6e 65 73 29 29 29 29 20 0a read-lines)))) .
ec50: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
ec60: 68 65 64 20 28 63 61 72 20 72 65 73 29 29 0a 09 hed (car res))..
ec70: 20 20 20 20 20 20 20 28 74 61 69 6c 20 28 63 64 (tail (cd
ec80: 72 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 28 r res))). (
ec90: 69 66 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 if (string-conta
eca0: 69 6e 73 20 68 65 64 20 70 61 74 74 29 0a 09 20 ins hed patt)..
ecb0: 20 23 74 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c #t.. (if (null
ecc0: 3f 20 74 61 69 6c 29 0a 09 20 20 20 20 20 20 28 ? tail).. (
ecd0: 62 65 67 69 6e 0a 09 09 28 69 66 20 6e 6f 74 69 begin...(if noti
ece0: 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 0a 09 09 fication-hook...
ecf0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 6f 74 69 (let* ((noti
ed00: 66 69 63 61 74 69 6f 6e 2d 63 6d 64 20 28 63 6f fication-cmd (co
ed10: 6e 63 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d nc notification-
ed20: 68 6f 6f 6b 20 22 20 2d 2d 70 6b 74 20 22 20 70 hook " --pkt " p
ed30: 6b 74 66 69 6c 65 20 22 20 2d 2d 6d 73 67 20 49 ktfile " --msg I
ed40: 4e 56 41 4c 49 44 5f 4d 4f 44 45 50 41 54 54 22 NVALID_MODEPATT"
ed50: 29 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 )))... (pri
ed60: 6e 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 6e 6f nt "Running " no
ed70: 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 0a tification-cmd).
ed80: 09 09 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 .. (system
ed90: 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 notification-cmd
eda0: 29 29 29 20 0a 09 09 23 66 29 0a 09 20 20 20 20 ))) ...#f)..
edb0: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 69 (loop (car tai
edc0: 6c 29 20 28 63 64 72 20 74 61 69 6c 29 29 29 29 l) (cdr tail))))
edd0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 )))..(define (ch
ede0: 65 63 6b 2d 69 66 2d 74 61 72 67 65 74 2d 64 65 eck-if-target-de
edf0: 66 69 6e 65 64 20 70 6b 74 61 20 6e 6f 74 69 66 fined pkta notif
ee00: 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 ication-hook pkt
ee10: 66 69 6c 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 file). (let* ((
ee20: 73 74 61 72 74 2d 64 69 72 20 28 61 6c 69 73 74 start-dir (alist
ee30: 2d 72 65 66 20 27 53 20 70 6b 74 61 29 29 0a 09 -ref 'S pkta))..
ee40: 20 28 74 61 72 67 65 74 20 28 61 6c 69 73 74 2d (target (alist-
ee50: 72 65 66 20 27 52 20 70 6b 74 61 29 29 0a 09 20 ref 'R pkta))..
ee60: 28 75 75 69 64 20 20 20 20 28 61 6c 69 73 74 2d (uuid (alist-
ee70: 72 65 66 20 27 5a 20 70 6b 74 61 29 29 0a 09 20 ref 'Z pkta))..
ee80: 28 63 6d 64 20 28 63 6f 6e 63 20 22 6d 65 67 61 (cmd (conc "mega
ee90: 74 65 73 74 20 2d 6c 69 73 74 2d 74 61 72 67 65 test -list-targe
eea0: 74 73 20 2d 73 74 61 72 74 2d 64 69 72 20 22 20 ts -start-dir "
eeb0: 73 74 61 72 74 2d 64 69 72 29 29 0a 09 20 28 72 start-dir)).. (r
eec0: 65 73 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 es (handle-ex
eed0: 63 65 70 74 69 6f 6e 73 0a 09 09 20 20 65 78 6e ceptions... exn
eee0: 0a 09 09 20 20 23 66 0a 09 09 20 20 28 70 72 69 ... #f... (pri
eef0: 6e 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 63 6d nt "Running " cm
ef00: 64 29 0a 09 09 20 20 28 77 69 74 68 2d 69 6e 70 d)... (with-inp
ef10: 75 74 2d 66 72 6f 6d 2d 70 69 70 65 20 63 6d 64 ut-from-pipe cmd
ef20: 20 72 65 61 64 2d 6c 69 6e 65 73 29 29 29 29 20 read-lines))))
ef30: 0a 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 . (if (member
ef40: 20 74 61 72 67 65 74 20 72 65 73 29 20 20 0a 09 target res) ..
ef50: 23 74 20 0a 09 28 62 65 67 69 6e 20 0a 09 20 20 #t ..(begin ..
ef60: 28 69 66 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e (if notification
ef70: 2d 68 6f 6f 6b 0a 09 20 20 20 20 20 20 28 6c 65 -hook.. (le
ef80: 74 2a 20 28 28 6e 6f 74 69 66 69 63 61 74 69 6f t* ((notificatio
ef90: 6e 2d 63 6d 64 20 28 63 6f 6e 63 20 6e 6f 74 69 n-cmd (conc noti
efa0: 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 22 20 fication-hook "
efb0: 2d 2d 70 6b 74 20 22 20 20 70 6b 74 66 69 6c 65 --pkt " pktfile
efc0: 20 22 20 2d 2d 6d 73 67 20 49 4e 56 41 4c 49 44 " --msg INVALID
efd0: 5f 54 41 52 47 45 54 22 29 29 29 0a 09 09 28 70 _TARGET")))...(p
efe0: 72 69 6e 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 rint "Running "
eff0: 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 notification-cmd
f000: 29 0a 09 09 28 73 79 73 74 65 6d 20 6e 6f 74 69 )...(system noti
f010: 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 29 29 0a fication-cmd))).
f020: 09 20 20 23 66 29 29 29 29 0a 0a 0a 28 64 65 66 . #f))))...(def
f030: 69 6e 65 20 28 76 61 6c 69 64 61 74 65 2d 63 6d ine (validate-cm
f040: 64 20 63 6d 64 20 70 6b 74 61 20 6e 6f 74 69 66 d cmd pkta notif
f050: 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 ication-hook pkt
f060: 66 69 6c 65 29 0a 20 20 28 6c 65 74 20 28 28 72 file). (let ((r
f070: 65 74 20 23 74 29 29 20 0a 20 20 20 20 28 69 66 et #t)) . (if
f080: 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e (string-contain
f090: 73 20 63 6d 64 20 22 2d 72 65 71 74 61 72 67 22 s cmd "-reqtarg"
f0a0: 29 20 0a 09 28 69 66 20 28 63 68 65 63 6b 2d 69 ) ..(if (check-i
f0b0: 66 2d 74 61 72 67 65 74 2d 64 65 66 69 6e 65 64 f-target-defined
f0c0: 20 70 6b 74 61 20 6e 6f 74 69 66 69 63 61 74 69 pkta notificati
f0d0: 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 29 on-hook pktfile)
f0e0: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
f0f0: 20 20 20 20 28 70 72 69 6e 74 20 22 54 61 72 67 (print "Targ
f100: 65 74 20 69 73 20 76 61 6c 69 64 22 29 0a 09 20 et is valid")..
f110: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
f120: 2d 63 6f 6e 74 61 69 6e 73 20 63 6d 64 20 22 2d -contains cmd "-
f130: 6d 6f 64 65 70 61 74 74 22 29 0a 09 09 20 20 28 modepatt")... (
f140: 69 66 20 28 63 68 65 63 6b 2d 69 66 2d 6d 6f 64 if (check-if-mod
f150: 65 70 61 74 74 2d 64 65 66 69 6e 65 64 20 70 6b epatt-defined pk
f160: 74 61 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d ta notification-
f170: 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 29 0a 09 09 hook pktfile)...
f180: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 4d 6f (print "Mo
f190: 64 65 70 61 74 74 20 69 73 20 76 61 6c 69 64 22 depatt is valid"
f1a0: 29 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 20 )... (set!
f1b0: 72 65 74 20 23 66 29 29 29 29 0a 09 20 20 20 20 ret #f))))..
f1c0: 28 73 65 74 21 20 72 65 74 20 23 66 29 29 0a 09 (set! ret #f))..
f1d0: 28 69 66 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 (if (string-cont
f1e0: 61 69 6e 73 20 63 6d 64 20 22 2d 6d 6f 64 65 70 ains cmd "-modep
f1f0: 61 74 74 22 29 0a 09 20 20 20 20 28 69 66 20 28 att").. (if (
f200: 63 68 65 63 6b 2d 69 66 2d 6d 6f 64 65 70 61 74 check-if-modepat
f210: 74 2d 64 65 66 69 6e 65 64 20 70 6b 74 61 20 6e t-defined pkta n
f220: 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b otification-hook
f230: 20 70 6b 74 66 69 6c 65 29 0a 09 09 28 70 72 69 pktfile)...(pri
f240: 6e 74 20 22 4d 6f 64 65 70 61 74 74 20 69 73 20 nt "Modepatt is
f250: 76 61 6c 69 64 22 29 0a 09 09 28 73 65 74 21 20 valid")...(set!
f260: 72 65 74 20 23 66 29 29 29 29 20 0a 20 20 20 20 ret #f)))) .
f270: 72 65 74 29 29 0a 0a 20 20 20 0a 3b 3b 20 63 6f ret)).. .;; co
f280: 6c 6c 65 63 74 20 61 6c 6c 20 6e 65 65 64 65 64 llect all needed
f290: 20 64 61 74 61 20 61 6e 64 20 63 72 65 61 74 65 data and create
f2a0: 20 72 75 6e 20 70 6b 74 73 20 66 6f 72 20 63 6f run pkts for co
f2b0: 6e 74 6f 75 72 73 20 77 69 74 68 20 63 68 61 6e ntours with chan
f2c0: 67 65 64 20 69 6e 70 75 74 73 0a 3b 3b 0a 28 64 ged inputs.;;.(d
f2d0: 65 66 69 6e 65 20 28 64 69 73 70 61 74 63 68 2d efine (dispatch-
f2e0: 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 6f 6e 66 20 commands mtconf
f2f0: 74 6f 70 70 61 74 68 29 0a 20 20 3b 3b 20 77 65 toppath). ;; we
f300: 20 61 72 65 20 65 78 70 65 63 74 69 6e 67 20 61 are expecting a
f310: 20 64 69 72 65 63 74 6f 72 79 20 22 6c 6f 67 73 directory "logs
f320: 22 2c 20 63 68 65 63 6b 20 61 6e 64 20 63 72 65 ", check and cre
f330: 61 74 65 20 69 74 2c 20 63 72 65 61 74 65 20 74 ate it, create t
f340: 68 65 20 6c 6f 67 20 69 6e 20 2f 74 6d 70 20 69 he log in /tmp i
f350: 66 20 6e 6f 74 20 61 62 6c 65 20 74 6f 20 63 72 f not able to cr
f360: 65 61 74 65 20 6c 6f 67 73 20 64 69 72 0a 20 20 eate logs dir.
f370: 28 6c 65 74 20 28 28 6c 6f 67 64 69 72 0a 09 20 (let ((logdir..
f380: 28 69 66 20 28 69 66 20 28 6e 6f 74 20 28 64 69 (if (if (not (di
f390: 72 65 63 74 6f 72 79 3f 20 22 6c 6f 67 73 22 29 rectory? "logs")
f3a0: 29 0a 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 )... (handle-exc
f3b0: 65 70 74 69 6f 6e 73 0a 09 09 20 20 65 78 6e 0a eptions... exn.
f3c0: 09 09 20 20 23 66 0a 09 09 20 20 28 63 72 65 61 .. #f... (crea
f3d0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 22 6c 6f te-directory "lo
f3e0: 67 73 22 29 0a 09 09 20 20 23 74 29 0a 09 09 20 gs")... #t)...
f3f0: 23 74 29 0a 09 20 20 20 20 20 22 6c 6f 67 73 22 #t).. "logs"
f400: 0a 09 20 20 20 20 20 22 2f 74 6d 70 22 29 29 0a .. "/tmp")).
f410: 09 28 63 70 75 6c 6f 61 64 20 28 61 6c 69 73 74 .(cpuload (alist
f420: 2d 72 65 66 20 27 61 64 6a 2d 70 72 6f 63 2d 6c -ref 'adj-proc-l
f430: 6f 61 64 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d oad (common:get-
f440: 6e 6f 72 6d 61 6c 69 7a 65 64 2d 63 70 75 2d 6c normalized-cpu-l
f450: 6f 61 64 20 23 66 29 29 29 0a 09 28 6d 61 78 6c oad #f)))..(maxl
f460: 6f 61 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d oad (string->num
f470: 62 65 72 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 ber (or (configf
f480: 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 :lookup mtconf "
f490: 73 65 74 75 70 22 20 22 6d 61 78 6c 6f 61 64 22 setup" "maxload"
f4a0: 29 0a 09 09 09 09 20 20 20 20 20 28 63 6f 6e 66 )..... (conf
f4b0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e igf:lookup mtcon
f4c0: 66 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 22 6d 61 f "jobtools" "ma
f4d0: 78 6c 6f 61 64 22 29 20 3b 3b 20 72 65 73 70 65 xload") ;; respe
f4e0: 63 74 20 76 61 6c 75 65 20 75 73 65 64 20 62 79 ct value used by
f4f0: 20 4d 65 67 61 74 65 73 74 20 63 61 6c 6c 73 0a Megatest calls.
f500: 09 09 09 09 20 20 20 20 20 22 31 2e 31 22 29 29 .... "1.1"))
f510: 29 0a 09 28 6e 6f 74 69 66 69 63 61 74 69 6f 6e )..(notification
f520: 2d 68 6f 6f 6b 20 28 69 66 20 28 63 6f 6e 66 69 -hook (if (confi
f530: 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 gf:lookup mtconf
f540: 20 22 73 65 74 75 70 22 20 22 6e 6f 74 69 66 69 "setup" "notifi
f550: 63 61 74 69 6f 6e 2d 68 6f 6f 6b 22 29 0a 09 09 cation-hook")...
f560: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
f570: 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 :lookup mtconf "
f580: 73 65 74 75 70 22 20 22 6e 6f 74 69 66 69 63 61 setup" "notifica
f590: 74 69 6f 6e 2d 68 6f 6f 6b 22 29 0a 09 09 09 20 tion-hook")....
f5a0: 20 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 #f))).
f5b0: 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 71 75 65 (common:with-que
f5c0: 75 65 2d 64 62 0a 20 20 20 20 20 6d 74 63 6f 6e ue-db. mtcon
f5d0: 66 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 f. (lambda (
f5e0: 70 6b 74 73 64 69 72 73 20 70 6b 74 73 64 69 72 pktsdirs pktsdir
f5f0: 20 70 64 62 29 0a 20 20 20 20 20 20 20 28 6c 65 pdb). (le
f600: 74 2a 20 28 28 72 67 63 6f 6e 66 64 61 74 20 28 t* ((rgconfdat (
f610: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
f620: 6e 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 nfig (conc toppa
f630: 74 68 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e th "/runconfigs.
f640: 63 6f 6e 66 69 67 22 29 29 29 0a 09 20 20 20 20 config")))..
f650: 20 20 28 72 67 63 6f 6e 66 20 20 20 20 28 63 61 (rgconf (ca
f660: 72 20 72 67 63 6f 6e 66 64 61 74 29 29 0a 09 20 r rgconfdat))..
f670: 20 20 20 20 20 28 61 72 65 61 73 20 20 20 20 20 (areas
f680: 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 (configf:get-sec
f690: 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 61 72 65 tion mtconf "are
f6a0: 61 73 22 29 29 0a 09 20 20 20 20 20 20 28 63 6f as")).. (co
f6b0: 6e 74 6f 75 72 73 20 20 28 63 6f 6e 66 69 67 66 ntours (configf
f6c0: 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 63 :get-section mtc
f6d0: 6f 6e 66 20 22 63 6f 6e 74 6f 75 72 73 22 29 29 onf "contours"))
f6e0: 0a 09 20 20 20 20 20 20 28 70 6b 74 73 20 20 20 .. (pkts
f6f0: 20 20 20 28 66 69 6e 64 2d 70 6b 74 73 20 70 64 (find-pkts pd
f700: 62 20 27 28 63 6d 64 29 20 27 28 29 29 29 0a 09 b '(cmd) '()))..
f710: 20 20 20 20 20 20 28 74 6f 72 75 6e 20 20 20 20 (torun
f720: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
f730: 65 29 29 20 3b 3b 20 74 61 72 67 65 74 20 3d 3e e)) ;; target =>
f740: 20 28 20 2e 2e 2e 20 69 6e 66 6f 20 2e 2e 2e 20 ( ... info ...
f750: 29 0a 09 20 20 20 20 20 20 28 72 67 65 6e 74 61 ).. (rgenta
f760: 72 67 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d rgs (hash-table-
f770: 6b 65 79 73 20 72 67 63 6f 6e 66 29 29 29 20 3b keys rgconf))) ;
f780: 3b 20 74 68 65 73 65 20 61 72 65 20 74 68 65 20 ; these are the
f790: 74 61 72 67 65 74 73 20 72 65 67 69 73 74 65 72 targets register
f7a0: 65 64 20 66 6f 72 20 61 75 74 6f 6d 61 74 69 63 ed for automatic
f7b0: 61 6c 6c 79 20 74 72 69 67 67 65 72 69 6e 67 0a ally triggering.
f7c0: 20 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 (sqlite
f7d0: 33 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 3:set-busy-handl
f7e0: 65 72 21 20 28 64 62 69 3a 64 62 2d 63 6f 6e 6e er! (dbi:db-conn
f7f0: 20 70 64 62 29 20 28 73 71 6c 69 74 65 33 3a 6d pdb) (sqlite3:m
f800: 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74 ake-busy-timeout
f810: 20 31 30 30 30 30 29 29 0a 09 20 28 66 6f 72 2d 10000)).. (for-
f820: 65 61 63 68 0a 09 20 20 28 6c 61 6d 62 64 61 20 each.. (lambda
f830: 28 70 6b 74 64 61 74 29 0a 09 20 20 20 20 28 6c (pktdat).. (l
f840: 65 74 2a 20 28 28 70 6b 74 61 20 20 20 20 28 61 et* ((pkta (a
f850: 6c 69 73 74 2d 72 65 66 20 27 61 70 6b 74 20 70 list-ref 'apkt p
f860: 6b 74 64 61 74 29 29 0a 09 09 20 20 20 28 61 63 ktdat))... (ac
f870: 74 69 6f 6e 20 20 28 61 6c 69 73 74 2d 72 65 66 tion (alist-ref
f880: 20 27 41 20 70 6b 74 61 29 29 0a 09 09 20 20 20 'A pkta))...
f890: 28 63 6d 64 6c 69 6e 65 20 28 70 6b 74 2d 3e 63 (cmdline (pkt->c
f8a0: 6d 64 6c 69 6e 65 20 70 6b 74 61 29 29 0a 09 09 mdline pkta))...
f8b0: 20 20 20 28 75 75 69 64 20 20 20 20 28 61 6c 69 (uuid (ali
f8c0: 73 74 2d 72 65 66 20 27 5a 20 70 6b 74 61 29 29 st-ref 'Z pkta))
f8d0: 0a 09 09 20 20 20 28 75 73 65 72 20 20 20 20 28 ... (user (
f8e0: 61 6c 69 73 74 2d 72 65 66 20 27 55 20 70 6b 74 alist-ref 'U pkt
f8f0: 61 29 29 0a 09 09 20 20 20 28 61 72 65 61 20 20 a))... (area
f900: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 47 20 (alist-ref 'G
f910: 70 6b 74 61 29 29 0a 09 09 20 20 20 28 6c 6f 67 pkta))... (log
f920: 66 20 20 20 20 28 63 6f 6e 63 20 6c 6f 67 64 69 f (conc logdi
f930: 72 20 22 2f 22 20 75 75 69 64 20 22 2d 72 75 6e r "/" uuid "-run
f940: 2e 6c 6f 67 22 29 29 0a 09 09 20 20 20 28 70 6b .log"))... (pk
f950: 74 66 69 6c 65 20 28 63 6f 6e 63 20 70 6b 74 73 tfile (conc pkts
f960: 64 69 72 20 22 2f 22 20 75 75 69 64 20 22 2e 70 dir "/" uuid ".p
f970: 6b 74 22 29 29 0a 09 09 20 20 20 28 66 75 6c 6c kt"))... (full
f980: 63 6d 64 20 28 63 6f 6e 63 20 22 4e 42 46 41 4b cmd (conc "NBFAK
f990: 45 5f 4c 4f 47 3d 22 20 6c 6f 67 66 20 22 20 6e E_LOG=" logf " n
f9a0: 62 66 61 6b 65 20 22 20 63 6d 64 6c 69 6e 65 29 bfake " cmdline)
f9b0: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 63 )).. (if (c
f9c0: 68 65 63 6b 2d 61 63 63 65 73 73 20 75 73 65 72 heck-access user
f9d0: 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f 6e 20 61 mtconf action a
f9e0: 72 65 61 29 0a 09 09 20 20 28 69 66 20 28 61 6e rea)... (if (an
f9f0: 64 20 28 3e 20 63 70 75 6c 6f 61 64 20 6d 61 78 d (> cpuload max
fa00: 6c 6f 61 64 29 0a 09 09 09 20 20 20 28 6d 65 6d load).... (mem
fa10: 62 65 72 20 61 63 74 69 6f 6e 20 27 28 22 72 75 ber action '("ru
fa20: 6e 22 20 22 61 72 63 68 69 76 65 22 29 29 29 20 n" "archive")))
fa30: 3b 3b 20 64 6f 20 6e 6f 74 20 72 75 6e 20 61 72 ;; do not run ar
fa40: 63 68 69 76 65 20 6f 72 20 72 75 6e 20 69 66 20 chive or run if
fa50: 6c 6f 61 64 20 69 73 20 6f 76 65 72 20 74 68 65 load is over the
fa60: 20 73 70 65 63 69 66 69 65 64 20 6c 69 6d 69 74 specified limit
fa70: 0a 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ... (begin.
fa80: 09 09 09 28 70 72 69 6e 74 20 22 57 41 52 4e 49 ...(print "WARNI
fa90: 4e 47 3a 20 63 70 75 6c 6f 61 64 20 74 6f 6f 20 NG: cpuload too
faa0: 68 69 67 68 2c 20 73 6b 69 70 70 69 6e 67 20 70 high, skipping p
fab0: 72 6f 63 65 73 73 69 6e 67 20 6f 66 20 22 20 75 rocessing of " u
fac0: 75 69 64 20 22 20 64 75 65 20 74 6f 20 22 20 63 uid " due to " c
fad0: 70 75 6c 6f 61 64 20 22 20 3e 20 22 20 6d 61 78 puload " > " max
fae0: 6c 6f 61 64 29 0a 09 09 09 28 69 66 20 6e 6f 74 load)....(if not
faf0: 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 0a 09 ification-hook..
fb00: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 6f .. (let* ((no
fb10: 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 20 28 tification-cmd (
fb20: 63 6f 6e 63 20 6e 6f 74 69 66 69 63 61 74 69 6f conc notificatio
fb30: 6e 2d 68 6f 6f 6b 20 22 20 2d 2d 70 6b 74 20 22 n-hook " --pkt "
fb40: 20 70 6b 74 66 69 6c 65 20 22 20 2d 2d 6d 73 67 pktfile " --msg
fb50: 20 48 49 47 48 5f 4c 4f 41 44 22 29 29 29 0a 09 HIGH_LOAD")))..
fb60: 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
fb70: 52 75 6e 6e 69 6e 67 20 22 20 6e 6f 74 69 66 69 Running " notifi
fb80: 63 61 74 69 6f 6e 2d 63 6d 64 29 20 0a 09 09 09 cation-cmd) ....
fb90: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 6e 6f (system no
fba0: 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 29 tification-cmd))
fbb0: 29 29 0a 09 09 20 20 20 20 20 20 28 62 65 67 69 ))... (begi
fbc0: 6e 0a 09 09 09 3b 3b 20 69 66 20 6d 6f 64 65 70 n....;; if modep
fbd0: 61 74 74 20 75 73 65 64 20 63 68 65 6b 20 69 66 att used chek if
fbe0: 20 69 74 20 69 73 20 64 65 66 69 6e 65 64 20 66 it is defined f
fbf0: 6f 72 20 74 68 65 20 74 61 72 67 65 74 2e 20 49 or the target. I
fc00: 66 20 2d 72 65 71 74 61 72 67 20 63 68 65 63 6b f -reqtarg check
fc10: 20 69 66 20 74 61 72 67 65 74 20 65 78 69 73 74 if target exist
fc20: 2e 0a 09 09 09 28 69 66 20 28 76 61 6c 69 64 61 .....(if (valida
fc30: 74 65 2d 63 6d 64 20 66 75 6c 6c 63 6d 64 20 70 te-cmd fullcmd p
fc40: 6b 74 61 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e kta notification
fc50: 2d 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 29 0a 09 -hook pktfile)..
fc60: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
fc70: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 52 55 (print "RU
fc80: 4e 4e 49 4e 47 3a 20 22 20 66 75 6c 6c 63 6d 64 NNING: " fullcmd
fc90: 29 0a 09 09 09 20 20 20 20 20 20 28 73 79 73 74 ).... (syst
fca0: 65 6d 20 66 75 6c 6c 63 6d 64 29 20 3b 3b 20 72 em fullcmd) ;; r
fcb0: 65 70 6c 61 63 65 20 77 69 74 68 20 70 72 6f 63 eplace with proc
fcc0: 65 73 73 20 2e 2e 2e 0a 09 09 09 20 20 20 20 20 ess .......
fcd0: 20 28 6d 61 72 6b 2d 70 72 6f 63 65 73 73 65 64 (mark-processed
fce0: 20 70 64 62 20 28 6c 69 73 74 20 28 61 6c 69 73 pdb (list (alis
fcf0: 74 2d 72 65 66 20 27 69 64 20 70 6b 74 64 61 74 t-ref 'id pktdat
fd00: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 ))).... (le
fd10: 74 2d 76 61 6c 75 65 73 20 28 28 28 61 63 6b 2d t-values (((ack-
fd20: 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 0a 09 09 uuid ack-pkt)...
fd30: 09 09 09 20 20 20 20 28 61 64 64 2d 7a 2d 63 61 ... (add-z-ca
fd40: 72 64 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f rd...... (co
fd50: 6e 73 74 72 75 63 74 2d 73 64 61 74 20 27 50 20 nstruct-sdat 'P
fd60: 75 75 69 64 0a 09 09 09 09 09 09 09 20 20 20 20 uuid........
fd70: 20 27 54 20 28 63 61 73 65 20 28 73 74 72 69 6e 'T (case (strin
fd80: 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f 6e g->symbol action
fd90: 29 0a 09 09 09 09 09 09 09 09 20 20 28 28 72 75 )......... ((ru
fda0: 6e 29 20 22 72 75 6e 73 74 61 72 74 22 29 0a 09 n) "runstart")..
fdb0: 09 09 09 09 09 09 09 20 20 28 28 73 79 6e 63 29 ....... ((sync)
fdc0: 20 22 73 79 6e 63 73 74 61 72 74 22 29 20 20 20 "syncstart")
fdd0: 20 3b 3b 20 65 78 61 6d 70 6c 65 20 6f 66 20 74 ;; example of t
fde0: 72 61 6e 73 6c 61 74 69 6e 67 20 72 75 6e 20 2d ranslating run -
fdf0: 3e 20 72 75 6e 73 74 61 72 74 0a 09 09 09 09 09 > runstart......
fe00: 09 09 09 20 20 28 65 6c 73 65 20 20 20 61 63 74 ... (else act
fe10: 69 6f 6e 29 29 0a 09 09 09 09 09 09 09 20 20 20 ion))........
fe20: 20 20 27 47 20 28 61 6c 69 73 74 2d 72 65 66 20 'G (alist-ref
fe30: 27 47 20 70 6b 74 61 29 0a 09 09 09 09 09 09 09 'G pkta)........
fe40: 20 20 20 20 20 27 63 20 28 61 6c 69 73 74 2d 72 'c (alist-r
fe50: 65 66 20 27 63 20 70 6b 74 61 29 20 3b 3b 20 54 ef 'c pkta) ;; T
fe60: 48 49 53 20 49 53 20 57 52 4f 4e 47 21 20 53 48 HIS IS WRONG! SH
fe70: 4f 55 4c 44 20 42 45 20 27 63 0a 09 09 09 09 09 OULD BE 'c......
fe80: 09 09 20 20 20 20 20 27 74 20 28 61 6c 69 73 74 .. 't (alist
fe90: 2d 72 65 66 20 27 74 20 70 6b 74 61 29 29 29 29 -ref 't pkta))))
fea0: 29 0a 09 09 09 09 28 77 72 69 74 65 2d 70 6b 74 ).....(write-pkt
feb0: 20 70 6b 74 73 64 69 72 20 61 63 6b 2d 75 75 69 pktsdir ack-uui
fec0: 64 20 61 63 6b 2d 70 6b 74 29 29 0a 09 09 09 20 d ack-pkt))....
fed0: 20 20 20 20 20 28 69 66 20 6e 6f 74 69 66 69 63 (if notific
fee0: 61 74 69 6f 6e 2d 68 6f 6f 6b 0a 09 09 09 09 20 ation-hook.....
fef0: 20 28 6c 65 74 2a 20 28 28 6e 6f 74 69 66 69 63 (let* ((notific
ff00: 61 74 69 6f 6e 2d 63 6d 64 20 28 63 6f 6e 63 20 ation-cmd (conc
ff10: 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f notification-hoo
ff20: 6b 20 22 20 2d 2d 70 6b 74 20 22 20 70 6b 74 66 k " --pkt " pktf
ff30: 69 6c 65 20 22 20 2d 2d 6d 73 67 20 52 55 4e 5f ile " --msg RUN_
ff40: 4c 41 55 4e 43 48 45 44 20 2d 2d 63 6f 6e 74 6f LAUNCHED --conto
ff50: 75 72 20 22 20 28 63 61 61 72 20 20 63 6f 6e 74 ur " (caar cont
ff60: 6f 75 72 73 29 20 22 20 2d 2d 6c 6f 67 5f 70 61 ours) " --log_pa
ff70: 74 68 20 22 20 6c 6f 67 66 20 29 29 29 0a 09 09 th " logf )))...
ff80: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 .. (print "Ru
ff90: 6e 6e 69 6e 67 20 22 20 6e 6f 74 69 66 69 63 61 nning " notifica
ffa0: 74 69 6f 6e 2d 63 6d 64 29 09 09 09 09 0a 09 09 tion-cmd).......
ffb0: 09 09 20 20 20 20 28 73 79 73 74 65 6d 20 6e 6f .. (system no
ffc0: 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 29 tification-cmd))
ffd0: 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e )).... (begin
ffe0: 0a 09 09 09 20 20 20 20 20 20 28 6d 61 72 6b 2d .... (mark-
fff0: 70 72 6f 63 65 73 73 65 64 20 70 64 62 20 28 6c processed pdb (l
10000 69 73 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 ist (alist-ref '
10010 69 64 20 70 6b 74 64 61 74 29 29 29 0a 09 09 09 id pktdat)))....
10020 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
10030 73 20 28 28 28 61 63 6b 2d 75 75 69 64 20 61 63 s (((ack-uuid ac
10040 6b 2d 70 6b 74 29 0a 09 09 09 09 09 20 20 20 20 k-pkt)......
10050 28 61 64 64 2d 7a 2d 63 61 72 64 0a 09 09 09 09 (add-z-card.....
10060 09 20 20 20 20 20 28 63 6f 6e 73 74 72 75 63 74 . (construct
10070 2d 73 64 61 74 20 27 50 20 75 75 69 64 0a 09 09 -sdat 'P uuid...
10080 09 09 09 09 09 20 20 20 20 20 27 54 20 22 69 6e ..... 'T "in
10090 76 61 6c 69 64 2d 69 6e 70 75 74 22 0a 09 09 09 valid-input"....
100a0 09 09 09 09 20 20 20 20 20 27 63 20 28 61 6c 69 .... 'c (ali
100b0 73 74 2d 72 65 66 20 27 6f 20 70 6b 74 61 29 20 st-ref 'o pkta)
100c0 3b 3b 20 54 48 49 53 20 49 53 20 57 52 4f 4e 47 ;; THIS IS WRONG
100d0 21 20 53 48 4f 55 4c 44 20 42 45 20 27 63 0a 09 ! SHOULD BE 'c..
100e0 09 09 09 09 09 09 20 20 20 20 20 27 74 20 28 61 ...... 't (a
100f0 6c 69 73 74 2d 72 65 66 20 27 74 20 70 6b 74 61 list-ref 't pkta
10100 29 29 29 29 29 0a 09 09 09 09 28 77 72 69 74 65 ))))).....(write
10110 2d 70 6b 74 20 70 6b 74 73 64 69 72 20 61 63 6b -pkt pktsdir ack
10120 2d 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 29 29 -uuid ack-pkt)))
10130 29 29 29 0a 09 09 20 20 28 62 65 67 69 6e 20 3b )))... (begin ;
10140 3b 20 61 63 63 65 73 73 20 64 65 6e 69 65 64 21 ; access denied!
10150 20 4d 61 72 6b 20 61 73 20 73 75 63 68 0a 09 09 Mark as such...
10160 20 20 20 20 28 6d 61 72 6b 2d 70 72 6f 63 65 73 (mark-proces
10170 73 65 64 20 70 64 62 20 28 6c 69 73 74 20 28 61 sed pdb (list (a
10180 6c 69 73 74 2d 72 65 66 20 27 69 64 20 70 6b 74 list-ref 'id pkt
10190 64 61 74 29 29 29 0a 09 09 20 20 20 20 28 6c 65 dat)))... (le
101a0 74 2d 76 61 6c 75 65 73 20 28 28 28 61 63 6b 2d t-values (((ack-
101b0 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 0a 09 09 uuid ack-pkt)...
101c0 09 09 20 20 28 61 64 64 2d 7a 2d 63 61 72 64 0a .. (add-z-card.
101d0 09 09 09 09 20 20 20 28 63 6f 6e 73 74 72 75 63 .... (construc
101e0 74 2d 73 64 61 74 20 27 50 20 75 75 69 64 0a 09 t-sdat 'P uuid..
101f0 09 09 09 09 09 20 20 20 27 54 20 22 61 63 63 65 ..... 'T "acce
10200 73 73 2d 64 65 6e 69 65 64 22 0a 09 09 09 09 09 ss-denied"......
10210 09 20 20 20 27 63 20 28 61 6c 69 73 74 2d 72 65 . 'c (alist-re
10220 66 20 27 6f 20 70 6b 74 61 29 20 3b 3b 20 54 48 f 'o pkta) ;; TH
10230 49 53 20 49 53 20 57 52 4f 4e 47 21 20 53 48 4f IS IS WRONG! SHO
10240 55 4c 44 20 42 45 20 27 63 0a 09 09 09 09 09 09 ULD BE 'c.......
10250 20 20 20 27 74 20 28 61 6c 69 73 74 2d 72 65 66 't (alist-ref
10260 20 27 74 20 70 6b 74 61 29 29 29 29 29 0a 09 09 't pkta)))))...
10270 20 20 20 20 20 20 28 77 72 69 74 65 2d 70 6b 74 (write-pkt
10280 20 70 6b 74 73 64 69 72 20 61 63 6b 2d 75 75 69 pktsdir ack-uui
10290 64 20 61 63 6b 2d 70 6b 74 29 29 0a 09 09 20 20 d ack-pkt))...
102a0 20 20 28 69 66 20 6e 6f 74 69 66 69 63 61 74 69 (if notificati
102b0 6f 6e 2d 68 6f 6f 6b 0a 09 09 09 28 6c 65 74 2a on-hook....(let*
102c0 20 28 28 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d ((notification-
102d0 63 6d 64 20 28 63 6f 6e 63 20 6e 6f 74 69 66 69 cmd (conc notifi
102e0 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 22 20 2d 2d cation-hook " --
102f0 70 6b 74 20 22 20 70 6b 74 66 69 6c 65 20 22 20 pkt " pktfile "
10300 2d 2d 6d 73 67 20 41 43 43 45 53 53 5f 44 45 4e --msg ACCESS_DEN
10310 49 45 44 22 29 29 29 0a 09 09 09 20 20 28 70 72 IED"))).... (pr
10320 69 6e 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 6e int "Running " n
10330 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 otification-cmd)
10340 0a 09 09 09 20 20 28 73 79 73 74 65 6d 20 6e 6f .... (system no
10350 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 29 29 tification-cmd))
10360 29 29 29 29 29 0a 09 20 20 70 6b 74 73 29 29 29 ))))).. pkts)))
10370 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 63 )))...(define (c
10380 68 65 63 6b 2d 61 63 63 65 73 73 20 75 73 65 72 heck-access user
10390 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f 6e 20 61 mtconf action a
103a0 72 65 61 29 0a 20 20 3b 3b 20 4e 4f 54 45 3a 20 rea). ;; NOTE:
103b0 4e 65 65 64 20 63 6f 6e 74 72 6f 6c 20 6f 76 65 Need control ove
103c0 72 20 64 65 66 61 75 6c 74 73 2e 20 45 2e 67 2e r defaults. E.g.
103d0 20 64 65 66 61 75 6c 74 20 6d 69 67 68 74 20 62 default might b
103e0 65 20 6e 6f 20 61 63 63 65 73 73 0a 20 20 28 6c e no access. (l
103f0 65 74 2a 20 28 28 61 63 63 65 73 73 2d 63 74 72 et* ((access-ctr
10400 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 65 78 l (hash-table-ex
10410 69 73 74 73 3f 20 6d 74 63 6f 6e 66 20 22 61 63 ists? mtconf "ac
10420 63 65 73 73 22 29 29 20 20 3b 3b 20 69 66 20 74 cess")) ;; if t
10430 68 65 72 65 20 69 73 20 61 6e 20 61 63 63 65 73 here is an acces
10440 73 20 73 65 63 74 69 6f 6e 20 74 68 65 20 64 65 s section the de
10450 66 61 75 6c 74 20 69 73 20 74 6f 20 52 45 51 55 fault is to REQU
10460 49 52 45 20 65 6e 61 62 6c 65 6d 65 6e 74 2f 61 IRE enablement/a
10470 63 63 65 73 73 0a 09 20 28 61 63 63 65 73 73 2d ccess.. (access-
10480 6c 69 73 74 20 28 6d 61 70 20 28 6c 61 6d 62 64 list (map (lambd
10490 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 28 73 a (x).... (s
104a0 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 3a tring-split x ":
104b0 22 29 29 0a 09 09 09 20 20 20 28 73 74 72 69 6e ")).... (strin
104c0 67 2d 73 70 6c 69 74 20 28 6f 72 20 28 63 6f 6e g-split (or (con
104d0 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
104e0 6e 66 20 22 61 63 63 65 73 73 22 20 61 72 65 61 nf "access" area
104f0 29 20 3b 3b 20 75 73 65 72 69 64 3a 72 69 67 68 ) ;; userid:righ
10500 74 73 74 79 70 65 20 75 73 65 72 69 64 32 3a 72 tstype userid2:r
10510 69 67 68 74 73 74 79 70 65 32 20 2e 2e 2e 0a 09 ightstype2 .....
10520 09 09 09 09 20 20 20 20 20 28 69 66 20 61 63 63 .... (if acc
10530 65 73 73 2d 63 74 72 6c 0a 09 09 09 09 09 09 20 ess-ctrl.......
10540 22 2a 3a 6e 6f 6e 65 22 20 20 3b 3b 20 6e 6f 62 "*:none" ;; nob
10550 6f 64 79 20 68 61 73 20 61 63 63 65 73 73 20 62 ody has access b
10560 79 20 64 65 66 61 75 6c 74 0a 09 09 09 09 09 09 y default.......
10570 20 22 2a 3a 61 6c 6c 22 29 29 29 29 29 0a 09 20 "*:all")))))..
10580 28 61 63 63 65 73 73 2d 74 79 70 65 73 2d 64 61 (access-types-da
10590 74 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 t (configf:get-s
105a0 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 61 ection mtconf "a
105b0 63 63 65 73 73 74 79 70 65 73 22 29 29 29 0a 20 ccesstypes"))).
105c0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
105d0 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
105e0 6f 72 74 2a 20 22 43 68 65 63 6b 69 6e 67 20 61 ort* "Checking a
105f0 63 63 65 73 73 20 69 6e 20 22 20 61 63 63 65 73 ccess in " acces
10600 73 2d 6c 69 73 74 20 22 20 77 69 74 68 20 61 63 s-list " with ac
10610 63 65 73 73 2d 63 74 72 6c 20 22 20 61 63 63 65 cess-ctrl " acce
10620 73 73 2d 63 74 72 6c 20 22 20 66 6f 72 20 61 72 ss-ctrl " for ar
10630 65 61 20 22 20 61 72 65 61 29 0a 20 20 20 20 28 ea " area). (
10640 69 66 20 61 63 63 65 73 73 2d 63 74 72 6c 0a 09 if access-ctrl..
10650 28 6c 65 74 2a 20 28 28 75 73 65 72 2d 61 63 63 (let* ((user-acc
10660 65 73 73 20 20 20 20 20 28 6f 72 20 28 61 73 73 ess (or (ass
10670 6f 63 20 75 73 65 72 20 61 63 63 65 73 73 2d 6c oc user access-l
10680 69 73 74 29 0a 09 09 09 09 20 20 20 20 28 61 73 ist)..... (as
10690 73 6f 63 20 22 2a 22 20 20 61 63 63 65 73 73 2d soc "*" access-
106a0 6c 69 73 74 29 29 29 0a 09 20 20 20 20 20 20 20 list)))..
106b0 28 61 63 63 65 73 73 2d 74 79 70 65 20 20 20 28 (access-type (
106c0 69 66 20 75 73 65 72 2d 61 63 63 65 73 73 0a 09 if user-access..
106d0 09 09 09 09 09 09 09 09 09 09 09 20 20 28 63 61 ........... (ca
106e0 64 72 20 75 73 65 72 2d 61 63 63 65 73 73 29 0a dr user-access).
106f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10700 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 0a #f)).
10710 09 20 20 20 20 20 20 20 28 61 63 63 65 73 73 2d . (access-
10720 74 79 70 65 73 20 20 20 20 28 6c 65 74 20 28 28 types (let ((
10730 72 65 73 20 28 61 6c 69 73 74 2d 72 65 66 20 61 res (alist-ref a
10740 63 63 65 73 73 2d 74 79 70 65 20 61 63 63 65 73 ccess-type acces
10750 73 2d 74 79 70 65 73 2d 64 61 74 20 65 71 75 61 s-types-dat equa
10760 6c 3f 29 29 29 0a 09 09 09 09 20 20 28 69 66 20 l?)))..... (if
10770 72 65 73 20 28 63 61 72 20 72 65 73 29 20 72 65 res (car res) re
10780 73 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 6c s))).. (al
10790 6c 6f 77 65 64 2d 61 63 74 69 6f 6e 73 20 28 73 lowed-actions (s
107a0 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 tring-split (or
107b0 61 63 63 65 73 73 2d 74 79 70 65 73 20 22 22 29 access-types "")
107c0 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 ))).. (debug:pr
107d0 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
107e0 6f 67 2d 70 6f 72 74 2a 20 22 47 6f 74 20 22 20 og-port* "Got "
107f0 61 6c 6c 6f 77 65 64 2d 61 63 74 69 6f 6e 73 20 allowed-actions
10800 22 20 66 6f 72 20 75 73 65 72 20 22 20 75 73 65 " for user " use
10810 72 20 22 20 77 68 65 72 65 20 61 63 63 65 73 73 r " where access
10820 2d 74 79 70 65 73 3d 22 20 61 63 63 65 73 73 2d -types=" access-
10830 74 79 70 65 73 20 22 20 61 63 63 65 73 73 2d 74 types " access-t
10840 79 70 65 3d 22 20 61 63 63 65 73 73 2d 74 79 70 ype=" access-typ
10850 65 29 0a 09 20 20 28 63 6f 6e 64 0a 09 20 20 20 e).. (cond..
10860 28 28 61 6e 64 20 61 63 63 65 73 73 2d 74 79 70 ((and access-typ
10870 65 73 20 28 6d 65 6d 62 65 72 20 61 63 74 69 6f es (member actio
10880 6e 20 61 6c 6c 6f 77 65 64 2d 61 63 74 69 6f 6e n allowed-action
10890 73 29 29 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 s)).. ;; (pri
108a0 6e 74 20 22 41 63 63 65 73 73 20 67 72 61 6e 74 nt "Access grant
108b0 65 64 20 66 6f 72 20 22 20 75 73 65 72 20 22 20 ed for " user "
108c0 66 6f 72 20 22 20 61 63 74 69 6f 6e 29 0a 09 20 for " action)..
108d0 20 20 20 23 74 29 0a 09 20 20 20 28 65 6c 73 65 #t).. (else
108e0 0a 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 .. ;; (print
108f0 22 41 63 63 65 73 73 20 64 65 6e 69 65 64 20 66 "Access denied f
10900 6f 72 20 22 20 75 73 65 72 20 22 20 66 6f 72 20 or " user " for
10910 22 20 61 63 74 69 6f 6e 29 0a 09 20 20 20 20 23 " action).. #
10920 66 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 f))))))..(define
10930 20 28 6f 70 65 6e 2d 6c 6f 67 66 69 6c 65 20 6c (open-logfile l
10940 6f 67 70 61 74 68 29 0a 20 20 28 63 6f 6e 64 69 ogpath). (condi
10950 74 69 6f 6e 2d 63 61 73 65 0a 20 20 20 28 6c 65 tion-case. (le
10960 74 2a 20 28 28 6c 6f 67 2d 64 69 72 20 28 6f 72 t* ((log-dir (or
10970 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
10980 74 6f 72 79 20 6c 6f 67 70 61 74 68 29 20 22 2e tory logpath) ".
10990 22 29 29 29 0a 20 20 20 20 20 28 69 66 20 28 6e "))). (if (n
109a0 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
109b0 69 73 74 73 3f 20 6c 6f 67 2d 64 69 72 29 29 0a ists? log-dir)).
109c0 20 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d (system
109d0 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 (conc "mkdir -p
109e0 20 22 20 6c 6f 67 2d 64 69 72 29 29 29 0a 20 20 " log-dir))).
109f0 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d (open-output-
10a00 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 29 0a 20 file logpath)).
10a10 20 20 28 65 78 6e 20 28 29 0a 20 20 20 20 20 20 (exn ().
10a20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
10a30 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
10a40 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 6f 75 6c 64 log-port* "Could
10a50 20 6e 6f 74 20 6f 70 65 6e 20 6c 6f 67 20 66 69 not open log fi
10a60 6c 65 20 66 6f 72 20 77 72 69 74 65 3a 20 22 6c le for write: "l
10a70 6f 67 70 61 74 68 29 0a 20 20 20 20 20 20 20 20 ogpath).
10a80 28 64 65 66 69 6e 65 20 2a 64 69 64 73 6f 6d 65 (define *didsome
10a90 74 68 69 6e 67 2a 20 23 74 29 20 20 0a 20 20 20 thing* #t) .
10aa0 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 (exit 1))))
10ab0 0a 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d ...(define (get-
10ac0 70 6b 74 73 2d 64 69 72 20 6d 74 63 6f 6e 66 29 pkts-dir mtconf)
10ad0 0a 20 20 28 6c 65 74 20 28 28 70 6b 74 73 64 69 . (let ((pktsdi
10ae0 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f rs (configf:loo
10af0 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 kup mtconf "setu
10b00 70 22 20 22 70 6b 74 73 64 69 72 73 22 29 29 0a p" "pktsdirs")).
10b10 09 28 70 6b 74 73 64 69 72 20 20 20 28 69 66 20 .(pktsdir (if
10b20 70 6b 74 73 64 69 72 73 20 28 63 61 72 20 28 73 pktsdirs (car (s
10b30 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 6b 74 73 tring-split pkts
10b40 64 69 72 73 20 22 20 22 29 29 20 23 66 29 29 29 dirs " ")) #f)))
10b50 0a 20 20 20 20 70 6b 74 73 64 69 72 29 29 0a 0a . pktsdir))..
10b60 28 6c 65 74 20 28 28 64 65 62 75 67 63 6f 6e 74 (let ((debugcont
10b70 72 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 2d rolf (conc (get-
10b80 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
10b90 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f 2e able "HOME") "/.
10ba0 6d 74 75 74 69 6c 72 63 22 29 29 29 0a 20 20 28 mtutilrc"))). (
10bb0 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d if (common:file-
10bc0 65 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f 6e exists? debugcon
10bd0 74 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c 6f trolf). (lo
10be0 61 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 ad debugcontrolf
10bf0 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 )))..(if (args:g
10c00 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 20 3b et-arg "-log") ;
10c10 3b 20 72 65 64 69 72 65 63 74 20 74 68 65 20 6c ; redirect the l
10c20 6f 67 20 61 6c 77 61 79 73 20 77 68 65 6e 20 61 og always when a
10c30 20 73 65 72 76 65 72 0a 20 20 20 20 28 68 61 6e server. (han
10c40 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
10c50 65 78 6e 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 exn..(begin.. (
10c60 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 print "ERROR: Fa
10c70 69 6c 65 64 20 74 6f 20 73 77 69 74 63 68 20 74 iled to switch t
10c80 6f 20 6c 6f 67 20 6f 75 74 70 75 74 2e 20 22 20 o log output. "
10c90 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
10ca0 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
10cb0 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
10cc0 29 29 0a 09 20 20 29 0a 20 20 20 20 20 20 28 6c )).. ). (l
10cd0 65 74 2a 20 28 28 74 6c 20 20 20 28 61 72 67 73 et* ((tl (args
10ce0 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 29 :get-arg "-log")
10cf0 29 20 20 20 3b 3b 20 72 75 6e 20 6c 61 75 6e 63 ) ;; run launc
10d00 68 3a 73 65 74 75 70 20 69 66 20 2d 73 65 72 76 h:setup if -serv
10d10 65 72 2c 20 65 6e 73 75 72 65 20 77 65 20 64 6f er, ensure we do
10d20 20 4e 4f 54 20 72 75 6e 20 6c 61 75 6e 63 68 3a NOT run launch:
10d30 73 65 74 75 70 20 69 66 20 2d 6c 6f 67 20 73 70 setup if -log sp
10d40 65 63 69 66 69 65 64 0a 09 20 20 20 20 20 28 6c ecified.. (l
10d50 6f 67 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ogf (args:get-ar
10d60 67 20 22 2d 6c 6f 67 22 29 29 20 3b 3b 20 75 73 g "-log")) ;; us
10d70 65 20 2d 6c 6f 67 20 75 6e 6c 65 73 73 20 77 65 e -log unless we
10d80 20 61 72 65 20 61 20 73 65 72 76 65 72 2c 20 74 are a server, t
10d90 68 65 6e 20 63 72 61 66 74 20 61 20 6c 6f 67 66 hen craft a logf
10da0 69 6c 65 20 6e 61 6d 65 0a 09 20 20 20 20 20 28 ile name.. (
10db0 6f 75 70 20 20 28 6f 70 65 6e 2d 6c 6f 67 66 69 oup (open-logfi
10dc0 6c 65 20 6c 6f 67 66 29 29 29 0a 09 3b 28 69 66 le logf)))..;(if
10dd0 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
10de0 61 72 67 20 22 2d 6c 6f 67 22 29 29 0a 09 3b 20 arg "-log"))..;
10df0 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
10e00 65 74 21 20 61 72 67 73 3a 61 72 67 2d 68 61 73 et! args:arg-has
10e10 68 20 22 2d 6c 6f 67 22 20 6c 6f 67 66 29 29 20 h "-log" logf))
10e20 3b 3b 20 66 61 6b 65 20 6f 75 74 20 66 75 74 75 ;; fake out futu
10e30 72 65 20 71 75 65 72 69 65 73 20 6f 66 20 2d 6c re queries of -l
10e40 6f 67 0a 09 28 70 72 69 6e 74 20 2a 64 65 66 61 og..(print *defa
10e50 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 ult-log-port* "S
10e60 65 6e 64 69 6e 67 20 6c 6f 67 20 6f 75 74 70 75 ending log outpu
10e70 74 20 74 6f 20 22 20 6c 6f 67 66 29 0a 09 28 73 t to " logf)..(s
10e80 65 74 21 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 et! *default-log
10e90 2d 70 6f 72 74 2a 20 6f 75 70 29 0a 29 29 29 0a -port* oup).))).
10ea0 0a 28 69 66 20 2a 61 63 74 69 6f 6e 2a 0a 20 20 .(if *action*.
10eb0 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
10ec0 3e 73 79 6d 62 6f 6c 20 2a 61 63 74 69 6f 6e 2a >symbol *action*
10ed0 29 0a 20 20 20 20 20 20 28 28 72 75 6e 20 72 65 ). ((run re
10ee0 6d 6f 76 65 20 72 65 72 75 6e 20 72 65 72 75 6e move rerun rerun
10ef0 2d 63 6c 65 61 6e 20 72 65 72 75 6e 2d 61 6c 6c -clean rerun-all
10f00 20 73 65 74 2d 73 73 20 61 72 63 68 69 76 65 20 set-ss archive
10f10 6b 69 6c 6c 20 6c 69 73 74 20 6b 69 6c 6c 2d 72 kill list kill-r
10f20 75 6e 20 6b 69 6c 6c 2d 72 65 72 75 6e 20 6c 6f un kill-rerun lo
10f30 63 6b 20 75 6e 6c 6f 63 6b 29 0a 20 20 20 20 20 ck unlock).
10f40 20 20 20 20 20 0a 20 20 20 20 20 20 20 28 6c 65 . (le
10f50 74 2a 20 28 28 6d 74 63 6f 6e 66 64 61 74 20 28 t* ((mtconfdat (
10f60 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 simple-setup (ar
10f70 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 gs:get-arg "-sta
10f80 72 74 2d 64 69 72 22 29 29 29 0a 09 20 20 20 20 rt-dir")))..
10f90 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 61 (mtconf (ca
10fa0 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 0a 09 20 r mtconfdat))..
10fb0 20 20 20 20 20 28 61 72 65 61 20 20 20 20 20 20 (area
10fc0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10fd0 61 72 65 61 22 29 29 20 3b 3b 20 6c 6f 6f 6b 20 area")) ;; look
10fe0 75 70 20 74 68 65 20 61 72 65 61 20 74 6f 20 64 up the area to d
10ff0 69 73 70 61 74 63 68 20 74 6f 20 66 72 6f 6d 20 ispatch to from
11000 5b 61 72 65 61 73 5d 20 73 65 63 74 69 6f 6e 0a [areas] section.
11010 09 20 20 20 20 20 20 28 61 72 65 61 73 65 63 20 . (areasec
11020 20 20 28 69 66 20 61 72 65 61 20 28 63 6f 6e 66 (if area (conf
11030 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e igf:lookup mtcon
11040 66 20 22 61 72 65 61 73 22 20 61 72 65 61 29 20 f "areas" area)
11050 23 66 29 29 0a 09 20 20 20 20 20 20 28 61 72 65 #f)).. (are
11060 61 64 61 74 20 20 20 28 69 66 20 61 72 65 61 73 adat (if areas
11070 65 63 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c 2d 3e ec (common:val->
11080 61 6c 69 73 74 20 61 72 65 61 73 65 63 29 20 23 alist areasec) #
11090 66 29 29 0a 09 20 20 20 20 20 20 28 61 72 65 61 f)).. (area
110a0 2d 70 61 74 68 20 28 69 66 20 61 72 65 61 64 61 -path (if areada
110b0 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 61 t (alist-ref 'pa
110c0 74 68 20 61 72 65 61 64 61 74 29 20 23 66 29 29 th areadat) #f))
110d0 0a 09 20 20 20 20 20 20 28 70 6b 74 73 64 69 72 .. (pktsdir
110e0 73 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b s (configf:look
110f0 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 up mtconf "setup
11100 22 20 22 70 6b 74 73 64 69 72 73 22 29 29 0a 09 " "pktsdirs"))..
11110 20 20 20 20 20 20 28 70 6b 74 73 64 69 72 20 20 (pktsdir
11120 20 28 69 66 20 70 6b 74 73 64 69 72 73 20 28 63 (if pktsdirs (c
11130 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ar (string-split
11140 20 70 6b 74 73 64 69 72 73 20 22 20 22 29 29 20 pktsdirs " "))
11150 23 66 29 29 0a 09 20 20 20 20 20 20 28 61 64 6a #f)).. (adj
11160 61 72 67 73 20 20 20 28 68 61 73 68 2d 74 61 62 args (hash-tab
11170 6c 65 2d 63 6f 70 79 20 61 72 67 73 3a 61 72 67 le-copy args:arg
11180 2d 68 61 73 68 29 29 0a 09 20 20 20 20 20 20 28 -hash)).. (
11190 6e 65 77 2d 73 73 20 20 20 20 28 61 72 67 73 3a new-ss (args:
111a0 67 65 74 2d 61 72 67 20 22 2d 6e 65 77 22 29 29 get-arg "-new"))
111b0 29 0a 09 20 3b 3b 20 63 68 65 63 6b 20 61 20 66 ).. ;; check a f
111c0 65 77 20 74 68 69 6e 67 73 0a 09 20 28 63 6f 6e ew things.. (con
111d0 64 0a 09 20 20 28 28 61 6e 64 20 61 72 65 61 20 d.. ((and area
111e0 28 6e 6f 74 20 61 72 65 61 2d 70 61 74 68 29 29 (not area-path))
111f0 0a 09 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 .. (print "ERR
11200 4f 52 3a 20 74 68 65 20 73 70 65 63 69 66 69 65 OR: the specifie
11210 64 20 61 72 65 61 20 77 61 73 20 6e 6f 74 20 66 d area was not f
11220 6f 75 6e 64 20 69 6e 20 74 68 65 20 5b 61 72 65 ound in the [are
11230 61 73 5d 20 74 61 62 6c 65 2e 20 41 72 65 61 20 as] table. Area
11240 6e 61 6d 65 3d 22 20 61 72 65 61 29 0a 09 20 20 name=" area)..
11250 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 28 28 (exit 1)).. ((
11260 6e 6f 74 20 61 72 65 61 29 0a 09 20 20 20 28 70 not area).. (p
11270 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 6e 6f 20 rint "ERROR: no
11280 61 72 65 61 20 73 70 65 63 69 66 69 65 64 2e 20 area specified.
11290 55 73 65 20 2d 61 72 65 61 20 3c 61 72 65 61 6e Use -area <arean
112a0 61 6d 65 3e 22 29 0a 09 20 20 20 28 65 78 69 74 ame>").. (exit
112b0 20 31 29 29 0a 09 20 20 28 65 6c 73 65 0a 09 20 1)).. (else..
112c0 20 20 28 6c 65 74 2a 20 28 28 75 73 72 2d 61 64 (let* ((usr-ad
112d0 6d 69 6e 20 28 63 68 65 63 6b 2d 61 63 63 65 73 min (check-acces
112e0 73 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d s (current-user-
112f0 6e 61 6d 65 29 20 6d 74 63 6f 6e 66 20 22 6f 76 name) mtconf "ov
11300 65 72 72 69 64 65 22 20 61 72 65 61 29 29 0a 09 erride" area))..
11310 09 09 09 09 28 75 73 65 72 20 28 69 66 20 28 61 ....(user (if (a
11320 6e 64 20 75 73 72 2d 61 64 6d 69 6e 20 28 61 72 nd usr-admin (ar
11330 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 gs:get-arg "-ove
11340 72 72 69 64 65 2d 75 73 65 72 22 29 29 0a 20 20 rride-user")).
11350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11360 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
11370 22 2d 6f 76 65 72 72 69 64 65 2d 75 73 65 72 22 "-override-user"
11380 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 63 75 ).......... (cu
11390 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 rrent-user-name)
113a0 29 29 29 0a 20 20 20 20 20 20 20 3b 20 28 70 72 ))). ; (pr
113b0 69 6e 74 20 22 75 73 65 72 20 31 32 33 20 22 20 int "user 123 "
113c0 75 73 72 2d 61 64 6d 69 6e 20 29 0a 20 20 20 20 usr-admin ).
113d0 20 20 20 20 3b 28 65 78 69 74 20 31 29 0a 20 20 ;(exit 1).
113e0 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
113f0 20 75 73 72 2d 61 64 6d 69 6e 29 20 28 61 72 67 usr-admin) (arg
11400 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 s:get-arg "-over
11410 72 69 64 65 2d 75 73 65 72 22 29 29 0a 20 20 20 ride-user")).
11420 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
11430 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 (print
11440 20 75 73 65 72 20 22 20 64 6f 65 73 20 6e 6f 74 user " does not
11450 20 68 61 76 65 20 61 63 63 65 73 73 20 74 6f 20 have access to
11460 6f 76 65 72 72 69 64 65 20 75 73 65 72 22 29 0a override user").
11470 20 20 20 20 20 20 20 20 20 20 28 65 78 69 74 20 (exit
11480 31 29 29 29 0a 09 20 20 20 28 69 66 20 28 63 68 1))).. (if (ch
11490 65 63 6b 2d 61 63 63 65 73 73 20 75 73 65 72 20 eck-access user
114a0 6d 74 63 6f 6e 66 20 2a 61 63 74 69 6f 6e 2a 20 mtconf *action*
114b0 61 72 65 61 29 3b 3b 20 63 68 65 63 6b 20 72 69 area);; check ri
114c0 67 68 74 73 0a 09 09 20 28 70 72 69 6e 74 20 22 ghts... (print "
114d0 41 63 63 65 73 73 20 67 72 61 6e 74 65 64 20 66 Access granted f
114e0 6f 72 20 22 20 2a 61 63 74 69 6f 6e 2a 20 22 20 or " *action* "
114f0 61 63 74 69 6f 6e 20 62 79 20 22 20 75 73 65 72 action by " user
11500 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 )... (begin...
11510 20 28 70 72 69 6e 74 20 22 41 63 63 65 73 73 20 (print "Access
11520 64 65 6e 69 65 64 20 66 6f 72 20 22 20 2a 61 63 denied for " *ac
11530 74 69 6f 6e 2a 20 22 20 61 63 74 69 6f 6e 20 62 tion* " action b
11540 79 20 22 20 75 73 65 72 29 0a 09 09 20 20 20 28 y " user)... (
11550 65 78 69 74 20 31 29 29 29 29 29 29 0a 09 20 0a exit 1)))))).. .
11560 09 20 3b 3b 20 28 66 6f 72 2d 65 61 63 68 0a 09 . ;; (for-each..
11570 20 3b 3b 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 ;; (lambda (ke
11580 79 29 0a 09 20 3b 3b 20 20 20 20 28 69 66 20 28 y).. ;; (if (
11590 6e 6f 74 20 28 6d 65 6d 62 65 72 20 6b 65 79 20 not (member key
115a0 2a 6c 65 67 61 6c 2d 70 61 72 61 6d 73 2a 29 29 *legal-params*))
115b0 0a 09 20 3b 3b 20 09 28 68 61 73 68 2d 74 61 62 .. ;; .(hash-tab
115c0 6c 65 2d 64 65 6c 65 74 65 21 20 61 64 6a 61 72 le-delete! adjar
115d0 67 73 20 6b 65 79 29 29 29 20 3b 3b 20 77 65 20 gs key))) ;; we
115e0 6e 65 65 64 20 74 6f 20 64 65 6c 65 74 65 20 61 need to delete a
115f0 6e 79 20 70 61 72 61 6d 73 20 69 6e 74 65 6e 64 ny params intend
11600 65 64 20 66 6f 72 20 6d 74 75 74 69 6c 0a 09 20 ed for mtutil..
11610 3b 3b 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ;; (hash-table-
11620 6b 65 79 73 20 61 64 6a 61 72 67 73 29 29 0a 09 keys adjargs))..
11630 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
11640 75 75 69 64 20 70 6b 74 29 0a 09 09 20 20 20 20 uuid pkt)...
11650 20 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 (command-line
11660 2d 3e 70 6b 74 20 2a 61 63 74 69 6f 6e 2a 20 61 ->pkt *action* a
11670 64 6a 61 72 67 73 20 23 66 20 61 72 65 61 2d 70 djargs #f area-p
11680 61 74 68 3a 20 61 72 65 61 2d 70 61 74 68 20 6e ath: area-path n
11690 65 77 2d 73 73 3a 20 6e 65 77 2d 73 73 29 29 29 ew-ss: new-ss)))
116a0 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 . (pri
116b0 6e 74 20 22 72 75 6e 20 6c 6f 67 20 40 20 22 20 nt "run log @ "
116c0 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 (conc (current-d
116d0 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 75 75 irectory) "/" uu
116e0 69 64 20 22 2d 22 20 2a 61 63 74 69 6f 6e 2a 20 id "-" *action*
116f0 22 2e 6c 6f 67 22 29 29 0a 09 20 20 20 28 77 72 ".log")).. (wr
11700 69 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 20 ite-pkt pktsdir
11710 75 75 69 64 20 70 6b 74 29 29 29 29 0a 20 20 20 uuid pkt)))).
11720 20 20 20 28 28 64 69 73 70 61 74 63 68 20 69 6d ((dispatch im
11730 70 6f 72 74 20 72 75 6e 67 65 6e 20 70 72 6f 63 port rungen proc
11740 65 73 73 20 67 6f 29 0a 20 20 20 20 20 20 20 28 ess go). (
11750 6c 65 74 2a 20 28 28 6d 74 63 6f 6e 66 64 61 74 let* ((mtconfdat
11760 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 (simple-setup (
11770 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
11780 74 61 72 74 2d 64 69 72 22 29 29 29 0a 09 20 20 tart-dir")))..
11790 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 28 (mtconf (
117a0 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 0a car mtconfdat)).
117b0 09 20 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 . (toppath
117c0 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 (configf:looku
117d0 70 20 6d 74 63 6f 6e 66 20 22 73 63 72 61 74 63 p mtconf "scratc
117e0 68 64 61 74 22 20 22 74 6f 70 70 61 74 68 22 29 hdat" "toppath")
117f0 29 0a 09 20 20 20 20 20 20 28 70 65 72 69 6f 64 ).. (period
11800 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (configf:loo
11810 6b 75 70 2d 6e 75 6d 62 65 72 20 6d 74 63 6f 6e kup-number mtcon
11820 66 20 22 6d 74 75 74 69 6c 22 20 22 61 75 74 6f f "mtutil" "auto
11830 72 75 6e 2d 70 65 72 69 6f 64 22 20 64 65 66 61 run-period" defa
11840 75 6c 74 3a 20 33 30 30 29 29 0a 09 20 20 20 20 ult: 300))..
11850 20 20 28 72 65 73 74 2d 74 69 6d 65 20 28 63 6f (rest-time (co
11860 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d nfigf:lookup-num
11870 62 65 72 20 6d 74 63 6f 6e 66 20 22 6d 74 75 74 ber mtconf "mtut
11880 69 6c 22 20 22 61 75 74 6f 72 75 6e 2d 72 65 73 il" "autorun-res
11890 74 22 20 20 20 64 65 66 61 75 6c 74 3a 20 33 30 t" default: 30
118a0 29 29 29 0a 09 20 28 70 72 69 6e 74 20 22 55 73 ))).. (print "Us
118b0 69 6e 67 20 70 65 72 69 6f 64 3d 22 70 65 72 69 ing period="peri
118c0 6f 64 22 20 61 6e 64 20 72 65 73 74 20 74 69 6d od" and rest tim
118d0 65 3d 22 72 65 73 74 2d 74 69 6d 65 29 0a 09 20 e="rest-time)..
118e0 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
118f0 79 6d 62 6f 6c 20 2a 61 63 74 69 6f 6e 2a 29 0a ymbol *action*).
11900 09 20 20 20 28 28 70 72 6f 63 65 73 73 29 20 20 . ((process)
11910 28 62 65 67 69 6e 0a 09 09 09 20 28 63 6f 6d 6d (begin.... (comm
11920 6f 6e 3a 6c 6f 61 64 2d 70 6b 74 73 2d 74 6f 2d on:load-pkts-to-
11930 64 62 20 6d 74 63 6f 6e 66 29 0a 09 09 09 20 28 db mtconf).... (
11940 67 65 6e 65 72 61 74 65 2d 72 75 6e 2d 70 6b 74 generate-run-pkt
11950 73 20 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 s mtconf toppath
11960 29 0a 09 09 09 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f ).... (common:lo
11970 61 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 ad-pkts-to-db mt
11980 63 6f 6e 66 29 0a 09 09 09 20 28 64 69 73 70 61 conf).... (dispa
11990 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 6d 74 63 tch-commands mtc
119a0 6f 6e 66 20 74 6f 70 70 61 74 68 29 29 29 0a 09 onf toppath)))..
119b0 20 20 20 28 28 69 6d 70 6f 72 74 29 20 20 20 28 ((import) (
119c0 63 6f 6d 6d 6f 6e 3a 6c 6f 61 64 2d 70 6b 74 73 common:load-pkts
119d0 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 29 29 20 -to-db mtconf))
119e0 3b 3b 20 69 6d 70 6f 72 74 20 70 6b 74 73 0a 09 ;; import pkts..
119f0 20 20 20 28 28 72 75 6e 67 65 6e 29 20 20 20 28 ((rungen) (
11a00 67 65 6e 65 72 61 74 65 2d 72 75 6e 2d 70 6b 74 generate-run-pkt
11a10 73 20 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 s mtconf toppath
11a20 29 29 0a 09 20 20 20 28 28 64 69 73 70 61 74 63 )).. ((dispatc
11a30 68 29 20 28 64 69 73 70 61 74 63 68 2d 63 6f 6d h) (dispatch-com
11a40 6d 61 6e 64 73 20 6d 74 63 6f 6e 66 20 74 6f 70 mands mtconf top
11a50 70 61 74 68 29 29 0a 09 20 20 20 3b 3b 20 5b 6d path)).. ;; [m
11a60 74 75 74 69 6c 5d 0a 09 20 20 20 3b 3b 20 23 20 tutil].. ;; #
11a70 61 70 70 72 6f 78 69 6d 61 74 65 20 69 6e 74 65 approximate inte
11a80 72 76 61 6c 20 62 65 74 77 65 65 6e 20 72 75 6e rval between run
11a90 20 70 72 6f 63 65 73 73 69 6e 67 20 69 6e 20 6d processing in m
11aa0 74 75 74 69 6c 20 28 73 65 63 6f 6e 64 73 29 0a tutil (seconds).
11ab0 09 20 20 20 3b 3b 20 61 75 74 6f 72 75 6e 2d 70 . ;; autorun-p
11ac0 65 72 69 6f 64 20 33 30 30 0a 09 20 20 20 3b 3b eriod 300.. ;;
11ad0 20 23 20 6d 69 6e 69 6d 61 6c 20 72 65 73 74 20 # minimal rest
11ae0 70 65 72 69 6f 64 20 62 65 74 77 65 65 6e 20 70 period between p
11af0 72 6f 63 65 73 73 69 6e 67 20 0a 09 20 20 20 3b rocessing .. ;
11b00 3b 20 61 75 74 6f 72 75 6e 2d 72 65 73 74 20 20 ; autorun-rest
11b10 20 33 30 0a 09 20 20 20 28 28 67 6f 29 0a 09 20 30.. ((go)..
11b20 20 20 20 3b 3b 20 64 65 74 65 72 6d 69 6e 65 20 ;; determine
11b30 69 66 20 49 27 6d 20 74 68 65 20 62 6f 73 73 0a if I'm the boss.
11b40 09 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 . (if (file-e
11b50 78 69 73 74 73 3f 20 22 6d 74 75 74 69 6c 2d 67 xists? "mtutil-g
11b60 6f 2e 70 69 64 22 29 0a 09 09 28 62 65 67 69 6e o.pid")...(begin
11b70 0a 09 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 ... (print "ERR
11b80 4f 52 3a 20 6d 74 75 74 69 6c 20 67 6f 20 69 73 OR: mtutil go is
11b90 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 already running
11ba0 20 75 6e 64 65 72 20 68 6f 73 74 20 61 6e 64 20 under host and
11bb0 70 69 64 20 22 20 28 77 69 74 68 2d 69 6e 70 75 pid " (with-inpu
11bc0 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 22 6d 74 75 t-from-file "mtu
11bd0 74 69 6c 2d 67 6f 2e 70 69 64 22 20 72 65 61 64 til-go.pid" read
11be0 2d 6c 69 6e 65 29 0a 09 09 09 20 22 2e 20 50 6c -line).... ". Pl
11bf0 65 61 73 65 20 6b 69 6c 6c 20 74 68 61 74 20 70 ease kill that p
11c00 72 6f 63 65 73 73 20 61 6e 64 20 72 65 6d 6f 76 rocess and remov
11c10 65 20 74 68 65 20 66 69 6c 65 20 5c 22 6d 75 74 e the file \"mut
11c20 69 6c 2d 67 6f 2e 70 69 64 5c 22 20 61 6e 64 20 il-go.pid\" and
11c30 74 72 79 20 61 67 61 69 6e 2e 22 29 0a 09 09 20 try again.")...
11c40 20 28 65 78 69 74 29 29 29 0a 09 20 20 20 20 28 (exit))).. (
11c50 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
11c60 69 6c 65 20 22 6d 74 75 74 69 6c 2d 67 6f 2e 70 ile "mtutil-go.p
11c70 69 64 22 20 28 6c 61 6d 62 64 61 20 28 29 28 70 id" (lambda ()(p
11c80 72 69 6e 74 20 28 67 65 74 2d 68 6f 73 74 2d 6e rint (get-host-n
11c90 61 6d 65 29 20 22 20 22 20 28 63 75 72 72 65 6e ame) " " (curren
11ca0 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 29 t-process-id))))
11cb0 0a 09 20 20 20 20 28 70 72 69 6e 74 20 22 53 74 .. (print "St
11cc0 61 72 74 69 6e 67 20 6c 6f 6e 67 20 72 75 6e 6e arting long runn
11cd0 69 6e 67 20 69 6d 70 6f 72 74 2c 20 72 75 6e 67 ing import, rung
11ce0 65 6e 2c 20 61 6e 64 20 70 72 6f 63 65 73 73 20 en, and process
11cf0 6c 6f 6f 70 22 29 0a 09 20 20 20 20 28 69 66 20 loop").. (if
11d00 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 64 (file-exists? "d
11d10 6f 2d 6e 6f 74 2d 72 75 6e 2d 6d 74 75 74 69 6c o-not-run-mtutil
11d20 2d 67 6f 22 29 0a 09 09 28 62 65 67 69 6e 0a 09 -go")...(begin..
11d30 09 20 20 28 70 72 69 6e 74 20 22 4e 4f 54 45 3a . (print "NOTE:
11d40 20 52 65 6d 6f 76 69 6e 67 20 66 6c 61 67 20 66 Removing flag f
11d50 69 6c 65 20 22 28 63 75 72 72 65 6e 74 2d 64 69 ile "(current-di
11d60 72 65 63 74 6f 72 79 29 22 2f 64 6f 2d 6e 6f 74 rectory)"/do-not
11d70 2d 72 75 6e 2d 6d 74 75 74 69 6c 2d 67 6f 22 29 -run-mtutil-go")
11d80 0a 09 09 20 20 28 64 65 6c 65 74 65 2d 66 69 6c ... (delete-fil
11d90 65 2a 20 22 64 6f 2d 6e 6f 74 2d 72 75 6e 2d 6d e* "do-not-run-m
11da0 74 75 74 69 6c 2d 67 6f 22 29 29 29 0a 09 20 20 tutil-go")))..
11db0 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 61 (let loop ((la
11dc0 73 74 2d 72 75 6e 20 28 2d 20 28 63 75 72 72 65 st-run (- (curre
11dd0 6e 74 2d 73 65 63 6f 6e 64 73 29 20 28 2b 20 70 nt-seconds) (+ p
11de0 65 72 69 6f 64 20 31 30 29 29 29 20 3b 3b 20 66 eriod 10))) ;; f
11df0 61 6b 65 20 6f 75 74 20 66 69 72 73 74 20 74 69 ake out first ti
11e00 6d 65 20 69 6e 20 0a 09 09 20 20 20 20 20 20 20 me in ...
11e10 28 74 68 69 73 2d 72 75 6e 20 28 63 75 72 72 65 (this-run (curre
11e20 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 20 nt-seconds)))..
11e30 20 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 (if (file-e
11e40 78 69 73 74 73 3f 20 22 64 6f 2d 6e 6f 74 2d 72 xists? "do-not-r
11e50 75 6e 2d 6d 74 75 74 69 6c 2d 67 6f 22 29 0a 09 un-mtutil-go")..
11e60 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 . (begin...
11e70 28 70 72 69 6e 74 20 22 46 69 6c 65 20 64 6f 2d (print "File do-
11e80 6e 6f 74 2d 72 75 6e 2d 6d 74 75 74 69 6c 2d 67 not-run-mtutil-g
11e90 6f 20 65 78 69 73 74 73 2c 20 65 78 69 74 69 6e o exists, exitin
11ea0 67 2e 22 29 0a 09 09 20 20 20 20 28 64 65 6c 65 g.")... (dele
11eb0 74 65 2d 66 69 6c 65 2a 20 22 6d 74 75 74 69 6c te-file* "mtutil
11ec0 2d 67 6f 2e 70 69 64 22 29 0a 09 09 20 20 20 20 -go.pid")...
11ed0 28 65 78 69 74 29 29 29 0a 09 20 20 20 20 20 20 (exit)))..
11ee0 28 6c 65 74 20 28 28 64 65 6c 74 61 20 28 2d 20 (let ((delta (-
11ef0 74 68 69 73 2d 72 75 6e 20 6c 61 73 74 2d 72 75 this-run last-ru
11f00 6e 29 29 29 0a 09 09 28 69 66 20 28 3e 3d 20 64 n)))...(if (>= d
11f10 65 6c 74 61 20 70 65 72 69 6f 64 29 0a 09 09 20 elta period)...
11f20 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e (let* ((mtcon
11f30 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 fdat (simple-set
11f40 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 up (args:get-arg
11f50 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 "-start-dir")))
11f60 0a 09 09 09 20 20 20 28 6d 74 63 6f 6e 66 20 20 .... (mtconf
11f70 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 (car mtconfdat
11f80 29 29 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 )))... (pri
11f90 6e 74 20 22 52 75 6e 6e 69 6e 67 20 69 6d 70 6f nt "Running impo
11fa0 72 74 20 61 74 20 22 20 28 63 75 72 72 65 6e 74 rt at " (current
11fb0 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 20 20 -seconds))...
11fc0 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 64 2d (common:load-
11fd0 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e pkts-to-db mtcon
11fe0 66 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 6e f)... (prin
11ff0 74 20 22 52 75 6e 6e 69 6e 67 20 67 65 6e 65 72 t "Running gener
12000 61 74 65 20 72 75 6e 20 70 6b 74 73 20 61 74 20 ate run pkts at
12010 22 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e " (current-secon
12020 64 73 29 29 0a 09 09 20 20 20 20 20 20 28 67 65 ds))... (ge
12030 6e 65 72 61 74 65 2d 72 75 6e 2d 70 6b 74 73 20 nerate-run-pkts
12040 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 0a mtconf toppath).
12050 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
12060 52 75 6e 6e 69 6e 67 20 72 75 6e 20 64 69 73 70 Running run disp
12070 61 74 63 68 20 61 74 20 22 20 28 63 75 72 72 65 atch at " (curre
12080 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 nt-seconds))...
12090 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 (common:loa
120a0 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 d-pkts-to-db mtc
120b0 6f 6e 66 29 0a 09 09 20 20 20 20 20 20 28 64 69 onf)... (di
120c0 73 70 61 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 spatch-commands
120d0 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 0a mtconf toppath).
120e0 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
120f0 44 6f 6e 65 20 72 75 6e 6e 69 6e 67 20 69 6d 70 Done running imp
12100 6f 72 74 2c 20 67 65 6e 65 72 61 74 65 2c 20 61 ort, generate, a
12110 6e 64 20 64 69 73 70 61 74 63 68 20 64 6f 6e 65 nd dispatch done
12120 20 69 6e 20 22 20 28 2d 20 28 63 75 72 72 65 6e in " (- (curren
12130 74 2d 73 65 63 6f 6e 64 73 29 20 74 68 69 73 2d t-seconds) this-
12140 72 75 6e 29 29 0a 09 09 20 20 20 20 20 20 28 70 run))... (p
12150 72 69 6e 74 20 22 4e 4f 54 45 3a 20 74 6f 75 63 rint "NOTE: touc
12160 68 20 22 20 28 63 75 72 72 65 6e 74 2d 64 69 72 h " (current-dir
12170 65 63 74 6f 72 79 29 20 22 2f 64 6f 2d 6e 6f 74 ectory) "/do-not
12180 2d 72 75 6e 2d 6d 74 75 74 69 6c 2d 67 6f 20 74 -run-mtutil-go t
12190 6f 20 6b 69 6c 6c 20 74 68 69 73 20 72 75 6e 6e o kill this runn
121a0 65 72 2e 22 29 0a 09 09 20 20 20 20 20 20 28 6c er.")... (l
121b0 6f 6f 70 20 74 68 69 73 2d 72 75 6e 20 28 63 75 oop this-run (cu
121c0 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 rrent-seconds)))
121d0 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e 6f ... (let ((no
121e0 77 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e w (current-secon
121f0 64 73 29 29 29 0a 09 09 20 20 20 20 20 20 28 70 ds)))... (p
12200 72 69 6e 74 20 22 53 6c 65 65 70 69 6e 67 20 22 rint "Sleeping "
12210 20 72 65 73 74 2d 74 69 6d 65 20 22 20 73 65 63 rest-time " sec
12220 6f 6e 64 73 2c 20 6e 65 78 74 20 72 75 6e 20 69 onds, next run i
12230 6e 20 61 70 72 6f 78 69 6d 61 74 65 6c 79 20 22 n aproximately "
12240 20 28 2d 20 70 65 72 69 6f 64 20 28 2d 20 6e 6f (- period (- no
12250 77 20 6c 61 73 74 2d 72 75 6e 29 29 20 22 20 73 w last-run)) " s
12260 65 63 6f 6e 64 73 22 29 0a 09 09 20 20 20 20 20 econds")...
12270 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
12280 72 65 73 74 2d 74 69 6d 65 29 0a 09 09 20 20 20 rest-time)...
12290 20 20 20 28 6c 6f 6f 70 20 6c 61 73 74 2d 72 75 (loop last-ru
122a0 6e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e n (current-secon
122b0 64 73 29 29 29 29 29 29 0a 09 20 20 20 20 28 64 ds)))))).. (d
122c0 65 6c 65 74 65 2d 66 69 6c 65 2a 20 22 6d 74 75 elete-file* "mtu
122d0 74 69 6c 2d 67 6f 2e 70 69 64 22 29 29 29 29 29 til-go.pid")))))
122e0 0a 20 20 20 20 20 20 3b 3b 20 6d 69 73 63 0a 20 . ;; misc.
122f0 20 20 20 20 20 28 28 73 68 6f 77 29 0a 20 20 20 ((show).
12300 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng
12310 74 68 20 72 65 6d 61 72 67 73 29 20 30 29 0a 09 th remargs) 0)..
12320 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e (let* ((mtcon
12330 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 fdat (simple-set
12340 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 up (args:get-arg
12350 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 "-start-dir")))
12360 0a 09 09 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 ... (mtconf
12370 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 (car mtconfdat))
12380 0a 09 09 20 20 28 73 65 63 74 2d 64 61 74 20 28 ... (sect-dat (
12390 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
123a0 69 6f 6e 20 6d 74 63 6f 6e 66 20 28 63 61 72 20 ion mtconf (car
123b0 72 65 6d 61 72 67 73 29 29 29 29 0a 09 20 20 20 remargs))))..
123c0 20 20 28 69 66 20 73 65 63 74 2d 64 61 74 0a 09 (if sect-dat..
123d0 09 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 . (for-each...
123e0 28 6c 61 6d 62 64 61 20 28 65 6e 74 72 79 29 0a (lambda (entry).
123f0 09 09 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 .. (if (> (le
12400 6e 67 74 68 20 65 6e 74 72 79 29 20 31 29 0a 09 ngth entry) 1)..
12410 09 09 28 70 72 69 6e 74 20 28 63 61 72 20 65 6e ..(print (car en
12420 74 72 79 29 20 22 20 20 20 22 20 28 63 61 64 72 try) " " (cadr
12430 20 65 6e 74 72 79 29 29 0a 09 09 09 28 70 72 69 entry))....(pri
12440 6e 74 20 28 63 61 72 20 65 6e 74 72 79 29 29 29 nt (car entry)))
12450 29 0a 09 09 20 20 73 65 63 74 2d 64 61 74 29 0a )... sect-dat).
12460 09 09 20 28 70 72 69 6e 74 20 22 4e 6f 20 73 65 .. (print "No se
12470 63 74 69 6f 6e 20 5c 22 22 20 28 63 61 72 20 72 ction \"" (car r
12480 65 6d 61 72 67 73 29 20 22 5c 22 20 66 6f 75 6e emargs) "\" foun
12490 64 22 29 29 29 0a 09 20 20 20 28 70 72 69 6e 74 d"))).. (print
124a0 20 22 45 52 52 4f 52 3a 20 6c 69 73 74 20 72 65 "ERROR: list re
124b0 71 75 69 72 65 73 20 73 65 63 74 69 6f 6e 20 70 quires section p
124c0 61 72 61 6d 65 74 65 72 3b 20 61 72 65 61 73 2c arameter; areas,
124d0 20 73 65 74 75 70 20 6f 72 20 63 6f 6e 74 6f 75 setup or contou
124e0 72 73 22 29 29 29 0a 20 20 20 20 20 20 28 28 67 rs"))). ((g
124f0 65 6e 64 6f 74 29 0a 20 20 20 20 20 20 20 28 6c endot). (l
12500 65 74 2a 20 28 28 6d 74 63 6f 6e 66 64 61 74 20 et* ((mtconfdat
12510 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 (simple-setup (a
12520 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
12530 61 72 74 2d 64 69 72 22 29 29 29 0a 09 20 20 20 art-dir")))..
12540 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 (mtconf (c
12550 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 29 0a ar mtconfdat))).
12560 09 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 64 2d 70 . (common:load-p
12570 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 kts-to-db mtconf
12580 20 75 73 65 2d 6c 74 3a 20 23 74 29 20 3b 3b 20 use-lt: #t) ;;
12590 6e 65 65 64 20 74 6f 20 4e 4f 54 20 64 6f 20 74 need to NOT do t
125a0 68 69 73 20 62 79 20 64 65 66 61 75 6c 74 20 2e his by default .
125b0 2e 2e 0a 09 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 .... (common:wit
125c0 68 2d 71 75 65 75 65 2d 64 62 0a 09 20 20 6d 74 h-queue-db.. mt
125d0 63 6f 6e 66 0a 09 20 20 28 6c 61 6d 62 64 61 20 conf.. (lambda
125e0 28 70 6b 74 73 64 69 72 73 20 70 6b 74 73 64 69 (pktsdirs pktsdi
125f0 72 20 63 6f 6e 6e 29 0a 09 20 20 20 20 3b 3b 20 r conn).. ;;
12600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12610 20 20 20 20 20 20 70 6b 74 73 70 65 63 20 64 69 pktspec di
12620 73 70 6c 61 79 2d 66 69 65 6c 64 73 20 0a 09 20 splay-fields ..
12630 20 20 20 28 6d 61 6b 65 2d 72 65 70 6f 72 74 20 (make-report
12640 22 6f 75 74 2e 64 6f 74 22 20 63 6f 6e 6e 0a 09 "out.dot" conn..
12650 09 09 20 27 28 28 63 6d 64 20 20 20 20 20 20 2e .. '((cmd .
12660 20 28 28 70 61 72 65 6e 74 20 2e 20 50 29 0a 09 ((parent . P)..
12670 09 09 09 09 28 75 73 65 72 20 20 20 2e 20 4d 29 ....(user . M)
12680 0a 09 09 09 09 09 28 74 61 72 67 65 74 20 2e 20 ......(target .
12690 74 29 29 29 0a 09 09 09 20 20 20 28 72 75 6e 73 t))).... (runs
126a0 74 61 72 74 20 2e 20 28 28 70 61 72 65 6e 74 20 tart . ((parent
126b0 2e 20 50 29 0a 09 09 09 09 09 28 74 61 72 67 65 . P)......(targe
126c0 74 20 2e 20 74 29 29 29 0a 09 09 09 20 20 20 28 t . t))).... (
126d0 72 75 6e 74 79 70 65 20 2e 20 28 28 70 61 72 65 runtype . ((pare
126e0 6e 74 20 2e 20 50 29 29 29 29 20 3b 3b 20 70 6b nt . P)))) ;; pk
126f0 74 73 70 65 63 0a 09 09 09 20 27 28 50 20 55 20 tspec.... '(P U
12700 74 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t)
12710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12730 20 20 20 20 20 20 20 3b 3b 20 0a 09 09 09 20 29 ;; .... )
12740 29 29 29 29 20 20 3b 3b 20 6e 6f 20 70 74 79 70 )))) ;; no ptyp
12750 65 73 20 6c 69 73 74 65 64 20 28 70 74 79 70 65 es listed (ptype
12760 73 20 61 72 65 20 73 74 72 69 6e 67 73 20 6f 66 s are strings of
12770 20 70 6b 74 20 74 79 70 65 73 20 74 6f 20 72 65 pkt types to re
12780 61 64 20 66 72 6f 6d 20 64 62 0a 20 20 20 20 20 ad from db.
12790 20 28 28 64 62 29 0a 20 20 20 20 20 20 20 28 69 ((db). (i
127a0 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 f (null? remargs
127b0 29 0a 09 20 20 20 28 70 72 69 6e 74 20 22 45 52 ).. (print "ER
127c0 52 4f 52 3a 20 6d 69 73 73 69 6e 67 20 73 75 62 ROR: missing sub
127d0 20 63 6f 6d 6d 61 6e 64 20 66 6f 72 20 64 62 20 command for db
127e0 63 6f 6d 6d 61 6e 64 22 29 0a 09 20 20 20 28 6c command").. (l
127f0 65 74 20 28 28 73 75 62 63 6d 64 20 28 63 61 72 et ((subcmd (car
12800 20 72 65 6d 61 72 67 73 29 29 29 0a 09 20 20 20 remargs)))..
12810 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
12820 3e 73 79 6d 62 6f 6c 20 73 75 62 63 6d 64 29 0a >symbol subcmd).
12830 09 20 20 20 20 20 20 20 28 28 70 67 73 63 68 65 . ((pgsche
12840 6d 61 29 0a 09 09 28 6c 65 74 2a 20 28 28 69 6e ma)...(let* ((in
12850 73 74 61 6c 6c 2d 68 6f 6d 65 20 28 63 6f 6d 6d stall-home (comm
12860 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 on:get-install-a
12870 72 65 61 29 29 0a 09 09 20 20 20 20 20 20 20 28 rea))... (
12880 73 63 68 65 6d 61 2d 66 69 6c 65 20 20 28 63 6f schema-file (co
12890 6e 63 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 nc install-home
128a0 22 2f 73 68 61 72 65 2f 64 62 2f 6d 74 2d 70 67 "/share/db/mt-pg
128b0 2e 73 71 6c 22 29 29 29 0a 09 09 20 20 28 69 66 .sql")))... (if
128c0 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
128d0 69 73 74 73 3f 20 73 63 68 65 6d 61 2d 66 69 6c ists? schema-fil
128e0 65 29 0a 09 09 20 20 20 20 20 20 28 73 79 73 74 e)... (syst
128f0 65 6d 20 28 63 6f 6e 63 20 22 2f 62 69 6e 2f 63 em (conc "/bin/c
12900 61 74 20 22 20 73 63 68 65 6d 61 2d 66 69 6c 65 at " schema-file
12910 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 28 ))))).. ((
12920 73 71 6c 69 74 65 33 73 63 68 65 6d 61 29 0a 09 sqlite3schema)..
12930 09 28 6c 65 74 2a 20 28 28 69 6e 73 74 61 6c 6c .(let* ((install
12940 2d 68 6f 6d 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 -home (common:ge
12950 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 61 29 29 t-install-area))
12960 0a 09 09 20 20 20 20 20 20 20 28 73 63 68 65 6d ... (schem
12970 61 2d 66 69 6c 65 20 20 28 63 6f 6e 63 20 69 6e a-file (conc in
12980 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f 73 68 61 stall-home "/sha
12990 72 65 2f 64 62 2f 6d 74 2d 73 71 6c 69 74 65 33 re/db/mt-sqlite3
129a0 2e 73 71 6c 22 29 29 29 0a 09 09 20 20 28 69 66 .sql")))... (if
129b0 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
129c0 69 73 74 73 3f 20 73 63 68 65 6d 61 2d 66 69 6c ists? schema-fil
129d0 65 29 0a 09 09 20 20 20 20 20 20 28 73 79 73 74 e)... (syst
129e0 65 6d 20 28 63 6f 6e 63 20 22 2f 62 69 6e 2f 63 em (conc "/bin/c
129f0 61 74 20 22 20 73 63 68 65 6d 61 2d 66 69 6c 65 at " schema-file
12a00 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 28 ))))).. ((
12a10 6a 75 6e 6b 29 0a 09 09 28 72 6d 74 3a 67 65 74 junk)...(rmt:get
12a20 2d 6b 65 79 73 29 29 29 29 29 29 0a 20 20 20 20 -keys)))))).
12a30 28 28 74 73 65 6e 64 29 0a 20 20 20 20 20 20 20 ((tsend).
12a40 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 (if (null? remar
12a50 67 73 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e gs).. (prin
12a60 74 20 22 45 52 52 4f 52 3a 20 6d 69 73 73 69 6e t "ERROR: missin
12a70 67 20 64 61 74 61 20 74 6f 20 73 65 6e 64 20 74 g data to send t
12a80 6f 20 74 72 69 67 67 65 72 20 6c 69 73 74 65 6e o trigger listen
12a90 65 72 73 22 29 0a 09 20 20 20 20 20 20 28 6c 65 ers").. (le
12aa0 74 2a 20 28 28 6d 73 67 20 20 20 20 20 20 20 28 t* ((msg (
12ab0 63 61 72 20 72 65 6d 61 72 67 73 29 29 0a 20 20 car remargs)).
12ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12ad0 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 69 6d 70 (mtconfdat (simp
12ae0 6c 65 2d 73 65 74 75 70 20 28 61 72 67 73 3a 67 le-setup (args:g
12af0 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 et-arg "-start-d
12b00 69 72 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 ir"))).
12b10 20 20 20 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 (mtconf
12b20 20 20 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 (car mtconfd
12b30 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 at)).
12b40 20 20 20 20 20 20 20 28 74 69 6d 65 2d 6f 75 74 (time-out
12b50 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
12b60 61 72 67 20 22 2d 74 69 6d 65 2d 6f 75 74 22 29 arg "-time-out")
12b70 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12b90 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
12ba0 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
12bb0 22 2d 74 69 6d 65 2d 6f 75 74 22 29 29 20 0a 20 "-time-out")) .
12bc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 35 29 5)
12be0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12bf0 20 20 20 20 28 6c 69 73 74 65 6e 65 72 73 20 28 (listeners (
12c00 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
12c10 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 6c 69 73 74 ion mtconf "list
12c20 65 6e 65 72 73 22 29 29 0a 20 20 20 20 20 20 20 eners")).
12c30 20 20 20 20 20 20 20 20 20 20 20 28 75 73 65 72 (user
12c40 2d 69 6e 66 6f 20 20 28 75 73 65 72 2d 69 6e 66 -info (user-inf
12c50 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 72 65 6e ormation (curren
12c60 74 2d 75 73 65 72 2d 69 64 29 29 29 0a 20 20 20 t-user-id))).
12c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12c80 70 72 65 76 2d 73 65 65 6e 20 28 6d 61 6b 65 2d prev-seen (make-
12c90 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 3b 3b hash-table))) ;;
12ca0 20 63 61 74 63 68 20 64 75 70 6c 69 63 61 74 65 catch duplicate
12cb0 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 s. (
12cc0 69 66 20 75 73 65 72 2d 69 6e 66 6f 0a 20 20 20 if user-info.
12cd0 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
12ce0 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
12cf0 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
12d00 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
12d10 20 28 6c 69 73 74 65 6e 65 72 29 0a 20 20 20 20 (listener).
12d20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
12d30 20 28 28 68 6f 73 74 2d 70 6f 72 74 20 28 63 61 ((host-port (ca
12d40 72 20 6c 69 73 74 65 6e 65 72 29 29 0a 20 20 20 r listener)).
12d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d60 20 20 20 28 61 74 74 72 69 62 20 28 76 61 6c 2d (attrib (val-
12d70 3e 61 6c 69 73 74 20 28 63 61 64 72 20 6c 69 73 >alist (cadr lis
12d80 74 65 6e 65 72 29 29 29 29 0a 20 20 20 20 20 20 tener)))).
12d90 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
12da0 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 6d 73 67 (and (equal? msg
12db0 20 22 74 69 6d 65 2d 74 6f 2d 64 69 65 22 29 20 "time-to-die")
12dc0 28 6e 6f 74 20 28 63 61 6e 2d 75 73 65 72 2d 6b (not (can-user-k
12dd0 69 6c 6c 2d 6c 69 73 74 6e 65 72 20 75 73 65 72 ill-listner user
12de0 2d 69 6e 66 6f 20 61 74 74 72 69 62 29 29 29 0a -info attrib))).
12df0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e00 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
12e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
12e30 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
12e40 67 2d 70 6f 72 74 2a 20 22 55 73 65 72 20 22 20 g-port* "User "
12e50 28 63 61 72 20 75 73 65 72 2d 69 6e 66 6f 29 20 (car user-info)
12e60 22 20 69 73 20 6e 6f 74 20 61 6c 6c 6f 77 65 64 " is not allowed
12e70 20 74 6f 20 73 65 6e 64 20 6d 65 73 73 61 67 65 to send message
12e80 20 27 22 20 6d 73 67 22 27 22 29 0a 20 20 20 20 '" msg"'").
12e90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12ea0 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 (exit 1))).
12eb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12ec0 70 72 69 6e 74 20 22 73 65 6e 64 69 6e 67 20 22 print "sending "
12ed0 20 6d 73 67 20 22 20 74 6f 20 22 20 68 6f 73 74 msg " to " host
12ee0 2d 70 6f 72 74 20 29 0a 20 20 20 20 20 20 20 20 -port ).
12ef0 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d (open-
12f00 73 65 6e 64 2d 63 6c 6f 73 65 2d 6e 6e 20 68 6f send-close-nn ho
12f10 73 74 2d 70 6f 72 74 20 6d 73 67 20 61 74 74 72 st-port msg attr
12f20 69 62 20 74 69 6d 65 6f 75 74 3a 20 74 69 6d 65 ib timeout: time
12f30 2d 6f 75 74 20 29 29 29 0a 20 20 20 20 20 20 20 -out ))).
12f40 20 20 20 20 20 20 20 6c 69 73 74 65 6e 65 72 73 listeners
12f50 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
12f60 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
12f70 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
12f80 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
12f90 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12fa0 43 6f 75 6c 64 20 6e 6f 74 20 49 64 65 6e 74 69 Could not Identi
12fb0 66 79 20 65 78 65 63 75 74 69 6e 67 20 75 73 65 fy executing use
12fc0 72 2e 20 57 69 6c 6c 20 6e 6f 74 20 73 65 6e 64 r. Will not send
12fd0 20 61 6e 79 20 6d 65 73 73 61 67 65 22 29 0a 20 any message").
12fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
12ff0 78 69 74 20 31 29 29 29 29 29 29 0a 20 20 20 20 xit 1)))))).
13000 20 28 28 74 71 75 65 72 79 29 0a 20 20 20 20 20 ((tquery).
13010 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
13020 61 72 67 73 29 0a 09 20 20 20 20 20 20 28 70 72 args).. (pr
13030 69 6e 74 20 22 45 52 52 4f 52 3a 20 6d 69 73 73 int "ERROR: miss
13040 69 6e 67 20 64 61 74 61 20 74 6f 20 73 65 6e 64 ing data to send
13050 20 74 6f 20 74 72 69 67 67 65 72 20 6c 69 73 74 to trigger list
13060 65 6e 65 72 73 22 29 0a 09 20 20 20 20 20 20 28 eners").. (
13070 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 20 20 let* ((msg
13080 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 0a (car remargs)).
13090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
130a0 20 20 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 69 (mtconfdat (si
130b0 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 73 mple-setup (args
130c0 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 :get-arg "-start
130d0 2d 64 69 72 22 29 29 29 0a 20 20 20 20 20 20 20 -dir"))).
130e0 20 20 20 20 20 20 20 20 20 20 20 28 6d 74 63 6f (mtco
130f0 6e 66 20 20 20 20 28 63 61 72 20 6d 74 63 6f 6e nf (car mtcon
13100 66 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 fdat)).
13110 20 20 20 20 20 20 20 20 20 28 74 69 6d 65 2d 6f (time-o
13120 75 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 ut (if (args:ge
13130 74 2d 61 72 67 20 22 2d 74 69 6d 65 2d 6f 75 74 t-arg "-time-out
13140 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
13150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13160 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
13170 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
13180 67 20 22 2d 74 69 6d 65 2d 6f 75 74 22 29 29 20 g "-time-out"))
13190 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
131a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
131b0 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 5)).
131c0 20 20 20 20 20 20 28 6c 69 73 74 65 6e 65 72 73 (listeners
131d0 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 (configf:get-se
131e0 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 6c 69 ction mtconf "li
131f0 73 74 65 6e 65 72 73 22 29 29 0a 20 20 20 20 20 steners")).
13200 20 20 20 20 20 20 20 20 20 20 20 20 20 28 75 73 (us
13210 65 72 2d 69 6e 66 6f 20 20 28 75 73 65 72 2d 69 er-info (user-i
13220 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 72 nformation (curr
13230 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 29 0a 20 ent-user-id))).
13240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13250 20 28 70 72 65 76 2d 73 65 65 6e 20 28 6d 61 6b (prev-seen (mak
13260 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 20 e-hash-table)))
13270 3b 3b 20 63 61 74 63 68 20 64 75 70 6c 69 63 61 ;; catch duplica
13280 74 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 tes.
13290 20 28 69 66 20 75 73 65 72 2d 69 6e 66 6f 0a 20 (if user-info.
132a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
132b0 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
132c0 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
132d0 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
132e0 64 61 20 28 6c 69 73 74 65 6e 65 72 29 0a 20 20 da (listener).
132f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
13300 65 74 20 28 28 68 6f 73 74 2d 70 6f 72 74 20 28 et ((host-port (
13310 63 61 72 20 6c 69 73 74 65 6e 65 72 29 29 0a 20 car listener)).
13320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13330 20 20 20 20 20 28 61 74 74 72 69 62 20 28 76 61 (attrib (va
13340 6c 2d 3e 61 6c 69 73 74 20 28 63 61 64 72 20 6c l->alist (cadr l
13350 69 73 74 65 6e 65 72 29 29 29 29 0a 20 20 20 20 istener)))).
13360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
13370 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 6d f (and (equal? m
13380 73 67 20 22 74 69 6d 65 2d 74 6f 2d 64 69 65 22 sg "time-to-die"
13390 29 20 28 6e 6f 74 20 28 63 61 6e 2d 75 73 65 72 ) (not (can-user
133a0 2d 6b 69 6c 6c 2d 6c 69 73 74 6e 65 72 20 75 73 -kill-listner us
133b0 65 72 2d 69 6e 66 6f 20 61 74 74 72 69 62 29 29 er-info attrib))
133c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
133d0 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
133e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
133f0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
13400 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
13410 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 65 72 20 log-port* "User
13420 22 20 28 63 61 72 20 75 73 65 72 2d 69 6e 66 6f " (car user-info
13430 29 20 22 20 69 73 20 6e 6f 74 20 61 6c 6c 6f 77 ) " is not allow
13440 65 64 20 74 6f 20 73 65 6e 64 20 6d 65 73 73 61 ed to send messa
13450 67 65 20 27 22 20 6d 73 67 22 27 22 29 0a 20 20 ge '" msg"'").
13460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13470 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 20 (exit 1))).
13480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13490 20 28 70 72 69 6e 74 20 22 73 65 6e 64 69 6e 67 (print "sending
134a0 20 22 20 6d 73 67 20 22 20 74 6f 20 22 20 68 6f " msg " to " ho
134b0 73 74 2d 70 6f 72 74 20 29 0a 20 20 20 20 20 20 st-port ).
134c0 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 (ope
134d0 6e 2d 73 65 6e 64 2d 72 65 63 65 69 76 65 2d 6e n-send-receive-n
134e0 6e 20 68 6f 73 74 2d 70 6f 72 74 20 6d 73 67 20 n host-port msg
134f0 61 74 74 72 69 62 20 74 69 6d 65 6f 75 74 3a 20 attrib timeout:
13500 74 69 6d 65 2d 6f 75 74 20 29 29 29 0a 20 20 20 time-out ))).
13510 20 20 20 20 20 20 20 20 20 20 20 6c 69 73 74 65 liste
13520 6e 65 72 73 29 29 0a 20 20 20 20 20 20 20 20 20 ners)).
13530 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
13540 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
13550 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
13560 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
13570 74 2a 20 22 43 6f 75 6c 64 20 6e 6f 74 20 49 64 t* "Could not Id
13580 65 6e 74 69 66 79 20 65 78 65 63 75 74 69 6e 67 entify executing
13590 20 75 73 65 72 2e 20 57 69 6c 6c 20 6e 6f 74 20 user. Will not
135a0 73 65 6e 64 20 61 6e 79 20 6d 65 73 73 61 67 65 send any message
135b0 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
135c0 20 20 28 65 78 69 74 20 31 29 29 29 29 29 29 0a (exit 1)))))).
135d0 0a 20 20 20 20 28 28 74 71 75 65 72 79 6c 69 73 . ((tquerylis
135e0 74 65 6e 29 0a 20 20 20 20 20 20 20 28 69 66 20 ten). (if
135f0 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 73 29 0a (null? remargs).
13600 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e (prin
13610 74 20 22 45 52 52 4f 52 3a 20 75 73 65 61 67 65 t "ERROR: useage
13620 20 66 6f 72 20 74 6c 69 73 74 65 6e 20 69 73 20 for tlisten is
13630 5c 22 6d 74 75 74 69 6c 20 74 6c 69 73 74 65 6e \"mtutil tlisten
13640 20 70 6f 72 74 6e 75 6d 5c 22 22 29 0a 20 20 20 portnum\"").
13650 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 (let ((p
13660 6f 72 74 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e ortnum (string->
13670 6e 75 6d 62 65 72 20 28 63 61 72 20 72 65 6d 61 number (car rema
13680 72 67 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 rgs)))).
13690 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
136a0 20 20 20 20 28 69 66 20 28 6e 6f 74 20 70 6f 72 (if (not por
136b0 74 6e 75 6d 29 0a 20 20 20 20 20 20 20 20 20 20 tnum).
136c0 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 (print "E
136d0 52 52 4f 52 3a 20 74 68 65 20 70 6f 72 74 6e 75 RROR: the portnu
136e0 6d 62 65 72 20 70 61 72 61 6d 65 74 65 72 20 6d mber parameter m
136f0 75 73 74 20 62 65 20 61 20 6e 75 6d 62 65 72 2c ust be a number,
13700 20 79 6f 75 20 67 61 76 65 3a 20 22 20 28 63 61 you gave: " (ca
13710 72 20 72 65 6d 61 72 67 73 29 29 0a 20 20 20 20 r remargs)).
13720 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
13730 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
13740 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
13750 28 69 73 2d 70 6f 72 74 2d 69 6e 2d 75 73 65 20 (is-port-in-use
13760 70 6f 72 74 6e 75 6d 29 29 20 20 0a 20 20 20 20 portnum)) .
13770 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13780 20 20 20 28 6c 65 74 2a 20 28 28 72 65 70 20 20 (let* ((rep
13790 20 20 20 20 20 28 73 74 61 72 74 2d 6e 6e 2d 73 (start-nn-s
137a0 65 72 76 65 72 20 70 6f 72 74 6e 75 6d 29 29 0a erver portnum)).
137b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
137c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
137d0 74 63 6f 6e 66 64 61 74 20 28 73 69 6d 70 6c 65 tconfdat (simple
137e0 2d 73 65 74 75 70 20 28 61 72 67 73 3a 67 65 74 -setup (args:get
137f0 2d 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 -arg "-start-dir
13800 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 "))).
13810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13820 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 (mtconf (c
13830 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 29 0a 20 ar mtconfdat)).
13840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13850 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
13860 6e 74 61 63 74 20 20 20 28 63 6f 6e 66 69 67 66 ntact (configf
13870 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 :lookup mtconf "
13880 6c 69 73 74 65 6e 65 72 22 20 22 6f 77 6e 65 72 listener" "owner
13890 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
138a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
138b0 20 20 28 73 63 72 69 70 74 20 20 20 20 28 63 6f (script (co
138c0 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 nfigf:lookup mtc
138d0 6f 6e 66 20 22 6c 69 73 74 65 6e 65 72 22 20 22 onf "listener" "
138e0 73 63 72 69 70 74 22 29 29 29 0a 20 20 20 20 20 script"))).
138f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13900 20 20 20 20 28 70 72 69 6e 74 20 22 4c 69 73 74 (print "List
13910 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 22 20 ening on port "
13920 70 6f 72 74 6e 75 6d 20 22 20 66 6f 72 20 6d 65 portnum " for me
13930 73 73 61 67 65 73 2e 22 29 0a 20 20 20 20 20 20 ssages.").
13940 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13950 20 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 (set-signal-h
13960 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 69 andler! signal/i
13970 6e 74 20 20 28 6c 61 6d 62 64 61 20 28 73 69 67 nt (lambda (sig
13980 6e 75 6d 29 20 0a 09 09 09 09 09 09 09 09 09 09 num) ...........
13990 09 09 09 09 09 28 73 65 74 21 20 2a 74 69 6d 65 .....(set! *time
139a0 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 -to-exit* #t).
139b0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 28 64 ..............(d
139c0 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
139d0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
139e0 70 6f 72 74 2a 20 22 52 65 63 65 69 76 65 64 20 port* "Received
139f0 73 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 signal " signum
13a00 22 20 73 65 6e 64 69 6e 67 20 65 6d 61 69 6c 20 " sending email
13a10 62 65 66 6f 72 20 65 78 69 74 69 6e 67 20 21 21 befor exiting !!
13a20 22 29 0a 20 20 09 09 09 09 09 09 09 09 09 09 09 "). ...........
13a30 09 09 09 28 6c 65 74 20 28 28 65 6d 61 69 6c 2d ...(let ((email-
13a40 62 6f 64 79 20 28 6d 74 75 74 3a 73 74 6d 6c 2d body (mtut:stml-
13a50 3e 73 74 72 69 6e 67 20 28 73 3a 62 6f 64 79 0a >string (s:body.
13a60 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
13a70 09 09 09 09 09 09 28 73 3a 70 20 28 63 6f 6e 63 ......(s:p (conc
13a80 20 22 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 "Received signa
13a90 6c 20 22 20 73 69 67 6e 75 6d 20 22 2e 20 4c 69 l " signum ". Li
13aa0 73 74 65 72 20 68 61 73 20 62 65 65 6e 20 74 65 ster has been te
13ab0 72 6d 69 6e 61 74 65 64 20 6f 6e 20 68 6f 73 74 rminated on host
13ac0 20 22 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d " (get-environm
13ad0 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
13ae0 53 54 22 29 20 22 2e 20 22 29 29 29 29 29 29 0a ST") ". ")))))).
13af0 20 20 20 20 20 20 20 20 20 20 20 20 20 09 09 09 ...
13b00 09 09 20 20 20 20 20 20 20 20 28 73 65 6e 64 6d .. (sendm
13b10 61 69 6c 20 63 6f 6e 74 61 63 74 20 22 4c 69 73 ail contact "Lis
13b20 74 6e 65 72 20 68 61 73 20 62 65 65 6e 20 74 65 tner has been te
13b30 72 6d 69 6e 61 74 65 64 2e 22 20 65 6d 61 69 6c rminated." email
13b40 2d 62 6f 64 79 20 20 75 73 65 5f 68 74 6d 6c 3a -body use_html:
13b50 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 #t)).
13b60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b70 20 20 20 20 28 65 78 69 74 29 29 29 0a 09 09 09 (exit)))....
13b80 09 09 09 09 09 09 09 09 09 09 09 09 28 73 65 74 ............(set
13b90 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 -signal-handler!
13ba0 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 20 28 6c signal/term (l
13bb0 61 6d 62 64 61 20 28 73 69 67 6e 75 6d 29 20 0a ambda (signum) .
13bc0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 28 ...............(
13bd0 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 set! *time-to-ex
13be0 69 74 2a 20 23 74 29 0a 20 20 09 09 09 09 09 09 it* #t). ......
13bf0 09 09 09 09 09 09 09 09 28 64 65 62 75 67 3a 70 ........(debug:p
13c00 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
13c10 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
13c20 22 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c "Received signal
13c30 20 22 20 73 69 67 6e 75 6d 20 22 20 73 65 6e 64 " signum " send
13c40 69 6e 67 20 65 6d 61 69 6c 20 62 65 66 6f 72 20 ing email befor
13c50 65 78 69 74 69 6e 67 20 21 21 22 29 0a 20 20 09 exiting !!"). .
13c60 09 09 09 09 09 09 09 09 09 09 09 09 09 28 6c 65 .............(le
13c70 74 20 28 28 65 6d 61 69 6c 2d 62 6f 64 79 20 28 t ((email-body (
13c80 6d 74 75 74 3a 73 74 6d 6c 2d 3e 73 74 72 69 6e mtut:stml->strin
13c90 67 20 28 73 3a 62 6f 64 79 0a 09 09 09 09 09 09 g (s:body.......
13ca0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
13cb0 28 73 3a 70 20 28 63 6f 6e 63 20 22 52 65 63 65 (s:p (conc "Rece
13cc0 69 76 65 64 20 73 69 67 6e 61 6c 20 22 20 73 69 ived signal " si
13cd0 67 6e 75 6d 20 22 2e 20 4c 69 73 74 65 72 20 68 gnum ". Lister h
13ce0 61 73 20 62 65 65 6e 20 74 65 72 6d 69 6e 61 74 as been terminat
13cf0 65 64 20 6f 6e 20 68 6f 73 74 20 22 20 28 67 65 ed on host " (ge
13d00 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
13d10 72 69 61 62 6c 65 20 22 48 4f 53 54 22 29 20 22 riable "HOST") "
13d20 2e 20 22 29 29 29 29 29 29 0a 20 20 20 20 20 20 . ")))))).
13d30 20 20 20 20 20 20 20 09 09 09 09 09 20 20 20 20 .....
13d40 20 20 20 20 28 73 65 6e 64 6d 61 69 6c 20 63 6f (sendmail co
13d50 6e 74 61 63 74 20 22 4c 69 73 74 6e 65 72 20 68 ntact "Listner h
13d60 61 73 20 62 65 65 6e 20 74 65 72 6d 69 6e 61 74 as been terminat
13d70 65 64 2e 22 20 65 6d 61 69 6c 2d 62 6f 64 79 20 ed." email-body
13d80 20 75 73 65 5f 68 74 6d 6c 3a 20 23 74 29 29 0a use_html: #t)).
13d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13da0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
13db0 78 69 74 29 29 29 0a 0a 20 20 20 20 20 20 20 20 xit)))..
13dc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13dd0 20 3b 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 ;(set-signal-ha
13de0 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 74 65 ndler! signal/te
13df0 72 6d 20 73 70 65 63 69 61 6c 2d 73 69 67 6e 61 rm special-signa
13e00 6c 2d 68 61 6e 64 6c 65 72 29 0a 20 20 20 20 20 l-handler).
13e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
13e30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
13e40 65 74 20 6c 6f 6f 70 20 28 28 69 6e 73 74 72 20 et loop ((instr
13e50 28 6e 6e 2d 72 65 63 76 20 72 65 70 29 29 29 0a (nn-recv rep))).
13e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e70 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 ;;(
13e80 6e 6e 2d 73 65 6e 64 20 72 65 70 20 22 33 2e 39 nn-send rep "3.9
13e90 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
13ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13eb0 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d (with-input-from
13ec0 2d 70 69 70 65 20 28 63 6f 6e 63 20 22 2f 75 73 -pipe (conc "/us
13ed0 72 2f 62 69 6e 2f 75 70 74 69 6d 65 20 7c 20 63 r/bin/uptime | c
13ee0 75 74 20 2d 64 27 3a 27 20 2d 66 34 20 7c 20 61 ut -d':' -f4 | a
13ef0 77 6b 20 27 7b 70 72 69 6e 74 20 24 31 7d 27 20 wk '{print $1}'
13f00 7c 20 63 75 74 20 2d 64 27 2c 27 20 2d 66 31 22 | cut -d',' -f1"
13f10 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
13f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 .
13f30 28 6c 61 6d 62 64 61 28 29 0a 20 20 20 20 20 20 (lambda().
13f40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f50 20 20 20 20 20 20 20 09 09 28 6c 65 74 20 6c 6f ..(let lo
13f60 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c op ((inl (read-l
13f70 69 6e 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 ine))).
13f80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f90 20 09 09 09 09 28 69 66 20 28 6e 6f 74 20 28 65 ....(if (not (e
13fa0 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 29 of-object? inl))
13fb0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13fc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 .
13fd0 09 09 09 28 62 65 67 69 6e 0a 20 20 20 20 20 20 ...(begin.
13fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13ff0 20 20 20 20 20 20 20 20 20 20 09 09 09 3b 3b 28 ...;;(
14000 70 72 69 6e 74 20 22 66 64 6b 37 33 3a 20 22 20 print "fdk73: "
14010 69 6e 6c 20 22 3a 22 29 0a 20 20 20 20 20 20 20 inl ":").
14020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14030 20 20 20 20 20 20 20 20 20 09 09 09 3b 3b 28 73 ...;;(s
14040 65 74 21 20 63 75 72 72 65 6e 74 2d 6c 69 73 74 et! current-list
14050 2d 63 69 61 66 20 28 61 70 70 65 6e 64 21 20 63 -ciaf (append! c
14060 75 72 72 65 6e 74 2d 6c 69 73 74 2d 63 69 61 66 urrent-list-ciaf
14070 20 28 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 73 (list (string-s
14080 75 62 73 74 69 74 75 74 65 20 22 5c 5c 73 2b 24 ubstitute "\\s+$
14090 22 20 22 22 20 69 6e 6c 29 29 29 29 0a 20 20 20 " "" inl)))).
140a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
140b0 20 20 20 20 20 20 20 20 20 20 20 20 20 09 09 09 ...
140c0 28 6e 6e 2d 73 65 6e 64 20 72 65 70 20 69 6e 6c (nn-send rep inl
140d0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
140e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
140f0 20 20 09 09 09 28 6c 6f 6f 70 28 72 65 61 64 2d ...(loop(read-
14100 6c 69 6e 65 29 29 29 0a 20 20 20 20 20 20 20 20 line))).
14110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14120 20 20 09 09 09 09 29 29 0a 0a 20 20 20 20 20 20 ....))..
14130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14140 20 20 20 20 20 20 20 09 29 0a 20 20 20 20 20 20 .).
14150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14160 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 ).
14170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14180 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 28 ;;(print (
14190 69 73 79 73 20 22 2f 75 73 72 2f 62 69 6e 2f 75 isys "/usr/bin/u
141a0 70 74 69 6d 65 22 20 66 6f 72 65 61 63 68 2d 73 ptime" foreach-s
141b0 74 64 6f 75 74 2d 74 68 75 6e 6b 3a 20 66 6f 72 tdout-thunk: for
141c0 65 61 63 68 2d 73 74 64 6f 75 74 29 29 0a 20 20 each-stdout)).
141d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
141e0 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
141f0 28 28 63 74 69 6d 65 20 28 64 61 74 65 2d 3e 73 ((ctime (date->s
14200 74 72 69 6e 67 20 28 63 75 72 72 65 6e 74 2d 64 tring (current-d
14210 61 74 65 29 29 29 29 20 0a 20 20 20 20 20 20 20 ate)))) .
14220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14230 20 20 20 20 20 20 28 69 66 20 20 28 65 71 75 61 (if (equa
14240 6c 3f 20 69 6e 73 74 72 20 22 74 69 6d 65 2d 74 l? instr "time-t
14250 6f 2d 64 69 65 22 29 0a 20 20 20 20 20 20 20 20 o-die").
14260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14270 20 20 20 20 20 20 28 62 65 67 69 6e 20 0a 20 20 (begin .
14280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14290 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
142a0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
142b0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 74 ult-log-port* ct
142c0 69 6d 65 20 22 20 72 65 63 65 69 76 65 64 20 27 ime " received '
142d0 22 20 69 6e 73 74 72 20 22 27 2e 20 54 69 6d 65 " instr "'. Time
142e0 20 74 6f 20 73 75 63 69 64 65 2e 22 20 29 0a 20 to sucide." ).
142f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
14310 65 74 20 28 28 70 69 64 20 20 28 63 75 72 72 65 et ((pid (curre
14320 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 nt-process-id)))
14330 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
14350 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
14360 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14370 20 22 4b 69 6c 6c 69 6e 67 20 63 75 72 72 65 6e "Killing curren
14380 74 20 70 72 6f 63 65 73 73 20 28 70 69 64 3d 22 t process (pid="
14390 20 70 69 64 20 22 29 22 29 0a 20 20 20 20 20 20 pid ")").
143a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
143b0 20 20 20 20 20 20 20 20 20 28 73 79 73 74 65 6d (system
143c0 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 22 20 70 (conc "kill " p
143d0 69 64 29 29 29 29 20 20 0a 20 20 20 20 20 20 20 id)))) .
143e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
143f0 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
14400 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e .....(debug:prin
14410 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
14420 2d 70 6f 72 74 2a 20 63 74 69 6d 65 20 22 20 72 -port* ctime " r
14430 65 63 65 69 76 65 64 20 22 20 69 6e 73 74 72 20 eceived " instr
14440 29 0a 09 09 09 09 09 09 09 09 3b 28 6e 6e 2d 73 ).........;(nn-s
14450 65 6e 64 20 72 65 70 20 22 6f 6b 22 29 0a 20 20 end rep "ok").
14460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
14480 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 f (not (equal? i
14490 6e 73 74 72 20 22 70 69 6e 67 22 29 29 0a 20 20 nstr "ping")).
144a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
144b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
144c0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
144d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
144e0 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
144f0 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
14500 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 74 69 6d t-log-port* ctim
14510 65 20 22 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 e " running \""
14520 73 63 72 69 70 74 20 22 20 22 20 69 6e 73 74 72 script " " instr
14530 20 22 5c 22 22 29 0a 20 20 20 20 20 20 20 20 20 "\"").
14540 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14550 20 20 20 20 20 20 20 20 20 20 20 3b 28 73 79 73 ;(sys
14560 74 65 6d 20 28 63 6f 6e 63 20 73 63 72 69 70 74 tem (conc script
14570 20 22 20 27 22 20 69 6e 73 74 72 20 22 27 22 29 " '" instr "'")
14580 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
14590 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
145a0 20 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 (process
145b0 2d 72 75 6e 20 73 63 72 69 70 74 20 28 6c 69 73 -run script (lis
145c0 74 20 20 69 6e 73 74 72 20 29 29 20 20 0a 20 20 t instr )) .
145d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
145e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
145f0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
14600 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
14610 6f 72 74 2a 20 63 74 69 6d 65 20 22 20 64 6f 6e ort* ctime " don
14620 65 22 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 e" )).
14630 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14640 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
14650 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14670 20 20 20 09 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
14680 71 75 61 6c 3f 20 69 6e 73 74 72 20 22 6c 6f 61 qual? instr "loa
14690 64 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 d")).
146a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146b0 20 20 20 20 20 20 20 20 09 20 09 28 70 72 69 6e . .(prin
146c0 74 20 22 43 68 65 63 6b 69 6e 67 20 6c 6f 61 64 t "Checking load
146d0 22 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")..
146e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146f0 20 20 20 20 20 20 20 09 20 29 20 0a 20 20 20 20 . ) .
14700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
14720 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
14730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14740 20 20 20 20 29 0a 0a 20 20 20 20 20 20 20 20 20 )..
14750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14760 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 20 20 ))).
14770 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14780 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 6e 6e 2d (loop (nn-
14790 72 65 63 76 20 72 65 70 29 29 29 29 0a 09 09 20 recv rep))))...
147a0 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 (print "ER
147b0 52 4f 52 3a 20 50 6f 72 74 20 22 20 70 6f 72 74 ROR: Port " port
147c0 6e 75 6d 20 22 20 61 6c 72 65 61 64 79 20 69 6e num " already in
147d0 20 75 73 65 2e 20 54 72 79 20 61 6e 6f 74 68 65 use. Try anothe
147e0 72 20 70 6f 72 74 22 29 29 29 29 29 29 29 0a 0a r port")))))))..
147f0 20 20 20 20 28 28 74 6c 69 73 74 65 6e 29 0a 20 ((tlisten).
14800 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
14810 65 6d 61 72 67 73 29 0a 20 20 20 20 20 20 20 20 emargs).
14820 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
14830 75 73 65 61 67 65 20 66 6f 72 20 74 6c 69 73 74 useage for tlist
14840 65 6e 20 69 73 20 5c 22 6d 74 75 74 69 6c 20 74 en is \"mtutil t
14850 6c 69 73 74 65 6e 20 70 6f 72 74 6e 75 6d 5c 22 listen portnum\"
14860 22 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 "). (let
14870 20 28 28 70 6f 72 74 6e 75 6d 20 28 73 74 72 69 ((portnum (stri
14880 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 ng->number (car
14890 72 65 6d 61 72 67 73 29 29 29 29 0a 20 20 20 20 remargs)))).
148a0 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
148b0 20 20 20 28 69 66 20 28 6e 6f 74 20 70 6f 72 74 (if (not port
148c0 6e 75 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 num).
148d0 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
148e0 52 3a 20 74 68 65 20 70 6f 72 74 6e 75 6d 62 65 R: the portnumbe
148f0 72 20 70 61 72 61 6d 65 74 65 72 20 6d 75 73 74 r parameter must
14900 20 62 65 20 61 20 6e 75 6d 62 65 72 2c 20 79 6f be a number, yo
14910 75 20 67 61 76 65 3a 20 22 20 28 63 61 72 20 72 u gave: " (car r
14920 65 6d 61 72 67 73 29 29 0a 20 20 20 20 20 20 20 emargs)).
14930 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
14940 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14950 28 69 66 20 28 6e 6f 74 20 28 69 73 2d 70 6f 72 (if (not (is-por
14960 74 2d 69 6e 2d 75 73 65 20 70 6f 72 74 6e 75 6d t-in-use portnum
14970 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 )) .
14980 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
14990 28 28 72 65 70 20 20 20 20 20 20 20 28 73 74 61 ((rep (sta
149a0 72 74 2d 6e 6e 2d 73 65 72 76 65 72 20 70 6f 72 rt-nn-server por
149b0 74 6e 75 6d 29 29 0a 20 20 20 20 20 20 20 20 20 tnum)).
149c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
149d0 20 20 20 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 (mtconfdat (s
149e0 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 imple-setup (arg
149f0 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
14a00 74 2d 64 69 72 22 29 29 29 0a 20 20 20 20 20 20 t-dir"))).
14a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a20 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 (mtconf
14a30 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 (car mtconfdat)
14a40 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
14a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
14a60 6f 6e 74 61 63 74 20 20 20 28 63 6f 6e 66 69 67 ontact (config
14a70 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 f:lookup mtconf
14a80 22 6c 69 73 74 65 6e 65 72 22 20 22 6f 77 6e 65 "listener" "owne
14a90 72 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 r")).
14aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14ab0 20 28 73 63 72 69 70 74 20 20 20 20 28 63 6f 6e (script (con
14ac0 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
14ad0 6e 66 20 22 6c 69 73 74 65 6e 65 72 22 20 22 73 nf "listener" "s
14ae0 63 72 69 70 74 22 29 29 29 0a 20 20 20 20 20 20 cript"))).
14af0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b00 20 28 70 72 69 6e 74 20 22 4c 69 73 74 65 6e 69 (print "Listeni
14b10 6e 67 20 6f 6e 20 70 6f 72 74 20 22 20 70 6f 72 ng on port " por
14b20 74 6e 75 6d 20 22 20 66 6f 72 20 6d 65 73 73 61 tnum " for messa
14b30 67 65 73 2e 22 29 0a 20 20 20 20 20 20 20 20 20 ges.").
14b40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
14b50 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 et-signal-handle
14b60 72 21 20 73 69 67 6e 61 6c 2f 69 6e 74 0a 09 09 r! signal/int...
14b70 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda (
14b80 73 69 67 6e 75 6d 29 20 0a 09 09 09 09 09 20 20 signum) ......
14b90 20 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d (set! *time-
14ba0 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 09 to-exit* #t). .
14bb0 09 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 .... (debug
14bc0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
14bd0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
14be0 2a 20 22 52 65 63 65 69 76 65 64 20 73 69 67 6e * "Received sign
14bf0 61 6c 20 22 20 73 69 67 6e 75 6d 0a 09 09 09 09 al " signum.....
14c00 09 09 09 09 20 22 20 73 65 6e 64 69 6e 67 20 65 .... " sending e
14c10 6d 61 69 6c 20 62 65 66 6f 72 20 65 78 69 74 69 mail befor exiti
14c20 6e 67 20 21 21 22 29 0a 20 20 09 09 09 09 09 20 ng !!"). .....
14c30 20 20 20 20 20 28 6c 65 74 20 28 28 65 6d 61 69 (let ((emai
14c40 6c 2d 62 6f 64 79 20 28 6d 74 75 74 3a 73 74 6d l-body (mtut:stm
14c50 6c 2d 3e 73 74 72 69 6e 67 0a 09 09 09 09 09 09 l->string.......
14c60 09 09 20 28 73 3a 62 6f 64 79 0a 09 09 09 09 09 .. (s:body......
14c70 09 09 09 20 20 28 73 3a 70 20 28 63 6f 6e 63 20 ... (s:p (conc
14c80 22 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c "Received signal
14c90 20 22 20 73 69 67 6e 75 6d 0a 09 09 09 09 09 09 " signum.......
14ca0 09 09 09 20 20 20 20 20 22 2e 20 4c 69 73 74 65 ... ". Liste
14cb0 72 20 68 61 73 20 62 65 65 6e 20 74 65 72 6d 69 r has been termi
14cc0 6e 61 74 65 64 20 6f 6e 20 68 6f 73 74 20 22 0a nated on host ".
14cd0 09 09 09 09 09 09 09 09 09 20 20 20 20 20 28 67 ......... (g
14ce0 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
14cf0 61 72 69 61 62 6c 65 20 22 48 4f 53 54 22 29 20 ariable "HOST")
14d00 22 2e 20 22 29 29 29 29 29 29 0a 20 20 20 20 20 ". ")))))).
14d10 20 20 20 20 20 20 20 20 09 09 09 09 09 28 73 65 .....(se
14d20 6e 64 6d 61 69 6c 20 63 6f 6e 74 61 63 74 20 22 ndmail contact "
14d30 4c 69 73 74 6e 65 72 20 68 61 73 20 62 65 65 6e Listner has been
14d40 20 74 65 72 6d 69 6e 61 74 65 64 2e 22 20 65 6d terminated." em
14d50 61 69 6c 2d 62 6f 64 79 20 20 75 73 65 5f 68 74 ail-body use_ht
14d60 6d 6c 3a 20 23 74 29 29 0a 09 09 09 09 09 20 20 ml: #t))......
14d70 20 20 20 20 28 65 78 69 74 29 29 29 0a 09 09 20 (exit)))...
14d80 20 20 20 20 20 20 28 73 65 74 2d 73 69 67 6e 61 (set-signa
14d90 6c 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 l-handler! signa
14da0 6c 2f 74 65 72 6d 20 20 28 6c 61 6d 62 64 61 20 l/term (lambda
14db0 28 73 69 67 6e 75 6d 29 20 0a 09 09 09 09 09 09 (signum) .......
14dc0 09 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d . (set! *time-
14dd0 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 09 to-exit* #t). .
14de0 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a ...... (debug:
14df0 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
14e00 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14e10 20 22 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 "Received signa
14e20 6c 20 22 0a 09 09 09 09 09 09 09 09 09 20 20 20 l "..........
14e30 20 20 20 73 69 67 6e 75 6d 20 22 20 73 65 6e 64 signum " send
14e40 69 6e 67 20 65 6d 61 69 6c 20 62 65 66 6f 72 20 ing email befor
14e50 65 78 69 74 69 6e 67 20 21 21 22 29 0a 20 20 09 exiting !!"). .
14e60 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 ...... (let ((
14e70 65 6d 61 69 6c 2d 62 6f 64 79 20 28 6d 74 75 74 email-body (mtut
14e80 3a 73 74 6d 6c 2d 3e 73 74 72 69 6e 67 0a 09 09 :stml->string...
14e90 09 09 09 09 09 09 09 20 20 20 20 20 20 28 73 3a ....... (s:
14ea0 62 6f 64 79 0a 09 09 09 09 09 09 09 09 09 20 20 body..........
14eb0 20 20 20 20 20 28 73 3a 70 20 28 63 6f 6e 63 20 (s:p (conc
14ec0 22 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c "Received signal
14ed0 20 22 20 73 69 67 6e 75 6d 0a 09 09 09 09 09 09 " signum.......
14ee0 09 09 09 09 09 20 20 22 2e 20 4c 69 73 74 65 72 ..... ". Lister
14ef0 20 68 61 73 20 62 65 65 6e 20 74 65 72 6d 69 6e has been termin
14f00 61 74 65 64 20 6f 6e 20 68 6f 73 74 20 22 0a 09 ated on host "..
14f10 09 09 09 09 09 09 09 09 09 09 20 20 28 67 65 74 .......... (get
14f20 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
14f30 69 61 62 6c 65 20 22 48 4f 53 54 22 29 20 22 2e iable "HOST") ".
14f40 20 22 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 ")))))).
14f50 20 20 20 20 20 20 09 09 09 09 09 20 20 20 20 20 .....
14f60 20 20 20 20 20 20 20 20 28 73 65 6e 64 6d 61 69 (sendmai
14f70 6c 20 63 6f 6e 74 61 63 74 20 22 4c 69 73 74 6e l contact "Listn
14f80 65 72 20 68 61 73 20 62 65 65 6e 20 74 65 72 6d er has been term
14f90 69 6e 61 74 65 64 2e 22 20 65 6d 61 69 6c 2d 62 inated." email-b
14fa0 6f 64 79 20 20 75 73 65 5f 68 74 6d 6c 3a 20 23 ody use_html: #
14fb0 74 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 65 t))........ (e
14fc0 78 69 74 29 29 29 0a 0a 09 09 20 20 20 20 20 20 xit)))....
14fd0 20 3b 3b 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d ;; (set-signal-
14fe0 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f handler! signal/
14ff0 74 65 72 6d 20 73 70 65 63 69 61 6c 2d 73 69 67 term special-sig
15000 6e 61 6c 2d 68 61 6e 64 6c 65 72 29 0a 20 20 20 nal-handler).
15010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15020 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
15030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
15040 65 74 20 6c 6f 6f 70 20 28 28 69 6e 73 74 72 20 et loop ((instr
15050 28 6e 6e 2d 72 65 63 76 20 72 65 70 29 29 29 0a (nn-recv rep))).
15060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15070 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6e (nn
15080 2d 73 65 6e 64 20 72 65 70 20 22 6f 6b 22 29 0a -send rep "ok").
15090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
150a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
150b0 74 20 28 28 63 74 69 6d 65 20 28 64 61 74 65 2d t ((ctime (date-
150c0 3e 73 74 72 69 6e 67 20 28 63 75 72 72 65 6e 74 >string (current
150d0 2d 64 61 74 65 29 29 29 29 20 0a 20 20 20 20 20 -date)))) .
150e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
150f0 20 20 20 20 20 20 20 20 28 69 66 20 20 28 65 71 (if (eq
15100 75 61 6c 3f 20 69 6e 73 74 72 20 22 74 69 6d 65 ual? instr "time
15110 2d 74 6f 2d 64 69 65 22 29 0a 20 20 20 20 20 20 -to-die").
15120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15130 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 0a (begin .
15140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
15160 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
15170 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
15180 63 74 69 6d 65 20 22 20 72 65 63 65 69 76 65 64 ctime " received
15190 20 27 22 20 69 6e 73 74 72 20 22 27 2e 20 54 69 '" instr "'. Ti
151a0 6d 65 20 74 6f 20 73 75 63 69 64 65 2e 22 20 29 me to sucide." )
151b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
151c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
151d0 28 6c 65 74 20 28 28 70 69 64 20 20 28 63 75 72 (let ((pid (cur
151e0 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
151f0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
15200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15210 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
15220 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
15230 74 2a 20 22 4b 69 6c 6c 69 6e 67 20 63 75 72 72 t* "Killing curr
15240 65 6e 74 20 70 72 6f 63 65 73 73 20 28 70 69 64 ent process (pid
15250 3d 22 20 70 69 64 20 22 29 22 29 0a 20 20 20 20 =" pid ")").
15260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15270 20 20 20 20 20 20 20 20 20 20 20 28 73 79 73 74 (syst
15280 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 22 em (conc "kill "
15290 20 70 69 64 29 29 29 29 20 20 0a 20 20 20 20 20 pid)))) .
152a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
152b0 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 (begin..
152c0 09 09 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 .......(debug:pr
152d0 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
152e0 6f 67 2d 70 6f 72 74 2a 20 63 74 69 6d 65 20 22 og-port* ctime "
152f0 20 72 65 63 65 69 76 65 64 20 22 20 69 6e 73 74 received " inst
15300 72 20 29 0a 09 09 09 09 09 09 09 09 3b 28 6e 6e r ).........;(nn
15310 2d 73 65 6e 64 20 72 65 70 20 22 6f 6b 22 29 0a -send rep "ok").
15320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15340 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
15350 20 69 6e 73 74 72 20 22 70 69 6e 67 22 29 29 0a instr "ping")).
15360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15370 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15380 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
15390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
153a0 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
153b0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
153c0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 74 ult-log-port* ct
153d0 69 6d 65 20 22 20 72 75 6e 6e 69 6e 67 20 5c 22 ime " running \"
153e0 22 20 73 63 72 69 70 74 20 22 20 22 20 69 6e 73 " script " " ins
153f0 74 72 20 22 5c 22 22 29 0a 20 20 20 20 20 20 20 tr "\"").
15400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
15420 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 73 63 72 system (conc scr
15430 69 70 74 20 22 20 27 22 20 69 6e 73 74 72 20 22 ipt " '" instr "
15440 27 20 26 22 29 29 0a 20 20 20 20 20 20 20 20 20 ' &")).
15450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15460 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 28 70 ;(p
15470 72 6f 63 65 73 73 2d 72 75 6e 20 73 63 72 69 70 rocess-run scrip
15480 74 20 28 6c 69 73 74 20 20 69 6e 73 74 72 20 29 t (list instr )
15490 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ) .
154a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
154b0 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
154c0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
154d0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 74 69 6d 65 -log-port* ctime
154e0 20 22 20 64 6f 6e 65 22 20 29 29 0a 20 20 20 20 " done" )).
154f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
15510 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
15520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15530 20 20 20 20 20 20 20 20 20 09 20 28 69 66 20 28 . (if (
15540 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 6e 73 74 not (equal? inst
15550 72 20 22 6c 6f 61 64 22 29 29 0a 20 20 20 20 20 r "load")).
15560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 .
15580 09 28 70 72 69 6e 74 20 22 43 68 65 63 6b 69 6e .(print "Checkin
15590 67 20 6c 6f 61 64 22 29 0a 0a 20 20 20 20 20 20 g load")..
155a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
155b0 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 29 . )
155c0 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
155d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
155e0 20 20 20 20 20 29 0a 0a 20 20 20 20 20 20 20 20 )..
155f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15600 20 20 20 20 20 20 20 20 20 20 29 0a 0a 20 20 20 )..
15610 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15620 20 20 20 20 20 20 20 20 20 20 20 20 20 29 29 29 )))
15630 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15640 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
15650 70 20 28 6e 6e 2d 72 65 63 76 20 72 65 70 29 29 p (nn-recv rep))
15660 29 29 0a 09 09 20 20 20 20 20 20 20 28 70 72 69 ))... (pri
15670 6e 74 20 22 45 52 52 4f 52 3a 20 50 6f 72 74 20 nt "ERROR: Port
15680 22 20 70 6f 72 74 6e 75 6d 20 22 20 61 6c 72 65 " portnum " alre
15690 61 64 79 20 69 6e 20 75 73 65 2e 20 54 72 79 20 ady in use. Try
156a0 61 6e 6f 74 68 65 72 20 70 6f 72 74 22 29 29 29 another port")))
156b0 29 29 29 29 0a 20 20 20 20 20 20 28 28 67 61 74 )))). ((gat
156c0 68 65 72 29 20 3b 3b 20 67 61 74 68 65 72 20 61 her) ;; gather a
156d0 6c 6c 20 61 72 65 61 20 64 62 27 73 20 69 6e 74 ll area db's int
156e0 6f 20 2f 74 6d 70 2f 24 55 53 45 52 5f 6d 65 67 o /tmp/$USER_meg
156f0 61 74 65 73 74 2f 61 6c 6c 64 62 73 0a 20 20 20 atest/alldbs.
15700 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f (let* ((mtco
15710 6e 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 nfdat (simple-se
15720 74 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 tup (args:get-ar
15730 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
15740 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15750 28 6d 74 63 6f 6e 66 20 20 20 20 28 63 61 72 20 (mtconf (car
15760 6d 74 63 6f 6e 66 64 61 74 29 29 0a 20 20 20 20 mtconfdat)).
15770 20 20 20 20 20 20 20 20 20 20 28 61 72 65 61 73 (areas
15780 20 20 20 20 20 28 67 65 74 2d 61 72 65 61 2d 6e (get-area-n
15790 61 6d 65 73 20 6d 74 63 6f 6e 66 29 29 29 0a 20 ames mtconf))).
157a0 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 (print "
157b0 61 72 65 61 73 3a 20 22 20 61 72 65 61 73 29 29 areas: " areas))
157c0 29 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 ). . (
157d0 65 6c 73 65 0a 20 20 20 20 20 20 20 28 6c 65 74 else. (let
157e0 20 28 28 61 6c 6c 2d 61 63 74 69 6f 6e 73 20 28 ((all-actions (
157f0 73 6f 72 74 20 28 6d 61 70 20 63 6f 6e 63 20 28 sort (map conc (
15800 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
15810 73 20 28 61 70 70 65 6e 64 20 2a 6f 74 68 65 72 s (append *other
15820 2d 61 63 74 69 6f 6e 73 2a 20 28 6d 61 70 20 63 -actions* (map c
15830 61 72 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 73 2a ar *action-keys*
15840 29 29 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 29 )))) string<=?))
15850 29 0a 09 20 28 70 72 69 6e 74 20 22 75 6e 72 65 ).. (print "unre
15860 63 6f 67 6e 69 73 65 64 20 61 63 74 69 6f 6e 3a cognised action:
15870 20 5c 22 22 20 2a 61 63 74 69 6f 6e 2a 20 22 5c \"" *action* "\
15880 22 2c 20 74 72 79 20 6f 6e 65 20 6f 66 3b 20 5c ", try one of; \
15890 22 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 "" (string-inter
158a0 73 70 65 72 73 65 20 61 6c 6c 2d 61 63 74 69 6f sperse all-actio
158b0 6e 73 20 22 5c 22 2c 20 5c 22 22 29 20 22 5c 22 ns "\", \"") "\"
158c0 22 29 29 29 0a 20 20 20 20 20 20 0a 20 20 20 20 "))). .
158d0 20 20 29 29 20 3b 3b 20 74 68 65 20 65 6e 64 0a )) ;; the end.
158e0 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 0a 3b ..;
158f0 3b 20 49 66 20 48 54 54 50 5f 48 4f 53 54 20 69 ; If HTTP_HOST i
15900 73 20 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 s defined then w
15910 65 20 6d 75 73 74 20 62 65 20 69 6e 20 74 68 65 e must be in the
15920 20 63 67 69 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 cgi environment
15930 0a 3b 3b 20 73 6f 20 72 75 6e 20 73 74 6d 6c 20 .;; so run stml
15940 61 6e 64 20 65 78 69 74 0a 3b 3b 0a 28 69 66 20 and exit.;;.(if
15950 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
15960 2d 76 61 72 69 61 62 6c 65 20 22 48 54 54 50 5f -variable "HTTP_
15970 48 4f 53 54 22 29 0a 20 20 20 20 28 62 65 67 69 HOST"). (begi
15980 6e 0a 20 20 20 20 20 20 28 73 74 6d 6c 3a 6d 61 n. (stml:ma
15990 69 6e 20 23 66 29 0a 20 20 20 20 20 20 28 65 78 in #f). (ex
159a0 69 74 29 29 29 0a 0a 28 69 66 20 28 6f 72 20 28 it)))..(if (or (
159b0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
159c0 65 70 6c 22 29 0a 09 28 61 72 67 73 3a 67 65 74 epl")..(args:get
159d0 2d 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 0a 20 -arg "-load")).
159e0 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
159f0 28 69 6d 70 6f 72 74 20 65 78 74 72 61 73 29 20 (import extras)
15a00 3b 3b 20 6d 69 67 68 74 20 6e 6f 74 20 62 65 20 ;; might not be
15a10 6e 65 65 64 65 64 0a 20 20 20 20 20 20 3b 3b 20 needed. ;;
15a20 28 69 6d 70 6f 72 74 20 63 73 69 29 0a 20 20 20 (import csi).
15a30 20 20 20 28 69 6d 70 6f 72 74 20 72 65 61 64 6c (import readl
15a40 69 6e 65 29 0a 20 20 20 20 20 20 28 69 6d 70 6f ine). (impo
15a50 72 74 20 61 70 72 6f 70 6f 73 29 0a 20 20 20 20 rt apropos).
15a60 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 28 70 72 ;; (import (pr
15a70 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c efix sqlite3 sql
15a80 69 74 65 33 3a 29 29 20 3b 3b 20 64 6f 65 73 6e ite3:)) ;; doesn
15a90 27 74 20 77 6f 72 6b 20 2e 2e 2e 0a 20 20 20 20 't work ....
15aa0 20 20 0a 20 20 20 20 20 20 28 69 6e 73 74 61 6c . (instal
15ab0 6c 2d 68 69 73 74 6f 72 79 2d 66 69 6c 65 20 28 l-history-file (
15ac0 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
15ad0 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 29 variable "HOME")
15ae0 20 22 2e 6d 74 75 74 69 6c 5f 68 69 73 74 6f 72 ".mtutil_histor
15af0 79 22 29 20 3b 3b 20 20 5b 68 6f 6d 65 64 69 72 y") ;; [homedir
15b00 5d 20 5b 66 69 6c 65 6e 61 6d 65 5d 20 5b 6e 6c ] [filename] [nl
15b10 69 6e 65 73 5d 29 0a 20 20 20 20 20 20 28 63 75 ines]). (cu
15b20 72 72 65 6e 74 2d 69 6e 70 75 74 2d 70 6f 72 74 rrent-input-port
15b30 20 28 6d 61 6b 65 2d 72 65 61 64 6c 69 6e 65 2d (make-readline-
15b40 70 6f 72 74 20 22 6d 74 75 74 69 6c 3e 20 22 29 port "mtutil> ")
15b50 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 72 67 ). (if (arg
15b60 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 70 6c s:get-arg "-repl
15b70 22 29 0a 09 20 20 28 72 65 70 6c 29 0a 09 20 20 ").. (repl)..
15b80 28 6c 6f 61 64 20 28 61 72 67 73 3a 67 65 74 2d (load (args:get-
15b90 61 72 67 20 22 2d 6c 6f 61 64 22 29 29 29 29 29 arg "-load")))))
15ba0 0a 0a 23 7c 0a 28 64 65 66 69 6e 65 20 6d 74 63 ..#|.(define mtc
15bb0 6f 6e 66 20 28 63 61 72 20 28 73 69 6d 70 6c 65 onf (car (simple
15bc0 2d 73 65 74 75 70 20 23 66 29 29 29 0a 28 64 65 -setup #f))).(de
15bd0 66 69 6e 65 20 64 61 74 20 28 63 6f 6d 6d 6f 6e fine dat (common
15be0 3a 77 69 74 68 2d 71 75 65 75 65 2d 64 62 20 6d :with-queue-db m
15bf0 74 63 6f 6e 66 20 28 6c 61 6d 62 64 61 20 28 63 tconf (lambda (c
15c00 6f 6e 6e 29 28 67 65 74 2d 70 6b 74 73 20 63 6f onn)(get-pkts co
15c10 6e 6e 20 27 28 29 29 29 29 29 0a 28 70 70 20 28 nn '())))).(pp (
15c20 70 6b 74 73 23 66 6c 61 74 74 65 6e 2d 61 6c 6c pkts#flatten-all
15c30 20 64 61 74 20 27 28 28 63 6d 64 20 2e 20 28 28 dat '((cmd . ((
15c40 70 61 72 65 6e 74 20 2e 20 50 29 28 75 72 6c 20 parent . P)(url
15c50 2e 20 4d 29 29 29 28 72 75 6e 74 79 70 65 20 2e . M)))(runtype .
15c60 20 28 28 70 61 72 65 6e 74 20 2e 20 50 29 29 29 ((parent . P)))
15c70 29 20 27 69 64 20 27 67 72 6f 75 70 2d 69 64 20 ) 'id 'group-id
15c80 27 75 75 69 64 20 27 70 61 72 65 6e 74 20 27 70 'uuid 'parent 'p
15c90 6b 74 2d 74 79 70 65 20 27 70 6b 74 20 27 70 72 kt-type 'pkt 'pr
15ca0 6f 63 65 73 73 65 64 29 29 0a 7c 23 0a ocessed)).|#.