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 3b 3b 20 28 69 6e 63 6c 75 64 65 20 m").;; (include
0320: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
0330: 6e 2e 73 63 6d 22 29 0a 0a 3b 3b 20 66 61 6b 65 n.scm")..;; fake
0340: 20 6f 75 74 20 72 65 61 64 6c 69 6e 65 20 75 73 out readline us
0350: 61 67 65 20 6f 66 20 74 6f 70 6c 65 76 65 6c 2d age of toplevel-
0360: 63 6f 6d 6d 61 6e 64 0a 28 64 65 66 69 6e 65 20 command.(define
0370: 28 74 6f 70 6c 65 76 65 6c 2d 63 6f 6d 6d 61 6e (toplevel-comman
0380: 64 20 2e 20 61 29 20 23 66 29 0a 0a 28 75 73 65 d . a) #f)..(use
0390: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 73 72 srfi-1 posix sr
03a0: 66 69 2d 36 39 20 72 65 61 64 6c 69 6e 65 20 3b fi-69 readline ;
03b0: 3b 20 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 ; regex regex-c
03c0: 61 73 65 20 73 72 66 69 2d 36 39 20 61 70 72 6f ase srfi-69 apro
03d0: 70 6f 73 20 6a 73 6f 6e 20 68 74 74 70 2d 63 6c pos json http-cl
03e0: 69 65 6e 74 20 64 69 72 65 63 74 6f 72 79 2d 75 ient directory-u
03f0: 74 69 6c 73 20 72 70 63 20 74 79 70 65 64 2d 72 tils rpc typed-r
0400: 65 63 6f 72 64 73 3b 3b 20 28 73 72 66 69 20 31 ecords;; (srfi 1
0410: 38 29 20 65 78 74 72 61 73 29 0a 20 20 20 73 72 8) extras). sr
0420: 66 69 2d 31 39 20 20 73 72 66 69 2d 31 38 20 65 fi-19 srfi-18 e
0430: 78 74 72 61 73 20 66 6f 72 6d 61 74 20 70 6b 74 xtras format pkt
0440: 73 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 s regex regex-ca
0450: 73 65 0a 20 20 20 20 20 28 70 72 65 66 69 78 20 se. (prefix
0460: 64 62 69 20 64 62 69 3a 29 0a 20 20 20 20 20 28 dbi dbi:). (
0470: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0480: 71 6c 69 74 65 33 3a 29 0a 20 20 20 20 20 6e 61 qlite3:). na
0490: 6e 6f 6d 73 67 29 0a 0a 28 64 65 63 6c 61 72 65 nomsg)..(declare
04a0: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
04d0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
04e0: 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 margs)).(declar
04f0: 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 e (uses configf)
0500: 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ).;; (declare (u
0510: 73 65 73 20 72 6d 74 29 29 0a 0a 28 75 73 65 20 ses rmt))..(use
0520: 64 75 63 74 74 61 70 65 2d 6c 69 62 29 0a 0a 28 ducttape-lib)..(
0530: 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 include "megates
0540: 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 t-fossil-hash.sc
0550: 6d 22 29 0a 0a 28 72 65 71 75 69 72 65 2d 6c 69 m")..(require-li
0560: 62 72 61 72 79 20 73 74 6d 6c 29 0a 0a 3b 3b 20 brary stml)..;;
0570: 73 74 75 66 66 20 66 6f 72 20 74 68 65 20 6d 61 stuff for the ma
0580: 70 70 65 72 20 61 6e 64 20 63 68 65 63 6b 65 72 pper and checker
0590: 20 66 75 6e 63 74 69 6f 6e 73 0a 3b 3b 0a 28 64 functions.;;.(d
05a0: 65 66 69 6e 65 20 2a 74 61 72 67 65 74 2d 6d 61 efine *target-ma
05b0: 70 70 65 72 73 2a 20 20 28 6d 61 6b 65 2d 68 61 ppers* (make-ha
05c0: 73 68 2d 74 61 62 6c 65 29 29 20 0a 28 64 65 66 sh-table)) .(def
05d0: 69 6e 65 20 2a 72 75 6e 6e 61 6d 65 2d 6d 61 70 ine *runname-map
05e0: 70 65 72 73 2a 20 28 6d 61 6b 65 2d 68 61 73 68 pers* (make-hash
05f0: 2d 74 61 62 6c 65 29 29 20 0a 28 64 65 66 69 6e -table)) .(defin
0600: 65 20 2a 61 72 65 61 2d 63 68 65 63 6b 65 72 73 e *area-checkers
0610: 2a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 * (make-hash-t
0620: 61 62 6c 65 29 29 20 0a 0a 28 64 65 66 69 6e 65 able)) ..(define
0630: 20 28 6d 74 75 74 3a 73 74 6d 6c 2d 3e 73 74 72 (mtut:stml->str
0640: 69 6e 67 20 69 6e 2d 73 74 6d 6c 29 0a 20 20 28 ing in-stml). (
0650: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
0660: 74 72 69 6e 67 0a 20 20 20 20 28 6c 61 6d 62 64 tring. (lambd
0670: 61 20 28 29 0a 20 20 20 20 20 20 28 73 3a 6f 75 a (). (s:ou
0680: 74 70 75 74 2d 6e 65 77 0a 20 20 20 20 20 20 20 tput-new.
0690: 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 74 2d (current-output-
06a0: 70 6f 72 74 29 0a 20 20 20 20 20 20 20 69 6e 2d port). in-
06b0: 73 74 6d 6c 29 29 29 29 0a 0a 3b 3b 20 68 65 6c stml))))..;; hel
06c0: 70 65 72 73 20 66 6f 72 20 6d 61 70 70 65 72 73 pers for mappers
06d0: 2f 63 68 65 63 6b 65 72 73 0a 28 64 65 66 69 6e /checkers.(defin
06e0: 65 20 28 61 64 64 2d 74 61 72 67 65 74 2d 6d 61 e (add-target-ma
06f0: 70 70 65 72 20 6e 61 6d 65 20 70 72 6f 63 29 0a pper name proc).
0700: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
0710: 74 21 20 2a 74 61 72 67 65 74 2d 6d 61 70 70 65 t! *target-mappe
0720: 72 73 2a 20 6e 61 6d 65 20 70 72 6f 63 29 29 0a rs* name proc)).
0730: 28 64 65 66 69 6e 65 20 28 61 64 64 2d 72 75 6e (define (add-run
0740: 6e 61 6d 65 2d 6d 61 70 70 65 72 20 6e 61 6d 65 name-mapper name
0750: 20 70 72 6f 63 29 0a 20 20 28 68 61 73 68 2d 74 proc). (hash-t
0760: 61 62 6c 65 2d 73 65 74 21 20 2a 72 75 6e 6e 61 able-set! *runna
0770: 6d 65 2d 6d 61 70 70 65 72 73 2a 20 6e 61 6d 65 me-mappers* name
0780: 20 70 72 6f 63 29 29 0a 28 64 65 66 69 6e 65 20 proc)).(define
0790: 28 61 64 64 2d 61 72 65 61 2d 63 68 65 63 6b 65 (add-area-checke
07a0: 72 20 6e 61 6d 65 20 70 72 6f 63 29 0a 20 20 28 r name proc). (
07b0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
07c0: 2a 61 72 65 61 2d 63 68 65 63 6b 65 72 73 2a 20 *area-checkers*
07d0: 6e 61 6d 65 20 70 72 6f 63 29 29 0a 0a 3b 3b 20 name proc))..;;
07e0: 67 69 76 65 6e 20 61 20 72 75 6e 6b 65 79 2c 20 given a runkey,
07f0: 78 6c 61 74 72 2d 6b 65 79 20 61 6e 64 20 6f 74 xlatr-key and ot
0800: 68 65 72 20 69 6e 66 6f 20 72 65 74 75 72 6e 20 her info return
0810: 6f 6e 65 20 6f 66 20 74 68 65 20 66 6f 6c 6c 6f one of the follo
0820: 77 69 6e 67 3a 0a 3b 3b 20 20 20 6c 69 73 74 20 wing:.;; list
0830: 6f 66 20 74 61 72 67 65 74 73 2c 20 6e 75 6c 6c of targets, null
0840: 20 6c 69 73 74 20 74 6f 20 73 6b 69 70 20 70 72 list to skip pr
0850: 6f 63 65 73 73 69 6e 67 0a 3b 3b 20 20 20 0a 28 ocessing.;; .(
0860: 64 65 66 69 6e 65 20 28 6d 61 70 2d 74 61 72 67 define (map-targ
0870: 65 74 73 20 6d 74 63 6f 6e 66 20 61 76 61 6c 2d ets mtconf aval-
0880: 61 6c 69 73 74 20 72 75 6e 6b 65 79 20 61 72 65 alist runkey are
0890: 61 20 63 6f 6e 74 6f 75 72 20 23 21 6b 65 79 20 a contour #!key
08a0: 28 78 6c 61 74 72 2d 6b 65 79 2d 69 6e 20 23 66 (xlatr-key-in #f
08b0: 29 29 0a 20 20 28 70 70 20 61 76 61 6c 2d 61 6c )). (pp aval-al
08c0: 69 73 74 29 0a 20 20 28 70 72 69 6e 74 20 22 49 ist). (print "I
08d0: 6e 20 4d 61 70 2d 74 61 72 67 65 74 73 22 29 0a n Map-targets").
08e0: 20 20 28 6c 65 74 2a 20 28 28 78 6c 61 74 72 2d (let* ((xlatr-
08f0: 6b 65 79 20 28 6f 72 20 78 6c 61 74 72 2d 6b 65 key (or xlatr-ke
0900: 79 2d 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 y-in.
0910: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
0920: 6e 66 2d 67 65 74 2f 64 65 66 61 75 6c 74 20 6d nf-get/default m
0930: 74 63 6f 6e 66 20 61 76 61 6c 2d 61 6c 69 73 74 tconf aval-alist
0940: 20 27 74 61 72 67 74 72 61 6e 73 29 29 29 0a 20 'targtrans))).
0950: 20 20 20 20 20 20 20 20 28 70 72 6f 63 20 20 20 (proc
0960: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
0970: 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 61 72 67 ef/default *targ
0980: 65 74 2d 6d 61 70 70 65 72 73 2a 20 78 6c 61 74 et-mappers* xlat
0990: 72 2d 6b 65 79 20 23 66 29 29 29 0a 20 20 20 20 r-key #f))).
09a0: 28 69 66 20 70 72 6f 63 0a 20 20 20 20 20 20 20 (if proc.
09b0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
09c0: 20 20 28 70 72 69 6e 74 20 22 55 73 69 6e 67 20 (print "Using
09d0: 74 61 72 67 65 74 20 6d 61 70 70 65 72 3a 20 22 target mapper: "
09e0: 20 78 6c 61 74 72 2d 6b 65 79 29 0a 20 20 20 20 xlatr-key).
09f0: 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 (handle-ex
0a00: 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 20 ceptions.
0a10: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 20 20 exn.
0a20: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
0a30: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 (print "F
0a40: 41 49 4c 45 44 20 54 4f 20 52 55 4e 20 54 41 52 AILED TO RUN TAR
0a50: 47 45 54 20 4d 41 50 50 45 52 20 46 4f 52 20 22 GET MAPPER FOR "
0a60: 20 61 72 65 61 20 22 2c 20 63 61 6c 6c 65 64 20 area ", called
0a70: 22 20 78 6c 61 74 72 2d 6b 65 79 29 0a 20 20 20 " xlatr-key).
0a80: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
0a90: 20 22 20 20 20 66 75 6e 63 74 69 6f 6e 20 69 73 " function is
0aa0: 3a 20 22 20 28 68 61 73 68 2d 74 61 62 6c 65 2d : " (hash-table-
0ab0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 61 72 ref/default *tar
0ac0: 67 65 74 2d 6d 61 70 70 65 72 73 2a 20 78 6c 61 get-mappers* xla
0ad0: 74 72 2d 6b 65 79 20 23 66 20 29 20 29 0a 20 20 tr-key #f ) ).
0ae0: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e (prin
0af0: 74 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 t " message: " (
0b00: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
0b10: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
0b20: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
0b30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 72 ). r
0b40: 75 6e 6b 65 79 29 0a 20 20 20 20 20 20 20 20 20 unkey).
0b50: 20 20 28 70 72 6f 63 20 72 75 6e 6b 65 79 20 61 (proc runkey a
0b60: 72 65 61 20 63 6f 6e 74 6f 75 72 29 29 29 0a 20 rea contour))).
0b70: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
0b80: 20 20 20 20 20 20 20 20 28 69 66 20 78 6c 61 74 (if xlat
0b90: 72 2d 6b 65 79 20 0a 20 20 20 20 20 20 20 20 20 r-key .
0ba0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR
0bb0: 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 66 69 OR: Failed to fi
0bc0: 6e 64 20 6e 61 6d 65 64 20 74 61 72 67 65 74 20 nd named target
0bd0: 74 72 61 6e 73 6c 61 74 6f 72 20 22 20 78 6c 61 translator " xla
0be0: 74 72 2d 6b 65 79 20 22 2c 20 75 73 69 6e 67 20 tr-key ", using
0bf0: 6f 72 69 67 69 6e 61 6c 20 74 61 72 67 65 74 2e original target.
0c00: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 60 28 ")). `(
0c10: 2c 72 75 6e 6b 65 79 29 29 29 29 29 20 3b 3b 20 ,runkey))))) ;;
0c20: 6e 6f 20 70 72 6f 63 20 74 68 65 6e 20 75 73 65 no proc then use
0c30: 20 72 75 6e 6b 65 79 0a 0a 3b 3b 20 67 69 76 65 runkey..;; give
0c40: 6e 20 6d 74 63 6f 6e 66 20 61 6e 64 20 61 72 65 n mtconf and are
0c50: 61 63 6f 6e 66 20 65 78 74 72 61 63 74 20 61 20 aconf extract a
0c60: 74 72 61 6e 73 6c 61 74 6f 72 2f 66 69 6c 74 65 translator/filte
0c70: 72 2c 20 66 69 72 73 74 20 6c 6f 6f 6b 20 61 74 r, first look at
0c80: 20 61 72 65 61 63 6f 6e 66 0a 3b 3b 20 74 68 65 areaconf.;; the
0c90: 6e 20 69 66 20 6e 6f 74 20 66 6f 75 6e 64 20 6c n if not found l
0ca0: 6f 6f 6b 20 61 74 20 64 65 66 61 75 6c 74 0a 3b ook at default.;
0cb0: 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 2d ;.(define (conf-
0cc0: 67 65 74 2f 64 65 66 61 75 6c 74 20 6d 74 63 6f get/default mtco
0cd0: 6e 66 20 61 72 65 61 63 6f 6e 66 20 6b 65 79 6e nf areaconf keyn
0ce0: 61 6d 65 20 23 21 6b 65 79 20 28 64 65 66 61 75 ame #!key (defau
0cf0: 6c 74 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 lt #f)). (let (
0d00: 28 72 65 73 20 28 6f 72 20 28 61 6c 69 73 74 2d (res (or (alist-
0d10: 72 65 66 20 6b 65 79 6e 61 6d 65 20 61 72 65 61 ref keyname area
0d20: 63 6f 6e 66 29 0a 20 20 20 20 20 20 20 20 20 20 conf).
0d30: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
0d40: 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 64 lookup mtconf "d
0d50: 65 66 61 75 6c 74 22 20 28 63 6f 6e 63 20 6b 65 efault" (conc ke
0d60: 79 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 yname)).
0d70: 20 20 20 20 20 20 20 20 20 64 65 66 61 75 6c 74 default
0d80: 29 29 29 0a 20 20 20 20 28 69 66 20 72 65 73 0a ))). (if res.
0d90: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
0da0: 3e 73 79 6d 62 6f 6c 20 72 65 73 29 0a 20 20 20 >symbol res).
0db0: 20 20 20 20 20 72 65 73 29 29 29 0a 20 20 0a 3b res))). .;
0dc0: 3b 20 74 68 69 73 20 6e 65 65 64 73 20 73 6f 6d ; this needs som
0dd0: 65 20 74 68 6f 75 67 68 74 20 72 65 67 61 72 64 e thought regard
0de0: 69 6e 67 20 73 65 63 75 72 69 74 79 20 69 6d 70 ing security imp
0df0: 6c 69 63 61 74 69 6f 6e 73 2e 0a 3b 3b 0a 3b 3b lications..;;.;;
0e00: 20 20 20 69 2e 20 43 68 65 63 6b 20 74 68 61 74 i. Check that
0e10: 20 6f 77 6e 65 72 20 6f 66 20 74 68 65 20 66 69 owner of the fi
0e20: 6c 65 20 61 6e 64 20 63 61 6c 6c 69 6e 67 20 75 le and calling u
0e30: 73 65 72 20 61 72 65 20 73 61 6d 65 3f 0a 3b 3b ser are same?.;;
0e40: 20 20 69 69 2e 20 43 68 65 63 6b 20 74 68 61 74 ii. Check that
0e50: 20 77 65 20 61 72 65 20 69 6e 20 61 20 6c 65 67 we are in a leg
0e60: 61 6c 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 al megatest area
0e70: 3f 0a 3b 3b 20 69 69 69 2e 20 48 61 76 65 20 73 ?.;; iii. Have s
0e80: 6f 6d 65 20 66 6f 72 6d 20 6f 66 20 61 75 74 68 ome form of auth
0e90: 65 6e 74 69 63 61 74 69 6f 6e 20 6f 72 20 72 65 entication or re
0ea0: 63 6f 72 64 20 6f 66 20 74 68 65 20 6d 64 35 73 cord of the md5s
0eb0: 75 6d 20 6f 72 20 73 69 6d 69 6c 61 72 20 6f 66 um or similar of
0ec0: 20 74 68 65 20 66 69 6c 65 3f 0a 3b 3b 20 20 69 the file?.;; i
0ed0: 76 2e 20 55 73 65 20 63 6f 6d 70 69 6c 65 64 20 v. Use compiled
0ee0: 76 65 72 73 69 6f 6e 20 69 6e 20 70 72 65 66 65 version in prefe
0ef0: 72 65 6e 63 65 20 74 6f 20 2e 73 63 6d 20 76 65 rence to .scm ve
0f00: 72 73 69 6f 6e 2e 20 54 68 75 73 20 74 68 65 72 rsion. Thus ther
0f10: 65 20 69 73 20 61 20 6d 61 6e 75 61 6c 20 22 62 e is a manual "b
0f20: 6c 65 73 73 69 6e 67 22 0a 3b 3b 20 20 20 20 20 lessing".;;
0f30: 20 72 65 71 75 69 72 65 64 20 74 6f 20 75 73 65 required to use
0f40: 20 2e 6d 74 75 74 69 6c 2e 73 63 6d 2e 0a 3b 3b .mtutil.scm..;;
0f50: 0a 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c .(if (common:fil
0f60: 65 2d 65 78 69 73 74 73 3f 20 22 6d 65 67 61 74 e-exists? "megat
0f70: 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 20 20 20 est.config").
0f80: 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c (if (common:fil
0f90: 65 2d 65 78 69 73 74 73 3f 20 22 2e 6d 74 75 74 e-exists? ".mtut
0fa0: 69 6c 2e 73 6f 22 29 0a 09 28 6c 6f 61 64 20 22 il.so")..(load "
0fb0: 2e 6d 74 75 74 69 6c 2e 73 6f 22 29 0a 09 28 69 .mtutil.so")..(i
0fc0: 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 f (common:file-e
0fd0: 78 69 73 74 73 3f 20 22 2e 6d 74 75 74 69 6c 2e xists? ".mtutil.
0fe0: 73 63 6d 22 29 0a 20 20 20 20 20 20 20 20 20 20 scm").
0ff0: 20 20 28 6c 6f 61 64 20 22 2e 6d 74 75 74 69 6c (load ".mtutil
1000: 2e 73 63 6d 22 29 29 29 29 0a 0a 3b 3b 20 6d 61 .scm"))))..;; ma
1010: 69 6e 20 74 68 72 65 65 20 74 79 70 65 73 20 6f in three types o
1020: 66 20 72 75 6e 0a 3b 3b 20 20 22 2d 72 75 6e 22 f run.;; "-run"
1030: 20 20 20 20 20 20 20 20 20 3d 3e 20 69 6e 69 74 => init
1040: 69 61 74 65 20 61 20 72 75 6e 0a 3b 3b 20 20 22 iate a run.;; "
1050: 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 20 3d 3e -rerun-clean" =>
1060: 20 73 65 74 20 66 61 69 6c 65 64 2c 20 61 62 6f set failed, abo
1070: 72 74 65 64 2c 20 6b 69 6c 6c 65 64 2c 20 65 74 rted, killed, et
1080: 63 2e 20 28 6e 6f 74 20 70 61 73 73 2f 66 61 69 c. (not pass/fai
1090: 6c 29 20 74 6f 20 4e 4f 54 5f 53 54 41 52 54 45 l) to NOT_STARTE
10a0: 44 20 61 6e 64 20 6b 69 63 6b 20 6f 66 66 20 72 D and kick off r
10b0: 75 6e 0a 3b 3b 20 20 22 2d 72 65 72 75 6e 2d 61 un.;; "-rerun-a
10c0: 6c 6c 22 20 20 20 3d 3e 20 73 65 74 20 61 6c 6c ll" => set all
10d0: 20 74 65 73 74 73 20 4e 4f 54 5f 53 54 41 52 54 tests NOT_START
10e0: 45 44 20 61 6e 64 20 6b 69 63 6b 20 6f 66 66 20 ED and kick off
10f0: 72 75 6e 20 61 67 61 69 6e 0a 0a 3b 3b 20 64 65 run again..;; de
1100: 70 72 65 63 61 74 65 64 2f 64 6f 20 6e 6f 74 20 precated/do not
1110: 75 73 65 0a 3b 3b 20 20 22 2d 72 75 6e 61 6c 6c use.;; "-runall
1120: 22 20 20 20 20 20 20 3d 3e 20 73 79 6e 6f 6e 79 " => synony
1130: 6d 20 66 6f 72 20 72 75 6e 2c 20 64 6f 20 6e 6f m for run, do no
1140: 74 20 75 73 65 0a 3b 3b 20 20 22 2d 72 75 6e 74 t use.;; "-runt
1150: 65 73 74 73 22 20 20 20 20 3d 3e 20 73 79 6e 6f ests" => syno
1160: 6e 79 6d 20 66 6f 72 20 72 75 6e 2c 20 64 6f 20 nym for run, do
1170: 6e 6f 74 20 75 73 65 0a 0a 3b 3b 20 44 69 73 61 not use..;; Disa
1180: 62 6c 65 64 20 68 65 6c 70 20 69 74 65 6d 73 0a bled help items.
1190: 3b 3b 20 20 2d 72 6f 6c 6c 75 70 20 20 20 20 20 ;; -rollup
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 28 63 : (c
11b0: 75 72 72 65 6e 74 6c 79 20 64 69 73 61 62 6c 65 urrently disable
11c0: 64 29 20 66 69 6c 6c 20 72 75 6e 20 28 73 65 74 d) fill run (set
11d0: 20 62 79 20 3a 72 75 6e 6e 61 6d 65 29 20 20 77 by :runname) w
11e0: 69 74 68 20 6c 61 74 65 73 74 20 74 65 73 74 28 ith latest test(
11f0: 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 s).;;
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1210: 20 66 72 6f 6d 20 70 72 69 6f 72 20 72 75 6e 73 from prior runs
1220: 20 77 69 74 68 20 73 61 6d 65 20 6b 65 79 73 0a with same keys.
1230: 3b 3b 20 43 6f 6e 74 6f 75 72 20 61 63 74 69 6f ;; Contour actio
1240: 6e 73 0a 3b 3b 20 20 20 20 69 6d 70 6f 72 74 20 ns.;; import
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1260: 20 3a 20 69 6d 70 6f 72 74 20 70 6b 74 73 0a 3b : import pkts.;
1270: 3b 20 20 20 20 64 69 73 70 61 74 63 68 20 20 20 ; dispatch
1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 : d
1290: 69 73 70 61 74 63 68 20 71 75 65 75 65 64 20 72 ispatch queued r
12a0: 75 6e 20 6a 6f 62 73 20 66 72 6f 6d 20 69 6d 70 un jobs from imp
12b0: 6f 72 74 65 64 20 70 6b 74 73 0a 3b 3b 20 20 20 orted pkts.;;
12c0: 20 72 75 6e 67 65 6e 20 20 20 20 20 20 20 20 20 rungen
12d0: 20 20 20 20 20 20 20 20 20 3a 20 6c 6f 6f 6b 20 : look
12e0: 61 74 20 69 6e 70 75 74 20 73 65 6e 73 65 20 6c at input sense l
12f0: 69 73 74 20 69 6e 20 5b 72 75 6e 67 65 6e 5d 20 ist in [rungen]
1300: 61 6e 64 20 67 65 6e 65 72 61 74 65 20 72 75 6e and generate run
1310: 20 70 6b 74 73 0a 0a 28 64 65 66 69 6e 65 20 68 pkts..(define h
1320: 65 6c 70 20 28 63 6f 6e 63 20 22 0a 6d 74 75 74 elp (conc ".mtut
1330: 69 6c 2c 20 70 61 72 74 20 6f 66 20 74 68 65 20 il, part of the
1340: 4d 65 67 61 74 65 73 74 20 74 6f 6f 6c 20 73 75 Megatest tool su
1350: 69 74 65 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 ite, documentati
1360: 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 on at http://www
1370: 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 .kiatoa.com/foss
1380: 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 ils/megatest. v
1390: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
13a0: 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 t-version ". li
13b0: 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 cense GPL, Copyr
13c0: 69 67 68 74 20 4d 61 74 74 20 57 65 6c 6c 61 6e ight Matt Wellan
13d0: 64 20 32 30 30 36 2d 32 30 31 37 0a 0a 55 73 61 d 2006-2017..Usa
13e0: 67 65 3a 20 6d 74 75 74 69 6c 20 61 63 74 69 6f ge: mtutil actio
13f0: 6e 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 n [options]. -h
1400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1410: 20 20 20 20 20 20 20 20 20 3a 20 74 68 69 73 20 : this
1420: 68 65 6c 70 0a 20 20 2d 6d 61 6e 75 61 6c 20 20 help. -manual
1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1440: 20 20 3a 20 73 68 6f 77 20 74 68 65 20 4d 65 67 : show the Meg
1450: 61 74 65 73 74 20 75 73 65 72 20 6d 61 6e 75 61 atest user manua
1460: 6c 0a 20 20 2d 76 65 72 73 69 6f 6e 20 20 20 20 l. -version
1470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3a :
1480: 20 70 72 69 6e 74 20 6d 65 67 61 74 65 73 74 20 print megatest
1490: 76 65 72 73 69 6f 6e 20 28 63 75 72 72 65 6e 74 version (current
14a0: 6c 79 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 ly " megatest-ve
14b0: 72 73 69 6f 6e 20 22 29 0a 09 09 09 20 20 20 20 rsion ")....
14c0: 20 0a 52 75 6e 20 6d 61 6e 61 67 65 6d 65 6e 74 .Run management
14d0: 3a 09 09 20 20 20 20 20 0a 20 20 20 72 75 6e 20 :.. . run
14e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14f0: 20 20 20 20 20 20 3a 20 69 6e 69 74 69 61 74 65 : initiate
1500: 20 6f 72 20 72 65 73 75 6d 65 20 61 20 72 75 6e or resume a run
1510: 2c 20 61 6c 72 65 61 64 79 20 63 6f 6d 70 6c 65 , already comple
1520: 74 65 64 20 61 6e 64 20 69 6e 2d 70 72 6f 67 72 ted and in-progr
1530: 65 73 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ess.
1540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1550: 20 20 20 74 65 73 74 73 20 61 72 65 20 6e 6f 74 tests are not
1560: 20 61 66 66 65 63 74 65 64 2e 0a 20 20 20 72 65 affected.. re
1570: 72 75 6e 2d 63 6c 65 61 6e 20 20 20 20 20 20 20 run-clean
1580: 20 20 20 20 20 20 20 20 3a 20 63 6c 65 61 6e 20 : clean
1590: 61 6e 64 20 72 65 72 75 6e 20 61 6c 6c 20 6e 6f and rerun all no
15a0: 74 20 63 6f 6d 70 6c 65 74 65 64 20 70 61 73 73 t completed pass
15b0: 2f 66 61 69 6c 20 74 65 73 74 73 0a 20 20 20 72 /fail tests. r
15c0: 65 72 75 6e 2d 61 6c 6c 20 20 20 20 20 20 20 20 erun-all
15d0: 20 20 20 20 20 20 20 20 20 3a 20 63 6c 65 61 6e : clean
15e0: 20 61 6e 64 20 72 65 72 75 6e 20 65 6e 74 69 72 and rerun entir
15f0: 65 20 72 75 6e 0a 20 20 20 6b 69 6c 6c 2d 72 75 e run. kill-ru
1600: 6e 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n
1610: 20 20 20 3a 20 6b 69 6c 6c 20 61 6c 6c 20 74 65 : kill all te
1620: 73 74 73 20 69 6e 20 72 75 6e 0a 20 20 20 6b 69 sts in run. ki
1630: 6c 6c 2d 72 65 72 75 6e 20 20 20 20 20 20 20 20 ll-rerun
1640: 20 20 20 20 20 20 20 20 3a 20 6b 69 6c 6c 20 61 : kill a
1650: 6c 6c 20 74 65 73 74 73 20 69 6e 20 72 75 6e 20 ll tests in run
1660: 61 6e 64 20 72 65 73 74 61 72 74 20 6e 6f 6e 2d and restart non-
1670: 63 6f 6d 70 6c 65 74 65 64 20 74 65 73 74 73 0a completed tests.
1680: 20 20 20 72 65 6d 6f 76 65 20 20 20 20 20 20 20 remove
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 : r
16a0: 65 6d 6f 76 65 20 72 75 6e 73 0a 20 20 20 73 65 emove runs. se
16b0: 74 2d 73 73 20 20 20 20 20 20 20 20 20 20 20 20 t-ss
16c0: 20 20 20 20 20 20 20 20 3a 20 73 65 74 20 73 74 : set st
16d0: 61 74 65 2f 73 74 61 74 75 73 0a 20 20 20 61 72 ate/status. ar
16e0: 63 68 69 76 65 20 20 20 20 20 20 20 20 20 20 20 chive
16f0: 20 20 20 20 20 20 20 20 3a 20 63 6f 6d 70 72 65 : compre
1700: 73 73 20 61 6e 64 20 6d 6f 76 65 20 74 65 73 74 ss and move test
1710: 20 64 61 74 61 20 74 6f 20 61 72 63 68 69 76 65 data to archive
1720: 20 64 69 73 6b 0a 20 20 20 6b 69 6c 6c 20 20 20 disk. kill
1730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1740: 20 20 20 3a 20 73 74 6f 70 20 74 65 73 74 73 20 : stop tests
1750: 6f 72 20 65 6e 74 69 72 65 20 72 75 6e 73 0a 20 or entire runs.
1760: 20 20 64 62 20 20 20 20 20 20 20 20 20 20 20 20 db
1770: 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 64 61 : da
1780: 74 61 62 61 73 65 20 75 74 69 6c 69 74 69 65 73 tabase utilities
1790: 0a 0a 51 75 65 72 69 65 73 3a 0a 20 20 20 73 68 ..Queries:. sh
17a0: 6f 77 20 5b 61 72 65 61 73 7c 63 6f 6e 74 6f 75 ow [areas|contou
17b0: 72 73 2e 2e 2e 20 5d 20 3a 20 73 68 6f 77 20 61 rs... ] : show a
17c0: 72 65 61 73 2c 20 63 6f 6e 74 6f 75 72 73 20 6f reas, contours o
17d0: 72 20 6f 74 68 65 72 20 73 65 63 74 69 6f 6e 20 r other section
17e0: 66 72 6f 6d 20 6d 65 67 61 74 65 73 74 2e 63 6f from megatest.co
17f0: 6e 66 69 67 0a 20 20 20 67 65 6e 64 6f 74 20 20 nfig. gendot
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1810: 20 20 3a 20 67 65 6e 65 72 61 74 65 20 61 20 67 : generate a g
1820: 72 61 70 68 76 69 7a 20 64 6f 74 20 66 69 6c 65 raphviz dot file
1830: 20 66 72 6f 6d 20 70 6b 74 73 2e 0a 0a 43 6f 6e from pkts...Con
1840: 74 6f 75 72 20 61 63 74 69 6f 6e 73 3a 0a 20 20 tour actions:.
1850: 20 70 72 6f 63 65 73 73 20 20 20 20 20 20 20 20 process
1860: 20 20 20 20 20 20 20 20 20 20 20 3a 20 72 75 6e : run
1870: 73 20 69 6d 70 6f 72 74 2c 20 72 75 6e 67 65 6e s import, rungen
1880: 20 61 6e 64 20 64 69 73 70 61 74 63 68 20 0a 09 and dispatch ..
1890: 09 09 20 20 20 20 20 0a 54 72 69 67 67 65 72 20 .. .Trigger
18a0: 70 72 6f 70 61 67 61 74 69 6f 6e 20 61 63 74 69 propagation acti
18b0: 6f 6e 73 3a 0a 20 20 20 74 73 65 6e 64 20 61 3d ons:. tsend a=
18c0: 62 2c 63 3d 64 2e 2e 2e 20 20 20 20 20 20 20 20 b,c=d...
18d0: 20 20 3a 20 73 65 6e 64 20 74 72 69 67 67 65 72 : send trigger
18e0: 20 69 6e 66 6f 20 74 6f 20 61 6c 6c 20 72 65 63 info to all rec
18f0: 70 69 65 6e 74 73 20 69 6e 20 74 68 65 20 5b 6c pients in the [l
1900: 69 73 74 65 6e 65 72 73 5d 20 73 65 63 74 69 6f isteners] sectio
1910: 6e 0a 20 20 20 74 6c 69 73 74 65 6e 20 2d 70 6f n. tlisten -po
1920: 72 74 20 4e 20 20 20 20 20 20 20 20 20 20 20 3a rt N :
1930: 20 6c 69 73 74 65 6e 20 66 6f 72 20 74 72 69 67 listen for trig
1940: 67 65 72 20 69 6e 66 6f 20 6f 6e 20 70 6f 72 74 ger info on port
1950: 20 4e 0a 09 09 09 20 20 20 20 20 0a 53 65 6c 65 N.... .Sele
1960: 63 74 6f 72 73 20 09 09 20 20 20 20 20 0a 20 20 ctors .. .
1970: 2d 69 6d 6d 65 64 69 61 74 65 20 20 20 20 20 20 -immediate
1980: 20 20 20 20 20 20 20 20 20 20 20 3a 20 61 70 70 : app
1990: 6c 79 20 74 68 69 73 20 61 63 74 69 6f 6e 20 69 ly this action i
19a0: 6d 6d 65 64 69 61 74 65 6c 79 2c 20 64 65 66 61 mmediately, defa
19b0: 75 6c 74 20 69 73 20 74 6f 20 71 75 65 75 65 20 ult is to queue
19c0: 75 70 20 61 63 74 69 6f 6e 73 0a 20 20 2d 61 72 up actions. -ar
19d0: 65 61 20 61 72 65 61 70 61 74 74 31 2c 61 72 65 ea areapatt1,are
19e0: 61 32 2e 2e 2e 20 20 20 3a 20 61 70 70 6c 79 20 a2... : apply
19f0: 74 68 69 73 20 61 63 74 69 6f 6e 20 6f 6e 6c 79 this action only
1a00: 20 74 6f 20 74 68 65 20 73 70 65 63 69 66 69 65 to the specifie
1a10: 64 20 61 72 65 61 73 0a 20 20 2d 74 61 72 67 65 d areas. -targe
1a20: 74 20 6b 65 79 31 2f 6b 65 79 32 2f 2e 2e 2e 20 t key1/key2/...
1a30: 20 20 20 20 20 3a 20 72 75 6e 20 66 6f 72 20 6b : run for k
1a40: 65 79 31 2c 20 6b 65 79 32 2c 20 65 74 63 2e 0a ey1, key2, etc..
1a50: 20 20 2d 74 65 73 74 2d 70 61 74 74 20 70 31 2f -test-patt p1/
1a60: 70 32 2c 70 33 2f 2e 2e 2e 20 20 20 20 3a 20 25 p2,p3/... : %
1a70: 20 69 73 20 77 69 6c 64 63 61 72 64 0a 20 20 2d is wildcard. -
1a80: 72 75 6e 2d 6e 61 6d 65 20 20 20 20 20 20 20 20 run-name
1a90: 20 20 20 20 20 20 20 20 20 20 3a 20 72 65 71 75 : requ
1aa0: 69 72 65 64 2c 20 6e 61 6d 65 20 66 6f 72 20 74 ired, name for t
1ab0: 68 69 73 20 70 61 72 74 69 63 75 6c 61 72 20 74 his particular t
1ac0: 65 73 74 20 72 75 6e 0a 20 20 2d 63 6f 6e 74 6f est run. -conto
1ad0: 75 72 20 63 6f 6e 74 6f 75 72 6e 61 6d 65 20 20 ur contourname
1ae0: 20 20 20 20 20 3a 20 72 75 6e 20 61 6c 6c 20 74 : run all t
1af0: 61 72 67 65 74 73 20 66 6f 72 20 63 6f 6e 74 6f argets for conto
1b00: 75 72 6e 61 6d 65 2c 20 72 65 71 75 69 72 65 73 urname, requires
1b10: 20 2d 72 75 6e 2d 6e 61 6d 65 2c 20 2d 74 61 72 -run-name, -tar
1b20: 67 65 74 0a 20 20 2d 73 74 61 74 65 2d 73 74 61 get. -state-sta
1b30: 74 75 73 20 63 2f 70 2c 63 2f 66 20 20 20 20 20 tus c/p,c/f
1b40: 20 3a 20 53 70 65 63 69 66 79 20 61 20 6c 69 73 : Specify a lis
1b50: 74 20 6f 66 20 73 74 61 74 65 20 61 6e 64 20 73 t of state and s
1b60: 74 61 74 75 73 20 70 61 74 74 65 72 6e 73 0a 20 tatus patterns.
1b70: 20 2d 74 61 67 2d 65 78 70 72 20 74 61 67 31 2c -tag-expr tag1,
1b80: 74 61 67 32 25 2c 2e 2e 20 20 20 20 3a 20 73 65 tag2%,.. : se
1b90: 6c 65 63 74 20 74 65 73 74 73 20 77 69 74 68 20 lect tests with
1ba0: 74 61 67 73 20 6d 61 74 63 68 69 6e 67 20 65 78 tags matching ex
1bb0: 70 72 65 73 73 69 6f 6e 0a 20 20 2d 6d 6f 64 65 pression. -mode
1bc0: 2d 70 61 74 74 20 6b 65 79 20 20 20 20 20 20 20 -patt key
1bd0: 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 74 65 73 : load tes
1be0: 74 70 61 74 74 20 66 72 6f 6d 20 3c 6b 65 79 3e tpatt from <key>
1bf0: 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 20 69 in runconfigs i
1c00: 6e 73 74 65 61 64 20 6f 66 20 64 65 66 61 75 6c nstead of defaul
1c10: 74 20 54 45 53 54 50 41 54 54 0a 20 20 20 20 20 t TESTPATT.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c30: 20 20 20 20 20 20 20 20 20 20 69 66 20 2d 74 65 if -te
1c40: 73 74 70 61 74 74 20 61 6e 64 20 2d 74 61 67 65 stpatt and -tage
1c50: 78 70 72 20 61 72 65 20 6e 6f 74 20 73 70 65 63 xpr are not spec
1c60: 69 66 69 65 64 0a 20 20 2d 6e 65 77 20 73 74 61 ified. -new sta
1c70: 74 65 2f 73 74 61 74 75 73 20 20 20 20 20 20 20 te/status
1c80: 20 20 20 3a 20 73 70 65 63 69 66 79 20 6e 65 77 : specify new
1c90: 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 66 6f state/status fo
1ca0: 72 20 73 65 74 2d 73 73 0a 09 09 09 20 20 20 20 r set-ss....
1cb0: 20 0a 4d 69 73 63 20 09 09 09 20 20 20 20 20 0a .Misc ... .
1cc0: 20 20 2d 73 74 61 72 74 2d 64 69 72 20 70 61 74 -start-dir pat
1cd0: 68 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 h : s
1ce0: 77 69 74 63 68 20 74 6f 20 74 68 69 73 20 64 69 witch to this di
1cf0: 72 65 63 74 6f 72 79 20 62 65 66 6f 72 65 20 72 rectory before r
1d00: 75 6e 6e 69 6e 67 20 6d 74 75 74 69 6c 0a 20 20 unning mtutil.
1d10: 2d 73 65 74 2d 76 61 72 73 20 56 31 3d 31 2c 56 -set-vars V1=1,V
1d20: 32 3d 32 20 20 20 20 20 20 20 20 3a 20 41 64 64 2=2 : Add
1d30: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 environment var
1d40: 69 61 62 6c 65 73 20 74 6f 20 61 20 72 75 6e 20 iables to a run
1d50: 4e 42 2f 2f 20 74 68 65 73 65 20 61 72 65 0a 20 NB// these are.
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 overwritten by
1d90: 20 76 61 6c 75 65 73 20 73 65 74 20 69 6e 20 63 values set in c
1da0: 6f 6e 66 69 67 20 66 69 6c 65 73 2e 0a 20 20 2d onfig files.. -
1db0: 6c 6f 67 20 6c 6f 67 66 69 6c 65 20 20 20 20 20 log logfile
1dc0: 20 20 20 20 20 20 20 20 20 20 3a 20 73 65 6e 64 : send
1dd0: 20 73 74 64 6f 75 74 20 61 6e 64 20 73 74 64 65 stdout and stde
1de0: 72 72 20 74 6f 20 6c 6f 67 66 69 6c 65 0a 20 20 rr to logfile.
1df0: 2d 72 65 70 6c 20 20 20 20 20 20 20 20 20 20 20 -repl
1e00: 20 20 20 20 20 20 20 20 20 20 20 3a 20 73 74 61 : sta
1e10: 72 74 20 61 20 72 65 70 6c 20 28 75 73 65 66 75 rt a repl (usefu
1e20: 6c 20 66 6f 72 20 65 78 74 65 6e 64 69 6e 67 20 l for extending
1e30: 6d 65 67 61 74 65 73 74 29 0a 20 20 2d 6c 6f 61 megatest). -loa
1e40: 64 20 66 69 6c 65 2e 73 63 6d 20 20 20 20 20 20 d file.scm
1e50: 20 20 20 20 20 20 20 3a 20 6c 6f 61 64 20 61 6e : load an
1e60: 64 20 72 75 6e 20 66 69 6c 65 2e 73 63 6d 0a 20 d run file.scm.
1e70: 20 2d 64 65 62 75 67 20 4e 7c 4e 2c 4d 2c 4f 2e -debug N|N,M,O.
1e80: 2e 2e 20 20 20 20 20 20 20 20 20 20 3a 20 65 6e .. : en
1e90: 61 62 6c 65 20 64 65 62 75 67 20 6d 65 73 73 61 able debug messa
1ea0: 67 65 73 20 30 2d 4e 20 6f 72 20 4e 20 61 6e 64 ges 0-N or N and
1eb0: 20 4d 20 61 6e 64 20 4f 20 2e 2e 2e 0a 20 20 2d M and O .... -
1ec0: 6c 69 73 74 2d 70 6b 74 2d 6b 65 79 73 20 20 20 list-pkt-keys
1ed0: 20 20 20 20 20 20 20 20 20 20 3a 20 6c 69 73 74 : list
1ee0: 20 61 6c 6c 20 70 6b 74 20 6b 65 79 73 0a 09 09 all pkt keys...
1ef0: 09 20 20 20 20 20 0a 55 74 69 6c 69 74 79 09 09 . .Utility..
1f00: 09 20 20 20 20 20 0a 20 64 62 20 70 67 73 63 68 . . db pgsch
1f10: 65 6d 61 20 20 20 20 20 20 20 20 20 20 20 20 20 ema
1f20: 20 20 20 20 3a 20 65 6d 69 74 20 70 6f 73 74 67 : emit postg
1f30: 72 65 73 71 6c 20 73 63 68 65 6d 61 3b 20 64 6f resql schema; do
1f40: 20 5c 22 6d 74 75 74 69 6c 20 64 62 20 70 67 73 \"mtutil db pgs
1f50: 63 68 65 6d 61 20 7c 20 70 73 71 6c 20 2d 64 20 chema | psql -d
1f60: 6d 79 64 62 5c 22 0a 20 67 61 74 68 65 72 64 62 mydb\". gatherdb
1f70: 20 5b 70 72 6f 70 61 67 61 74 65 5d 20 20 20 20 [propagate]
1f80: 20 20 20 20 3a 20 67 61 74 68 65 72 20 64 62 73 : gather dbs
1f90: 20 66 72 6f 6d 20 61 6c 6c 20 61 72 65 61 73 20 from all areas
1fa0: 69 6e 74 6f 20 2f 74 6d 70 2f 24 55 53 45 52 5f into /tmp/$USER_
1fb0: 6d 65 67 61 74 65 73 74 2f 61 6c 6c 64 62 73 2c megatest/alldbs,
1fc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 6f 70 74 69 6f 6e 61 6c 6c 79 20 70 72 6f 70 61 optionally propa
1ff0: 67 61 74 65 20 74 68 65 20 64 61 74 61 20 74 6f gate the data to
2000: 20 6d 65 67 61 74 65 73 74 32 2e 30 20 66 6f 72 megatest2.0 for
2010: 6d 61 74 0a 20 0a 0a 45 78 61 6d 70 6c 65 73 3a mat. ..Examples:
2020: 0a 0a 23 20 53 74 61 72 74 20 61 20 6d 65 67 61 ..# Start a mega
2030: 74 65 73 74 20 72 75 6e 20 69 6e 20 74 68 65 20 test run in the
2040: 61 72 65 61 20 5c 22 6d 79 74 65 73 74 73 5c 22 area \"mytests\"
2050: 0a 6d 74 75 74 69 6c 20 72 75 6e 20 2d 61 72 65 .mtutil run -are
2060: 61 20 6d 79 74 65 73 74 73 20 2d 74 61 72 67 65 a mytests -targe
2070: 74 20 76 31 2e 36 33 2f 61 61 33 65 20 2d 6d 6f t v1.63/aa3e -mo
2080: 64 65 2d 70 61 74 74 20 4d 59 50 41 54 54 20 2d de-patt MYPATT -
2090: 74 61 67 2d 65 78 70 72 20 71 75 69 63 6b 0a 0a tag-expr quick..
20a0: 23 20 53 74 61 72 74 20 61 20 63 6f 6e 74 6f 75 # Start a contou
20b0: 72 0a 6d 74 75 74 69 6c 20 72 75 6e 20 2d 63 6f r.mtutil run -co
20c0: 6e 74 6f 75 72 20 71 75 69 63 6b 20 2d 74 61 72 ntour quick -tar
20d0: 67 65 74 20 76 31 2e 36 33 2f 61 61 33 65 20 0a get v1.63/aa3e .
20e0: 0a 43 61 6c 6c 65 64 20 61 73 20 22 20 28 73 74 .Called as " (st
20f0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
2100: 20 28 61 72 67 76 29 20 22 20 22 29 20 22 0a 56 (argv) " ") ".V
2110: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
2120: 74 2d 76 65 72 73 69 6f 6e 20 22 2c 20 62 75 69 t-version ", bui
2130: 6c 74 20 66 72 6f 6d 20 22 20 6d 65 67 61 74 65 lt from " megate
2140: 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 20 29 st-fossil-hash )
2150: 29 0a 0a 3b 3b 20 61 72 67 73 20 61 6e 64 20 70 )..;; args and p
2160: 6b 74 20 6b 65 79 20 73 70 65 63 73 0a 3b 3b 0a kt key specs.;;.
2170: 28 64 65 66 69 6e 65 20 2a 61 72 67 2d 6b 65 79 (define *arg-key
2180: 73 2a 0a 20 20 3b 3b 20 75 73 65 64 20 6b 65 79 s*. ;; used key
2190: 73 0a 20 20 3b 3b 20 20 20 20 61 20 20 2d 20 61 s. ;; a - a
21a0: 63 74 69 6f 6e 0a 20 20 27 28 0a 20 20 20 20 28 ction. '(. (
21b0: 22 2d 61 72 65 61 22 20 20 20 20 20 20 20 20 20 "-area"
21c0: 20 20 20 2e 20 47 29 20 3b 3b 20 6d 61 70 73 20 . G) ;; maps
21d0: 74 6f 20 67 72 6f 75 70 0a 20 20 20 20 28 22 2d to group. ("-
21e0: 63 6f 6e 74 6f 75 72 22 20 20 20 20 20 20 20 20 contour"
21f0: 20 2e 20 63 29 0a 20 20 20 20 28 22 2d 61 70 70 . c). ("-app
2200: 65 6e 64 2d 63 6f 6e 66 69 67 22 20 20 20 2e 20 end-config" .
2210: 64 29 0a 20 20 20 20 28 22 2d 73 74 61 74 65 22 d). ("-state"
2220: 20 20 20 20 20 20 20 20 20 20 20 2e 20 65 29 0a . e).
2230: 20 20 20 20 28 22 2d 69 74 65 6d 2d 70 61 74 74 ("-item-patt
2240: 22 20 20 20 20 20 20 20 2e 20 69 29 0a 20 20 20 " . i).
2250: 20 28 22 2d 73 79 6e 63 2d 74 6f 22 20 20 20 20 ("-sync-to"
2260: 20 20 20 20 20 2e 20 6b 29 0a 20 20 20 20 28 22 . k). ("
2270: 2d 6e 65 77 22 20 20 20 20 20 20 20 20 20 20 20 -new"
2280: 20 20 2e 20 6c 29 20 3b 3b 20 6c 20 28 73 65 65 . l) ;; l (see
2290: 20 62 65 6c 6f 77 29 20 69 73 20 6e 65 77 2d 73 below) is new-s
22a0: 73 0a 20 20 20 20 28 22 2d 72 75 6e 2d 6e 61 6d s. ("-run-nam
22b0: 65 22 20 20 20 20 20 20 20 20 2e 20 6e 29 0a 20 e" . n).
22c0: 20 20 20 28 22 2d 6d 6f 64 65 2d 70 61 74 74 22 ("-mode-patt"
22d0: 20 20 20 20 20 20 20 2e 20 6f 29 0a 20 20 20 20 . o).
22e0: 28 22 2d 74 65 73 74 2d 70 61 74 74 22 20 20 20 ("-test-patt"
22f0: 20 20 20 20 2e 20 70 29 20 20 3b 3b 20 69 64 65 . p) ;; ide
2300: 61 2c 20 65 6e 68 61 6e 63 65 20 6d 61 72 67 73 a, enhance margs
2310: 20 28 22 2d 74 65 73 74 2d 70 61 74 74 22 20 22 ("-test-patt" "
2320: 2d 74 65 73 74 70 61 74 74 22 29 20 3d 3e 20 79 -testpatt") => y
2330: 69 65 6c 64 73 20 6f 6e 65 20 76 61 6c 75 65 20 ields one value
2340: 69 6e 20 22 2d 74 65 73 74 2d 70 61 74 74 22 0a in "-test-patt".
2350: 20 20 20 20 28 22 2d 73 74 61 74 75 73 22 20 20 ("-status"
2360: 20 20 20 20 20 20 20 20 2e 20 73 29 0a 20 20 20 . s).
2370: 20 28 22 2d 74 61 72 67 65 74 22 20 20 20 20 20 ("-target"
2380: 20 20 20 20 20 2e 20 74 29 0a 20 20 20 20 28 22 . t). ("
2390: 2d 72 65 71 74 61 72 67 22 20 20 20 20 20 20 20 -reqtarg"
23a0: 20 20 2e 20 52 29 0a 0a 20 20 20 20 28 22 2d 74 . R).. ("-t
23b0: 61 67 2d 65 78 70 72 22 20 20 20 20 20 20 20 20 ag-expr"
23c0: 2e 20 78 29 0a 20 20 20 20 3b 3b 20 6d 69 73 63 . x). ;; misc
23d0: 0a 20 20 20 20 28 22 2d 64 65 62 75 67 22 20 20 . ("-debug"
23e0: 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 20 20 . #f)
23f0: 3b 3b 20 66 6f 72 20 2a 76 65 72 62 6f 73 69 74 ;; for *verbosit
2400: 79 2a 20 3e 20 32 0a 20 20 20 20 28 22 2d 6c 6f y* > 2. ("-lo
2410: 61 64 22 20 20 20 20 20 20 20 20 20 20 20 20 2e ad" .
2420: 20 23 66 29 20 20 3b 3b 20 6c 6f 61 64 20 61 6e #f) ;; load an
2430: 64 20 65 78 65 63 74 75 74 65 20 61 20 73 63 68 d exectute a sch
2440: 65 6d 65 20 66 69 6c 65 0a 20 20 20 20 28 22 2d eme file. ("-
2450: 6c 6f 67 22 20 20 20 20 20 20 20 20 20 20 20 20 log"
2460: 20 2e 20 23 66 29 0a 20 20 20 20 28 22 2d 6f 76 . #f). ("-ov
2470: 65 72 72 69 64 65 2d 75 73 65 72 22 20 20 20 2e erride-user" .
2480: 20 23 66 29 0a 20 20 20 20 28 22 2d 6d 73 67 22 #f). ("-msg"
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 2e 20 4d . M
24a0: 29 0a 20 20 20 20 28 22 2d 73 74 61 72 74 2d 64 ). ("-start-d
24b0: 69 72 22 20 20 20 20 20 20 20 2e 20 53 29 0a 20 ir" . S).
24c0: 20 20 20 28 22 2d 73 65 74 2d 76 61 72 73 22 20 ("-set-vars"
24d0: 20 20 20 20 20 20 20 2e 20 76 29 0a 20 20 20 20 . v).
24e0: 28 22 2d 63 6f 6e 66 69 67 22 20 20 20 20 20 20 ("-config"
24f0: 20 20 20 20 2e 20 68 29 0a 20 20 20 20 28 22 2d . h). ("-
2500: 74 69 6d 65 2d 6f 75 74 22 20 20 20 20 20 20 20 time-out"
2510: 20 2e 20 75 29 0a 20 20 20 20 28 22 2d 61 72 63 . u). ("-arc
2520: 68 69 76 65 22 20 20 20 20 20 20 20 20 20 2e 20 hive" .
2530: 62 29 0a 20 20 20 20 29 29 0a 28 64 65 66 69 6e b). )).(defin
2540: 65 20 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a 0a e *switch-keys*.
2550: 20 20 27 28 0a 20 20 20 20 28 22 2d 68 22 20 20 '(. ("-h"
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 2e 20 23 . #
2570: 66 29 0a 20 20 20 20 28 22 2d 68 65 6c 70 22 20 f). ("-help"
2580: 20 20 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 . #f)
2590: 0a 20 20 20 20 28 22 2d 2d 68 65 6c 70 22 20 20 . ("--help"
25a0: 20 20 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 . #f).
25b0: 20 20 20 28 22 2d 6d 61 6e 75 61 6c 22 20 20 20 ("-manual"
25c0: 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 20 . #f).
25d0: 20 28 22 2d 76 65 72 73 69 6f 6e 22 20 20 20 20 ("-version"
25e0: 20 20 20 20 20 2e 20 23 66 29 0a 20 20 20 20 3b . #f). ;
25f0: 3b 20 6d 69 73 63 09 20 20 20 20 20 20 20 20 0a ; misc. .
2600: 20 20 20 20 28 22 2d 72 65 70 6c 22 20 20 20 20 ("-repl"
2610: 20 20 20 20 20 20 20 20 2e 20 23 66 29 0a 20 20 . #f).
2620: 20 20 28 22 2d 69 6d 6d 65 64 69 61 74 65 22 20 ("-immediate"
2630: 20 20 20 20 20 20 2e 20 49 29 0a 20 20 20 20 28 . I). (
2640: 22 2d 70 72 65 63 6c 65 61 6e 22 20 20 20 20 20 "-preclean"
2650: 20 20 20 2e 20 72 29 0a 20 20 20 20 28 22 2d 70 . r). ("-p
2660: 72 65 70 65 6e 64 2d 63 6f 6e 74 6f 75 72 22 20 repend-contour"
2670: 2e 20 77 29 0a 20 20 20 20 28 22 2d 66 6f 72 63 . w). ("-forc
2680: 65 22 20 20 20 20 20 20 20 20 20 20 20 2e 20 46 e" . F
2690: 29 0a 20 20 20 20 28 22 2d 6c 69 73 74 2d 70 6b ). ("-list-pk
26a0: 74 2d 6b 65 79 73 22 20 20 20 2e 20 23 66 29 0a t-keys" . #f).
26b0: 20 20 20 20 29 29 0a 0a 3b 3b 20 61 6c 69 73 74 ))..;; alist
26c0: 20 74 6f 20 6d 61 70 20 61 63 74 69 6f 6e 73 20 to map actions
26d0: 74 6f 20 6f 6c 64 20 6d 65 67 61 74 65 73 74 20 to old megatest
26e0: 63 6f 6d 6d 61 6e 64 73 0a 28 64 65 66 69 6e 65 commands.(define
26f0: 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 73 2a 0a 20 *action-keys*.
2700: 20 27 28 28 72 75 6e 20 20 20 20 20 20 20 20 20 '((run
2710: 2e 20 22 2d 72 75 6e 22 29 0a 20 20 20 20 28 72 . "-run"). (r
2720: 65 72 75 6e 2d 63 6c 65 61 6e 20 2e 20 22 2d 72 erun-clean . "-r
2730: 65 72 75 6e 2d 63 6c 65 61 6e 22 29 0a 20 20 20 erun-clean").
2740: 20 28 72 65 72 75 6e 2d 61 6c 6c 20 20 20 2e 20 (rerun-all .
2750: 22 2d 72 65 72 75 6e 2d 61 6c 6c 22 29 0a 20 20 "-rerun-all").
2760: 20 20 28 6b 69 6c 6c 2d 72 75 6e 20 20 20 20 2e (kill-run .
2770: 20 22 2d 6b 69 6c 6c 2d 72 75 6e 73 22 29 0a 20 "-kill-runs").
2780: 20 20 20 28 6b 69 6c 6c 2d 72 65 72 75 6e 20 20 (kill-rerun
2790: 2e 20 22 2d 6b 69 6c 6c 2d 72 65 72 75 6e 22 29 . "-kill-rerun")
27a0: 0a 20 20 20 20 28 6c 6f 63 6b 20 20 20 20 20 20 . (lock
27b0: 20 20 2e 20 22 2d 6c 6f 63 6b 22 29 0a 20 20 20 . "-lock").
27c0: 20 28 75 6e 6c 6f 63 6b 20 20 20 20 20 20 2e 20 (unlock .
27d0: 22 2d 75 6e 6c 6f 63 6b 22 29 0a 20 20 20 20 28 "-unlock"). (
27e0: 73 79 6e 63 20 20 20 20 20 20 20 20 2e 20 22 22 sync . ""
27f0: 29 0a 20 20 20 20 28 61 72 63 68 69 76 65 20 20 ). (archive
2800: 20 20 20 2e 20 22 22 29 0a 20 20 20 20 28 73 65 . ""). (se
2810: 74 2d 73 73 20 20 20 20 20 20 2e 20 22 2d 73 65 t-ss . "-se
2820: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 22 29 t-state-status")
2830: 0a 20 20 20 20 28 72 65 6d 6f 76 65 20 20 20 20 . (remove
2840: 20 20 2e 20 22 2d 72 65 6d 6f 76 65 2d 72 75 6e . "-remove-run
2850: 73 22 29 29 29 0a 0a 3b 3b 20 6d 61 6e 75 61 6c s")))..;; manual
2860: 6c 79 20 6b 65 65 70 20 74 68 69 73 20 6c 69 73 ly keep this lis
2870: 74 20 75 70 64 61 74 65 64 20 66 72 6f 6d 20 74 t updated from t
2880: 68 65 20 6b 65 79 73 20 74 6f 0a 3b 3b 20 74 68 he keys to.;; th
2890: 65 20 63 61 73 65 20 2a 61 63 74 69 6f 6e 2a 20 e case *action*
28a0: 6e 65 61 72 20 74 68 65 20 65 6e 64 20 6f 66 20 near the end of
28b0: 74 68 69 73 20 66 69 6c 65 2e 0a 28 64 65 66 69 this file..(defi
28c0: 6e 65 20 2a 6f 74 68 65 72 2d 61 63 74 69 6f 6e ne *other-action
28d0: 73 2a 0a 20 20 27 28 72 75 6e 20 72 65 6d 6f 76 s*. '(run remov
28e0: 65 20 72 65 72 75 6e 20 73 65 74 2d 73 73 20 61 e rerun set-ss a
28f0: 72 63 68 69 76 65 20 6b 69 6c 6c 20 6c 69 73 74 rchive kill list
2900: 0a 09 64 69 73 70 61 74 63 68 20 69 6d 70 6f 72 ..dispatch impor
2910: 74 20 72 75 6e 67 65 6e 20 70 72 6f 63 65 73 73 t rungen process
2920: 0a 09 73 68 6f 77 20 67 65 6e 64 6f 74 20 64 62 ..show gendot db
2930: 20 74 73 65 6e 64 20 74 6c 69 73 74 65 6e 29 29 tsend tlisten))
2940: 0a 0a 3b 3b 20 43 61 72 64 20 74 79 70 65 73 3a ..;; Card types:
2950: 0a 3b 3b 0a 3b 3b 20 41 20 61 63 74 69 6f 6e 0a .;;.;; A action.
2960: 3b 3b 20 55 20 75 73 65 72 6e 61 6d 65 20 28 55 ;; U username (U
2970: 6e 69 78 29 0a 3b 3b 20 44 20 74 69 6d 65 73 74 nix).;; D timest
2980: 61 6d 70 0a 3b 3b 20 54 20 63 61 72 64 20 74 79 amp.;; T card ty
2990: 70 65 0a 0a 3b 3b 20 61 20 73 75 6d 6d 61 72 79 pe..;; a summary
29a0: 20 6c 69 73 74 20 6f 66 20 75 73 65 64 20 63 61 list of used ca
29b0: 72 64 20 74 79 70 65 73 20 66 6f 72 20 68 65 6c rd types for hel
29c0: 70 69 6e 67 20 74 6f 20 6e 6f 74 20 61 63 63 69 ping to not acci
29d0: 64 65 6e 74 61 6c 6c 79 20 72 65 2d 75 73 65 20 dentally re-use
29e0: 74 68 65 6d 0a 3b 3b 0a 3b 3b 20 41 44 47 49 4d them.;;.;; ADGIM
29f0: 53 54 55 5a 61 62 63 64 65 66 67 68 69 6b 6c 6e STUZabcdefghikln
2a00: 6f 70 72 73 74 75 76 77 78 0a 0a 3b 3b 20 75 74 oprstuvwx..;; ut
2a10: 69 6c 69 74 61 72 69 61 6e 20 61 6c 69 73 74 20 ilitarian alist
2a20: 66 6f 72 20 73 74 61 6e 64 61 72 64 20 63 61 72 for standard car
2a30: 64 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 61 ds.;;.(define *a
2a40: 64 64 69 74 69 6f 6e 61 6c 2d 63 61 72 64 73 2a dditional-cards*
2a50: 0a 20 20 27 28 0a 20 20 20 20 3b 3b 20 53 74 61 . '(. ;; Sta
2a60: 6e 64 61 72 64 20 43 61 72 64 73 0a 20 20 20 20 ndard Cards.
2a70: 28 41 20 20 2e 20 61 63 74 69 6f 6e 20 20 20 20 (A . action
2a80: 29 0a 20 20 20 20 28 44 20 20 2e 20 74 69 6d 65 ). (D . time
2a90: 73 74 61 6d 70 20 29 0a 20 20 20 20 28 54 20 20 stamp ). (T
2aa0: 2e 20 63 61 72 64 74 79 70 65 20 20 29 0a 20 20 . cardtype ).
2ab0: 20 20 28 55 20 20 2e 20 75 73 65 72 20 20 20 20 (U . user
2ac0: 20 20 29 20 3b 3b 20 75 73 65 72 6e 61 6d 65 0a ) ;; username.
2ad0: 20 20 20 20 28 5a 20 20 2e 20 73 68 61 72 31 73 (Z . shar1s
2ae0: 75 6d 20 20 29 0a 0a 20 20 20 20 3b 3b 20 45 78 um ).. ;; Ex
2af0: 74 72 61 73 0a 20 20 20 20 28 61 20 20 2e 20 72 tras. (a . r
2b00: 75 6e 6b 65 79 20 20 20 20 29 20 3b 3b 20 6e 65 unkey ) ;; ne
2b10: 65 64 65 64 20 66 6f 72 20 6d 61 74 63 68 69 6e eded for matchin
2b20: 67 20 75 70 20 70 6b 74 73 20 77 69 74 68 20 74 g up pkts with t
2b30: 61 72 67 65 74 20 64 65 72 69 76 65 64 20 66 72 arget derived fr
2b40: 6f 6d 20 72 75 6e 6b 65 79 0a 20 20 20 20 3b 3b om runkey. ;;
2b50: 20 28 6c 20 20 2e 20 6e 65 77 2d 73 73 20 20 20 (l . new-ss
2b60: 20 29 20 3b 3b 20 6e 65 77 20 73 74 61 74 65 2f ) ;; new state/
2b70: 73 74 61 74 75 73 0a 20 20 20 20 28 62 20 20 2e status. (b .
2b80: 20 62 72 61 6e 63 68 20 20 20 20 29 20 3b 3b 20 branch ) ;;
2b90: 72 65 70 6f 73 69 74 6f 72 79 20 62 72 61 6e 63 repository branc
2ba0: 68 20 6f 72 20 74 61 67 20 28 66 6f 73 73 69 6c h or tag (fossil
2bb0: 20 6f 72 20 67 69 74 29 0a 20 20 20 20 28 66 20 or git). (f
2bc0: 20 2e 20 75 72 6c 20 20 20 20 20 20 20 29 20 3b . url ) ;
2bd0: 3b 20 72 65 70 6f 73 69 74 6f 72 79 20 55 52 4c ; repository URL
2be0: 20 28 65 2e 67 2e 20 66 6f 73 73 69 6c 20 6f 72 (e.g. fossil or
2bf0: 20 67 69 74 29 0a 20 20 20 20 28 67 20 20 2e 20 git). (g .
2c00: 63 6c 6f 6e 65 20 20 20 20 20 29 20 3b 3b 20 65 clone ) ;; e
2c10: 78 69 73 74 69 6e 67 20 63 6c 6f 6e 65 20 61 72 xisting clone ar
2c20: 65 61 20 28 63 61 63 68 65 64 20 69 6e 20 2f 74 ea (cached in /t
2c30: 6d 70 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 69 mp). ))..;; i
2c40: 6e 6c 73 74 20 69 73 20 61 6e 20 61 6c 74 65 72 nlst is an alter
2c50: 6e 61 74 69 76 65 20 69 6e 70 75 74 0a 3b 3b 0a native input.;;.
2c60: 28 64 65 66 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d (define (lookup-
2c70: 70 61 72 61 6d 2d 62 79 2d 6b 65 79 20 6b 65 79 param-by-key key
2c80: 20 23 21 6b 65 79 20 28 69 6e 6c 73 74 20 23 66 #!key (inlst #f
2c90: 29 29 0a 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 )). (fold (lamb
2ca0: 64 61 20 28 61 20 72 65 73 29 0a 09 20 20 28 69 da (a res).. (i
2cb0: 66 20 28 65 71 3f 20 28 63 64 72 20 61 29 20 6b f (eq? (cdr a) k
2cc0: 65 79 29 0a 09 20 20 20 20 20 20 28 63 61 72 20 ey).. (car
2cd0: 61 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a a).. res)).
2ce0: 09 23 66 0a 09 28 6f 72 20 69 6e 6c 73 74 20 2a .#f..(or inlst *
2cf0: 61 72 67 2d 6b 65 79 73 2a 29 29 29 0a 0a 28 64 arg-keys*)))..(d
2d00: 65 66 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d 61 63 efine (lookup-ac
2d10: 74 69 6f 6e 2d 62 79 2d 6b 65 79 20 6b 65 79 29 tion-by-key key)
2d20: 0a 20 20 28 61 6c 69 73 74 2d 72 65 66 20 28 73 . (alist-ref (s
2d30: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6b 65 tring->symbol ke
2d40: 79 29 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 73 2a y) *action-keys*
2d50: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 77 69 ))..(define (swi
2d60: 7a 7a 6c 65 2d 61 6c 69 73 74 20 6c 73 74 29 0a zzle-alist lst).
2d70: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
2d80: 78 29 28 63 6f 6e 73 20 28 63 64 72 20 78 29 28 x)(cons (cdr x)(
2d90: 63 61 72 20 78 29 29 29 20 6c 73 74 29 29 0a 0a car x))) lst))..
2da0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
2db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2de0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 55 20 54 ========.;; U T
2df0: 20 49 20 4c 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d I L S.;;=======
2e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a ===============.
2e40: 0a 3b 3b 20 67 69 76 65 6e 20 61 20 6d 74 75 74 .;; given a mtut
2e50: 69 6c 20 70 61 72 61 6d 2c 20 72 65 74 75 72 6e il param, return
2e60: 20 74 68 65 20 6f 6c 64 20 6d 65 67 61 74 65 73 the old megates
2e70: 74 20 65 71 75 69 76 61 6c 65 6e 74 0a 3b 3b 0a t equivalent.;;.
2e80: 28 64 65 66 69 6e 65 20 28 6d 65 67 61 74 65 73 (define (megates
2e90: 74 2d 70 61 72 61 6d 2d 3e 6d 74 75 74 69 6c 2d t-param->mtutil-
2ea0: 70 61 72 61 6d 20 70 61 72 61 6d 29 0a 20 20 28 param param). (
2eb0: 6c 65 74 2a 20 28 28 6d 61 70 70 69 6e 67 2d 61 let* ((mapping-a
2ec0: 6c 69 73 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 list (common:get
2ed0: 2d 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 20 66 -param-mapping f
2ee0: 6c 61 76 6f 72 3a 20 27 73 77 69 74 63 68 2d 73 lavor: 'switch-s
2ef0: 79 6d 62 6f 6c 29 29 29 0a 20 20 20 20 28 61 6c ymbol))). (al
2f00: 69 73 74 2d 72 65 66 20 28 73 74 72 69 6e 67 2d ist-ref (string-
2f10: 3e 73 79 6d 62 6f 6c 20 70 61 72 61 6d 29 20 6d >symbol param) m
2f20: 61 70 70 69 6e 67 2d 61 6c 69 73 74 20 65 71 3f apping-alist eq?
2f30: 20 70 61 72 61 6d 29 0a 20 20 20 20 70 61 72 61 param). para
2f40: 6d 29 29 0a 0a 28 64 65 66 69 6e 65 20 76 61 6c m))..(define val
2f50: 2d 3e 61 6c 69 73 74 20 63 6f 6d 6d 6f 6e 3a 76 ->alist common:v
2f60: 61 6c 2d 3e 61 6c 69 73 74 29 0a 0a 28 64 65 66 al->alist)..(def
2f70: 69 6e 65 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 ine (push-run-sp
2f80: 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 ec torun contour
2f90: 20 72 75 6e 6b 65 79 20 73 70 65 63 29 0a 20 20 runkey spec).
2fa0: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section
2fb0: 2d 76 61 72 2d 73 65 74 21 20 74 6f 72 75 6e 20 -var-set! torun
2fc0: 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 contour runkey..
2fd0: 09 09 20 20 20 20 28 63 6f 6e 73 20 73 70 65 63 .. (cons spec
2fe0: 0a 09 09 09 09 20 20 28 6f 72 20 28 63 6f 6e 66 ..... (or (conf
2ff0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 6f 72 75 6e igf:lookup torun
3000: 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 29 contour runkey)
3010: 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 29 29 ..... '()))
3020: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 6f 73 ))..(define (fos
3030: 73 69 6c 3a 63 6c 6f 6e 65 2d 6f 72 2d 73 79 6e sil:clone-or-syn
3040: 63 20 75 72 6c 20 6e 61 6d 65 20 64 65 73 74 2d c url name dest-
3050: 64 69 72 29 0a 20 20 28 6c 65 74 20 28 28 74 61 dir). (let ((ta
3060: 72 67 2d 66 69 6c 65 20 28 63 6f 6e 63 20 64 65 rg-file (conc de
3070: 73 74 2d 64 69 72 20 22 2f 22 20 6e 61 6d 65 29 st-dir "/" name)
3080: 29 29 20 3b 3b 20 64 6f 20 6e 6f 74 20 66 6f 72 )) ;; do not for
3090: 63 65 20 75 73 61 67 65 20 6f 66 20 2e 66 6f 73 ce usage of .fos
30a0: 73 69 6c 20 65 78 74 65 6e 73 69 6f 6e 0a 20 20 sil extension.
30b0: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
30c0: 69 6f 6e 73 0a 09 65 78 6e 0a 09 28 70 72 69 6e ions..exn..(prin
30d0: 74 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 t "ERROR: failed
30e0: 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 to create direc
30f0: 74 6f 72 79 20 22 20 64 65 73 74 2d 64 69 72 20 tory " dest-dir
3100: 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 " message: " ((c
3110: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
3120: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
3130: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 'message) exn)).
3140: 20 20 20 20 20 20 28 63 72 65 61 74 65 2d 64 69 (create-di
3150: 72 65 63 74 6f 72 79 20 64 65 73 74 2d 64 69 72 rectory dest-dir
3160: 20 23 74 29 29 0a 20 20 20 20 28 68 61 6e 64 6c #t)). (handl
3170: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 65 78 e-exceptions..ex
3180: 6e 0a 09 28 70 72 69 6e 74 20 22 45 52 52 4f 52 n..(print "ERROR
3190: 3a 20 66 61 69 6c 65 64 20 74 6f 20 63 6c 6f 6e : failed to clon
31a0: 65 20 6f 72 20 73 79 6e 63 20 31 6f 73 73 69 6c e or sync 1ossil
31b0: 20 22 20 75 72 6c 20 22 20 6d 65 73 73 61 67 65 " url " message
31c0: 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d : " ((condition-
31d0: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
31e0: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
31f0: 20 65 78 6e 29 29 0a 20 20 20 20 20 20 28 69 66 exn)). (if
3200: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
3210: 69 73 74 73 3f 20 74 61 72 67 2d 66 69 6c 65 29 ists? targ-file)
3220: 0a 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e .. (system (con
3230: 63 20 22 66 6f 73 73 69 6c 20 70 75 6c 6c 20 2d c "fossil pull -
3240: 2d 6f 6e 63 65 20 22 20 75 72 6c 20 22 20 2d 52 -once " url " -R
3250: 20 22 20 74 61 72 67 2d 66 69 6c 65 29 29 0a 09 " targ-file))..
3260: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
3270: 22 66 6f 73 73 69 6c 20 63 6c 6f 6e 65 20 22 20 "fossil clone "
3280: 75 72 6c 20 22 20 22 20 74 61 72 67 2d 66 69 6c url " " targ-fil
3290: 65 29 29 0a 09 20 20 29 29 29 29 0a 0a 28 64 65 e)).. ))))..(de
32a0: 66 69 6e 65 20 28 66 6f 73 73 69 6c 3a 6c 61 73 fine (fossil:las
32b0: 74 2d 63 68 61 6e 67 65 2d 6e 6f 64 65 2d 61 6e t-change-node-an
32c0: 64 2d 74 69 6d 65 20 66 6f 73 73 69 6c 73 2d 64 d-time fossils-d
32d0: 69 72 20 66 6f 73 73 69 6c 2d 6e 61 6d 65 20 62 ir fossil-name b
32e0: 72 61 6e 63 68 29 0a 20 20 28 6c 65 74 2a 20 28 ranch). (let* (
32f0: 28 66 6f 73 73 69 6c 2d 66 69 6c 65 20 20 20 28 (fossil-file (
3300: 63 6f 6e 63 20 66 6f 73 73 69 6c 73 2d 64 69 72 conc fossils-dir
3310: 20 22 2f 22 20 66 6f 73 73 69 6c 2d 6e 61 6d 65 "/" fossil-name
3320: 29 29 0a 09 20 28 74 69 6d 65 6c 69 6e 65 2d 70 )).. (timeline-p
3330: 6f 72 74 20 28 69 66 20 28 66 69 6c 65 2d 72 65 ort (if (file-re
3340: 61 64 2d 61 63 63 65 73 73 3f 20 66 6f 73 73 69 ad-access? fossi
3350: 6c 2d 66 69 6c 65 29 0a 09 09 09 20 20 20 20 28 l-file).... (
3360: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
3370: 73 0a 09 09 09 09 65 78 6e 0a 09 09 09 09 28 62 s.....exn.....(b
3380: 65 67 69 6e 0a 09 09 09 09 20 20 28 70 72 69 6e egin..... (prin
3390: 74 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 t "ERROR: failed
33a0: 20 74 6f 20 67 65 74 20 74 69 6d 65 6c 69 6e 65 to get timeline
33b0: 20 66 72 6f 6d 20 22 20 66 6f 73 73 69 6c 2d 66 from " fossil-f
33c0: 69 6c 65 20 22 20 6d 65 73 73 61 67 65 3a 20 22 ile " message: "
33d0: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
33e0: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
33f0: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
3400: 6e 29 29 0a 09 09 09 09 20 20 23 66 29 0a 09 09 n))..... #f)...
3410: 09 20 20 20 20 20 20 28 6f 70 65 6e 2d 69 6e 70 . (open-inp
3420: 75 74 2d 70 69 70 65 20 28 63 6f 6e 63 20 22 66 ut-pipe (conc "f
3430: 6f 73 73 69 6c 20 74 69 6d 65 6c 69 6e 65 20 2d ossil timeline -
3440: 74 20 63 69 20 2d 57 20 30 20 2d 6e 20 30 20 2d t ci -W 0 -n 0 -
3450: 52 20 22 20 66 6f 73 73 69 6c 2d 66 69 6c 65 29 R " fossil-file)
3460: 29 29 0a 09 09 09 20 20 20 20 23 66 29 29 0a 09 )).... #f))..
3470: 20 28 67 65 74 2d 6c 69 6e 65 20 20 20 20 20 20 (get-line
3480: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 (lambda ()....
3490: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
34a0: 6e 73 0a 09 09 09 20 20 20 20 20 20 65 78 6e 0a ns.... exn.
34b0: 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ... (begin.
34c0: 09 09 09 09 28 70 72 69 6e 74 20 22 45 52 52 4f ....(print "ERRO
34d0: 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 72 65 61 R: failed to rea
34e0: 64 20 66 72 6f 6d 20 66 69 6c 65 20 22 20 66 6f d from file " fo
34f0: 73 73 69 6c 2d 66 69 6c 65 20 22 20 6d 65 73 73 ssil-file " mess
3500: 61 67 65 3a 20 22 20 20 28 28 63 6f 6e 64 69 74 age: " ((condit
3510: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
3520: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
3530: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 09 23 age) exn)).....#
3540: 66 29 0a 09 09 09 20 20 20 20 28 72 65 61 64 2d f).... (read-
3550: 6c 69 6e 65 20 74 69 6d 65 6c 69 6e 65 2d 70 6f line timeline-po
3560: 72 74 29 29 29 29 0a 09 20 28 64 61 74 65 2d 72 rt)))).. (date-r
3570: 78 20 20 20 20 20 20 20 28 72 65 67 65 78 70 20 x (regexp
3580: 22 5e 3d 3d 3d 20 28 5c 5c 53 2b 29 20 3d 3d 3d "^=== (\\S+) ===
3590: 24 22 29 29 0a 09 20 28 6e 6f 64 65 2d 72 78 20 $")).. (node-rx
35a0: 20 20 20 20 20 20 28 72 65 67 65 78 70 20 22 5e (regexp "^
35b0: 28 5c 5c 53 2b 29 20 5c 5c 5b 28 5c 5c 53 2b 29 (\\S+) \\[(\\S+)
35c0: 5c 5c 5d 2e 2a 5c 5c 28 2e 2a 74 61 67 73 3a 5c \\].*\\(.*tags:\
35d0: 5c 73 2b 28 5b 5e 5c 5c 29 5d 2b 29 5c 5c 29 24 \s+([^\\)]+)\\)$
35e0: 22 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f "))). (let lo
35f0: 6f 70 20 28 28 69 6e 6c 20 28 67 65 74 2d 6c 69 op ((inl (get-li
3600: 6e 65 29 29 0a 09 20 20 20 20 20 20 20 28 64 61 ne)).. (da
3610: 74 65 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 te #f).. (
3620: 6e 6f 64 65 20 23 66 29 0a 09 20 20 20 20 20 20 node #f)..
3630: 20 28 74 69 6d 65 20 23 66 29 29 0a 20 20 20 20 (time #f)).
3640: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 (cond. (
3650: 28 61 6e 64 20 64 61 74 65 20 74 69 6d 65 20 6e (and date time n
3660: 6f 64 65 29 20 3b 3b 20 68 61 76 65 20 61 6c 6c ode) ;; have all
3670: 2c 20 72 65 74 75 72 6e 20 27 65 6d 0a 09 28 63 , return 'em..(c
3680: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
3690: 74 69 6d 65 6c 69 6e 65 2d 70 6f 72 74 29 0a 09 timeline-port)..
36a0: 28 76 61 6c 75 65 73 20 28 63 6f 6d 6d 6f 6e 3a (values (common:
36b0: 64 61 74 65 2d 74 69 6d 65 2d 3e 73 65 63 6f 6e date-time->secon
36c0: 64 73 20 28 63 6f 6e 63 20 64 61 74 65 20 22 20 ds (conc date "
36d0: 22 20 74 69 6d 65 29 29 20 6e 6f 64 65 29 29 0a " time)) node)).
36e0: 20 20 20 20 20 20 20 28 28 61 6e 64 20 69 6e 6c ((and inl
36f0: 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 (not (eof-objec
3700: 74 3f 20 69 6e 6c 29 29 29 20 3b 3b 20 68 61 76 t? inl))) ;; hav
3710: 65 20 61 20 6c 69 6e 65 20 74 6f 20 70 72 6f 63 e a line to proc
3720: 65 73 73 0a 09 28 72 65 67 65 78 2d 63 61 73 65 ess..(regex-case
3730: 20 69 6e 6c 0a 09 20 20 28 64 61 74 65 2d 72 78 inl.. (date-rx
3740: 20 28 20 5f 20 6e 65 77 64 61 74 65 20 29 20 28 ( _ newdate ) (
3750: 6c 6f 6f 70 20 28 67 65 74 2d 6c 69 6e 65 29 20 loop (get-line)
3760: 6e 65 77 64 61 74 65 20 6e 6f 64 65 20 74 69 6d newdate node tim
3770: 65 29 29 0a 09 20 20 3b 3b 20 32 32 3a 34 37 3a e)).. ;; 22:47:
3780: 34 38 20 5b 61 30 32 34 64 39 65 36 30 66 5d 20 48 [a024d9e60f]
3790: 41 64 64 65 64 20 2a 75 73 65 72 2d 68 61 73 68 Added *user-hash
37a0: 2d 64 61 74 61 2a 20 2d 20 61 20 67 6c 6f 62 61 -data* - a globa
37b0: 6c 20 74 68 61 74 20 63 61 6e 20 62 65 20 75 73 l that can be us
37c0: 65 64 20 69 6e 20 2d 72 65 70 6c 20 61 6e 64 20 ed in -repl and
37d0: 23 7b 73 63 68 65 6d 65 20 2e 2e 2e 7d 20 63 61 #{scheme ...} ca
37e0: 6c 6c 73 20 62 79 20 74 68 65 20 65 6e 64 20 75 lls by the end u
37f0: 73 65 72 20 28 75 73 65 72 3a 20 6d 61 74 74 20 ser (user: matt
3800: 74 61 67 73 3a 20 76 31 2e 36 33 29 0a 09 20 20 tags: v1.63)..
3810: 28 6e 6f 64 65 2d 72 78 20 28 20 5f 20 6e 65 77 (node-rx ( _ new
3820: 74 69 6d 65 20 6e 65 77 6e 6f 64 65 20 61 6c 6c time newnode all
3830: 74 61 67 73 20 29 0a 09 09 20 20 20 28 6c 65 74 tags )... (let
3840: 20 28 28 74 61 67 73 20 28 73 74 72 69 6e 67 2d ((tags (string-
3850: 73 70 6c 69 74 2d 66 69 65 6c 64 73 20 22 2c 5c split-fields ",\
3860: 5c 73 2a 22 20 61 6c 6c 74 61 67 73 20 23 3a 69 \s*" alltags #:i
3870: 6e 66 69 78 29 29 29 0a 09 09 20 20 20 20 20 28 nfix)))... (
3880: 70 72 69 6e 74 20 22 74 61 67 73 3a 20 22 20 74 print "tags: " t
3890: 61 67 73 29 0a 09 09 20 20 20 20 20 28 69 66 20 ags)... (if
38a0: 28 6d 65 6d 62 65 72 20 62 72 61 6e 63 68 20 74 (member branch t
38b0: 61 67 73 29 0a 09 09 09 20 28 6c 6f 6f 70 20 28 ags).... (loop (
38c0: 67 65 74 2d 6c 69 6e 65 29 20 64 61 74 65 20 6e get-line) date n
38d0: 65 77 6e 6f 64 65 20 6e 65 77 74 69 6d 65 29 0a ewnode newtime).
38e0: 09 09 09 20 28 6c 6f 6f 70 20 28 67 65 74 2d 6c ... (loop (get-l
38f0: 69 6e 65 29 20 64 61 74 65 20 6e 6f 64 65 20 74 ine) date node t
3900: 69 6d 65 29 29 29 29 0a 09 20 20 28 65 6c 73 65 ime)))).. (else
3910: 20 3b 3b 20 68 61 76 65 20 73 6f 6d 65 20 75 6e ;; have some un
3920: 72 65 63 6f 67 6e 69 73 65 64 20 6a 75 6e 6b 3f recognised junk?
3930: 20 73 70 69 74 20 6f 75 74 20 65 72 72 6f 72 20 spit out error
3940: 6d 65 73 73 61 67 65 0a 09 20 20 20 28 70 72 69 message.. (pri
3950: 6e 74 20 22 45 52 52 4f 52 3a 20 66 6f 73 73 69 nt "ERROR: fossi
3960: 6c 20 74 69 6d 65 6c 69 6e 65 20 72 65 74 75 72 l timeline retur
3970: 6e 65 64 20 75 6e 72 65 63 6f 67 6e 69 73 61 62 ned unrecognisab
3980: 6c 65 20 6a 75 6e 6b 20 5c 22 22 20 69 6e 6c 20 le junk \"" inl
3990: 22 5c 22 22 29 0a 09 20 20 20 28 6c 6f 6f 70 20 "\"").. (loop
39a0: 28 67 65 74 2d 6c 69 6e 65 29 20 64 61 74 65 20 (get-line) date
39b0: 6e 6f 64 65 20 74 69 6d 65 29 29 29 29 0a 20 20 node time)))).
39c0: 20 20 20 20 20 28 65 6c 73 65 20 3b 3b 20 6e 6f (else ;; no
39d0: 20 6d 6f 72 65 20 64 61 74 61 74 20 61 6e 64 20 more datat and
39e0: 6c 61 73 74 20 6e 6f 64 65 20 6f 6e 20 62 72 61 last node on bra
39f0: 6e 63 68 20 6e 6f 74 20 66 6f 75 6e 64 0a 09 28 nch not found..(
3a00: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
3a10: 20 74 69 6d 65 6c 69 6e 65 2d 70 6f 72 74 29 0a timeline-port).
3a20: 09 28 76 61 6c 75 65 73 20 20 28 63 6f 6d 6d 6f .(values (commo
3a30: 6e 3a 64 61 74 65 2d 74 69 6d 65 2d 3e 73 65 63 n:date-time->sec
3a40: 6f 6e 64 73 20 28 63 6f 6e 63 20 64 61 74 65 20 onds (conc date
3a50: 22 20 22 20 74 69 6d 65 29 29 20 6e 6f 64 65 29 " " time)) node)
3a60: 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d )))))..;;=======
3a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3ab0: 3b 3b 20 47 4c 4f 42 41 4c 53 0a 3b 3b 3d 3d 3d ;; GLOBALS.;;===
3ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 3b 3b 20 66 69 72 73 74 20 74 6f ===..;; first to
3b10: 6b 65 6e 20 69 73 20 6f 75 72 20 61 63 74 69 6f ken is our actio
3b20: 6e 2c 20 62 75 74 20 6f 6e 6c 79 20 69 66 20 6e n, but only if n
3b30: 6f 20 6c 65 61 64 69 6e 67 20 64 61 73 68 0a 28 o leading dash.(
3b40: 64 65 66 69 6e 65 20 2a 61 63 74 69 6f 6e 2a 20 define *action*
3b50: 28 69 66 20 28 61 6e 64 20 28 3e 20 28 6c 65 6e (if (and (> (len
3b60: 67 74 68 20 28 61 72 67 76 29 29 20 31 29 0a 20 gth (argv)) 1).
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 73 (not (s
3b90: 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 5c 5c tring-match "^\\
3ba0: 2d 2e 2a 22 20 28 63 61 64 72 20 28 61 72 67 76 -.*" (cadr (argv
3bb0: 29 29 29 29 29 0a 09 09 20 20 20 20 20 28 63 61 )))))... (ca
3bc0: 64 72 20 28 61 72 67 76 29 29 0a 09 09 20 20 20 dr (argv))...
3bd0: 20 20 23 66 29 29 0a 0a 3b 3b 20 70 72 6f 63 65 #f))..;; proce
3be0: 73 73 20 61 72 67 75 6d 65 6e 74 73 2c 20 65 78 ss arguments, ex
3bf0: 74 72 61 63 74 20 73 77 69 74 63 68 65 73 20 61 tract switches a
3c00: 6e 64 20 70 61 72 61 6d 65 74 65 72 73 20 66 69 nd parameters fi
3c10: 72 73 74 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 rst.(define rema
3c20: 72 67 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 rgs (args:get-ar
3c30: 67 73 20 0a 09 09 20 28 69 66 20 2a 61 63 74 69 gs ... (if *acti
3c40: 6f 6e 2a 20 28 63 64 72 20 28 61 72 67 76 29 29 on* (cdr (argv))
3c50: 20 28 61 72 67 76 29 29 20 3b 3b 20 61 72 67 73 (argv)) ;; args
3c60: 3a 67 65 74 2d 61 72 67 73 20 64 75 6d 70 73 20 :get-args dumps
3c70: 66 69 72 73 74 20 69 6e 20 61 72 67 76 20 6c 69 first in argv li
3c80: 73 74 20 28 74 68 65 20 70 72 6f 67 72 61 6d 20 st (the program
3c90: 6e 61 6d 65 29 0a 09 09 20 28 6d 61 70 20 63 61 name)... (map ca
3ca0: 72 20 2a 61 72 67 2d 6b 65 79 73 2a 29 0a 09 09 r *arg-keys*)...
3cb0: 20 28 6d 61 70 20 63 61 72 20 2a 73 77 69 74 63 (map car *switc
3cc0: 68 2d 6b 65 79 73 2a 29 0a 09 09 20 61 72 67 73 h-keys*)... args
3cd0: 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 :arg-hash... 0))
3ce0: 0a 0a 3b 3b 20 68 61 6e 64 6c 65 20 72 65 71 75 ..;; handle requ
3cf0: 65 73 74 73 20 66 6f 72 20 68 65 6c 70 0a 3b 3b ests for help.;;
3d00: 0a 28 69 66 20 28 6f 72 20 28 6d 65 6d 62 65 72 .(if (or (member
3d10: 20 2a 61 63 74 69 6f 6e 2a 20 27 28 22 2d 68 22 *action* '("-h"
3d20: 20 22 2d 68 65 6c 70 22 20 22 68 65 6c 70 22 20 "-help" "help"
3d30: 22 2d 2d 68 65 6c 70 22 29 29 0a 09 28 61 72 67 "--help"))..(arg
3d40: 73 3a 61 6e 79 2d 64 65 66 69 6e 65 64 3f 20 22 s:any-defined? "
3d50: 2d 68 22 20 22 2d 68 65 6c 70 22 20 22 2d 2d 68 -h" "-help" "--h
3d60: 65 6c 70 22 29 29 0a 20 20 20 20 28 62 65 67 69 elp")). (begi
3d70: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 n. (print h
3d80: 65 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 elp). (exit
3d90: 20 31 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 1)))..(define (
3da0: 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 79 73 20 69 print-pkt-keys i
3db0: 6e 6c 73 74 29 0a 20 20 28 66 6f 72 2d 65 61 63 nlst). (for-eac
3dc0: 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 70 29 h. (lambda (p)
3dd0: 0a 20 20 20 20 20 28 6c 65 74 20 28 28 73 77 20 . (let ((sw
3de0: 28 63 61 72 20 70 29 29 0a 20 20 20 20 20 20 20 (car p)).
3df0: 20 20 20 20 28 63 20 20 28 63 64 72 20 70 29 29 (c (cdr p))
3e00: 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 ). (print
3e10: 28 6f 72 20 63 20 22 6e 2f 61 22 29 20 22 5c 74 (or c "n/a") "\t
3e20: 22 20 73 77 29 29 29 0a 20 20 20 69 6e 6c 73 74 " sw))). inlst
3e30: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 72 69 ))..(define (pri
3e40: 6e 74 2d 64 75 70 6c 69 63 61 74 65 2d 6b 65 79 nt-duplicate-key
3e50: 73 20 2e 20 61 6c 6c 29 0a 20 20 28 6c 65 74 20 s . all). (let
3e60: 28 28 63 61 72 64 2d 68 61 73 68 20 28 6d 61 6b ((card-hash (mak
3e70: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
3e80: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
3e90: 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 73 74 29 (lambda (lst)
3ea0: 0a 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 . (for-eac
3eb0: 68 0a 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 h. (lambd
3ec0: 61 20 28 63 61 72 64 2d 73 70 65 63 29 0a 20 20 a (card-spec).
3ed0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6b (let ((k
3ee0: 20 28 63 64 72 20 63 61 72 64 2d 73 70 65 63 29 (cdr card-spec)
3ef0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b )). ;
3f00: 3b 20 28 70 72 69 6e 74 20 22 63 61 72 64 2d 73 ; (print "card-s
3f10: 70 65 63 3a 20 22 20 63 61 72 64 2d 73 70 65 63 pec: " card-spec
3f20: 20 22 2c 20 6b 3a 20 22 20 6b 29 0a 20 20 20 20 ", k: " k).
3f30: 20 20 20 20 20 20 20 20 28 69 66 20 6b 20 28 68 (if k (h
3f40: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 ash-table-set! c
3f50: 61 72 64 2d 68 61 73 68 20 6b 20 28 2b 20 28 68 ard-hash k (+ (h
3f60: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
3f70: 66 61 75 6c 74 20 63 61 72 64 2d 68 61 73 68 20 fault card-hash
3f80: 6b 20 30 29 20 31 29 29 29 29 29 0a 20 20 20 20 k 0) 1))))).
3f90: 20 20 20 20 6c 73 74 29 29 0a 20 20 20 20 20 61 lst)). a
3fa0: 6c 6c 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ll). (for-eac
3fb0: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
3fc0: 6b 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 3e k). (if (>
3fd0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
3fe0: 20 63 61 72 64 2d 68 61 73 68 20 6b 29 20 31 29 card-hash k) 1)
3ff0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 . (pri
4000: 6e 74 20 6b 20 22 5c 74 22 20 28 68 61 73 68 2d nt k "\t" (hash-
4010: 74 61 62 6c 65 2d 72 65 66 20 63 61 72 64 2d 68 table-ref card-h
4020: 61 73 68 20 6b 29 29 29 29 0a 20 20 20 20 20 28 ash k)))). (
4030: 73 6f 72 74 20 28 68 61 73 68 2d 74 61 62 6c 65 sort (hash-table
4040: 2d 6b 65 79 73 20 63 61 72 64 2d 68 61 73 68 29 -keys card-hash)
4050: 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3e (lambda (a b)(>
4060: 3d 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 = (hash-table-re
4070: 66 20 63 61 72 64 2d 68 61 73 68 20 61 29 28 68 f card-hash a)(h
4080: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 61 ash-table-ref ca
4090: 72 64 2d 68 61 73 68 20 62 29 29 29 29 29 0a 20 rd-hash b))))).
40a0: 20 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))..(define (
40b0: 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 79 2d 69 6e print-pkt-key-in
40c0: 66 6f 29 0a 20 20 28 70 72 69 6e 74 20 22 41 72 fo). (print "Ar
40d0: 67 75 6d 65 6e 74 20 6b 65 79 73 22 29 0a 20 20 gument keys").
40e0: 28 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 79 73 20 (print-pkt-keys
40f0: 2a 61 72 67 2d 6b 65 79 73 2a 29 0a 20 20 28 70 *arg-keys*). (p
4100: 72 69 6e 74 20 22 5c 6e 53 77 69 74 63 68 20 6b rint "\nSwitch k
4110: 65 79 73 22 29 0a 20 20 28 70 72 69 6e 74 2d 70 eys"). (print-p
4120: 6b 74 2d 6b 65 79 73 20 2a 73 77 69 74 63 68 2d kt-keys *switch-
4130: 6b 65 79 73 2a 29 0a 20 20 28 70 72 69 6e 74 20 keys*). (print
4140: 22 5c 6e 41 63 74 69 6f 6e 20 6b 65 79 73 22 29 "\nAction keys")
4150: 0a 20 20 28 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 . (print-pkt-ke
4160: 79 73 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 73 2a ys *action-keys*
4170: 29 0a 20 20 28 70 72 69 6e 74 20 22 5c 6e 41 64 ). (print "\nAd
4180: 64 69 74 69 6f 6e 61 6c 20 63 61 72 64 73 22 29 ditional cards")
4190: 0a 20 20 28 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 . (print-pkt-ke
41a0: 79 73 20 28 73 77 69 7a 7a 6c 65 2d 61 6c 69 73 ys (swizzle-alis
41b0: 74 20 2a 61 64 64 69 74 69 6f 6e 61 6c 2d 63 61 t *additional-ca
41c0: 72 64 73 2a 29 29 0a 20 20 28 70 72 69 6e 74 20 rds*)). (print
41d0: 22 5c 6e 44 75 70 6c 69 63 61 74 65 20 6b 65 79 "\nDuplicate key
41e0: 73 22 29 0a 20 20 28 70 72 69 6e 74 2d 64 75 70 s"). (print-dup
41f0: 6c 69 63 61 74 65 2d 6b 65 79 73 20 2a 61 72 67 licate-keys *arg
4200: 2d 6b 65 79 73 2a 20 2a 73 77 69 74 63 68 2d 6b -keys* *switch-k
4210: 65 79 73 2a 20 2a 61 63 74 69 6f 6e 2d 6b 65 79 eys* *action-key
4220: 73 2a 20 28 73 77 69 7a 7a 6c 65 2d 61 6c 69 73 s* (swizzle-alis
4230: 74 20 2a 61 64 64 69 74 69 6f 6e 61 6c 2d 63 61 t *additional-ca
4240: 72 64 73 2a 29 29 0a 20 20 28 70 72 69 6e 74 20 rds*)). (print
4250: 22 5c 6e 45 6e 64 20 6f 66 20 72 65 70 6f 72 74 "\nEnd of report
4260: 2e 22 29 0a 20 20 29 0a 0a 3b 3b 20 6c 69 73 74 ."). )..;; list
4270: 20 70 61 63 6b 65 74 20 6b 65 79 73 0a 3b 3b 0a packet keys.;;.
4280: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
4290: 67 20 22 2d 6c 69 73 74 2d 70 6b 74 2d 6b 65 79 g "-list-pkt-key
42a0: 73 22 29 0a 20 20 20 20 28 62 65 67 69 6e 20 28 s"). (begin (
42b0: 70 72 69 6e 74 2d 70 6b 74 2d 6b 65 79 2d 69 6e print-pkt-key-in
42c0: 66 6f 29 28 65 78 69 74 20 30 29 29 29 0a 0a 3b fo)(exit 0)))..;
42d0: 3b 20 28 70 72 69 6e 74 20 22 2a 61 63 74 69 6f ; (print "*actio
42e0: 6e 2a 3a 20 22 20 2a 61 63 74 69 6f 6e 2a 29 0a n*: " *action*).
42f0: 0a 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 .;; (let-values
4300: 28 28 28 75 75 69 64 20 70 6b 74 29 0a 3b 3b 20 (((uuid pkt).;;
4310: 09 20 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 2d . (command-
4320: 6c 69 6e 65 2d 3e 70 6b 74 20 23 66 20 61 72 67 line->pkt #f arg
4330: 73 3a 61 72 67 2d 68 61 73 68 29 29 29 0a 3b 3b s:arg-hash))).;;
4340: 20 20 20 28 70 72 69 6e 74 20 70 6b 74 29 29 0a (print pkt)).
4350: 0a 3b 3b 20 41 64 64 20 61 72 67 73 20 74 68 61 .;; Add args tha
4360: 74 20 75 73 65 20 72 65 6d 61 72 67 73 20 68 65 t use remargs he
4370: 72 65 0a 3b 3b 0a 28 69 66 20 28 61 6e 64 20 28 re.;;.(if (and (
4380: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 not (null? remar
4390: 67 73 29 29 0a 09 20 28 6e 6f 74 20 28 6f 72 0a gs)).. (not (or.
43a0: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
43b0: 74 2d 61 72 67 20 22 2d 72 75 6e 73 74 65 70 22 t-arg "-runstep"
43c0: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
43d0: 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 63 61 70 get-arg "-envcap
43e0: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
43f0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 6e 76 64 65 :get-arg "-envde
4400: 6c 74 61 22 29 0a 09 20 20 20 20 20 20 20 28 6d lta").. (m
4410: 65 6d 62 65 72 20 2a 61 63 74 69 6f 6e 2a 20 27 ember *action* '
4420: 28 22 64 62 22 20 22 74 73 65 6e 64 22 20 22 74 ("db" "tsend" "t
4430: 6c 69 73 74 65 6e 22 29 29 20 20 20 3b 3b 20 76 listen")) ;; v
4440: 65 72 79 20 6c 6f 6f 73 65 20 63 68 65 63 6b 73 ery loose checks
4450: 20 6f 6e 20 64 62 20 61 6e 64 20 74 73 65 6e 64 on db and tsend
4460: 2f 6c 69 73 74 65 6e 0a 09 20 20 20 20 20 20 20 /listen..
4470: 28 65 71 75 61 6c 3f 20 2a 61 63 74 69 6f 6e 2a (equal? *action*
4480: 20 22 73 68 6f 77 22 29 20 20 20 20 3b 3b 20 6a "show") ;; j
4490: 75 73 74 20 6b 65 65 70 20 67 6f 69 6e 67 20 69 ust keep going i
44a0: 66 20 6c 69 73 74 0a 09 20 20 20 20 20 20 20 29 f list.. )
44b0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
44c0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
44d0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
44e0: 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 61 72 67 Unrecognised arg
44f0: 75 6d 65 6e 74 73 3a 20 22 20 28 73 74 72 69 6e uments: " (strin
4500: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 69 g-intersperse (i
4510: 66 20 28 6c 69 73 74 3f 20 72 65 6d 61 72 67 73 f (list? remargs
4520: 29 20 72 65 6d 61 72 67 73 20 28 61 72 67 76 29 ) remargs (argv)
4530: 29 20 20 22 20 22 29 29 29 0a 0a 28 69 66 20 28 ) " ")))..(if (
4540: 6f 72 20 28 61 72 67 73 3a 61 6e 79 3f 20 22 2d or (args:any? "-
4550: 68 22 20 22 68 65 6c 70 22 20 22 2d 68 65 6c 70 h" "help" "-help
4560: 22 20 22 2d 2d 68 65 6c 70 22 29 0a 09 28 6d 65 " "--help")..(me
4570: 6d 62 65 72 20 2a 61 63 74 69 6f 6e 2a 20 27 28 mber *action* '(
4580: 22 2d 68 22 20 22 2d 68 65 6c 70 22 20 22 2d 2d "-h" "-help" "--
4590: 68 65 6c 70 22 20 22 68 65 6c 70 22 29 29 29 0a help" "help"))).
45a0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
45b0: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
45c0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 0a (exit 1)))..
45d0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
45e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
45f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4610: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 61 6e 6f ========.;; Nano
4620: 6d 73 67 20 74 72 61 6e 73 70 6f 72 74 0a 3b 3b msg transport.;;
4630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 66 69 6e 65 2d ======..(define-
4680: 69 6e 6c 69 6e 65 20 28 65 6e 63 6f 64 65 20 64 inline (encode d
4690: 61 74 61 29 0a 20 20 28 77 69 74 68 2d 6f 75 74 ata). (with-out
46a0: 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 20 20 put-to-string.
46b0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
46c0: 20 20 20 28 77 72 69 74 65 20 64 61 74 61 29 29 (write data))
46d0: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 ))..(define-inli
46e0: 6e 65 20 28 64 65 63 6f 64 65 20 64 61 74 61 29 ne (decode data)
46f0: 0a 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 . (with-input-f
4700: 72 6f 6d 2d 73 74 72 69 6e 67 0a 20 20 20 20 20 rom-string.
4710: 20 64 61 74 61 0a 20 20 20 20 28 6c 61 6d 62 64 data. (lambd
4720: 61 20 28 29 0a 20 20 20 20 20 20 28 72 65 61 64 a (). (read
4730: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 ))))..(define (i
4740: 73 2d 70 6f 72 74 2d 69 6e 2d 75 73 65 20 70 6f s-port-in-use po
4750: 72 74 2d 6e 75 6d 29 0a 20 28 6c 65 74 2a 20 28 rt-num). (let* (
4760: 28 72 65 74 20 23 66 29 29 0a 20 20 20 20 20 28 (ret #f)). (
4770: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 69 6e let-values (((in
4780: 70 20 6f 75 70 20 70 69 64 29 0a 20 20 20 20 20 p oup pid).
4790: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 (proc
47a0: 65 73 73 20 22 6e 65 74 73 74 61 74 22 20 28 6c ess "netstat" (l
47b0: 69 73 74 20 20 22 2d 74 75 6c 70 6e 22 20 29 29 ist "-tulpn" ))
47c0: 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f )). (let lo
47d0: 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c op ((inl (read-l
47e0: 69 6e 65 20 69 6e 70 29 29 29 0a 20 20 20 20 20 ine inp))).
47f0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 (if (not (eof
4800: 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 29 0a 20 -object? inl)).
4810: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
4820: 6e 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n .
4830: 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 73 (if (string-s
4840: 65 61 72 63 68 20 28 72 65 67 65 78 70 20 28 63 earch (regexp (c
4850: 6f 6e 63 20 22 3a 22 20 70 6f 72 74 2d 6e 75 6d onc ":" port-num
4860: 29 29 20 69 6e 6c 29 0a 20 20 20 20 20 20 20 20 )) inl).
4870: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
4880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4890: 20 3b 28 70 72 69 6e 74 20 22 4f 75 74 70 75 74 ;(print "Output
48a0: 3a 20 22 20 20 69 6e 6c 29 0a 20 20 20 20 20 20 : " inl).
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
48c0: 21 20 72 65 74 20 20 23 74 29 29 0a 20 20 20 20 ! ret #t)).
48d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
48e0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in
48f0: 70 29 29 29 29 29 29 29 0a 72 65 74 29 29 0a 0a p))))))).ret))..
4900: 3b 3b 73 74 61 72 74 20 61 20 73 65 72 76 65 72 ;;start a server
4910: 2c 20 72 65 74 75 72 6e 73 20 74 68 65 20 63 6f , returns the co
4920: 6e 6e 65 63 74 69 6f 6e 0a 3b 3b 0a 28 64 65 66 nnection.;;.(def
4930: 69 6e 65 20 28 73 74 61 72 74 2d 6e 6e 2d 73 65 ine (start-nn-se
4940: 72 76 65 72 20 70 6f 72 74 6e 75 6d 20 29 0a 20 rver portnum ).
4950: 20 28 6c 65 74 20 28 28 72 65 70 20 28 6e 6e 2d (let ((rep (nn-
4960: 73 6f 63 6b 65 74 20 27 72 65 70 29 29 29 0a 20 socket 'rep))).
4970: 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 (handle-excep
4980: 74 69 6f 6e 73 0a 20 20 20 20 20 65 78 6e 0a 20 tions. exn.
4990: 20 20 20 20 28 6c 65 74 20 28 28 65 6d 73 67 20 (let ((emsg
49a0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
49b0: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
49c0: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
49d0: 29 29 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e ))). (prin
49e0: 74 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 t "ERROR: Failed
49f0: 20 74 6f 20 73 74 61 72 74 20 73 65 72 76 65 72 to start server
4a00: 20 5c 22 22 20 65 6d 73 67 20 22 5c 22 22 29 0a \"" emsg "\"").
4a10: 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 (exit 1))
4a20: 0a 20 20 20 20 20 20 0a 20 20 20 20 20 28 6e 6e . . (nn
4a30: 2d 62 69 6e 64 20 72 65 70 20 28 63 6f 6e 63 20 -bind rep (conc
4a40: 22 74 63 70 3a 2f 2f 2a 3a 22 20 70 6f 72 74 6e "tcp://*:" portn
4a50: 75 6d 29 29 29 0a 20 20 20 20 72 65 70 29 29 0a um))). rep)).
4a60: 0a 28 64 65 66 69 6e 65 20 28 63 61 6e 2d 75 73 .(define (can-us
4a70: 65 72 2d 6b 69 6c 6c 2d 6c 69 73 74 6e 65 72 20 er-kill-listner
4a80: 75 73 65 72 2d 69 6e 66 6f 20 61 74 74 72 69 62 user-info attrib
4a90: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f 6e 74 ). (let* ((cont
4aa0: 61 63 74 73 20 28 61 6c 69 73 74 2d 72 65 66 20 acts (alist-ref
4ab0: 27 63 6f 6e 74 61 63 74 20 61 74 74 72 69 62 29 'contact attrib)
4ac0: 29 0a 20 20 20 20 20 20 20 20 20 28 75 73 65 72 ). (user
4ad0: 2d 69 64 20 28 63 61 64 64 64 72 20 28 63 64 72 -id (cadddr (cdr
4ae0: 20 75 73 65 72 2d 69 6e 66 6f 29 29 29 0a 20 20 user-info))).
4af0: 20 20 20 20 20 20 20 28 72 65 74 20 23 66 29 20 (ret #f)
4b00: 20 0a 20 20 20 20 20 20 20 20 20 28 63 6f 6e 74 . (cont
4b10: 61 63 74 2d 6c 69 73 74 20 28 73 74 72 69 6e 67 act-list (string
4b20: 2d 73 70 6c 69 74 20 63 6f 6e 74 61 63 74 73 20 -split contacts
4b30: 22 2c 22 29 29 29 20 0a 20 20 20 20 28 66 6f 72 ","))) . (for
4b40: 2d 65 61 63 68 0a 20 20 20 20 20 20 28 6c 61 6d -each. (lam
4b50: 62 64 61 20 28 61 64 6d 69 6e 29 0a 20 20 20 20 bda (admin).
4b60: 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d (if (string-
4b70: 63 6f 6e 74 61 69 6e 73 20 20 75 73 65 72 2d 69 contains user-i
4b80: 64 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 d (car (string-s
4b90: 70 6c 69 74 20 61 64 6d 69 6e 20 22 40 22 29 29 plit admin "@"))
4ba0: 29 0a 20 20 20 20 20 20 20 20 20 28 73 65 74 21 ). (set!
4bb0: 20 72 65 74 20 23 74 29 29 29 20 20 0a 20 20 20 ret #t))) .
4bc0: 20 63 6f 6e 74 61 63 74 2d 6c 69 73 74 29 0a 20 contact-list).
4bd0: 20 20 72 65 74 29 29 0a 0a 3b 3b 20 6f 70 65 6e ret))..;; open
4be0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 74 6f 20 73 connection to s
4bf0: 65 72 76 65 72 2c 20 73 65 6e 64 20 6d 65 73 73 erver, send mess
4c00: 61 67 65 2c 20 63 6c 6f 73 65 20 63 6f 6e 6e 65 age, close conne
4c10: 63 74 69 6f 6e 0a 3b 3b 0a 28 64 65 66 69 6e 65 ction.;;.(define
4c20: 20 28 6f 70 65 6e 2d 73 65 6e 64 2d 63 6c 6f 73 (open-send-clos
4c30: 65 2d 6e 6e 20 68 6f 73 74 2d 70 6f 72 74 20 6d e-nn host-port m
4c40: 73 67 20 61 74 74 72 69 62 20 23 21 6b 65 79 20 sg attrib #!key
4c50: 28 74 69 6d 65 6f 75 74 20 33 29 20 29 20 3b 3b (timeout 3) ) ;;
4c60: 20 64 65 66 61 75 6c 74 20 74 69 6d 65 6f 75 74 default timeout
4c70: 20 69 73 20 33 20 73 65 63 6f 6e 64 73 0a 20 20 is 3 seconds.
4c80: 28 6c 65 74 20 28 28 72 65 71 20 20 28 6e 6e 2d (let ((req (nn-
4c90: 73 6f 63 6b 65 74 20 27 72 65 71 29 29 0a 20 20 socket 'req)).
4ca0: 20 20 20 20 20 20 28 75 72 69 20 20 28 63 6f 6e (uri (con
4cb0: 63 20 22 74 63 70 3a 2f 2f 22 20 68 6f 73 74 2d c "tcp://" host-
4cc0: 70 6f 72 74 29 29 0a 20 20 20 20 20 20 20 20 28 port)). (
4cd0: 72 65 73 20 20 23 66 29 0a 20 20 20 20 20 20 20 res #f).
4ce0: 20 28 63 6f 6e 74 61 63 74 73 20 28 61 6c 69 73 (contacts (alis
4cf0: 74 2d 72 65 66 20 27 63 6f 6e 74 61 63 74 20 61 t-ref 'contact a
4d00: 74 74 72 69 62 29 29 0a 20 20 20 20 20 20 20 20 ttrib)).
4d10: 28 6d 6f 64 65 20 28 61 6c 69 73 74 2d 72 65 66 (mode (alist-ref
4d20: 20 27 6d 6f 64 65 20 61 74 74 72 69 62 29 29 29 'mode attrib)))
4d30: 20 0a 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 . (handle-ex
4d40: 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 65 78 ceptions. ex
4d50: 6e 0a 20 20 20 20 20 28 6c 65 74 20 28 28 65 6d n. (let ((em
4d60: 73 67 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 sg ((condition-p
4d70: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
4d80: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
4d90: 65 78 6e 29 29 29 0a 20 20 20 20 20 20 20 3b 3b exn))). ;;
4da0: 20 53 65 6e 64 20 6e 6f 74 69 66 69 63 61 74 69 Send notificati
4db0: 6f 6e 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 on .
4dc0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
4dd0: 46 61 69 6c 65 64 20 74 6f 20 63 6f 6e 6e 65 63 Failed to connec
4de0: 74 20 2f 20 73 65 6e 64 20 74 6f 20 22 20 75 72 t / send to " ur
4df0: 69 20 22 20 6d 65 73 73 61 67 65 20 77 61 73 20 i " message was
4e00: 5c 22 22 20 65 6d 73 67 20 22 5c 22 22 20 29 0a \"" emsg "\"" ).
4e10: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 (if (eq
4e20: 75 61 6c 3f 20 6d 6f 64 65 20 22 70 72 6f 64 75 ual? mode "produ
4e30: 63 74 69 6f 6e 22 29 0a 20 20 20 20 20 20 20 20 ction").
4e40: 20 20 20 20 20 28 62 65 67 69 6e 20 0a 20 20 20 (begin .
4e50: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
4e60: 20 22 20 53 65 6e 64 69 6e 67 20 65 6d 61 69 6c " Sending email
4e70: 20 74 6f 20 63 6f 6e 74 61 63 74 73 20 3a 20 22 to contacts : "
4e80: 20 63 6f 6e 74 61 63 74 73 20 29 0a 20 20 20 20 contacts ).
4e90: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
4ea0: 65 6d 61 69 6c 2d 62 6f 64 79 20 28 6d 74 75 74 email-body (mtut
4eb0: 3a 73 74 6d 6c 2d 3e 73 74 72 69 6e 67 20 28 73 :stml->string (s
4ec0: 3a 62 6f 64 79 0a 09 09 09 09 09 09 09 09 09 09 :body...........
4ed0: 28 73 3a 70 20 28 63 6f 6e 63 20 22 57 65 20 63 (s:p (conc "We c
4ee0: 6f 75 6c 64 20 6e 6f 74 20 73 65 6e 64 20 6d 65 ould not send me
4ef0: 73 73 61 67 65 73 20 74 6f 20 74 68 65 20 73 65 ssages to the se
4f00: 72 76 65 72 20 6f 6e 20 22 20 75 72 69 20 22 2e rver on " uri ".
4f10: 22 20 20 22 50 6c 65 61 73 65 20 63 68 65 63 6b " "Please check
4f20: 20 69 66 20 74 68 65 20 6c 69 73 74 6e 65 72 20 if the listner
4f30: 69 73 20 72 75 6e 6e 69 6e 67 2e 20 49 74 20 69 is running. It i
4f40: 73 20 70 6f 73 73 69 62 6c 65 20 74 68 61 74 20 s possible that
4f50: 74 68 65 20 68 6f 73 74 20 69 73 20 6f 76 65 72 the host is over
4f60: 6c 6f 61 64 65 64 20 64 75 65 20 74 6f 20 77 68 loaded due to wh
4f70: 69 63 68 20 69 74 20 6d 61 79 20 74 61 6b 65 20 ich it may take
4f80: 74 6f 6f 20 6c 6f 6e 67 20 74 6f 20 72 65 73 70 too long to resp
4f90: 6f 6e 64 2e 20 5c 6e 20 43 6f 6e 74 61 63 74 20 ond. \n Contact
4fa0: 79 6f 75 72 20 73 79 73 74 65 6d 20 61 64 6d 69 your system admi
4fb0: 6e 73 74 72 61 74 6f 72 20 69 66 20 73 65 72 76 nstrator if serv
4fc0: 65 72 20 6c 6f 61 64 20 69 73 20 68 69 67 68 2e er load is high.
4fd0: 22 20 28 73 3a 62 72 29 22 20 54 68 61 6e 6b 20 " (s:br)" Thank
4fe0: 59 6f 75 20 22 29 20 29 29 29 29 29 0a 20 20 20 You ") ))))).
4ff0: 20 20 20 20 20 20 20 20 20 20 28 73 65 6e 64 6d (sendm
5000: 61 69 6c 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e ail (string-join
5010: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
5020: 6f 6e 74 61 63 74 73 20 22 3b 22 20 29 29 20 28 ontacts ";" )) (
5030: 63 6f 6e 63 20 22 5b 4c 69 73 74 6e 65 72 20 45 conc "[Listner E
5040: 72 72 6f 72 5d 20 46 69 6c 65 64 20 74 6f 20 63 rror] Filed to c
5050: 6f 6e 6e 65 63 74 20 74 6f 20 6c 69 73 74 6e 65 onnect to listne
5060: 72 20 6f 6e 20 22 20 75 72 69 29 20 65 6d 61 69 r on " uri) emai
5070: 6c 2d 62 6f 64 79 20 20 75 73 65 5f 68 74 6d 6c l-body use_html
5080: 3a 20 23 74 29 29 29 0a 20 20 20 20 20 20 20 20 : #t))).
5090: 20 20 20 20 20 28 70 72 69 6e 74 20 22 20 6d 6f (print " mo
50a0: 64 65 20 3a 20 22 20 6d 6f 64 65 20 22 20 4e 6f de : " mode " No
50b0: 74 20 73 65 6e 64 69 6e 67 20 61 6e 79 20 65 6d t sending any em
50c0: 61 69 6c 73 22 20 29 29 0a 20 20 20 20 20 20 20 ails" )).
50d0: 23 66 29 0a 20 20 20 20 20 28 6e 6e 2d 63 6f 6e #f). (nn-con
50e0: 6e 65 63 74 20 72 65 71 20 75 72 69 29 0a 20 20 nect req uri).
50f0: 20 20 20 28 70 72 69 6e 74 20 22 43 6f 6e 6e 65 (print "Conne
5100: 63 74 65 64 20 74 6f 20 74 68 65 20 73 65 72 76 cted to the serv
5110: 65 72 20 22 20 29 0a 20 20 20 20 20 28 6e 6e 2d er " ). (nn-
5120: 73 65 6e 64 20 72 65 71 20 6d 73 67 29 0a 20 20 send req msg).
5130: 20 20 20 28 70 72 69 6e 74 20 22 52 65 71 75 65 (print "Reque
5140: 73 74 20 53 65 6e 74 22 29 20 20 0a 20 20 20 20 st Sent") .
5150: 20 28 6c 65 74 2a 20 28 28 74 68 31 20 20 28 6d (let* ((th1 (m
5160: 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 ake-thread (lamb
5170: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
5180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5190: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 (let ((re
51a0: 73 70 20 28 6e 6e 2d 72 65 63 76 20 72 65 71 29 sp (nn-recv req)
51b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
51c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51d0: 20 20 20 20 20 20 28 6e 6e 2d 63 6c 6f 73 65 20 (nn-close
51e0: 72 65 71 29 0a 20 20 20 20 20 20 20 20 20 20 20 req).
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 (set! re
5210: 73 20 28 69 66 20 28 65 71 75 61 6c 3f 20 72 65 s (if (equal? re
5220: 73 70 20 22 6f 6b 22 29 0a 20 20 20 20 20 20 20 sp "ok").
5230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5250: 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 #t.
5260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
5290: 29 29 29 29 0a 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 22 72 65 63 76 20 74 68 72 65 61 64 "recv thread
52c0: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
52d0: 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 (th2 (make-threa
52e0: 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 d (lambda ().
52f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 68 (th
5310: 72 65 61 64 2d 73 6c 65 65 70 21 20 74 69 6d 65 read-sleep! time
5320: 6f 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 out).
5330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5340: 20 20 20 20 20 28 74 68 72 65 61 64 2d 74 65 72 (thread-ter
5350: 6d 69 6e 61 74 65 21 20 74 68 31 29 29 0a 20 20 minate! th1)).
5360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5370: 20 20 20 20 20 20 20 20 20 20 20 22 74 69 6d 65 "time
5380: 72 20 74 68 72 65 61 64 22 29 29 29 0a 20 20 20 r thread"))).
5390: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
53a0: 74 21 20 74 68 31 29 0a 20 20 20 20 20 20 20 28 t! th1). (
53b0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
53c0: 32 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 2). (threa
53d0: 64 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 20 20 20 d-join! th1).
53e0: 20 20 20 20 72 65 73 29 29 29 29 0a 0a 28 64 65 res))))..(de
53f0: 66 69 6e 65 20 28 6f 70 65 6e 2d 73 65 6e 64 2d fine (open-send-
5400: 72 65 63 65 69 76 65 2d 6e 6e 20 68 6f 73 74 2d receive-nn host-
5410: 70 6f 72 74 20 6d 73 67 20 61 74 74 72 69 62 20 port msg attrib
5420: 23 21 6b 65 79 20 28 74 69 6d 65 6f 75 74 20 33 #!key (timeout 3
5430: 29 20 29 20 3b 3b 20 64 65 66 61 75 6c 74 20 74 ) ) ;; default t
5440: 69 6d 65 6f 75 74 20 69 73 20 33 20 73 65 63 6f imeout is 3 seco
5450: 6e 64 73 0a 20 20 28 6c 65 74 20 28 28 72 65 71 nds. (let ((req
5460: 20 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 27 72 65 (nn-socket 're
5470: 71 29 29 0a 20 20 20 20 20 20 20 20 28 75 72 69 q)). (uri
5480: 20 20 28 63 6f 6e 63 20 22 74 63 70 3a 2f 2f 22 (conc "tcp://"
5490: 20 68 6f 73 74 2d 70 6f 72 74 29 29 0a 20 20 20 host-port)).
54a0: 20 20 20 20 20 28 72 65 73 20 20 23 66 29 0a 20 (res #f).
54b0: 20 20 20 20 20 20 20 28 63 6f 6e 74 61 63 74 73 (contacts
54c0: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 63 6f 6e (alist-ref 'con
54d0: 74 61 63 74 20 61 74 74 72 69 62 29 29 0a 20 20 tact attrib)).
54e0: 20 20 20 20 20 20 28 6d 6f 64 65 20 28 61 6c 69 (mode (ali
54f0: 73 74 2d 72 65 66 20 27 6d 6f 64 65 20 61 74 74 st-ref 'mode att
5500: 72 69 62 29 29 29 20 0a 20 20 20 20 28 68 61 6e rib))) . (han
5510: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
5520: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 28 6c 65 exn. (le
5530: 74 20 28 28 65 6d 73 67 20 28 28 63 6f 6e 64 69 t ((emsg ((condi
5540: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
5550: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
5560: 73 61 67 65 29 20 65 78 6e 29 29 29 0a 20 20 20 sage) exn))).
5570: 20 20 20 20 3b 3b 20 53 65 6e 64 20 6e 6f 74 69 ;; Send noti
5580: 66 69 63 61 74 69 6f 6e 20 20 20 20 20 20 0a 20 fication .
5590: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 (print "ER
55a0: 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 63 ROR: Failed to c
55b0: 6f 6e 6e 65 63 74 20 2f 20 73 65 6e 64 20 74 6f onnect / send to
55c0: 20 22 20 75 72 69 20 22 20 6d 65 73 73 61 67 65 " uri " message
55d0: 20 77 61 73 20 5c 22 22 20 65 6d 73 67 20 22 5c was \"" emsg "\
55e0: 22 22 20 29 0a 20 20 20 20 20 20 20 20 20 28 69 "" ). (i
55f0: 66 20 28 65 71 75 61 6c 3f 20 6d 6f 64 65 20 22 f (equal? mode "
5600: 70 72 6f 64 75 63 74 69 6f 6e 22 29 0a 20 20 20 production").
5610: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
5620: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
5630: 70 72 69 6e 74 20 22 20 53 65 6e 64 69 6e 67 20 print " Sending
5640: 65 6d 61 69 6c 20 74 6f 20 63 6f 6e 74 61 63 74 email to contact
5650: 73 20 3a 20 22 20 63 6f 6e 74 61 63 74 73 20 29 s : " contacts )
5660: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c . (l
5670: 65 74 20 28 28 65 6d 61 69 6c 2d 62 6f 64 79 20 et ((email-body
5680: 28 6d 74 75 74 3a 73 74 6d 6c 2d 3e 73 74 72 69 (mtut:stml->stri
5690: 6e 67 20 28 73 3a 62 6f 64 79 0a 09 09 09 09 09 ng (s:body......
56a0: 09 09 09 09 09 28 73 3a 70 20 28 63 6f 6e 63 20 .....(s:p (conc
56b0: 22 57 65 20 63 6f 75 6c 64 20 6e 6f 74 20 73 65 "We could not se
56c0: 6e 64 20 6d 65 73 73 61 67 65 73 20 74 6f 20 74 nd messages to t
56d0: 68 65 20 73 65 72 76 65 72 20 6f 6e 20 22 20 75 he server on " u
56e0: 72 69 20 22 2e 22 20 20 22 50 6c 65 61 73 65 20 ri "." "Please
56f0: 63 68 65 63 6b 20 69 66 20 74 68 65 20 6c 69 73 check if the lis
5700: 74 6e 65 72 20 69 73 20 72 75 6e 6e 69 6e 67 2e tner is running.
5710: 20 49 74 20 69 73 20 70 6f 73 73 69 62 6c 65 20 It is possible
5720: 74 68 61 74 20 74 68 65 20 68 6f 73 74 20 69 73 that the host is
5730: 20 6f 76 65 72 6c 6f 61 64 65 64 20 64 75 65 20 overloaded due
5740: 74 6f 20 77 68 69 63 68 20 69 74 20 6d 61 79 20 to which it may
5750: 74 61 6b 65 20 74 6f 6f 20 6c 6f 6e 67 20 74 6f take too long to
5760: 20 72 65 73 70 6f 6e 64 2e 20 5c 6e 20 43 6f 6e respond. \n Con
5770: 74 61 63 74 20 79 6f 75 72 20 73 79 73 74 65 6d tact your system
5780: 20 61 64 6d 69 6e 73 74 72 61 74 6f 72 20 69 66 adminstrator if
5790: 20 73 65 72 76 65 72 20 6c 6f 61 64 20 69 73 20 server load is
57a0: 68 69 67 68 2e 22 20 28 73 3a 62 72 29 22 20 54 high." (s:br)" T
57b0: 68 61 6e 6b 20 59 6f 75 20 22 29 20 29 29 29 29 hank You ") ))))
57c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
57d0: 73 65 6e 64 6d 61 69 6c 20 28 73 74 72 69 6e 67 sendmail (string
57e0: 2d 6a 6f 69 6e 20 28 73 74 72 69 6e 67 2d 73 70 -join (string-sp
57f0: 6c 69 74 20 63 6f 6e 74 61 63 74 73 20 22 3b 22 lit contacts ";"
5800: 20 29 29 20 28 63 6f 6e 63 20 22 5b 4c 69 73 74 )) (conc "[List
5810: 6e 65 72 20 45 72 72 6f 72 5d 20 46 69 6c 65 64 ner Error] Filed
5820: 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 6c to connect to l
5830: 69 73 74 6e 65 72 20 6f 6e 20 22 20 75 72 69 29 istner on " uri)
5840: 20 65 6d 61 69 6c 2d 62 6f 64 79 20 20 75 73 65 email-body use
5850: 5f 68 74 6d 6c 3a 20 23 74 29 29 29 0a 20 20 20 _html: #t))).
5860: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
5870: 20 22 20 6d 6f 64 65 20 3a 20 22 20 6d 6f 64 65 " mode : " mode
5880: 20 22 20 4e 6f 74 20 73 65 6e 64 69 6e 67 20 61 " Not sending a
5890: 6e 79 20 65 6d 61 69 6c 73 22 20 29 29 0a 20 20 ny emails" )).
58a0: 20 20 20 20 20 23 66 29 0a 20 20 20 20 20 28 6e #f). (n
58b0: 6e 2d 63 6f 6e 6e 65 63 74 20 72 65 71 20 75 72 n-connect req ur
58c0: 69 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 i). (print "
58d0: 43 6f 6e 6e 65 63 74 65 64 20 74 6f 20 74 68 65 Connected to the
58e0: 20 73 65 72 76 65 72 20 22 20 29 0a 20 20 20 20 server " ).
58f0: 20 28 6e 6e 2d 73 65 6e 64 20 72 65 71 20 6d 73 (nn-send req ms
5900: 67 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 g). (print "
5910: 52 65 71 75 65 73 74 20 53 65 6e 74 22 29 20 20 Request Sent")
5920: 0a 20 20 20 20 20 3b 3b 20 72 65 63 65 69 76 65 . ;; receive
5930: 20 63 6f 64 65 20 68 65 72 65 0a 20 20 20 20 20 code here.
5940: 3b 3b 28 70 72 69 6e 74 20 28 6e 6e 2d 72 65 63 ;;(print (nn-rec
5950: 76 20 72 65 71 29 29 0a 20 20 20 20 20 28 6c 65 v req)). (le
5960: 74 2a 20 28 28 74 68 31 20 20 28 6d 61 6b 65 2d t* ((th1 (make-
5970: 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 thread (lambda (
5980: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59a0: 20 20 20 28 6c 65 74 20 28 28 72 65 73 70 20 28 (let ((resp (
59b0: 6e 6e 2d 72 65 63 76 20 72 65 71 29 29 29 0a 20 nn-recv req))).
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59e0: 20 20 28 6e 6e 2d 63 6c 6f 73 65 20 72 65 71 29 (nn-close req)
59f0: 0a 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 20 20 20 20 20 20 20
5a10: 20 20 20 20 28 70 72 69 6e 74 20 72 65 73 70 29 (print resp)
5a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a40: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 69 (set! res (i
5a50: 66 20 28 65 71 75 61 6c 3f 20 72 65 73 70 20 22 f (equal? resp "
5a60: 6f 6b 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ok").
5a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 #t.
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ac0: 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 29 #f))))
5ad0: 0a 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: 22 72 65 63 76 20 74 68 72 65 61 64 22 29 29 0a "recv thread")).
5b00: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 68 32 (th2
5b10: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c (make-thread (l
5b20: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
5b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b40: 20 20 20 20 20 20 20 20 20 28 74 68 72 65 61 64 (thread
5b50: 2d 73 6c 65 65 70 21 20 74 69 6d 65 6f 75 74 29 -sleep! timeout)
5b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b80: 20 28 74 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 (thread-termina
5b90: 74 65 21 20 74 68 31 29 29 0a 20 20 20 20 20 20 te! th1)).
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bb0: 20 20 20 20 20 20 20 22 74 69 6d 65 72 20 74 68 "timer th
5bc0: 72 65 61 64 22 29 29 29 0a 20 20 20 20 20 20 20 read"))).
5bd0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t
5be0: 68 31 29 0a 20 20 20 20 20 20 20 28 74 68 72 65 h1). (thre
5bf0: 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 20 ad-start! th2).
5c00: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f (thread-jo
5c10: 69 6e 21 20 74 68 31 29 0a 20 20 20 20 20 20 20 in! th1).
5c20: 72 65 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d res))))..;;=====
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c70: 3d 0a 3b 3b 20 52 75 6e 73 0a 3b 3b 3d 3d 3d 3d =.;; Runs.;;====
5c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c90: 3d 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 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 75 ==..;; make a ru
5cd0: 6e 6e 61 6d 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 nname.;;.(define
5ce0: 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 20 70 (make-runname p
5cf0: 72 65 20 70 6f 73 74 29 0a 20 28 74 69 6d 65 2d re post). (time-
5d00: 3e 73 74 72 69 6e 67 0a 20 20 28 73 65 63 6f 6e >string. (secon
5d10: 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 28 ds->local-time (
5d20: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
5d30: 29 20 22 25 59 77 25 56 2e 25 77 2d 25 48 25 4d ) "%Yw%V.%w-%H%M
5d40: 22 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 74 2c "))..;; collect,
5d50: 20 74 72 61 6e 73 6c 61 74 65 2c 20 63 6f 6c 6c translate, coll
5d60: 61 74 65 20 61 6e 64 20 61 73 73 65 6d 62 6c 65 ate and assemble
5d70: 20 61 20 70 6b 74 20 66 72 6f 6d 20 74 68 65 20 a pkt from the
5d80: 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 0a 3b 3b 0a command-line.;;.
5d90: 3b 3b 20 73 63 68 65 64 20 3d 3e 20 66 6f 72 63 ;; sched => forc
5da0: 65 20 74 68 65 20 72 75 6e 20 73 74 61 72 74 20 e the run start
5db0: 74 69 6d 65 20 74 6f 20 62 65 20 72 65 63 6f 72 time to be recor
5dc0: 64 65 64 20 61 73 20 73 63 68 65 64 20 55 6e 69 ded as sched Uni
5dd0: 78 0a 3b 3b 20 65 70 6f 63 68 2e 20 54 68 69 73 x.;; epoch. This
5de0: 20 61 6c 69 67 6e 73 20 74 69 6d 65 73 20 70 72 aligns times pr
5df0: 6f 70 65 72 6c 79 20 66 6f 72 20 74 72 69 67 67 operly for trigg
5e00: 65 72 73 20 69 6e 20 73 6f 6d 65 20 63 61 73 65 ers in some case
5e10: 73 2e 0a 3b 3b 0a 3b 3b 20 20 65 78 74 72 61 2d s..;;.;; extra-
5e20: 64 61 74 20 66 6f 72 6d 61 74 20 69 73 20 28 20 dat format is (
5e30: 27 78 20 78 76 61 6c 20 27 79 20 79 76 61 6c 20 'x xval 'y yval
5e40: 2e 2e 2e 2e 20 29 0a 3b 3b 0a 28 64 65 66 69 6e .... ).;;.(defin
5e50: 65 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d e (command-line-
5e60: 3e 70 6b 74 20 61 63 74 69 6f 6e 20 61 72 67 73 >pkt action args
5e70: 2d 61 6c 69 73 74 20 73 63 68 65 64 2d 69 6e 20 -alist sched-in
5e80: 23 21 6b 65 79 20 28 65 78 74 72 61 2d 64 61 74 #!key (extra-dat
5e90: 20 27 28 29 29 28 61 72 65 61 2d 70 61 74 68 20 '())(area-path
5ea0: 23 66 29 28 6e 65 77 2d 73 73 20 23 66 29 29 0a #f)(new-ss #f)).
5eb0: 20 20 20 28 6c 65 74 2a 20 28 28 73 63 68 65 64 (let* ((sched
5ec0: 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 20 20 20 (cond...
5ed0: 20 20 28 28 76 65 63 74 6f 72 3f 20 73 63 68 65 ((vector? sche
5ee0: 64 2d 69 6e 29 28 6c 6f 63 61 6c 2d 74 69 6d 65 d-in)(local-time
5ef0: 2d 3e 73 65 63 6f 6e 64 73 20 73 63 68 65 64 2d ->seconds sched-
5f00: 69 6e 29 29 20 3b 3b 20 77 65 20 72 65 63 69 65 in)) ;; we recie
5f10: 76 65 64 20 61 20 74 69 6d 65 0a 09 09 20 20 20 ved a time...
5f20: 20 20 28 28 6e 75 6d 62 65 72 3f 20 73 63 68 65 ((number? sche
5f30: 64 2d 69 6e 29 20 73 63 68 65 64 2d 69 6e 29 0a d-in) sched-in).
5f40: 09 09 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 .. (else
5f50: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
5f60: 73 29 29 29 29 0a 20 20 20 28 75 73 65 72 20 20 s)))). (user
5f70: 28 69 66 20 28 61 6e 64 20 61 72 67 73 2d 61 6c (if (and args-al
5f80: 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 3f ist (hash-table?
5f90: 20 61 72 67 73 2d 61 6c 69 73 74 29 29 0a 20 20 args-alist)).
5fa0: 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 73 (has
5fb0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5fc0: 75 6c 74 20 61 72 67 73 2d 61 6c 69 73 74 20 22 ult args-alist "
5fd0: 2d 6f 76 65 72 72 69 64 65 2d 75 73 65 72 22 20 -override-user"
5fe0: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
5ff0: 6d 65 29 29 0a 09 09 09 09 09 09 20 20 28 63 75 me))....... (cu
6000: 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 rrent-user-name)
6010: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6020: 20 20 20 20 20 20 20 0a 09 20 28 61 72 67 73 2d .. (args-
6030: 64 61 74 61 20 28 69 66 20 61 72 67 73 2d 61 6c data (if args-al
6040: 69 73 74 0a 09 09 09 28 69 66 20 28 68 61 73 68 ist....(if (hash
6050: 2d 74 61 62 6c 65 3f 20 61 72 67 73 2d 61 6c 69 -table? args-ali
6060: 73 74 29 20 3b 3b 20 73 65 72 69 6f 75 73 6c 79 st) ;; seriously
6070: 3f 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 ?.... (hash-t
6080: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 72 67 73 able->alist args
6090: 2d 61 6c 69 73 74 29 0a 09 09 09 20 20 20 20 61 -alist).... a
60a0: 72 67 73 2d 61 6c 69 73 74 29 0a 09 09 09 28 68 rgs-alist)....(h
60b0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
60c0: 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 args:arg-hash))
60d0: 29 20 3b 3b 20 69 66 20 6e 6f 20 61 72 67 73 2d ) ;; if no args-
60e0: 61 6c 69 73 74 20 74 68 65 6e 20 77 65 20 61 73 alist then we as
60f0: 73 75 6d 65 20 74 68 69 73 20 69 73 20 61 20 63 sume this is a c
6100: 61 6c 6c 20 64 72 69 76 65 6e 20 64 69 72 65 63 all driven direc
6110: 74 6c 79 20 62 79 20 63 6f 6d 6d 61 6e 64 6c 69 tly by commandli
6120: 6e 65 0a 09 20 28 61 6c 6c 64 61 74 20 20 20 20 ne.. (alldat
6130: 28 61 70 70 6c 79 20 61 70 70 65 6e 64 0a 09 09 (apply append...
6140: 09 20 20 20 28 6c 69 73 74 20 27 41 20 61 63 74 . (list 'A act
6150: 69 6f 6e 0a 09 09 09 09 20 27 55 20 75 73 65 72 ion..... 'U user
6160: 0a 09 09 09 09 20 27 44 20 73 63 68 65 64 29 0a ..... 'D sched).
6170: 09 09 09 20 20 20 28 69 66 20 61 72 65 61 2d 70 ... (if area-p
6180: 61 74 68 0a 09 09 09 20 20 20 20 20 20 20 28 6c ath.... (l
6190: 69 73 74 20 27 53 20 61 72 65 61 2d 70 61 74 68 ist 'S area-path
61a0: 29 20 3b 3b 20 74 68 65 20 61 72 65 61 2d 70 61 ) ;; the area-pa
61b0: 74 68 20 69 73 20 6d 61 70 70 65 64 20 74 6f 20 th is mapped to
61c0: 74 68 65 20 73 74 61 72 74 2d 64 69 72 0a 09 09 the start-dir...
61d0: 09 20 20 20 20 20 20 20 27 28 29 29 0a 20 20 20 . '()).
61e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61f0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6c 69 73 (if (lis
6200: 74 3f 20 65 78 74 72 61 2d 64 61 74 29 0a 09 09 t? extra-dat)...
6210: 09 20 20 20 20 20 20 20 65 78 74 72 61 2d 64 61 . extra-da
6220: 74 0a 09 09 09 20 20 20 20 20 20 20 28 62 65 67 t.... (beg
6230: 69 6e 0a 09 09 09 09 20 28 64 65 62 75 67 3a 70 in..... (debug:p
6240: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
6250: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 log-port* "ERROR
6260: 3a 20 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 3e : command-line->
6270: 70 6b 74 20 72 65 63 65 69 76 65 64 20 62 61 64 pkt received bad
6280: 20 65 78 74 72 61 2d 64 61 74 20 22 20 65 78 74 extra-dat " ext
6290: 72 61 2d 64 61 74 29 0a 09 09 09 09 20 27 28 29 ra-dat)..... '()
62a0: 29 29 0a 09 09 09 20 20 20 28 6d 61 70 20 28 6c )).... (map (l
62b0: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 20 20 ambda (x).....
62c0: 28 6c 65 74 2a 20 28 28 70 61 72 61 6d 20 28 63 (let* ((param (c
62d0: 61 72 20 78 29 29 0a 09 09 09 09 09 20 28 76 61 ar x))...... (va
62e0: 6c 75 65 20 28 63 64 72 20 78 29 29 0a 09 09 09 lue (cdr x))....
62f0: 09 09 20 28 70 6d 65 74 61 20 28 61 73 73 6f 63 .. (pmeta (assoc
6300: 20 70 61 72 61 6d 20 2a 61 72 67 2d 6b 65 79 73 param *arg-keys
6310: 2a 29 29 20 20 20 20 3b 3b 20 74 72 61 6e 73 6c *)) ;; transl
6320: 61 74 65 20 74 68 65 20 63 61 72 64 20 6b 65 79 ate the card key
6330: 20 74 6f 20 61 20 6d 65 67 61 74 65 73 74 20 73 to a megatest s
6340: 77 69 74 63 68 20 6f 72 20 70 61 72 61 6d 65 74 witch or paramet
6350: 65 72 0a 09 09 09 09 09 20 28 73 6d 65 74 61 20 er...... (smeta
6360: 28 61 73 73 6f 63 20 70 61 72 61 6d 20 2a 73 77 (assoc param *sw
6370: 69 74 63 68 2d 6b 65 79 73 2a 29 29 20 3b 3b 20 itch-keys*)) ;;
6380: 66 69 72 73 74 20 6c 6f 6f 6b 75 70 20 74 68 65 first lookup the
6390: 20 6b 65 79 20 69 6e 20 61 72 67 2d 6b 65 79 73 key in arg-keys
63a0: 20 6f 72 20 73 77 69 74 63 68 2d 6b 65 79 73 0a or switch-keys.
63b0: 09 09 09 09 09 20 28 6d 65 74 61 20 20 28 69 66 ..... (meta (if
63c0: 20 28 6f 72 20 70 6d 65 74 61 20 73 6d 65 74 61 (or pmeta smeta
63d0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 63 64 72 )....... (cdr
63e0: 20 28 6f 72 20 70 6d 65 74 61 20 73 6d 65 74 61 (or pmeta smeta
63f0: 29 29 20 20 20 3b 3b 20 66 6f 75 6e 64 20 69 74 )) ;; found it
6400: 3f 0a 09 09 09 09 09 09 20 20 20 20 23 66 29 29 ?....... #f))
6410: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
6420: 20 6d 65 74 61 20 20 20 20 20 20 20 20 20 20 20 meta
6430: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 6f 6e ;; con
6440: 73 74 72 75 63 74 20 74 68 65 20 73 77 69 74 63 struct the switc
6450: 68 2f 70 61 72 61 6d 20 70 61 69 72 2e 0a 09 09 h/param pair....
6460: 09 09 09 28 6c 69 73 74 20 6d 65 74 61 20 76 61 ...(list meta va
6470: 6c 75 65 29 0a 09 09 09 09 09 27 28 29 29 29 29 lue)......'())))
6480: 0a 20 20 20 20 20 20 20 20 20 20 0a 09 09 09 09 . .....
6490: 28 66 69 6c 74 65 72 20 63 64 72 20 61 72 67 73 (filter cdr args
64a0: 2d 64 61 74 61 29 29 29 29 29 0a 20 20 20 20 28 -data))))). (
64b0: 70 72 69 6e 74 20 20 22 41 6c 6c 64 61 74 3a 20 print "Alldat:
64c0: 22 20 61 6c 6c 64 61 74 20 20 29 20 3b 3b 44 6f " alldat ) ;;Do
64d0: 20 6e 6f 74 20 72 65 6d 6f 76 65 2e 20 54 68 69 not remove. Thi
64e0: 73 20 69 73 20 75 65 73 65 64 20 62 79 20 6f 74 s is uesed by ot
64f0: 68 65 72 20 61 70 70 6c 69 63 61 74 69 6f 6e 73 her applications
6500: 20 74 6f 20 63 61 6c 63 75 6c 61 74 65 20 7a 20 to calculate z
6510: 63 61 72 64 20 0a 20 20 20 20 3b 28 65 78 69 74 card . ;(exit
6520: 29 0a 20 20 20 20 28 61 64 64 2d 7a 2d 63 61 72 ). (add-z-car
6530: 64 0a 20 20 20 20 20 28 61 70 70 6c 79 20 63 6f d. (apply co
6540: 6e 73 74 72 75 63 74 2d 73 64 61 74 20 61 6c 6c nstruct-sdat all
6550: 64 61 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 dat))))..(define
6560: 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 73 (simple-setup s
6570: 74 61 72 74 2d 64 69 72 2d 69 6e 29 0a 20 20 28 tart-dir-in). (
6580: 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 64 69 72 let* ((start-dir
6590: 20 28 6f 72 20 73 74 61 72 74 2d 64 69 72 2d 69 (or start-dir-i
65a0: 6e 20 22 2e 22 29 29 0a 09 20 28 6d 74 63 6f 6e n ".")).. (mtcon
65b0: 66 69 67 20 20 28 6f 72 20 28 61 72 67 73 3a 67 fig (or (args:g
65c0: 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 et-arg "-config"
65d0: 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 ) "megatest.conf
65e0: 69 67 22 29 29 0a 09 20 28 6d 74 63 6f 6e 66 64 ig")).. (mtconfd
65f0: 61 74 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 at (find-and-rea
6600: 64 2d 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 d-config
6610: 3b 3b 20 4e 42 2f 2f 20 73 65 74 73 20 4d 54 5f ;; NB// sets MT_
6620: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 20 61 73 RUN_AREA_HOME as
6630: 20 73 69 64 65 20 65 66 66 65 63 74 0a 09 09 20 side effect...
6640: 20 20 20 20 6d 74 63 6f 6e 66 69 67 0a 09 09 20 mtconfig...
6650: 20 20 20 20 3b 3b 20 65 6e 76 69 72 6f 6e 2d 70 ;; environ-p
6660: 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 att: "env-overri
6670: 64 65 22 0a 09 09 20 20 20 20 20 67 69 76 65 6e de"... given
6680: 2d 74 6f 70 70 61 74 68 3a 20 73 74 61 72 74 2d -toppath: start-
6690: 64 69 72 0a 09 09 20 20 20 20 20 3b 3b 20 70 61 dir... ;; pa
66a0: 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 thenvvar: "MT_RU
66b0: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 0a 09 09 20 N_AREA_HOME"...
66c0: 20 20 20 20 29 29 0a 09 20 28 6d 74 63 6f 6e 66 )).. (mtconf
66d0: 20 20 20 20 28 69 66 20 6d 74 63 6f 6e 66 64 61 (if mtconfda
66e0: 74 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 t (car mtconfdat
66f0: 29 20 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 77 ) #f))). ;; w
6700: 65 20 73 65 74 20 73 6f 6d 65 20 64 79 6e 61 6d e set some dynam
6710: 69 63 20 64 61 74 61 20 69 6e 20 61 20 73 65 63 ic data in a sec
6720: 74 69 6f 6e 20 63 61 6c 6c 65 64 20 22 73 63 72 tion called "scr
6730: 61 74 63 68 64 61 74 61 22 0a 20 20 20 20 28 69 atchdata". (i
6740: 66 20 6d 74 63 6f 6e 66 0a 09 28 62 65 67 69 6e f mtconf..(begin
6750: 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 .. (configf:sec
6760: 74 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 6d 74 tion-var-set! mt
6770: 63 6f 6e 66 20 22 73 63 72 61 74 63 68 64 61 74 conf "scratchdat
6780: 22 20 22 74 6f 70 70 61 74 68 22 20 73 74 61 72 " "toppath" star
6790: 74 2d 64 69 72 29 29 29 0a 20 20 20 20 3b 3b 20 t-dir))). ;;
67a0: 28 70 72 69 6e 74 20 22 54 4f 50 50 41 54 48 3a (print "TOPPATH:
67b0: 20 22 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b " (configf:look
67c0: 75 70 20 6d 74 63 6f 6e 66 20 22 73 63 72 61 74 up mtconf "scrat
67d0: 63 68 64 61 74 22 20 22 74 6f 70 70 61 74 68 22 chdat" "toppath"
67e0: 29 29 0a 20 20 20 20 6d 74 63 6f 6e 66 64 61 74 )). mtconfdat
67f0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
6800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
6840: 41 72 65 61 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d Areas.;;========
6850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a ==============..
6890: 3b 3b 20 6c 6f 6f 6b 20 66 6f 72 20 61 72 65 61 ;; look for area
68a0: 73 3d 61 31 2c 61 32 2c 61 33 20 4f 52 20 61 72 s=a1,a2,a3 OR ar
68b0: 65 61 66 6e 3d 73 6f 6d 65 66 75 6e 63 6e 61 6d eafn=somefuncnam
68c0: 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 61 e.;;.(define (va
68d0: 6c 2d 61 6c 69 73 74 2d 3e 61 72 65 61 73 20 76 l-alist->areas v
68e0: 61 6c 2d 61 6c 69 73 74 29 0a 20 20 28 6c 65 74 al-alist). (let
68f0: 20 28 28 61 72 65 61 73 2d 73 74 72 69 6e 67 20 ((areas-string
6900: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 72 (alist-ref 'ar
6910: 65 61 73 20 20 76 61 6c 2d 61 6c 69 73 74 29 29 eas val-alist))
6920: 0a 09 28 61 72 65 61 73 2d 70 72 6f 63 6e 61 6d ..(areas-procnam
6930: 65 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 72 e (alist-ref 'ar
6940: 65 61 66 6e 20 76 61 6c 2d 61 6c 69 73 74 29 29 eafn val-alist))
6950: 29 0a 20 20 20 20 28 69 66 20 61 72 65 61 73 2d ). (if areas-
6960: 70 72 6f 63 6e 61 6d 65 20 3b 3b 20 61 72 65 61 procname ;; area
6970: 73 2d 70 72 6f 63 6e 61 6d 65 20 74 61 6b 65 20 s-procname take
6980: 70 72 65 63 65 64 65 6e 63 65 0a 09 61 72 65 61 precedence..area
6990: 73 2d 70 72 6f 63 6e 61 6d 65 0a 09 28 73 74 72 s-procname..(str
69a0: 69 6e 67 2d 73 70 6c 69 74 20 28 6f 72 20 61 72 ing-split (or ar
69b0: 65 61 73 2d 73 74 72 69 6e 67 20 22 22 29 20 22 eas-string "") "
69c0: 2c 22 29 29 29 29 0a 0a 3b 3b 20 61 72 65 61 20 ,"))))..;; area
69d0: 20 20 2d 20 74 68 65 20 63 75 72 72 65 6e 74 20 - the current
69e0: 61 72 65 61 20 75 6e 64 65 72 20 63 6f 6e 73 69 area under consi
69f0: 64 65 72 61 74 69 6f 6e 0a 3b 3b 20 61 72 65 61 deration.;; area
6a00: 73 20 20 2d 20 74 68 65 20 6c 69 73 74 20 6f 66 s - the list of
6a10: 20 61 6c 6c 6f 77 65 64 20 61 72 65 61 73 20 66 allowed areas f
6a20: 72 6f 6d 20 74 68 65 20 63 6f 6e 74 6f 75 72 20 rom the contour
6a30: 73 70 65 63 20 2d 4f 52 2d 0a 3b 3b 20 20 20 20 spec -OR-.;;
6a40: 20 20 20 20 20 20 69 66 20 69 74 20 69 73 20 61 if it is a
6a50: 20 73 74 72 69 6e 67 20 74 68 65 6e 20 69 74 20 string then it
6a60: 69 73 20 74 68 65 20 66 75 6e 63 74 69 6f 6e 20 is the function
6a70: 74 6f 20 75 73 65 20 74 6f 0a 3b 3b 20 20 20 20 to use to.;;
6a80: 20 20 20 20 20 20 6c 6f 6f 6b 75 70 20 69 6e 20 lookup in
6a90: 2a 61 72 65 61 2d 63 68 65 63 6b 65 72 73 2a 0a *area-checkers*.
6aa0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 72 65 61 ;;.(define (area
6ab0: 2d 61 6c 6c 6f 77 65 64 3f 20 61 72 65 61 20 61 -allowed? area a
6ac0: 72 65 61 73 20 72 75 6e 6b 65 79 20 63 6f 6e 74 reas runkey cont
6ad0: 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 29 0a 20 our mode-patt).
6ae0: 20 3b 3b 28 70 72 69 6e 74 20 22 41 72 65 61 73 ;;(print "Areas
6af0: 3a 20 22 20 61 72 65 61 73 29 0a 20 20 28 63 6f : " areas). (co
6b00: 6e 64 0a 20 20 20 28 28 6e 6f 74 20 61 72 65 61 nd. ((not area
6b10: 73 29 20 23 74 29 20 3b 3b 20 6e 6f 20 73 70 65 s) #t) ;; no spe
6b20: 63 0a 20 20 20 28 28 73 74 72 69 6e 67 3f 20 61 c. ((string? a
6b30: 72 65 61 73 29 20 3b 3b 20 0a 20 20 20 20 28 6c reas) ;; . (l
6b40: 65 74 20 28 28 63 68 65 63 6b 2d 66 6e 20 28 68 et ((check-fn (h
6b50: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6b60: 66 61 75 6c 74 20 2a 61 72 65 61 2d 63 68 65 63 fault *area-chec
6b70: 6b 65 72 73 2a 20 28 73 74 72 69 6e 67 2d 3e 73 kers* (string->s
6b80: 79 6d 62 6f 6c 20 61 72 65 61 73 29 20 23 66 29 ymbol areas) #f)
6b90: 29 29 0a 20 20 20 20 20 20 28 69 66 20 63 68 65 )). (if che
6ba0: 63 6b 2d 66 6e 0a 09 20 20 28 63 68 65 63 6b 2d ck-fn.. (check-
6bb0: 66 6e 20 61 72 65 61 20 72 75 6e 6b 65 79 20 63 fn area runkey c
6bc0: 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 ontour mode-patt
6bd0: 29 0a 09 20 20 23 66 29 29 29 0a 20 20 20 28 28 ).. #f))). ((
6be0: 6c 69 73 74 3f 20 61 72 65 61 73 29 28 6d 65 6d list? areas)(mem
6bf0: 62 65 72 20 61 72 65 61 20 61 72 65 61 73 29 29 ber area areas))
6c00: 0a 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 20 . (else #f)))
6c10: 3b 3b 20 73 68 6f 75 6c 64 6e 27 74 20 67 65 74 ;; shouldn't get
6c20: 20 68 65 72 65 20 0a 0a 28 64 65 66 69 6e 65 20 here ..(define
6c30: 28 67 65 74 2d 61 72 65 61 2d 6e 61 6d 65 73 20 (get-area-names
6c40: 6d 74 63 6f 6e 66 29 0a 20 20 28 6d 61 70 20 63 mtconf). (map c
6c50: 61 72 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d ar (configf:get-
6c60: 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 section mtconf "
6c70: 61 72 65 61 73 22 29 29 29 0a 0a 3b 3b 3d 3d 3d areas")))..;;===
6c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6cc0: 3d 3d 3d 0a 3b 3b 20 50 6b 74 73 20 66 6f 72 20 ===.;; Pkts for
6cd0: 72 65 6d 6f 74 65 20 63 6f 6e 74 72 6f 6c 0a 3b remote control.;
6ce0: 3b 3d 3d 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 0a 0a 3b 3b 20 4e 45 45 44 =======..;; NEED
6d30: 20 54 49 4d 45 53 54 41 4d 50 20 4f 4e 20 50 4b TIMESTAMP ON PK
6d40: 54 53 20 66 6f 72 20 65 66 66 69 63 69 65 6e 74 TS for efficient
6d50: 20 6c 6f 61 64 69 6e 67 20 6f 66 20 70 61 63 6b loading of pack
6d60: 65 74 73 20 69 6e 74 6f 20 64 62 2e 0a 0a 0a 3b ets into db....;
6d70: 3b 20 6d 61 6b 65 20 61 20 72 75 6e 20 72 65 71 ; make a run req
6d80: 75 65 73 74 20 70 6b 74 20 66 72 6f 6d 20 62 61 uest pkt from ba
6d90: 73 69 63 20 64 61 74 61 2c 20 74 68 69 73 20 73 sic data, this s
6da0: 65 72 69 6f 75 73 6c 79 20 6e 65 65 64 73 20 74 eriously needs t
6db0: 6f 20 62 65 20 72 65 66 61 63 74 6f 72 65 64 0a o be refactored.
6dc0: 3b 3b 20 20 20 69 2e 20 54 61 6b 65 20 74 68 65 ;; i. Take the
6dd0: 20 63 6f 64 65 20 74 68 61 74 20 62 75 69 6c 64 code that build
6de0: 73 20 74 68 65 20 69 6e 66 6f 20 74 6f 20 73 75 s the info to su
6df0: 62 6d 69 74 20 74 6f 20 63 72 65 61 74 65 2d 72 bmit to create-r
6e00: 75 6e 2d 70 6b 74 20 61 6e 64 20 68 61 76 65 20 un-pkt and have
6e10: 69 74 0a 3b 3b 20 20 20 20 20 20 67 65 6e 65 72 it.;; gener
6e20: 61 74 65 20 74 68 65 20 70 6b 74 20 6b 65 79 73 ate the pkt keys
6e30: 20 64 69 72 65 63 74 6c 79 2e 0a 3b 3b 20 20 69 directly..;; i
6e40: 69 2e 20 50 61 73 73 20 74 68 65 20 70 6b 74 20 i. Pass the pkt
6e50: 6b 65 79 73 20 61 6e 64 20 76 61 6c 75 65 73 20 keys and values
6e60: 74 6f 20 74 68 69 73 20 70 72 6f 63 20 61 6e 64 to this proc and
6e70: 20 67 6f 20 66 72 6f 6d 20 74 68 65 72 65 2e 0a go from there..
6e80: 3b 3b 20 69 69 69 2e 20 4d 61 79 62 65 20 68 61 ;; iii. Maybe ha
6e90: 76 65 20 61 6e 20 61 62 73 74 72 61 63 74 69 6f ve an abstractio
6ea0: 6e 20 61 6c 69 73 74 20 77 69 74 68 20 6d 65 61 n alist with mea
6eb0: 6e 69 6e 67 66 75 6c 20 6e 61 6d 65 73 20 66 6f ningful names fo
6ec0: 72 20 74 68 65 20 70 6b 74 20 6b 65 79 73 0a 3b r the pkt keys.;
6ed0: 3b 0a 3b 3b 20 4f 76 65 72 72 69 64 65 20 74 68 ;.;; Override th
6ee0: 65 20 72 75 6e 20 73 74 61 72 74 20 74 69 6d 65 e run start time
6ef0: 20 72 65 63 6f 72 64 20 77 69 74 68 20 73 63 68 record with sch
6f00: 65 64 2e 20 55 73 75 61 6c 6c 79 20 23 66 20 69 ed. Usually #f i
6f10: 73 20 66 69 6e 65 2e 0a 3b 3b 20 0a 28 64 65 66 s fine..;; .(def
6f20: 69 6e 65 20 28 63 72 65 61 74 65 2d 72 75 6e 2d ine (create-run-
6f30: 70 6b 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f pkt mtconf actio
6f40: 6e 20 61 72 65 61 20 72 75 6e 6b 65 79 20 74 61 n area runkey ta
6f50: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 6d 6f 64 rget runname mod
6f60: 65 2d 70 61 74 74 20 0a 20 20 20 20 20 20 20 20 e-patt .
6f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f80: 74 61 67 2d 65 78 70 72 20 70 6b 74 73 64 69 72 tag-expr pktsdir
6f90: 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 20 reason contour
6fa0: 73 63 68 65 64 20 64 62 64 65 73 74 20 61 70 70 sched dbdest app
6fb0: 65 6e 64 2d 63 6f 6e 66 0a 20 20 20 20 20 20 20 end-conf.
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 72 75 6e 74 72 61 6e 73 29 0a 20 20 28 6c 65 runtrans). (le
6fe0: 74 2a 20 28 28 67 6f 6f 64 2d 76 61 6c 20 20 20 t* ((good-val
6ff0: 28 6c 61 6d 62 64 61 20 28 69 6e 76 61 6c 29 28 (lambda (inval)(
7000: 61 6e 64 20 69 6e 76 61 6c 20 28 73 74 72 69 6e and inval (strin
7010: 67 3f 20 69 6e 76 61 6c 29 28 6e 6f 74 20 28 73 g? inval)(not (s
7020: 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 76 61 tring-null? inva
7030: 6c 29 29 29 29 29 0a 09 20 28 61 72 65 61 2d 64 l))))).. (area-d
7040: 61 74 20 20 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c at (common:val
7050: 2d 3e 61 6c 69 73 74 20 28 6f 72 20 28 63 6f 6e ->alist (or (con
7060: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
7070: 6e 66 20 22 61 72 65 61 73 22 20 61 72 65 61 29 nf "areas" area)
7080: 20 22 22 29 29 29 0a 09 20 28 61 72 65 61 2d 70 ""))).. (area-p
7090: 61 74 68 20 20 28 61 6c 69 73 74 2d 72 65 66 20 ath (alist-ref
70a0: 27 70 61 74 68 20 20 20 20 20 20 61 72 65 61 2d 'path area-
70b0: 64 61 74 29 29 0a 09 20 3b 3b 20 28 61 72 65 61 dat)).. ;; (area
70c0: 2d 78 6c 61 74 72 20 28 61 6c 69 73 74 2d 72 65 -xlatr (alist-re
70d0: 66 20 27 74 61 72 67 74 72 61 6e 73 20 61 72 65 f 'targtrans are
70e0: 61 2d 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 a-dat)).
70f0: 20 3b 3b 20 28 78 6c 61 74 72 2d 6b 65 79 20 20 ;; (xlatr-key
7100: 28 69 66 20 61 72 65 61 2d 78 6c 61 74 72 20 28 (if area-xlatr (
7110: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 61 string->symbol a
7120: 72 65 61 2d 78 6c 61 74 72 29 20 23 66 29 29 0a rea-xlatr) #f)).
7130: 20 20 20 20 20 20 20 20 20 28 6e 65 77 2d 72 75 (new-ru
7140: 6e 6e 61 6d 65 20 28 6c 65 74 2a 20 28 28 63 61 nname (let* ((ca
7150: 6c 6c 6e 61 6d 65 20 28 69 66 20 28 73 74 72 69 llname (if (stri
7160: 6e 67 3f 20 72 75 6e 74 72 61 6e 73 29 28 73 74 ng? runtrans)(st
7170: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 72 75 6e ring->symbol run
7180: 74 72 61 6e 73 29 20 23 66 29 29 0a 09 09 09 20 trans) #f))....
7190: 20 20 20 20 28 6d 61 70 70 65 72 20 20 20 28 69 (mapper (i
71a0: 66 20 63 61 6c 6c 6e 61 6d 65 20 28 68 61 73 68 f callname (hash
71b0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
71c0: 6c 74 20 2a 72 75 6e 6e 61 6d 65 2d 6d 61 70 70 lt *runname-mapp
71d0: 65 72 73 2a 20 63 61 6c 6c 6e 61 6d 65 20 23 66 ers* callname #f
71e0: 29 20 23 66 29 29 29 0a 09 09 09 3b 3b 20 28 70 ) #f)))....;; (p
71f0: 72 69 6e 74 20 22 63 61 6c 6c 6e 61 6d 65 3d 22 rint "callname="
7200: 20 63 61 6c 6c 6e 61 6d 65 20 22 20 72 75 6e 74 callname " runt
7210: 72 61 6e 73 3d 22 20 72 75 6e 74 72 61 6e 73 20 rans=" runtrans
7220: 22 20 6d 61 70 70 65 72 3d 22 20 6d 61 70 70 65 " mapper=" mappe
7230: 72 29 0a 09 09 09 28 69 66 20 28 61 6e 64 20 63 r)....(if (and c
7240: 61 6c 6c 6e 61 6d 65 0a 09 09 09 09 20 28 6e 6f allname..... (no
7250: 74 20 28 65 71 75 61 6c 3f 20 63 61 6c 6c 6e 61 t (equal? callna
7260: 6d 65 20 22 61 75 74 6f 22 29 29 0a 09 09 09 09 me "auto")).....
7270: 20 28 6e 6f 74 20 6d 61 70 70 65 72 29 29 0a 09 (not mapper))..
7280: 09 09 20 20 20 20 28 70 72 69 6e 74 20 22 4e 6f .. (print "No
7290: 20 6d 61 70 70 65 72 20 22 20 63 61 6c 6c 6e 61 mapper " callna
72a0: 6d 65 20 22 20 66 6f 72 20 61 72 65 61 20 22 20 me " for area "
72b0: 61 72 65 61 20 22 20 75 73 69 6e 67 20 22 20 63 area " using " c
72c0: 61 6c 6c 6e 61 6d 65 20 22 20 61 73 20 74 68 65 allname " as the
72d0: 20 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 28 runname"))....(
72e0: 69 66 20 6d 61 70 70 65 72 0a 09 09 09 20 20 20 if mapper....
72f0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
7300: 6f 6e 73 0a 09 09 09 09 65 78 6e 0a 09 09 09 09 ons.....exn.....
7310: 28 62 65 67 69 6e 0a 09 09 09 09 20 20 28 70 72 (begin..... (pr
7320: 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 0a int-call-chain).
7330: 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 46 41 .... (print "FA
7340: 49 4c 45 44 20 54 4f 20 52 55 4e 20 52 55 4e 4e ILED TO RUN RUNN
7350: 41 4d 45 20 4d 41 50 50 45 52 20 22 20 63 61 6c AME MAPPER " cal
7360: 6c 6e 61 6d 65 20 22 20 46 4f 52 20 41 52 45 41 lname " FOR AREA
7370: 20 22 20 61 72 65 61 29 0a 09 09 09 09 20 20 28 " area)..... (
7380: 70 72 69 6e 74 20 22 20 6d 65 73 73 61 67 65 3a print " message:
7390: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
73a0: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
73b0: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
73c0: 65 78 6e 29 29 0a 09 09 09 09 20 20 72 75 6e 6e exn))..... runn
73d0: 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 28 70 ame).... (p
73e0: 72 69 6e 74 20 22 28 6d 61 70 70 65 72 20 22 20 rint "(mapper "
73f0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7400: 72 73 65 20 28 6c 69 73 74 20 72 75 6e 6b 65 79 rse (list runkey
7410: 20 72 75 6e 6e 61 6d 65 20 61 72 65 61 20 61 72 runname area ar
7420: 65 61 2d 70 61 74 68 20 72 65 61 73 6f 6e 20 63 ea-path reason c
7430: 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 ontour mode-patt
7440: 29 20 22 2c 20 22 29 20 22 29 22 29 0a 09 09 09 ) ", ") ")")....
7450: 20 20 20 20 20 20 28 6d 61 70 70 65 72 20 72 75 (mapper ru
7460: 6e 6b 65 79 20 72 75 6e 6e 61 6d 65 20 61 72 65 nkey runname are
7470: 61 20 61 72 65 61 2d 70 61 74 68 20 72 65 61 73 a area-path reas
7480: 6f 6e 20 63 6f 6e 74 6f 75 72 20 6d 6f 64 65 2d on contour mode-
7490: 70 61 74 74 29 29 0a 09 09 09 20 20 20 20 28 63 patt)).... (c
74a0: 61 73 65 20 63 61 6c 6c 6e 61 6d 65 0a 09 09 09 ase callname....
74b0: 20 20 20 20 20 20 28 28 61 75 74 6f 20 23 66 29 ((auto #f)
74c0: 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 20 20 20 runname)....
74d0: 20 20 20 28 65 6c 73 65 20 20 20 72 75 6e 74 72 (else runtr
74e0: 61 6e 73 29 29 29 29 29 0a 09 20 28 6e 65 77 2d ans))))).. (new-
74f0: 74 61 72 67 65 74 20 20 20 20 20 74 61 72 67 65 target targe
7500: 74 29 20 3b 3b 20 49 20 62 65 6c 69 65 76 65 20 t) ;; I believe
7510: 77 65 20 77 69 6c 6c 20 77 61 6e 74 20 74 61 72 we will want tar
7520: 67 65 74 20 6d 61 6e 69 70 75 6c 61 74 69 6f 6e get manipulation
7530: 20 68 65 72 65 20 2e 2e 20 28 6d 61 70 2d 74 61 here .. (map-ta
7540: 72 67 65 74 73 20 78 6c 61 74 72 2d 6b 65 79 20 rgets xlatr-key
7550: 72 75 6e 6b 65 79 20 61 72 65 61 20 63 6f 6e 74 runkey area cont
7560: 6f 75 72 29 29 0a 09 20 28 61 63 74 75 61 6c 2d our)).. (actual-
7570: 61 63 74 69 6f 6e 20 20 28 69 66 20 61 63 74 69 action (if acti
7580: 6f 6e 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 on.... (if (
7590: 65 71 75 61 6c 3f 20 61 63 74 69 6f 6e 20 22 73 equal? action "s
75a0: 79 6e 63 2d 70 72 65 70 65 6e 64 22 29 0a 09 09 ync-prepend")...
75b0: 09 09 20 22 73 79 6e 63 22 0a 09 09 09 09 20 61 .. "sync"..... a
75c0: 63 74 69 6f 6e 29 0a 09 09 09 20 20 20 20 20 22 ction).... "
75d0: 72 75 6e 22 29 29 29 20 3b 3b 20 74 68 69 73 20 run"))) ;; this
75e0: 68 61 73 20 67 6f 74 74 65 6e 20 61 20 62 69 74 has gotten a bit
75f0: 20 75 67 6c 79 2e 20 4e 65 65 64 20 61 20 66 75 ugly. Need a fu
7600: 6e 63 74 69 6f 6e 20 74 6f 20 68 61 6e 64 6c 65 nction to handle
7610: 20 61 63 74 69 6f 6e 73 20 70 72 6f 63 65 73 73 actions process
7620: 69 6e 67 2e 0a 20 20 20 20 3b 3b 20 73 6f 6d 65 ing.. ;; some
7630: 20 68 61 63 6b 73 20 74 6f 20 72 65 6d 6f 76 65 hacks to remove
7640: 20 73 77 69 74 63 68 65 73 20 6e 6f 74 20 6e 65 switches not ne
7650: 65 64 65 64 20 69 6e 20 63 65 72 74 61 69 6e 20 eded in certain
7660: 63 61 73 65 73 0a 20 20 20 20 28 63 61 73 65 20 cases. (case
7670: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
7680: 28 6f 72 20 61 63 74 69 6f 6e 20 22 72 75 6e 22 (or action "run"
7690: 29 29 0a 20 20 20 20 20 20 28 28 73 79 6e 63 20 )). ((sync
76a0: 73 79 6e 63 2d 70 72 65 70 65 6e 64 29 0a 20 20 sync-prepend).
76b0: 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 2d 74 (set! new-t
76c0: 61 72 67 65 74 20 23 66 29 0a 20 20 20 20 20 20 arget #f).
76d0: 20 28 73 65 74 21 20 72 75 6e 61 6d 65 20 20 20 (set! runame
76e0: 20 20 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 28 #f))). ;; (
76f0: 70 72 69 6e 74 20 22 61 72 65 61 2d 70 61 74 68 print "area-path
7700: 3a 20 22 20 61 72 65 61 2d 70 61 74 68 20 22 20 : " area-path "
7710: 6f 72 69 67 2d 74 61 72 67 65 74 3a 20 22 20 72 orig-target: " r
7720: 75 6e 6b 65 79 20 22 20 6e 65 77 2d 74 61 72 67 unkey " new-targ
7730: 65 74 3a 20 22 20 6e 65 77 2d 74 61 72 67 65 74 et: " new-target
7740: 29 0a 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 ). (let-value
7750: 73 20 28 28 28 75 75 69 64 20 70 6b 74 29 0a 09 s (((uuid pkt)..
7760: 09 20 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 . (command-line
7770: 2d 3e 70 6b 74 0a 09 09 20 20 20 61 63 74 75 61 ->pkt... actua
7780: 6c 2d 61 63 74 69 6f 6e 0a 09 09 20 20 20 28 61 l-action... (a
7790: 70 70 65 6e 64 20 0a 09 09 20 20 20 20 60 28 28 ppend ... `((
77a0: 22 2d 73 74 61 72 74 2d 64 69 72 22 20 20 2e 20 "-start-dir" .
77b0: 2c 61 72 65 61 2d 70 61 74 68 29 0a 09 09 20 20 ,area-path)...
77c0: 20 20 20 20 3b 3b 28 22 2d 6d 73 67 22 20 20 20 ;;("-msg"
77d0: 20 20 20 20 20 2e 20 2c 72 65 61 73 6f 6e 29 0a . ,reason).
77e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77f0: 20 20 20 20 20 20 28 22 2d 6d 73 67 22 20 20 20 ("-msg"
7800: 20 20 20 20 20 2e 20 2c 22 53 63 72 69 70 74 2d . ,"Script-
7810: 74 72 69 67 67 65 72 65 64 22 29 0a 09 09 20 20 triggered")...
7820: 20 20 20 20 28 22 2d 63 6f 6e 74 6f 75 72 22 20 ("-contour"
7830: 20 20 20 2e 20 2c 63 6f 6e 74 6f 75 72 29 29 0a . ,contour)).
7840: 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f 64 2d .. (if (good-
7850: 76 61 6c 20 6e 65 77 2d 72 75 6e 6e 61 6d 65 29 val new-runname)
7860: 20 60 28 28 22 2d 72 75 6e 2d 6e 61 6d 65 22 20 `(("-run-name"
7870: 20 20 20 20 20 2e 20 2c 6e 65 77 2d 72 75 6e 6e . ,new-runn
7880: 61 6d 65 29 29 20 27 28 29 29 0a 09 09 20 20 20 ame)) '())...
7890: 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c 20 6e (if (good-val n
78a0: 65 77 2d 74 61 72 67 65 74 29 20 20 60 28 28 22 ew-target) `(("
78b0: 2d 74 61 72 67 65 74 22 20 20 20 20 20 20 20 20 -target"
78c0: 2e 20 2c 6e 65 77 2d 74 61 72 67 65 74 29 29 20 . ,new-target))
78d0: 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 20 '())... (if
78e0: 28 67 6f 6f 64 2d 76 61 6c 20 61 72 65 61 29 20 (good-val area)
78f0: 20 20 20 20 20 20 20 60 28 28 22 2d 61 72 65 61 `(("-area
7900: 22 20 20 20 20 20 20 20 20 20 20 2e 20 2c 61 72 " . ,ar
7910: 65 61 29 29 20 20 20 20 20 20 20 20 27 28 29 29 ea)) '())
7920: 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f 64 ... (if (good
7930: 2d 76 61 6c 20 6d 6f 64 65 2d 70 61 74 74 29 20 -val mode-patt)
7940: 20 20 60 28 28 22 2d 6d 6f 64 65 2d 70 61 74 74 `(("-mode-patt
7950: 22 20 20 20 20 20 2e 20 2c 6d 6f 64 65 2d 70 61 " . ,mode-pa
7960: 74 74 29 29 20 20 20 27 28 29 29 0a 09 09 20 20 tt)) '())...
7970: 20 20 28 69 66 20 28 67 6f 6f 64 2d 76 61 6c 20 (if (good-val
7980: 74 61 67 2d 65 78 70 72 29 20 20 20 20 60 28 28 tag-expr) `((
7990: 22 2d 74 61 67 2d 65 78 70 72 22 20 20 20 20 20 "-tag-expr"
79a0: 20 2e 20 2c 74 61 67 2d 65 78 70 72 29 29 20 20 . ,tag-expr))
79b0: 20 20 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 '())... (if
79c0: 20 28 67 6f 6f 64 2d 76 61 6c 20 64 62 64 65 73 (good-val dbdes
79d0: 74 29 20 20 20 20 20 20 60 28 28 22 2d 73 79 6e t) `(("-syn
79e0: 63 2d 74 6f 22 20 20 20 20 20 20 20 2e 20 2c 64 c-to" . ,d
79f0: 62 64 65 73 74 29 29 20 20 20 20 20 20 27 28 29 bdest)) '()
7a00: 29 0a 09 09 20 20 20 20 28 69 66 20 28 67 6f 6f )... (if (goo
7a10: 64 2d 76 61 6c 20 61 70 70 65 6e 64 2d 63 6f 6e d-val append-con
7a20: 66 29 20 60 28 28 22 2d 61 70 70 65 6e 64 2d 63 f) `(("-append-c
7a30: 6f 6e 66 69 67 22 20 2e 20 2c 61 70 70 65 6e 64 onfig" . ,append
7a40: 2d 63 6f 6e 66 29 29 20 27 28 29 29 0a 09 09 20 -conf)) '())...
7a50: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 61 (if (equal? a
7a60: 63 74 69 6f 6e 20 22 73 79 6e 63 2d 70 72 65 70 ction "sync-prep
7a70: 65 6e 64 22 29 20 27 28 28 22 2d 70 72 65 70 65 end") '(("-prepe
7a80: 6e 64 2d 63 6f 6e 74 6f 75 72 22 20 2e 20 22 20 nd-contour" . "
7a90: 22 29 29 20 20 20 27 28 29 29 0a 09 09 20 20 20 ")) '())...
7aa0: 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 6d 6f (if (not (or mo
7ab0: 64 65 2d 70 61 74 74 20 74 61 67 2d 65 78 70 72 de-patt tag-expr
7ac0: 29 29 0a 09 09 09 60 28 28 22 2d 74 65 73 74 70 ))....`(("-testp
7ad0: 61 74 74 22 20 20 2e 20 22 25 22 29 29 0a 09 09 att" . "%"))...
7ae0: 09 27 28 29 29 0a 09 09 20 20 20 20 28 69 66 20 .'())... (if
7af0: 28 6f 72 20 28 6e 6f 74 20 61 63 74 69 6f 6e 29 (or (not action)
7b00: 0a 09 09 09 20 20 20 20 28 65 71 75 61 6c 3f 20 .... (equal?
7b10: 61 63 74 69 6f 6e 20 22 72 75 6e 22 29 29 0a 09 action "run"))..
7b20: 09 09 60 28 28 22 2d 70 72 65 63 6c 65 61 6e 22 ..`(("-preclean"
7b30: 20 20 2e 20 22 20 22 29 0a 09 09 09 20 20 28 22 . " ").... ("
7b40: 2d 72 65 72 75 6e 2d 61 6c 6c 22 20 2e 20 22 20 -rerun-all" . "
7b50: 22 29 29 20 20 20 20 20 20 3b 3b 20 69 66 20 72 ")) ;; if r
7b60: 75 6e 20 77 65 20 2a 61 6c 77 61 79 73 2a 20 77 un we *always* w
7b70: 61 6e 74 20 70 72 65 63 6c 65 61 6e 20 73 65 74 ant preclean set
7b80: 2c 20 75 73 65 20 73 69 6e 67 6c 65 20 73 70 61 , use single spa
7b90: 63 65 20 61 73 20 70 6c 61 63 65 68 6f 6c 64 65 ce as placeholde
7ba0: 72 0a 09 09 09 27 28 29 29 0a 09 09 20 20 20 20 r....'())...
7bb0: 29 0a 09 09 20 20 20 73 63 68 65 64 0a 20 20 20 )... sched.
7bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bd0: 65 78 74 72 61 2d 64 61 74 3a 20 60 28 61 20 2c extra-dat: `(a ,
7be0: 72 75 6e 6b 65 79 29 20 20 3b 3b 20 77 65 20 6e runkey) ;; we n
7bf0: 65 65 64 20 74 68 65 20 72 75 6e 20 6b 65 79 20 eed the run key
7c00: 66 6f 72 20 6d 61 72 6b 69 6e 67 20 74 68 65 20 for marking the
7c10: 72 75 6e 20 61 73 20 6c 61 75 6e 63 68 65 64 0a run as launched.
7c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c30: 20 20 20 29 29 29 0a 20 20 20 20 20 20 28 77 69 ))). (wi
7c40: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
7c50: 65 0a 09 20 20 28 63 6f 6e 63 20 70 6b 74 73 64 e.. (conc pktsd
7c60: 69 72 20 22 2f 22 20 75 75 69 64 20 22 2e 70 6b ir "/" uuid ".pk
7c70: 74 22 29 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a t")..(lambda ().
7c80: 09 20 20 28 70 72 69 6e 74 20 70 6b 74 29 29 29 . (print pkt)))
7c90: 29 29 29 0a 0a 3b 3b 20 28 75 73 65 20 74 72 61 )))..;; (use tra
7ca0: 63 65 29 28 74 72 61 63 65 20 63 72 65 61 74 65 ce)(trace create
7cb0: 2d 72 75 6e 2d 70 6b 74 29 0a 28 64 65 66 69 6e -run-pkt).(defin
7cc0: 65 20 28 63 6f 6e 74 61 69 6e 73 20 6c 69 73 74 e (contains list
7cd0: 20 78 29 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c x) (cond ((null
7ce0: 3f 20 6c 69 73 74 29 20 23 66 29 20 28 28 65 71 ? list) #f) ((eq
7cf0: 3f 20 28 63 61 72 20 6c 69 73 74 29 20 78 29 20 ? (car list) x)
7d00: 23 74 29 20 28 65 6c 73 65 20 28 63 6f 6e 74 61 #t) (else (conta
7d10: 69 6e 73 20 28 63 64 72 20 6c 69 73 74 29 20 78 ins (cdr list) x
7d20: 29 29 29 29 0a 0a 3b 3b 20 63 6f 6c 6c 65 63 74 ))))..;; collect
7d30: 20 61 6c 6c 20 6e 65 65 64 65 64 20 64 61 74 61 all needed data
7d40: 20 61 6e 64 20 63 72 65 61 74 65 20 72 75 6e 20 and create run
7d50: 70 6b 74 73 20 66 6f 72 20 63 6f 6e 74 6f 75 72 pkts for contour
7d60: 73 20 77 69 74 68 20 63 68 61 6e 67 65 64 20 69 s with changed i
7d70: 6e 70 75 74 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 nputs.;;.(define
7d80: 20 28 67 65 6e 65 72 61 74 65 2d 72 75 6e 2d 70 (generate-run-p
7d90: 6b 74 73 20 6d 74 63 6f 6e 66 20 74 6f 70 70 61 kts mtconf toppa
7da0: 74 68 29 0a 20 20 28 6c 65 74 20 28 28 73 74 64 th). (let ((std
7db0: 2d 72 75 6e 6e 61 6d 65 20 28 63 6f 6e 63 20 22 -runname (conc "
7dc0: 73 63 68 65 64 22 20 20 28 74 69 6d 65 2d 3e 73 sched" (time->s
7dd0: 74 72 69 6e 67 20 28 73 65 63 6f 6e 64 73 2d 3e tring (seconds->
7de0: 6c 6f 63 61 6c 2d 74 69 6d 65 20 28 63 75 72 72 local-time (curr
7df0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 22 25 ent-seconds)) "%
7e00: 4d 25 48 25 64 22 29 29 29 0a 20 20 20 20 20 20 M%H%d"))).
7e10: 20 20 28 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 (packets-gener
7e20: 61 74 65 64 20 30 29 29 0a 20 20 20 20 28 63 6f ated 0)). (co
7e30: 6d 6d 6f 6e 3a 77 69 74 68 2d 71 75 65 75 65 2d mmon:with-queue-
7e40: 64 62 0a 20 20 20 20 20 6d 74 63 6f 6e 66 0a 20 db. mtconf.
7e50: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6b 74 (lambda (pkt
7e60: 73 64 69 72 73 20 70 6b 74 73 64 69 72 20 70 64 sdirs pktsdir pd
7e70: 62 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 b). (let*
7e80: 28 28 72 67 63 6f 6e 66 64 61 74 20 28 66 69 6e ((rgconfdat (fin
7e90: 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 d-and-read-confi
7ea0: 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 g (conc toppath
7eb0: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
7ec0: 66 69 67 22 29 29 29 0a 09 20 20 20 20 20 20 28 fig"))).. (
7ed0: 72 67 63 6f 6e 66 20 20 20 20 28 63 61 72 20 72 rgconf (car r
7ee0: 67 63 6f 6e 66 64 61 74 29 29 0a 09 20 20 20 20 gconfdat))..
7ef0: 20 20 28 61 6c 6c 2d 61 72 65 61 73 20 28 6d 61 (all-areas (ma
7f00: 70 20 63 61 72 20 28 63 6f 6e 66 69 67 66 3a 67 p car (configf:g
7f10: 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e et-section mtcon
7f20: 66 20 22 61 72 65 61 73 22 29 29 29 0a 09 20 20 f "areas")))..
7f30: 20 20 20 20 28 63 6f 6e 74 6f 75 72 73 20 20 28 (contours (
7f40: 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
7f50: 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 63 6f 6e 74 ion mtconf "cont
7f60: 6f 75 72 73 22 29 29 0a 09 20 20 20 20 20 20 28 ours")).. (
7f70: 74 6f 72 75 6e 20 20 20 20 20 28 6d 61 6b 65 2d torun (make-
7f80: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 hash-table)) ;;
7f90: 74 61 72 67 65 74 20 3d 3e 20 28 20 2e 2e 2e 20 target => ( ...
7fa0: 69 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 20 20 20 info ... )..
7fb0: 20 20 28 72 67 65 6e 74 61 72 67 73 20 28 68 61 (rgentargs (ha
7fc0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 67 sh-table-keys rg
7fd0: 63 6f 6e 66 29 29 29 20 3b 3b 20 74 68 65 73 65 conf))) ;; these
7fe0: 20 61 72 65 20 74 68 65 20 74 61 72 67 65 74 73 are the targets
7ff0: 20 72 65 67 69 73 74 65 72 65 64 20 66 6f 72 20 registered for
8000: 61 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 74 72 automatically tr
8010: 69 67 67 65 72 69 6e 67 0a 0a 09 20 3b 3b 28 70 iggering... ;;(p
8020: 72 69 6e 74 20 22 72 67 65 6e 74 61 72 67 73 3a rint "rgentargs:
8030: 20 22 20 72 67 65 6e 74 61 72 67 73 29 0a 09 20 " rgentargs)..
8040: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 28 6c (for-each.. (l
8050: 61 6d 62 64 61 20 28 72 75 6e 6b 65 79 29 0a 09 ambda (runkey)..
8060: 20 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 64 (let* ((keyd
8070: 61 74 73 20 20 20 28 63 6f 6e 66 69 67 66 3a 67 ats (configf:g
8080: 65 74 2d 73 65 63 74 69 6f 6e 20 72 67 63 6f 6e et-section rgcon
8090: 66 20 72 75 6e 6b 65 79 29 29 29 0a 09 20 20 20 f runkey)))..
80a0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 (for-each..
80b0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
80c0: 6e 73 65 29 20 3b 3b 20 74 68 65 73 65 20 61 72 nse) ;; these ar
80d0: 65 20 74 68 65 20 73 65 6e 73 65 20 72 75 6c 65 e the sense rule
80e0: 73 0a 09 09 20 28 6c 65 74 2a 20 28 28 6b 65 79 s... (let* ((key
80f0: 20 20 20 20 20 20 20 20 28 63 61 72 20 73 65 6e (car sen
8100: 73 65 29 29 0a 09 09 09 28 76 61 6c 20 20 20 20 se))....(val
8110: 20 20 20 20 28 63 61 64 72 20 73 65 6e 73 65 29 (cadr sense)
8120: 29 0a 09 09 09 28 6b 65 79 70 61 72 74 73 20 20 )....(keyparts
8130: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6b (string-split k
8140: 65 79 20 22 3a 22 29 29 20 3b 3b 20 63 6f 6e 74 ey ":")) ;; cont
8150: 6f 75 72 3a 72 75 6c 65 74 79 70 65 3a 61 63 74 our:ruletype:act
8160: 69 6f 6e 3a 6f 70 74 69 6f 6e 61 6c 0a 09 09 09 ion:optional....
8170: 28 63 6f 6e 74 6f 75 72 20 20 20 20 28 63 61 72 (contour (car
8180: 20 6b 65 79 70 61 72 74 73 29 29 0a 09 09 09 28 keyparts))....(
8190: 6c 65 6e 2d 6b 65 79 20 20 20 20 28 6c 65 6e 67 len-key (leng
81a0: 74 68 20 6b 65 79 70 61 72 74 73 29 29 0a 09 09 th keyparts))...
81b0: 09 28 72 75 6c 65 74 79 70 65 20 20 20 28 69 66 .(ruletype (if
81c0: 20 28 3e 20 6c 65 6e 2d 6b 65 79 20 31 29 28 63 (> len-key 1)(c
81d0: 61 64 72 20 6b 65 79 70 61 72 74 73 29 20 23 66 adr keyparts) #f
81e0: 29 29 0a 09 09 09 28 61 63 74 69 6f 6e 20 20 20 ))....(action
81f0: 20 20 28 69 66 20 28 3e 20 6c 65 6e 2d 6b 65 79 (if (> len-key
8200: 20 32 29 28 63 61 64 64 72 20 6b 65 79 70 61 72 2)(caddr keypar
8210: 74 73 29 20 23 66 29 29 0a 09 09 09 28 6f 70 74 ts) #f))....(opt
8220: 69 6f 6e 61 6c 20 20 20 28 69 66 20 28 3e 20 6c ional (if (> l
8230: 65 6e 2d 6b 65 79 20 33 29 28 63 61 64 64 64 72 en-key 3)(cadddr
8240: 20 6b 65 79 70 61 72 74 73 29 20 23 66 29 29 0a keyparts) #f)).
8250: 09 09 09 3b 3b 20 28 76 61 6c 2d 6c 69 73 74 20 ...;; (val-list
8260: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d (string-split-
8270: 66 69 65 6c 64 73 20 22 3b 5c 5c 73 2a 22 20 76 fields ";\\s*" v
8280: 61 6c 20 23 3a 69 6e 66 69 78 29 29 20 3b 3b 20 al #:infix)) ;;
8290: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 (string-split va
82a0: 6c 29 29 20 3b 3b 20 72 75 6e 6e 61 6d 65 2d 72 l)) ;; runname-r
82b0: 75 6c 65 20 70 61 72 61 6d 73 0a 09 09 09 28 76 ule params....(v
82c0: 61 6c 2d 61 6c 69 73 74 20 20 28 63 6f 6d 6d 6f al-alist (commo
82d0: 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 76 61 6c n:val->alist val
82e0: 29 29 0a 09 09 09 28 72 75 6e 6e 61 6d 65 20 20 ))....(runname
82f0: 20 20 28 6d 61 6b 65 2d 72 75 6e 6e 61 6d 65 20 (make-runname
8300: 22 22 20 22 22 29 29 0a 09 09 09 28 72 75 6e 74 "" ""))....(runt
8310: 72 61 6e 73 20 20 20 28 61 6c 69 73 74 2d 72 65 rans (alist-re
8320: 66 20 27 72 75 6e 74 72 61 6e 73 20 76 61 6c 2d f 'runtrans val-
8330: 61 6c 69 73 74 29 29 0a 0a 09 09 09 3b 3b 20 74 alist)).....;; t
8340: 68 65 73 65 20 6d 61 79 20 6f 72 20 6d 61 79 20 hese may or may
8350: 6e 6f 74 20 62 65 20 64 65 66 69 6e 65 64 20 61 not be defined a
8360: 6e 64 20 6e 6f 74 20 61 6c 6c 20 61 72 65 20 75 nd not all are u
8370: 73 65 64 20 69 6e 20 65 61 63 68 20 68 61 6e 64 sed in each hand
8380: 6c 65 72 20 74 79 70 65 20 69 6e 20 74 68 65 20 ler type in the
8390: 63 61 73 65 20 62 65 6c 6f 77 0a 09 09 09 28 72 case below....(r
83a0: 75 6e 2d 6e 61 6d 65 20 20 20 28 61 6c 69 73 74 un-name (alist
83b0: 2d 72 65 66 20 27 72 75 6e 2d 6e 61 6d 65 20 76 -ref 'run-name v
83c0: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 74 al-alist))....(t
83d0: 61 72 67 65 74 20 20 20 20 20 28 61 6c 69 73 74 arget (alist
83e0: 2d 72 65 66 20 27 74 61 72 67 65 74 20 20 20 76 -ref 'target v
83f0: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 63 al-alist))....(c
8400: 72 6f 6e 74 61 62 20 20 20 20 28 61 6c 69 73 74 rontab (alist
8410: 2d 72 65 66 20 27 63 72 6f 6e 20 20 20 20 20 76 -ref 'cron v
8420: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 28 61 al-alist))....(a
8430: 72 65 61 73 20 20 20 20 20 20 28 76 61 6c 2d 61 reas (val-a
8440: 6c 69 73 74 2d 3e 61 72 65 61 73 20 20 20 20 76 list->areas v
8450: 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 61 72 al-alist)) ;; ar
8460: 65 61 73 20 63 61 6e 20 62 65 20 61 20 73 69 6e eas can be a sin
8470: 67 6c 65 20 73 74 72 69 6e 67 20 28 61 20 72 65 gle string (a re
8480: 66 65 72 65 6e 63 65 20 74 6f 20 63 61 6c 6c 20 ference to call
8490: 61 6e 20 61 72 65 61 73 20 66 75 6e 63 74 69 6f an areas functio
84a0: 6e 29 2c 20 6f 72 20 61 20 6c 69 73 74 20 6f 66 n), or a list of
84b0: 20 61 72 65 61 20 6e 61 6d 65 73 2e 0a 09 09 09 area names.....
84c0: 28 64 62 64 65 73 74 20 20 20 20 20 28 61 6c 69 (dbdest (ali
84d0: 73 74 2d 72 65 66 20 27 64 62 64 65 73 74 20 20 st-ref 'dbdest
84e0: 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 val-alist))....
84f0: 28 61 70 70 65 6e 64 63 6f 6e 66 20 28 61 6c 69 (appendconf (ali
8500: 73 74 2d 72 65 66 20 27 61 70 70 65 6e 64 63 6f st-ref 'appendco
8510: 6e 66 20 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 nf val-alist))..
8520: 09 09 28 66 69 6c 65 2d 67 6c 6f 62 73 20 28 61 ..(file-globs (a
8530: 6c 69 73 74 2d 72 65 66 20 27 67 6c 6f 62 20 76 list-ref 'glob v
8540: 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 09 0a 09 al-alist))......
8550: 09 09 28 72 75 6e 73 74 61 72 74 73 20 20 28 66 ..(runstarts (f
8560: 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 72 ind-pkts pdb '(r
8570: 75 6e 73 74 61 72 74 29 20 60 28 28 63 20 2e 20 unstart) `((c .
8580: 2c 63 6f 6e 74 6f 75 72 29 0a 09 09 09 09 09 09 ,contour).......
8590: 09 09 20 28 74 20 2e 20 2c 72 75 6e 6b 65 79 29 .. (t . ,runkey)
85a0: 29 29 29 0a 09 09 09 28 72 73 70 6b 74 73 20 20 )))....(rspkts
85b0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 (common:get-p
85c0: 6b 74 2d 61 6c 69 73 74 73 20 72 75 6e 73 74 61 kt-alists runsta
85d0: 72 74 73 29 29 0a 09 09 09 3b 3b 20 73 74 61 72 rts))....;; star
85e0: 74 74 69 6d 65 73 20 69 73 20 66 6f 72 20 72 75 ttimes is for ru
85f0: 6e 20 73 74 61 72 74 20 74 69 6d 65 73 20 61 6e n start times an
8600: 64 20 69 73 20 75 73 65 64 20 74 6f 20 6b 6e 6f d is used to kno
8610: 77 20 77 68 65 6e 20 74 68 65 20 6c 61 73 74 20 w when the last
8620: 72 75 6e 20 77 61 73 20 6c 61 75 6e 63 68 65 64 run was launched
8630: 0a 09 09 09 28 73 74 61 72 74 74 69 6d 65 73 20 ....(starttimes
8640: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 6b 74 2d (common:get-pkt-
8650: 74 69 6d 65 73 20 72 73 70 6b 74 73 29 29 20 3b times rspkts)) ;
8660: 3b 20 73 6f 72 74 20 62 79 20 61 67 65 20 28 79 ; sort by age (y
8670: 6f 75 6e 67 65 73 74 20 66 69 72 73 74 29 20 61 oungest first) a
8680: 6e 64 20 64 65 6c 65 74 65 20 64 75 70 6c 69 63 nd delete duplic
8690: 61 74 65 73 20 62 79 20 74 61 72 67 65 74 0a 09 ates by target..
86a0: 09 09 28 6c 61 73 74 2d 72 75 6e 20 20 20 28 69 ..(last-run (i
86b0: 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 74 69 f (null? startti
86c0: 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 29 20 74 mes) ;; if '() t
86d0: 68 65 6e 20 69 74 20 68 61 73 20 6e 65 76 65 72 hen it has never
86e0: 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c 73 65 20 been run, else
86f0: 67 65 74 20 74 68 65 20 6d 61 78 0a 09 09 09 09 get the max.....
8700: 09 30 0a 09 09 09 09 09 28 61 70 70 6c 79 20 6d .0......(apply m
8710: 61 78 20 28 6d 61 70 20 63 64 72 20 73 74 61 72 ax (map cdr star
8720: 74 74 69 6d 65 73 29 29 29 29 0a 09 09 09 3b 3b ttimes))))....;;
8730: 20 73 79 6e 63 74 69 6d 65 73 20 69 73 20 66 6f synctimes is fo
8740: 72 20 66 69 67 75 72 69 6e 67 20 6f 75 74 20 74 r figuring out t
8750: 68 65 20 6c 61 73 74 20 74 69 6d 65 20 61 20 73 he last time a s
8760: 79 6e 63 20 77 61 73 20 64 6f 6e 65 0a 09 09 09 ync was done....
8770: 28 73 79 6e 63 73 74 61 72 74 73 20 28 66 69 6e (syncstarts (fin
8780: 64 2d 70 6b 74 73 20 70 64 62 20 27 28 73 79 6e d-pkts pdb '(syn
8790: 63 73 74 61 72 74 29 20 27 28 29 29 29 20 3b 3b cstart) '())) ;;
87a0: 20 6e 6f 20 71 75 61 6c 69 66 69 65 72 73 2c 20 no qualifiers,
87b0: 61 20 73 79 6e 63 20 64 6f 65 73 20 61 6c 6c 20 a sync does all
87c0: 74 61 72 65 74 73 20 65 74 63 2e 0a 09 09 09 28 tarets etc.....(
87d0: 73 73 70 6b 74 73 20 20 20 20 20 20 20 28 63 6f sspkts (co
87e0: 6d 6d 6f 6e 3a 67 65 74 2d 70 6b 74 2d 61 6c 69 mmon:get-pkt-ali
87f0: 73 74 73 20 73 79 6e 63 73 74 61 72 74 73 29 29 sts syncstarts))
8800: 0a 09 09 09 28 73 79 6e 63 74 69 6d 65 73 20 20 ....(synctimes
8810: 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 70 6b (common:get-pk
8820: 74 2d 74 69 6d 65 73 20 20 73 73 70 6b 74 73 29 t-times sspkts)
8830: 29 0a 09 09 09 28 6c 61 73 74 2d 73 79 6e 63 20 )....(last-sync
8840: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 79 6e 63 (if (null? sync
8850: 74 69 6d 65 73 29 20 3b 3b 20 69 66 20 27 28 29 times) ;; if '()
8860: 20 74 68 65 6e 20 69 74 20 68 61 73 20 6e 65 76 then it has nev
8870: 65 72 20 62 65 65 6e 20 72 75 6e 2c 20 65 6c 73 er been run, els
8880: 65 20 67 65 74 20 74 68 65 20 6d 61 78 0a 09 09 e get the max...
8890: 09 09 09 30 0a 09 09 09 09 09 28 61 70 70 6c 79 ...0......(apply
88a0: 20 6d 61 78 20 28 6d 61 70 20 63 64 72 20 73 79 max (map cdr sy
88b0: 6e 63 74 69 6d 65 73 29 29 29 29 0a 09 09 09 29 nctimes))))....)
88c0: 0a 0a 09 09 20 20 20 28 6c 65 74 20 28 28 64 65 .... (let ((de
88d0: 6c 74 61 20 28 6c 61 6d 62 64 61 20 28 78 29 0a lta (lambda (x).
88e0: 09 09 09 09 20 20 28 72 6f 75 6e 64 20 28 2f 20 .... (round (/
88f0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
8900: 6e 64 73 29 20 78 29 20 36 30 29 29 29 29 29 0a nds) x) 60))))).
8910: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
8920: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8930: 2d 74 61 72 67 65 74 22 29 0a 20 20 20 20 20 20 -target").
8940: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 (if (st
8950: 72 69 6e 67 3d 20 28 61 72 67 73 3a 67 65 74 2d ring= (args:get-
8960: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 20 72 arg "-target") r
8970: 75 6e 6b 65 79 29 0a 09 09 20 20 20 20 20 20 20 unkey)...
8980: 28 62 65 67 69 6e 20 28 70 72 69 6e 74 20 22 72 (begin (print "r
8990: 75 6e 6b 65 79 3a 20 22 20 72 75 6e 6b 65 79 20 unkey: " runkey
89a0: 22 2c 20 72 75 6c 65 74 79 70 65 3a 20 22 20 72 ", ruletype: " r
89b0: 75 6c 65 74 79 70 65 20 22 2c 20 61 63 74 69 6f uletype ", actio
89c0: 6e 3a 20 22 20 61 63 74 69 6f 6e 20 22 2c 20 6c n: " action ", l
89d0: 61 73 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 2d ast-run: " last-
89e0: 72 75 6e 20 22 20 74 69 6d 65 20 73 69 6e 63 65 run " time since
89f0: 3b 20 6c 61 73 74 2d 72 75 6e 3a 20 22 20 28 64 ; last-run: " (d
8a00: 65 6c 74 61 20 6c 61 73 74 2d 72 75 6e 29 20 22 elta last-run) "
8a10: 2c 20 6c 61 73 74 2d 73 79 6e 63 3a 20 22 20 28 , last-sync: " (
8a20: 64 65 6c 74 61 20 6c 61 73 74 2d 73 79 6e 63 29 delta last-sync)
8a30: 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20 )...
8a40: 20 20 28 70 72 69 6e 74 20 22 76 61 6c 2d 61 6c (print "val-al
8a50: 69 73 74 3d 22 20 76 61 6c 2d 61 6c 69 73 74 20 ist=" val-alist
8a60: 22 20 72 75 6e 74 72 61 6e 73 3d 22 20 72 75 6e " runtrans=" run
8a70: 74 72 61 6e 73 29 29 0a 20 20 20 20 20 20 20 20 trans)).
8a80: 20 20 20 20 20 20 20 28 69 66 20 23 66 20 28 70 (if #f (p
8a90: 72 69 6e 74 20 22 73 6b 69 70 70 69 6e 67 3a 20 rint "skipping:
8aa0: 22 20 72 75 6e 6b 65 79 29 29 29 0a 09 09 20 20 " runkey)))...
8ab0: 20 20 20 20 20 28 62 65 67 69 6e 20 28 70 72 69 (begin (pri
8ac0: 6e 74 20 22 72 75 6e 6b 65 79 3a 20 22 20 72 75 nt "runkey: " ru
8ad0: 6e 6b 65 79 20 22 2c 20 72 75 6c 65 74 79 70 65 nkey ", ruletype
8ae0: 3a 20 22 20 72 75 6c 65 74 79 70 65 20 22 2c 20 : " ruletype ",
8af0: 61 63 74 69 6f 6e 3a 20 22 20 61 63 74 69 6f 6e action: " action
8b00: 20 22 2c 20 6c 61 73 74 2d 72 75 6e 3a 20 22 20 ", last-run: "
8b10: 6c 61 73 74 2d 72 75 6e 20 22 20 74 69 6d 65 20 last-run " time
8b20: 73 69 6e 63 65 3b 20 6c 61 73 74 2d 72 75 6e 3a since; last-run:
8b30: 20 22 20 28 64 65 6c 74 61 20 6c 61 73 74 2d 72 " (delta last-r
8b40: 75 6e 29 20 22 2c 20 6c 61 73 74 2d 73 79 6e 63 un) ", last-sync
8b50: 3a 20 22 20 28 64 65 6c 74 61 20 6c 61 73 74 2d : " (delta last-
8b60: 73 79 6e 63 29 29 0a 09 09 20 20 20 20 20 20 20 sync))...
8b70: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 76 (print "v
8b80: 61 6c 2d 61 6c 69 73 74 3d 22 20 76 61 6c 2d 61 al-alist=" val-a
8b90: 6c 69 73 74 20 22 20 72 75 6e 74 72 61 6e 73 3d list " runtrans=
8ba0: 22 20 72 75 6e 74 72 61 6e 73 29 29 0a 20 20 20 " runtrans)).
8bb0: 20 20 20 20 20 20 20 20 29 29 0a 0a 09 09 20 20 ))....
8bc0: 20 0a 09 09 20 20 20 3b 3b 20 6c 6f 6f 6b 20 69 ... ;; look i
8bd0: 6e 20 72 75 6e 73 74 61 72 74 73 20 66 6f 72 20 n runstarts for
8be0: 6d 61 74 63 68 69 6e 67 20 72 75 6e 73 20 62 79 matching runs by
8bf0: 20 74 61 72 67 65 74 20 61 6e 64 20 63 6f 6e 74 target and cont
8c00: 6f 75 72 0a 09 09 20 20 20 3b 3b 20 67 65 74 20 our... ;; get
8c10: 74 68 65 20 74 69 6d 65 73 74 61 6d 70 20 66 6f the timestamp fo
8c20: 72 20 77 68 65 6e 20 74 68 61 74 20 72 75 6e 20 r when that run
8c30: 73 74 61 72 74 65 64 20 61 6e 64 20 70 61 73 73 started and pass
8c40: 20 69 74 0a 09 09 20 20 20 3b 3b 20 74 6f 20 74 it... ;; to t
8c50: 68 65 20 72 75 6c 65 20 6c 6f 67 69 63 20 68 65 he rule logic he
8c60: 72 65 20 77 68 65 72 65 20 22 72 75 6c 65 74 79 re where "rulety
8c70: 70 65 22 20 77 69 6c 6c 20 62 65 20 61 70 70 6c pe" will be appl
8c80: 69 65 64 0a 09 09 20 20 20 3b 3b 20 69 66 20 69 ied... ;; if i
8c90: 74 20 63 6f 6d 65 73 20 62 61 63 6b 20 22 63 68 t comes back "ch
8ca0: 61 6e 67 65 64 22 20 74 68 65 6e 20 70 72 6f 63 anged" then proc
8cb0: 65 65 64 20 74 6f 20 72 65 67 69 73 74 65 72 20 eed to register
8cc0: 74 68 65 20 72 75 6e 73 0a 09 09 20 20 20 0a 09 the runs... ..
8cd0: 09 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e . (case (strin
8ce0: 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 20 72 75 g->symbol (or ru
8cf0: 6c 65 74 79 70 65 20 22 6e 6f 2d 73 75 63 68 2d letype "no-such-
8d00: 72 75 6c 65 22 29 29 0a 0a 09 09 20 20 20 20 20 rule"))....
8d10: 28 28 6e 6f 2d 73 75 63 68 2d 72 75 6c 65 29 20 ((no-such-rule)
8d20: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 6e (print "ERROR: n
8d30: 6f 20 73 75 63 68 20 72 75 6c 65 20 66 6f 72 20 o such rule for
8d40: 22 20 73 65 6e 73 65 29 29 0a 0a 09 09 20 20 20 " sense))....
8d50: 20 20 3b 3b 20 48 61 6e 64 6c 65 20 63 72 6f 6e ;; Handle cron
8d60: 74 61 62 20 6c 69 6b 65 20 72 75 6c 65 73 0a 09 tab like rules..
8d70: 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 . ;;...
8d80: 28 28 73 63 68 65 64 75 6c 65 64 29 0a 09 09 20 ((scheduled)...
8d90: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 (if (not (a
8da0: 6c 69 73 74 2d 72 65 66 20 27 63 72 6f 6e 20 76 list-ref 'cron v
8db0: 61 6c 2d 61 6c 69 73 74 29 29 20 3b 3b 20 67 6f al-alist)) ;; go
8dc0: 74 74 61 20 68 61 76 65 20 63 72 6f 6e 20 73 70 tta have cron sp
8dd0: 65 63 0a 09 09 09 20 20 28 70 72 69 6e 74 20 22 ec.... (print "
8de0: 45 52 52 4f 52 3a 20 62 61 64 20 73 65 6e 73 65 ERROR: bad sense
8df0: 20 73 70 65 63 20 5c 22 22 20 28 73 74 72 69 6e spec \"" (strin
8e00: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 65 g-intersperse se
8e10: 6e 73 65 20 22 20 22 29 20 22 5c 22 20 70 61 72 nse " ") "\" par
8e20: 61 6d 73 3a 20 22 20 76 61 6c 2d 61 6c 69 73 74 ams: " val-alist
8e30: 29 0a 09 09 09 20 20 28 6c 65 74 2a 20 28 0a 09 ).... (let* (..
8e40: 09 09 09 20 3b 3b 20 28 61 63 74 69 6f 6e 20 20 ... ;; (action
8e50: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 63 74 (alist-ref 'act
8e60: 69 6f 6e 20 20 20 76 61 6c 2d 61 6c 69 73 74 29 ion val-alist)
8e70: 29 0a 09 09 09 09 20 28 63 72 6f 6e 2d 73 61 66 )..... (cron-saf
8e80: 65 2d 73 74 72 69 6e 67 20 28 73 74 72 69 6e 67 e-string (string
8e90: 2d 74 72 61 6e 73 6c 61 74 65 20 28 73 74 72 69 -translate (stri
8ea0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
8eb0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 72 6f string-split cro
8ec0: 6e 74 61 62 29 20 22 2d 22 29 20 22 2a 22 20 22 ntab) "-") "*" "
8ed0: 58 22 29 29 0a 09 09 09 09 20 28 72 75 6e 6e 61 X"))..... (runna
8ee0: 6d 65 20 20 73 74 64 2d 72 75 6e 6e 61 6d 65 29 me std-runname)
8ef0: 29 20 3b 3b 20 28 63 6f 6e 63 20 22 73 63 68 65 ) ;; (conc "sche
8f00: 64 22 20 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 d" (time->string
8f10: 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c (seconds->local
8f20: 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 -time (current-s
8f30: 65 63 6f 6e 64 73 29 29 20 22 25 4d 25 48 25 64 econds)) "%M%H%d
8f40: 22 29 29 29 29 29 0a 09 09 09 20 20 20 20 3b 3b "))))).... ;;
8f50: 20 28 70 72 69 6e 74 20 22 6c 61 73 74 2d 72 75 (print "last-ru
8f60: 6e 3a 20 22 20 6c 61 73 74 2d 72 75 6e 20 22 20 n: " last-run "
8f70: 6e 65 65 64 2d 72 75 6e 3a 20 22 20 6e 65 65 64 need-run: " need
8f80: 2d 72 75 6e 29 0a 09 09 09 20 20 20 20 3b 3b 20 -run).... ;;
8f90: 28 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 09 09 (if need-run....
8fa0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
8fb0: 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f 6e g->symbol action
8fc0: 29 0a 09 09 09 20 20 20 20 20 20 28 28 73 79 6e ).... ((syn
8fd0: 63 20 73 79 6e 63 2d 70 72 65 70 65 6e 64 29 0a c sync-prepend).
8fe0: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 63 ... (if (c
8ff0: 6f 6d 6d 6f 6e 3a 65 78 74 65 6e 64 65 64 2d 63 ommon:extended-c
9000: 72 6f 6e 20 63 72 6f 6e 74 61 62 20 23 66 20 6c ron crontab #f l
9010: 61 73 74 2d 73 79 6e 63 29 0a 09 09 09 09 20 20 ast-sync).....
9020: 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 (push-run-spec
9030: 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 torun contour ru
9040: 6e 6b 65 79 0a 09 09 09 09 09 09 20 20 60 28 28 nkey....... `((
9050: 6d 65 73 73 61 67 65 20 2e 20 2c 28 63 6f 6e 63 message . ,(conc
9060: 20 72 75 6c 65 74 79 70 65 20 22 3a 73 79 6e 63 ruletype ":sync
9070: 2d 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 74 72 -" cron-safe-str
9080: 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 20 20 ing)).......
9090: 28 61 63 74 69 6f 6e 20 20 2e 20 2c 61 63 74 69 (action . ,acti
90a0: 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 20 28 64 on)....... (d
90b0: 62 64 65 73 74 20 20 2e 20 2c 64 62 64 65 73 74 bdest . ,dbdest
90c0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 61 70 70 )....... (app
90d0: 65 6e 64 20 20 2e 20 2c 61 70 70 65 6e 64 63 6f end . ,appendco
90e0: 6e 66 29 0a 09 09 09 09 09 09 20 20 20 20 28 61 nf)....... (a
90f0: 72 65 61 73 20 20 20 2e 20 2c 61 72 65 61 73 29 reas . ,areas)
9100: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 28 )))).... ((
9110: 72 75 6e 29 0a 09 09 09 20 20 20 20 20 20 20 28 run).... (
9120: 69 66 20 28 63 6f 6d 6d 6f 6e 3a 65 78 74 65 6e if (common:exten
9130: 64 65 64 2d 63 72 6f 6e 20 63 72 6f 6e 74 61 62 ded-cron crontab
9140: 20 23 66 20 6c 61 73 74 2d 72 75 6e 29 0a 09 09 #f last-run)...
9150: 09 09 20 20 20 28 70 75 73 68 2d 72 75 6e 2d 73 .. (push-run-s
9160: 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 pec torun contou
9170: 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 09 20 r runkey.......
9180: 20 60 28 28 6d 65 73 73 61 67 65 20 20 2e 20 2c `((message . ,
9190: 28 63 6f 6e 63 20 72 75 6c 65 74 79 70 65 20 22 (conc ruletype "
91a0: 3a 22 20 63 72 6f 6e 2d 73 61 66 65 2d 73 74 72 :" cron-safe-str
91b0: 69 6e 67 29 29 0a 09 09 09 09 09 09 20 20 20 20 ing)).......
91c0: 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e (runname . ,run
91d0: 6e 61 6d 65 29 0a 09 09 09 09 09 09 20 20 20 20 name).......
91e0: 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e (runtrans . ,run
91f0: 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 20 20 trans).......
9200: 20 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 (action . ,ac
9210: 74 69 6f 6e 29 0a 09 09 09 09 09 09 20 20 20 20 tion).......
9220: 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 (areas . ,are
9230: 61 73 29 0a 09 09 09 09 09 09 20 20 20 20 28 74 as)....... (t
9240: 61 72 67 65 74 20 20 20 2e 20 2c 74 61 72 67 65 arget . ,targe
9250: 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 t))))).
9260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9270: 20 20 20 20 20 28 28 72 65 6d 6f 76 65 29 0a 20 ((remove).
9280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
92a0: 75 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 ush-run-spec tor
92b0: 75 6e 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 un contour runke
92c0: 79 0a 09 09 09 09 09 09 20 20 60 28 28 6d 65 73 y....... `((mes
92d0: 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 sage . ,(conc r
92e0: 75 6c 65 74 79 70 65 20 22 3a 22 20 63 72 6f 6e uletype ":" cron
92f0: 2d 73 61 66 65 2d 73 74 72 69 6e 67 29 29 0a 09 -safe-string))..
9300: 09 09 09 09 09 20 20 20 20 28 72 75 6e 6e 61 6d ..... (runnam
9310: 65 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 e . ,runname)..
9320: 09 09 09 09 09 20 20 20 20 28 72 75 6e 74 72 61 ..... (runtra
9330: 6e 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a ns . ,runtrans).
9340: 09 09 09 09 09 09 20 20 20 20 28 61 63 74 69 6f ...... (actio
9350: 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a 09 n . ,action)..
9360: 09 09 09 09 09 20 20 20 20 28 61 72 65 61 73 20 ..... (areas
9370: 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 09 . ,areas)....
9380: 09 09 09 20 20 20 20 28 74 61 72 67 65 74 20 20 ... (target
9390: 20 2e 20 2c 74 61 72 67 65 74 29 29 29 29 0a 09 . ,target))))..
93a0: 09 09 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 .. (else...
93b0: 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 . (print "
93c0: 45 52 52 4f 52 3a 20 61 63 74 69 6f 6e 20 5c 22 ERROR: action \"
93d0: 22 20 61 63 74 69 6f 6e 20 22 5c 22 20 68 61 73 " action "\" has
93e0: 20 6e 6f 20 73 63 68 65 64 75 6c 65 64 20 68 61 no scheduled ha
93f0: 6e 64 6c 65 72 22 29 0a 09 09 09 20 20 20 20 20 ndler")....
9400: 20 20 29 29 29 29 29 0a 0a 0a 09 09 20 20 20 20 ))))).....
9410: 20 3b 3b 20 73 63 72 69 70 74 20 62 61 73 65 64 ;; script based
9420: 20 73 65 6e 73 6f 72 73 0a 09 09 20 20 20 20 20 sensors...
9430: 3b 3b 0a 09 09 20 20 20 20 20 28 28 73 63 72 69 ;;... ((scri
9440: 70 74 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 73 pt)... ;; s
9450: 79 6e 74 61 78 20 69 73 20 61 20 6c 69 74 74 6c yntax is a littl
9460: 65 20 64 69 66 66 65 72 65 6e 74 20 68 65 72 65 e different here
9470: 2e 20 49 74 20 69 73 20 61 20 6c 69 73 74 20 6f . It is a list o
9480: 66 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 72 75 f commands to ru
9490: 6e 2c 20 22 73 63 72 69 70 74 6e 61 6d 65 20 3d n, "scriptname =
94a0: 20 65 78 74 72 61 5f 70 61 72 61 6d 65 74 65 72 extra_parameter
94b0: 73 3b 73 63 72 69 70 74 6e 61 6d 65 20 3d 20 2e s;scriptname = .
94c0: 2e 2e 22 0a 09 09 20 20 20 20 20 20 3b 3b 20 77 .."... ;; w
94d0: 68 65 72 65 20 73 63 72 69 70 74 6e 61 6d 65 20 here scriptname
94e0: 6d 61 79 20 62 65 20 72 65 70 65 61 74 65 64 20 may be repeated
94f0: 6d 75 6c 74 69 70 6c 65 20 74 69 6d 65 73 2e 20 multiple times.
9500: 54 68 65 20 73 63 72 69 70 74 20 6d 75 73 74 20 The script must
9510: 72 65 74 75 72 6e 20 75 6e 69 78 2d 65 70 6f 63 return unix-epoc
9520: 68 20 6f 66 20 6c 61 73 74 20 63 68 61 6e 67 65 h of last change
9530: 2c 20 6e 65 77 2d 74 61 72 67 65 74 2d 6e 61 6d , new-target-nam
9540: 65 20 61 6e 64 20 6e 65 77 2d 72 75 6e 2d 6e 61 e and new-run-na
9550: 6d 65 0a 09 09 20 20 20 20 20 20 3b 3b 20 74 68 me... ;; th
9560: 65 20 73 63 72 69 70 74 20 69 73 20 63 61 6c 6c e script is call
9570: 65 64 20 6c 69 6b 65 20 74 68 69 73 3a 20 20 73 ed like this: s
9580: 63 72 69 70 74 6e 61 6d 65 20 63 6f 6e 74 6f 75 criptname contou
9590: 72 20 72 75 6e 6b 65 79 20 73 74 64 2d 72 75 6e r runkey std-run
95a0: 6e 61 6d 65 20 61 63 74 69 6f 6e 20 65 78 74 72 name action extr
95b0: 61 5f 70 61 72 61 6d 31 20 65 78 74 72 61 5f 70 a_param1 extra_p
95c0: 61 72 61 6d 32 20 2e 2e 2e 0a 09 09 20 20 20 20 aram2 ......
95d0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 (for-each...
95e0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6d (lambda (cm
95f0: 64 29 0a 09 09 09 20 28 70 72 69 6e 74 20 22 63 d).... (print "c
9600: 6d 64 3a 20 22 20 63 6d 64 29 0a 09 09 09 20 28 md: " cmd).... (
9610: 6c 65 74 2a 20 28 28 73 63 72 69 70 74 20 28 63 let* ((script (c
9620: 61 72 20 63 6d 64 29 29 0a 09 09 09 09 28 70 61 ar cmd)).....(pa
9630: 72 61 6d 73 20 28 63 64 72 20 63 6d 64 29 29 0a rams (cdr cmd)).
9640: 09 09 09 09 28 63 6d 64 20 20 20 20 28 63 6f 6e ....(cmd (con
9650: 63 20 73 63 72 69 70 74 20 22 20 22 20 63 6f 6e c script " " con
9660: 74 6f 75 72 20 22 20 22 20 72 75 6e 6b 65 79 20 tour " " runkey
9670: 22 20 22 20 73 74 64 2d 72 75 6e 6e 61 6d 65 20 " " std-runname
9680: 22 20 22 20 61 63 74 69 6f 6e 20 22 20 22 20 70 " " action " " p
9690: 61 72 61 6d 73 29 29 0a 09 09 09 09 28 72 65 73 arams)).....(res
96a0: 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 (handle-exce
96b0: 70 74 69 6f 6e 73 0a 09 09 09 09 09 20 20 20 20 ptions......
96c0: 65 78 6e 0a 09 09 09 09 09 20 20 20 20 23 66 0a exn...... #f.
96d0: 09 09 09 09 09 20 20 28 70 72 69 6e 74 20 22 52 ..... (print "R
96e0: 75 6e 6e 69 6e 67 20 22 20 63 6d 64 29 0a 09 09 unning " cmd)...
96f0: 09 09 09 20 20 28 77 69 74 68 2d 69 6e 70 75 74 ... (with-input
9700: 2d 66 72 6f 6d 2d 70 69 70 65 20 63 6d 64 20 72 -from-pipe cmd r
9710: 65 61 64 2d 6c 69 6e 65 73 29 29 29 29 0a 09 09 ead-lines))))...
9720: 09 20 20 20 28 69 66 20 28 61 6e 64 20 72 65 73 . (if (and res
9730: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 73 (not (null? res
9740: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c ))).... (l
9750: 65 74 2a 20 28 28 70 61 72 74 73 20 20 20 20 20 et* ((parts
9760: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
9770: 28 63 61 72 20 72 65 73 29 29 29 20 3b 3b 0a 09 (car res))) ;;..
9780: 09 09 09 20 20 20 20 20 20 28 72 65 6d 2d 6c 69 ... (rem-li
9790: 6e 65 73 20 20 20 28 63 64 72 20 72 65 73 29 29 nes (cdr res))
97a0: 0a 09 09 09 09 20 20 20 20 20 20 28 6e 75 6d 2d ..... (num-
97b0: 70 61 72 74 73 20 20 20 28 6c 65 6e 67 74 68 20 parts (length
97c0: 70 61 72 74 73 29 29 0a 09 09 09 09 20 20 20 20 parts)).....
97d0: 20 20 28 6c 61 73 74 2d 63 68 61 6e 67 65 20 28 (last-change (
97e0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
97f0: 69 66 20 28 3e 20 6e 75 6d 2d 70 61 72 74 73 20 if (> num-parts
9800: 30 29 28 63 61 72 20 70 61 72 74 73 29 20 22 61 0)(car parts) "a
9810: 62 63 22 29 29 29 20 20 3b 3b 20 66 6f 72 63 65 bc"))) ;; force
9820: 20 6e 6f 20 72 75 6e 20 69 66 20 6e 6f 74 20 61 no run if not a
9830: 20 6e 75 6d 62 65 72 20 72 65 74 75 72 6e 65 64 number returned
9840: 0a 09 09 09 09 20 20 20 20 20 20 28 6e 65 77 2d ..... (new-
9850: 74 61 72 67 65 74 20 20 28 69 66 20 28 3e 20 6e target (if (> n
9860: 75 6d 2d 70 61 72 74 73 20 31 29 0a 09 09 09 09 um-parts 1).....
9870: 09 09 20 20 20 20 20 20 20 28 63 61 64 72 20 70 .. (cadr p
9880: 61 72 74 73 29 0a 09 09 09 09 09 09 20 20 20 20 arts).......
9890: 20 20 20 72 75 6e 6b 65 79 29 29 0a 09 09 09 09 runkey)).....
98a0: 20 20 20 20 20 20 28 6e 65 77 2d 72 75 6e 6e 61 (new-runna
98b0: 6d 65 20 28 69 66 20 28 3e 20 6e 75 6d 2d 70 61 me (if (> num-pa
98c0: 72 74 73 20 32 29 0a 09 09 09 09 09 09 20 20 20 rts 2).......
98d0: 20 20 20 20 28 63 61 64 64 72 20 70 61 72 74 73 (caddr parts
98e0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 73 )....... s
98f0: 74 64 2d 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 td-runname))....
9900: 09 20 20 20 20 20 20 28 6d 65 73 73 61 67 65 20 . (message
9910: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
9920: 65 6d 2d 6c 69 6e 65 73 29 0a 09 09 09 09 09 09 em-lines).......
9930: 20 20 20 20 20 20 20 63 6d 64 0a 09 09 09 09 09 cmd......
9940: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
9950: 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 6d 2d intersperse rem-
9960: 6c 69 6e 65 73 20 22 2d 22 29 29 29 0a 09 09 09 lines "-")))....
9970: 09 20 20 20 20 20 20 28 6e 65 65 64 2d 72 75 6e . (need-run
9980: 20 20 20 20 28 3e 20 6c 61 73 74 2d 63 68 61 6e (> last-chan
9990: 67 65 20 6c 61 73 74 2d 72 75 6e 29 29 29 0a 09 ge last-run)))..
99a0: 09 09 09 20 28 70 72 69 6e 74 20 22 6c 61 73 74 ... (print "last
99b0: 2d 72 75 6e 3a 20 22 20 6c 61 73 74 2d 72 75 6e -run: " last-run
99c0: 20 22 20 6e 65 65 64 2d 72 75 6e 3a 20 22 20 6e " need-run: " n
99d0: 65 65 64 2d 72 75 6e 29 0a 09 09 09 09 20 28 69 eed-run)..... (i
99e0: 66 20 6e 65 65 64 2d 72 75 6e 0a 09 09 09 09 20 f need-run.....
99f0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 2d (let* ((key-
9a00: 6d 73 67 20 20 20 20 60 28 28 6d 65 73 73 61 67 msg `((messag
9a10: 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c 65 e . ,(conc rule
9a20: 74 79 70 65 20 22 3a 22 20 6d 65 73 73 61 67 65 type ":" message
9a30: 29 29 0a 09 09 09 09 09 09 09 20 20 28 72 75 6e ))........ (run
9a40: 6e 61 6d 65 20 20 2e 20 2c 6e 65 77 2d 72 75 6e name . ,new-run
9a50: 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 20 20 28 name)........ (
9a60: 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e 74 runtrans . ,runt
9a70: 72 61 6e 73 29 0a 09 09 09 09 09 09 09 20 20 28 rans)........ (
9a80: 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 action . ,acti
9a90: 6f 6e 29 0a 09 09 09 09 09 09 09 20 20 28 61 72 on)........ (ar
9aa0: 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 73 29 eas . ,areas)
9ab0: 0a 09 09 09 09 09 09 09 20 20 3b 3b 28 74 61 72 ........ ;;(tar
9ac0: 67 65 74 20 20 20 2e 20 2c 28 6c 69 73 74 20 6e get . ,(list n
9ad0: 65 77 2d 74 61 72 67 65 74 29 29 20 3b 3b 20 6f ew-target)) ;; o
9ae0: 76 65 72 72 69 64 69 6e 67 20 77 69 74 68 20 72 verriding with r
9af0: 65 73 75 6c 74 20 66 72 6f 6d 20 72 75 6e 69 6e esult from runin
9b00: 67 20 74 68 65 20 73 63 72 69 70 74 0a 20 20 20 g the script.
9b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b40: 20 20 20 20 20 20 20 29 29 29 0a 09 09 09 09 20 ))).....
9b50: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 6b 65 (print "ke
9b60: 79 2d 6d 73 67 3a 20 22 20 6b 65 79 2d 6d 73 67 y-msg: " key-msg
9b70: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 70 75 )..... (pu
9b80: 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 sh-run-spec toru
9b90: 6e 20 63 6f 6e 74 6f 75 72 0a 09 09 09 09 09 09 n contour.......
9ba0: 20 20 20 20 20 20 28 69 66 20 6f 70 74 69 6f 6e (if option
9bb0: 61 6c 20 20 3b 3b 20 77 65 20 6e 65 65 64 20 74 al ;; we need t
9bc0: 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 64 69 66 o be able to dif
9bd0: 66 65 72 65 6e 74 69 61 74 65 20 73 61 6d 65 20 ferentiate same
9be0: 63 6f 6e 74 6f 75 72 2c 20 64 69 66 66 65 72 65 contour, differe
9bf0: 6e 74 20 62 65 68 61 76 69 6f 72 2e 20 0a 09 09 nt behavior. ...
9c00: 09 09 09 09 09 20 20 28 63 6f 6e 63 20 72 75 6e ..... (conc run
9c10: 6b 65 79 20 22 3a 22 20 6f 70 74 69 6f 6e 61 6c key ":" optional
9c20: 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 4e 4f 54 20 ) ;; NOTE: NOT
9c30: 43 4f 4d 50 4c 45 54 45 4c 59 20 49 4d 50 4c 45 COMPLETELY IMPLE
9c40: 4d 45 4e 54 45 44 2e 20 44 4f 20 4e 4f 54 20 55 MENTED. DO NOT U
9c50: 53 45 0a 09 09 09 09 09 09 09 20 20 72 75 6e 6b SE........ runk
9c60: 65 79 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ey).......
9c70: 6b 65 79 2d 6d 73 67 29 29 29 29 29 29 29 0a 09 key-msg)))))))..
9c80: 09 20 20 20 20 20 20 20 76 61 6c 2d 61 6c 69 73 . val-alis
9c90: 74 29 29 20 3b 3b 20 69 74 65 72 61 74 65 20 6f t)) ;; iterate o
9ca0: 76 65 72 20 74 68 65 20 70 61 72 61 6d 20 73 70 ver the param sp
9cb0: 6c 69 74 20 62 79 20 3b 5c 73 2a 0a 0a 09 09 20 lit by ;\s*....
9cc0: 20 20 20 20 3b 3b 20 73 63 72 69 70 74 20 62 61 ;; script ba
9cd0: 73 65 64 20 73 65 6e 73 6f 72 73 0a 09 09 20 20 sed sensors...
9ce0: 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 61 ;;... ((a
9cf0: 72 65 61 2d 73 63 72 69 70 74 29 0a 09 09 20 20 rea-script)...
9d00: 20 20 20 20 3b 3b 20 73 79 6e 74 61 78 20 69 73 ;; syntax is
9d10: 20 61 20 6c 69 74 74 6c 65 20 64 69 66 66 65 72 a little differ
9d20: 65 6e 74 20 68 65 72 65 2e 20 49 74 20 69 73 20 ent here. It is
9d30: 61 20 6c 69 73 74 20 6f 66 20 63 6f 6d 6d 61 6e a list of comman
9d40: 64 73 20 74 6f 20 72 75 6e 2c 20 22 73 63 72 69 ds to run, "scri
9d50: 70 74 6e 61 6d 65 20 3d 20 65 78 74 72 61 5f 70 ptname = extra_p
9d60: 61 72 61 6d 65 74 65 72 73 3b 73 63 72 69 70 74 arameters;script
9d70: 6e 61 6d 65 20 3d 20 2e 2e 2e 22 0a 09 09 20 20 name = ..."...
9d80: 20 20 20 20 3b 3b 20 77 68 65 72 65 20 73 63 72 ;; where scr
9d90: 69 70 74 6e 61 6d 65 20 6d 61 79 20 62 65 20 72 iptname may be r
9da0: 65 70 65 61 74 65 64 20 6d 75 6c 74 69 70 6c 65 epeated multiple
9db0: 20 74 69 6d 65 73 2e 20 54 68 65 20 73 63 72 69 times. The scri
9dc0: 70 74 20 6d 75 73 74 20 72 65 74 75 72 6e 20 75 pt must return u
9dd0: 6e 69 78 2d 65 70 6f 63 68 20 6f 66 20 6c 61 73 nix-epoch of las
9de0: 74 20 63 68 61 6e 67 65 2c 20 6e 65 77 2d 74 61 t change, new-ta
9df0: 72 67 65 74 2d 6e 61 6d 65 20 61 6e 64 20 6e 65 rget-name and ne
9e00: 77 2d 72 75 6e 2d 6e 61 6d 65 0a 09 09 20 20 20 w-run-name...
9e10: 20 20 20 3b 3b 20 74 68 65 20 73 63 72 69 70 74 ;; the script
9e20: 20 69 73 20 63 61 6c 6c 65 64 20 6c 69 6b 65 20 is called like
9e30: 74 68 69 73 3a 20 20 73 63 72 69 70 74 6e 61 6d this: scriptnam
9e40: 65 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 e contour runkey
9e50: 20 73 74 64 2d 72 75 6e 6e 61 6d 65 20 61 63 74 std-runname act
9e60: 69 6f 6e 20 65 78 74 72 61 5f 70 61 72 61 6d 31 ion extra_param1
9e70: 20 65 78 74 72 61 5f 70 61 72 61 6d 32 20 2e 2e extra_param2 ..
9e80: 2e 0a 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 .... (for-e
9e90: 61 63 68 0a 09 09 20 20 20 20 20 20 20 28 6c 61 ach... (la
9ea0: 6d 62 64 61 20 28 63 6d 64 29 0a 09 09 09 20 3b mbda (cmd).... ;
9eb0: 3b 28 70 72 69 6e 74 20 22 63 6d 64 3a 20 22 20 ;(print "cmd: "
9ec0: 63 6d 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 cmd).
9ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
9ee0: 28 70 72 69 6e 74 20 22 41 72 65 61 73 3a 20 22 (print "Areas: "
9ef0: 20 61 6c 6c 2d 61 72 65 61 73 29 0a 20 20 20 20 all-areas).
9f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f10: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
9f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f30: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
9f40: 64 61 20 28 61 72 65 61 29 20 0a 20 20 20 20 20 da (area) .
9f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f60: 20 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 ;;(print
9f70: 20 22 41 72 65 61 3a 20 22 20 61 72 65 61 29 0a "Area: " area).
9f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 ;;(
9fa0: 70 72 69 6e 74 20 22 54 61 72 67 65 74 3a 20 22 print "Target: "
9fb0: 20 72 75 6e 6b 65 79 29 0a 20 20 20 20 20 20 20 runkey).
9fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fd0: 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 ;;(print "
9fe0: 4f 52 3a 20 22 20 28 6f 72 20 28 73 74 72 69 6e OR: " (or (strin
9ff0: 67 2d 3e 6e 75 6d 62 65 72 20 28 69 66 20 28 63 g->number (if (c
a000: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 onfigf:lookup mt
a010: 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 6d 61 conf "setup" "ma
a020: 78 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 75 x_packets_per_ru
a030: 6e 22 29 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f n") (configf:loo
a040: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 kup mtconf "setu
a050: 70 22 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f p" "max_packets_
a060: 70 65 72 5f 72 75 6e 22 29 20 22 31 30 30 30 30 per_run") "10000
a070: 22 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 " )))).
a080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a090: 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 50 61 ;;(print "Pa
a0a0: 63 6b 65 74 73 20 67 65 6e 65 72 61 74 65 64 3a ckets generated:
a0b0: 20 22 20 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 " packets-gener
a0c0: 61 74 65 64 29 0a 20 20 20 20 20 20 20 20 20 20 ated).
a0d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a0e0: 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 43 6f 6d ;;(print "Com
a0f0: 70 61 72 69 73 6f 6e 3a 20 22 20 28 3c 20 70 61 parison: " (< pa
a100: 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 65 64 20 ckets-generated
a110: 34 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 4)).
a120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a130: 20 3b 3b 28 70 72 69 6e 74 20 22 46 75 6c 6c 20 ;;(print "Full
a140: 43 6f 6d 70 61 72 69 73 6f 6e 3a 20 22 20 0a 20 Comparison: " .
a150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a160: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
a170: 20 28 61 6e 64 20 28 3c 20 70 61 63 6b 65 74 73 (and (< packets
a180: 2d 67 65 6e 65 72 61 74 65 64 20 28 6f 72 20 28 -generated (or (
a190: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
a1a0: 69 66 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b if (configf:look
a1b0: 75 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 up mtconf "setup
a1c0: 22 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f 70 " "max_packets_p
a1d0: 65 72 5f 72 75 6e 22 29 20 28 63 6f 6e 66 69 67 er_run") (config
a1e0: 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 f:lookup mtconf
a1f0: 22 73 65 74 75 70 22 20 22 6d 61 78 5f 70 61 63 "setup" "max_pac
a200: 6b 65 74 73 5f 70 65 72 5f 72 75 6e 22 29 20 22 kets_per_run") "
a210: 31 30 30 30 30 22 20 29 29 20 31 30 30 30 30 29 10000" )) 10000)
a220: 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ) .
a230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a240: 20 3b 3b 20 20 20 20 20 20 20 20 28 69 66 20 28 ;; (if (
a250: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
a260: 61 72 67 65 74 22 29 20 0a 20 20 20 20 20 20 20 arget") .
a270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a280: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
a290: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
a2a0: 3d 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 = (args:get-arg
a2b0: 22 2d 74 61 72 67 65 74 22 29 20 72 75 6e 6b 65 "-target") runke
a2c0: 79 29 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 y) (area-allowed
a2d0: 3f 20 61 72 65 61 20 22 61 72 65 61 2d 6e 65 65 ? area "area-nee
a2e0: 64 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 75 ds-to-be-run" ru
a2f0: 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 29 nkey contour #f)
a300: 20 23 66 29 20 0a 20 20 20 20 20 20 20 20 20 20 #f) .
a310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a320: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
a330: 20 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 3f (area-allowed?
a340: 20 61 72 65 61 20 22 61 72 65 61 2d 6e 65 65 64 area "area-need
a350: 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 75 6e s-to-be-run" run
a360: 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 29 29 key contour #f))
a370: 29 29 0a 09 09 09 20 20 20 20 3b 3b 28 70 72 69 )).... ;;(pri
a380: 6e 74 20 22 41 72 65 61 20 41 6c 6c 6f 77 65 64 nt "Area Allowed
a390: 3a 20 22 20 28 61 72 65 61 2d 61 6c 6c 6f 77 65 : " (area-allowe
a3a0: 64 3f 20 61 72 65 61 20 22 61 72 65 61 2d 6e 65 d? area "area-ne
a3b0: 65 64 73 2d 74 6f 2d 62 65 2d 72 75 6e 22 20 72 eds-to-be-run" r
a3c0: 75 6e 6b 65 79 20 63 6f 6e 74 6f 75 72 20 23 66 unkey contour #f
a3d0: 29 29 0a 3b 41 64 64 20 63 6f 64 65 20 74 6f 20 )).;Add code to
a3e0: 63 68 65 63 6b 20 77 68 65 74 68 65 72 20 61 72 check whether ar
a3f0: 65 61 20 69 73 20 76 61 6c 69 64 0a 09 09 09 20 ea is valid....
a400: 20 20 20 20 28 69 66 20 0a 20 20 20 20 20 20 20 (if .
a410: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 ;; T
a420: 68 69 73 20 63 6f 64 65 20 63 68 65 63 6b 73 20 his code checks
a430: 77 68 65 74 68 65 72 20 74 68 65 20 74 61 72 67 whether the targ
a440: 65 74 20 68 61 73 20 62 65 65 6e 20 70 61 73 73 et has been pass
a450: 65 64 20 69 6e 20 76 69 61 20 61 72 67 75 6d 65 ed in via argume
a460: 6e 74 2c 20 61 6e 64 20 6f 6e 6c 79 20 72 75 6e nt, and only run
a470: 73 20 74 68 65 20 73 70 65 63 69 66 69 65 64 20 s the specified
a480: 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 20 target.
a490: 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 (and (
a4a0: 3c 20 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 61 < packets-genera
a4b0: 74 65 64 20 28 6f 72 20 28 73 74 72 69 6e 67 2d ted (or (string-
a4c0: 3e 6e 75 6d 62 65 72 20 28 69 66 20 28 63 6f 6e >number (if (con
a4d0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
a4e0: 6e 66 20 22 73 65 74 75 70 22 20 22 6d 61 78 5f nf "setup" "max_
a4f0: 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 75 6e 22 packets_per_run"
a500: 29 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 ) (configf:looku
a510: 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 p mtconf "setup"
a520: 20 22 6d 61 78 5f 70 61 63 6b 65 74 73 5f 70 65 "max_packets_pe
a530: 72 5f 72 75 6e 22 29 20 22 31 30 30 30 30 22 20 r_run") "10000"
a540: 29 29 20 31 30 30 30 30 29 29 20 20 0a 20 20 20 )) 10000)) .
a550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a560: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
a570: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
a580: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
a590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
a5a0: 69 66 20 28 73 74 72 69 6e 67 3d 20 28 61 72 67 if (string= (arg
a5b0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
a5c0: 65 74 22 29 20 72 75 6e 6b 65 79 29 20 28 61 72 et") runkey) (ar
a5d0: 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 72 65 61 ea-allowed? area
a5e0: 20 22 61 72 65 61 2d 6e 65 65 64 73 2d 74 6f 2d "area-needs-to-
a5f0: 62 65 2d 72 75 6e 22 20 72 75 6e 6b 65 79 20 63 be-run" runkey c
a600: 6f 6e 74 6f 75 72 20 23 66 29 20 23 66 29 20 0a ontour #f) #f) .
a610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a630: 28 61 72 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 (area-allowed? a
a640: 72 65 61 20 22 61 72 65 61 2d 6e 65 65 64 73 2d rea "area-needs-
a650: 74 6f 2d 62 65 2d 72 75 6e 22 20 72 75 6e 6b 65 to-be-run" runke
a660: 79 20 63 6f 6e 74 6f 75 72 20 23 66 29 29 29 0a y contour #f))).
a670: 20 20 20 20 20 20 20 0a 09 09 09 20 20 20 20 20 ....
a680: 28 6c 65 74 2a 20 28 28 73 63 72 69 70 74 20 28 (let* ((script (
a690: 63 61 72 20 63 6d 64 29 29 0a 09 09 09 09 28 70 car cmd)).....(p
a6a0: 61 72 61 6d 73 20 28 63 64 72 20 63 6d 64 29 29 arams (cdr cmd))
a6b0: 0a 09 09 09 09 28 63 6d 64 20 20 20 20 28 63 6f .....(cmd (co
a6c0: 6e 63 20 73 63 72 69 70 74 20 22 20 22 20 63 6f nc script " " co
a6d0: 6e 74 6f 75 72 20 22 20 22 20 61 72 65 61 20 22 ntour " " area "
a6e0: 20 22 20 72 75 6e 6b 65 79 20 22 20 22 20 73 74 " runkey " " st
a6f0: 64 2d 72 75 6e 6e 61 6d 65 20 22 20 22 20 61 63 d-runname " " ac
a700: 74 69 6f 6e 20 22 20 22 20 70 61 72 61 6d 73 29 tion " " params)
a710: 29 0a 09 09 09 09 28 72 65 73 20 20 20 20 28 68 ).....(res (h
a720: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
a730: 0a 09 09 09 09 09 20 20 20 20 65 78 6e 0a 09 09 ...... exn...
a740: 09 09 09 20 20 20 20 23 66 0a 09 09 09 09 09 20 ... #f......
a750: 20 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 6e 67 (print "Running
a760: 20 22 20 63 6d 64 29 0a 09 09 09 09 09 20 20 28 " cmd)...... (
a770: 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d with-input-from-
a780: 70 69 70 65 20 63 6d 64 20 72 65 61 64 2d 6c 69 pipe cmd read-li
a790: 6e 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 nes))).
a7a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a7b0: 20 20 20 20 20 20 20 28 63 76 61 6c 20 20 20 20 (cval
a7c0: 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a (or (configf:
a7d0: 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 63 lookup mtconf "c
a7e0: 6f 6e 74 6f 75 72 73 22 20 63 6f 6e 74 6f 75 72 ontours" contour
a7f0: 29 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 ) "")).
a800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a810: 20 20 20 20 20 20 20 28 63 76 61 6c 2d 61 6c 69 (cval-ali
a820: 73 74 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c 2d 3e st (common:val->
a830: 61 6c 69 73 74 20 63 76 61 6c 29 29 20 20 20 20 alist cval))
a840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a850: 20 3b 3b 20 42 45 57 41 52 45 20 2e 2e 2e 20 4e ;; BEWARE ... N
a860: 4f 54 20 74 68 65 20 73 61 6d 65 20 76 61 6c 2d OT the same val-
a870: 61 6c 69 73 74 20 61 73 20 61 62 6f 76 65 21 0a alist as above!.
a880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8a0: 3b 3b 28 61 72 65 61 73 20 20 20 20 20 20 28 76 ;;(areas (v
a8b0: 61 6c 2d 61 6c 69 73 74 2d 3e 61 72 65 61 73 20 al-alist->areas
a8c0: 63 76 61 6c 2d 61 6c 69 73 74 29 29 0a 20 20 20 cval-alist)).
a8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
a8f0: 6c 65 63 74 6f 72 20 20 20 28 61 6c 69 73 74 2d lector (alist-
a900: 72 65 66 20 27 73 65 6c 65 63 74 6f 72 20 63 76 ref 'selector cv
a910: 61 6c 2d 61 6c 69 73 74 29 29 0a 20 20 20 20 20 al-alist)).
a920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a930: 20 20 20 20 20 20 20 20 20 20 20 28 6d 6f 64 65 (mode
a940: 2d 74 61 67 20 20 20 28 61 6e 64 20 73 65 6c 65 -tag (and sele
a950: 63 74 6f 72 20 28 73 74 72 69 6e 67 2d 73 70 6c ctor (string-spl
a960: 69 74 2d 66 69 65 6c 64 73 20 22 2f 22 20 73 65 it-fields "/" se
a970: 6c 65 63 74 6f 72 20 23 3a 69 6e 66 69 78 29 29 lector #:infix))
a980: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9a0: 20 20 28 6d 6f 64 65 2d 70 61 74 74 20 20 28 61 (mode-patt (a
a9b0: 6e 64 20 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 nd mode-tag (if
a9c0: 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 6d 6f 64 (eq? (length mod
a9d0: 65 2d 74 61 67 29 20 32 29 28 63 61 64 72 20 6d e-tag) 2)(cadr m
a9e0: 6f 64 65 2d 74 61 67 29 20 23 66 29 29 29 0a 20 ode-tag) #f))).
a9f0: 20 20 20 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 28 (
aa10: 74 61 67 2d 65 78 70 72 20 20 20 28 61 6e 64 20 tag-expr (and
aa20: 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 28 6e 75 mode-tag (if (nu
aa30: 6c 6c 3f 20 6d 6f 64 65 2d 74 61 67 29 20 23 66 ll? mode-tag) #f
aa40: 20 28 63 61 72 20 6d 6f 64 65 2d 74 61 67 29 29 (car mode-tag))
aa50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
aa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa70: 20 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 ).... (if (
aa80: 61 6e 64 20 72 65 73 20 28 6e 6f 74 20 28 6e 75 and res (not (nu
aa90: 6c 6c 3f 20 72 65 73 29 29 29 0a 09 09 09 20 20 ll? res)))....
aaa0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 72 (let* ((par
aab0: 74 73 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 ts (string
aac0: 2d 73 70 6c 69 74 20 28 63 61 72 20 72 65 73 29 -split (car res)
aad0: 29 29 20 3b 3b 0a 09 09 09 09 20 20 20 20 20 20 )) ;;.....
aae0: 28 72 65 6d 2d 6c 69 6e 65 73 20 20 20 28 63 64 (rem-lines (cd
aaf0: 72 20 72 65 73 29 29 0a 09 09 09 09 20 20 20 20 r res)).....
ab00: 20 20 28 6e 75 6d 2d 70 61 72 74 73 20 20 20 28 (num-parts (
ab10: 6c 65 6e 67 74 68 20 70 61 72 74 73 29 29 0a 09 length parts))..
ab20: 09 09 09 20 20 20 20 20 20 28 6c 61 73 74 2d 63 ... (last-c
ab30: 68 61 6e 67 65 20 28 73 74 72 69 6e 67 2d 3e 6e hange (string->n
ab40: 75 6d 62 65 72 20 28 69 66 20 28 3e 20 6e 75 6d umber (if (> num
ab50: 2d 70 61 72 74 73 20 30 29 28 63 61 72 20 70 61 -parts 0)(car pa
ab60: 72 74 73 29 20 22 61 62 63 22 29 29 29 20 20 3b rts) "abc"))) ;
ab70: 3b 20 66 6f 72 63 65 20 6e 6f 20 72 75 6e 20 69 ; force no run i
ab80: 66 20 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 72 f not a number r
ab90: 65 74 75 72 6e 65 64 0a 09 09 09 09 20 20 20 20 eturned.....
aba0: 20 20 28 6e 65 77 2d 74 61 72 67 65 74 20 20 28 (new-target (
abb0: 69 66 20 28 3e 20 6e 75 6d 2d 70 61 72 74 73 20 if (> num-parts
abc0: 31 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 1).......
abd0: 28 63 61 64 72 20 70 61 72 74 73 29 0a 09 09 09 (cadr parts)....
abe0: 09 09 09 20 20 20 20 20 20 20 72 75 6e 6b 65 79 ... runkey
abf0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 6e 65 ))..... (ne
ac00: 77 2d 72 75 6e 6e 61 6d 65 20 28 69 66 20 28 3e w-runname (if (>
ac10: 20 6e 75 6d 2d 70 61 72 74 73 20 32 29 0a 09 09 num-parts 2)...
ac20: 09 09 09 09 20 20 20 20 20 20 20 28 63 61 64 64 .... (cadd
ac30: 72 20 70 61 72 74 73 29 0a 09 09 09 09 09 09 20 r parts).......
ac40: 20 20 20 20 20 20 73 74 64 2d 72 75 6e 6e 61 6d std-runnam
ac50: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
ac60: 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 20 .
ac70: 20 20 20 28 61 72 65 61 2d 70 6b 74 73 20 20 28 (area-pkts (
ac80: 66 69 6e 64 2d 70 6b 74 73 20 70 64 62 20 27 28 find-pkts pdb '(
ac90: 72 75 6e 73 74 61 72 74 29 20 60 28 28 63 20 2e runstart) `((c .
aca0: 20 2c 63 6f 6e 74 6f 75 72 29 0a 20 20 20 20 20 ,contour).
acb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ace0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acf0: 20 20 20 20 20 20 20 20 20 20 28 74 20 2e 20 2c (t . ,
ad00: 72 75 6e 6b 65 79 29 0a 20 20 20 20 20 20 20 20 runkey).
ad10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 47 20 2e 20 2c 61 72 65 (G . ,are
ad60: 61 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 a )))).
ad70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 75 (ru
ad90: 6e 73 74 61 72 74 73 20 28 66 69 6c 74 65 72 20 nstarts (filter
ada0: 28 6c 61 6d 62 64 61 20 28 6d 79 2d 70 6b 74 29 (lambda (my-pkt)
adb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
adc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
add0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 70 ;;(p
ade0: 72 69 6e 74 20 6d 79 2d 70 6b 74 29 0a 20 20 20 rint my-pkt).
adf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae10: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 63 6f (not (co
ae20: 6e 74 61 69 6e 73 20 28 6d 61 70 0a 20 20 20 20 ntains (map.
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 20 20 20
ae50: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
ae60: 64 61 20 28 63 29 0a 20 20 20 20 20 20 20 20 20 da (c).
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 20 20 20 20 20 20 20
ae90: 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 ;;(print
aea0: 22 43 3a 20 22 20 63 20 22 50 4b 54 3a 20 22 20 "C: " c "PKT: "
aeb0: 6d 79 2d 70 6b 74 29 20 0a 20 20 20 20 20 20 20 my-pkt) .
aec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aee0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
aef0: 28 63 74 79 70 65 20 28 63 61 72 20 63 29 29 0a (ctype (car c)).
af00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af30: 20 20 20 20 20 20 20 28 72 78 20 28 63 64 72 20 (rx (cdr
af40: 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c)).
af50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
af70: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 66 6f ;;(fo
af80: 6f 32 20 28 70 72 69 6e 74 20 22 43 74 79 70 65 o2 (print "Ctype
af90: 3a 20 22 20 63 74 79 70 65 20 22 20 52 58 3a 20 : " ctype " RX:
afa0: 22 20 72 78 29 29 0a 20 20 20 20 20 20 20 20 20 " rx)).
afb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 70 (p
afe0: 6b 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 70 kt (alist-ref 'p
aff0: 6b 74 20 6d 79 2d 70 6b 74 29 29 0a 20 20 20 20 kt my-pkt)).
b000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b030: 20 20 20 28 61 70 6b 74 20 28 70 6b 74 2d 3e 61 (apkt (pkt->a
b040: 6c 69 73 74 20 70 6b 74 29 29 0a 20 20 20 20 20 list pkt)).
b050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b080: 20 20 28 63 64 61 74 20 28 61 6c 69 73 74 2d 72 (cdat (alist-r
b090: 65 66 20 63 74 79 70 65 20 61 70 6b 74 29 29 29 ef ctype apkt)))
b0a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0d0: 20 20 28 69 66 20 72 78 0a 20 20 20 20 20 20 20 (if rx.
b0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b100: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
b110: 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 74 22 20 tring-match "t"
b120: 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 (symbol->string
b130: 63 74 79 70 65 29 20 29 0a 20 20 20 20 20 20 20 ctype) ).
b140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 62 65 67 69 6e (begin
b170: 20 28 69 66 20 23 66 20 28 70 72 69 6e 74 20 22 (if #f (print "
b180: 52 58 3a 20 22 20 72 78 20 22 20 43 44 41 54 3a RX: " rx " CDAT:
b190: 20 22 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 " (string-join
b1a0: 28 74 61 6b 65 20 28 73 74 72 69 6e 67 2d 73 70 (take (string-sp
b1b0: 6c 69 74 20 63 64 61 74 20 22 2f 22 29 20 33 29 lit cdat "/") 3)
b1c0: 20 22 2f 22 29 29 29 20 28 69 66 20 63 64 61 74 "/"))) (if cdat
b1d0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 72 (string-match r
b1e0: 78 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 28 x (string-join (
b1f0: 74 61 6b 65 20 28 73 74 72 69 6e 67 2d 73 70 6c take (string-spl
b200: 69 74 20 63 64 61 74 20 22 2f 22 29 20 33 29 20 it cdat "/") 3)
b210: 22 2f 22 29 29 20 23 66 29 29 0a 20 20 20 20 20 "/")) #f)).
b220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b240: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
b250: 69 6e 20 28 69 66 20 23 66 20 28 70 72 69 6e 74 in (if #f (print
b260: 20 22 52 58 3a 20 22 20 72 78 20 22 20 43 44 41 "RX: " rx " CDA
b270: 54 3a 20 22 20 63 64 61 74 29 29 20 28 69 66 20 T: " cdat)) (if
b280: 63 64 61 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 cdat (string-mat
b290: 63 68 20 72 78 20 63 64 61 74 29 20 23 66 29 29 ch rx cdat) #f))
b2a0: 29 20 23 66 29 0a 0a 20 20 20 20 20 20 20 20 20 ) #f)..
b2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2d0: 20 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 20 )).
b2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b300: 20 20 20 60 28 28 63 20 2e 20 2c 63 6f 6e 74 6f `((c . ,conto
b310: 75 72 29 20 28 74 20 2e 20 2c 72 75 6e 6b 65 79 ur) (t . ,runkey
b320: 29 20 28 47 20 2e 20 2c 61 72 65 61 29 29 29 20 ) (G . ,area)))
b330: 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f))).
b340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 72 ar
b360: 65 61 2d 70 6b 74 73 29 29 0a 0a 20 20 20 20 20 ea-pkts))..
b370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b390: 20 3b 3b 28 74 65 73 74 20 28 70 70 20 72 75 6e ;;(test (pp run
b3a0: 73 74 61 72 74 73 29 29 0a 20 20 20 20 20 20 20 starts)).
b3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3c0: 20 09 20 20 20 20 20 20 28 72 73 70 6b 74 73 20 . (rspkts
b3d0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
b3e0: 70 6b 74 2d 61 6c 69 73 74 73 20 72 75 6e 73 74 pkt-alists runst
b3f0: 61 72 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 arts)).
b400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 .
b410: 20 20 20 20 20 20 3b 3b 20 73 74 61 72 74 74 69 ;; startti
b420: 6d 65 73 20 69 73 20 66 6f 72 20 72 75 6e 20 73 mes is for run s
b430: 74 61 72 74 20 74 69 6d 65 73 20 61 6e 64 20 69 tart times and i
b440: 73 20 75 73 65 64 20 74 6f 20 6b 6e 6f 77 20 77 s used to know w
b450: 68 65 6e 20 74 68 65 20 6c 61 73 74 20 72 75 6e hen the last run
b460: 20 77 61 73 20 6c 61 75 6e 63 68 65 64 0a 20 20 was launched.
b470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b480: 20 20 20 20 20 20 09 20 20 20 20 20 20 28 73 74 . (st
b490: 61 72 74 74 69 6d 65 73 20 28 63 6f 6d 6d 6f 6e arttimes (common
b4a0: 3a 67 65 74 2d 70 6b 74 2d 74 69 6d 65 73 20 72 :get-pkt-times r
b4b0: 73 70 6b 74 73 29 29 20 3b 3b 20 73 6f 72 74 20 spkts)) ;; sort
b4c0: 62 79 20 61 67 65 20 28 79 6f 75 6e 67 65 73 74 by age (youngest
b4d0: 20 66 69 72 73 74 29 20 61 6e 64 20 64 65 6c 65 first) and dele
b4e0: 74 65 20 64 75 70 6c 69 63 61 74 65 73 20 62 79 te duplicates by
b4f0: 20 74 61 72 67 65 74 0a 20 20 20 20 20 20 20 20 target.
b500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b510: 09 20 20 20 20 20 20 28 6c 61 73 74 2d 72 75 6e . (last-run
b520: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 (if (null? st
b530: 61 72 74 74 69 6d 65 73 29 20 3b 3b 20 69 66 20 arttimes) ;; if
b540: 27 28 29 20 74 68 65 6e 20 69 74 20 68 61 73 20 '() then it has
b550: 6e 65 76 65 72 20 62 65 65 6e 20 72 75 6e 2c 20 never been run,
b560: 65 6c 73 65 20 67 65 74 20 74 68 65 20 6d 61 78 else get the max
b570: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b590: 20 20 20 20 20 20 20 20 20 20 20 30 0a 20 20 20 0.
b5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5c0: 20 20 20 20 20 28 61 70 70 6c 79 20 6d 61 78 20 (apply max
b5d0: 28 6d 61 70 20 63 64 72 20 73 74 61 72 74 74 69 (map cdr startti
b5e0: 6d 65 73 29 29 29 29 0a 0a 20 20 20 20 20 20 20 mes))))..
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 20 20 3b 3b ;;
b610: 20 28 6c 61 73 74 2d 72 75 6e 20 20 39 29 20 3b (last-run 9) ;
b620: 3b 20 49 20 74 68 69 6e 6b 20 77 65 20 63 61 6e ; I think we can
b630: 20 64 6f 20 61 20 6d 6f 72 65 20 76 61 6c 69 64 do a more valid
b640: 20 63 61 6c 63 75 6c 61 74 69 6f 6e 20 66 6f 72 calculation for
b650: 20 74 68 69 73 20 62 61 73 65 64 20 6f 6e 20 74 this based on t
b660: 68 65 20 72 75 6e 20 73 74 61 72 74 65 64 20 70 he run started p
b670: 61 63 6b 65 74 73 20 66 6f 72 20 74 68 69 73 20 ackets for this
b680: 70 61 72 74 69 63 75 6c 61 72 20 61 72 65 61 20 particular area
b690: 61 6e 64 20 74 61 72 67 65 74 0a 20 20 20 20 20 and target.
b6a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b6b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b6c0: 20 28 72 65 61 73 6f 6e 20 22 41 72 65 61 2d 73 (reason "Area-s
b6d0: 63 72 69 70 74 2d 74 72 69 67 67 65 72 65 64 22 cript-triggered"
b6e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b6f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b700: 20 20 20 20 20 20 20 20 3b 3b 28 6d 6f 64 65 2d ;;(mode-
b710: 70 61 74 74 20 23 66 29 0a 20 20 20 20 20 20 20 patt #f).
b720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
b740: 3b 28 74 61 67 2d 65 78 70 72 20 23 66 29 0a 09 ;(tag-expr #f)..
b750: 09 09 09 20 20 20 20 20 20 28 73 63 68 65 64 20 ... (sched
b760: 23 66 29 0a 09 09 09 09 20 20 20 20 20 20 28 6d #f)..... (m
b770: 65 73 73 61 67 65 20 20 20 20 20 28 69 66 20 28 essage (if (
b780: 6e 75 6c 6c 3f 20 72 65 6d 2d 6c 69 6e 65 73 29 null? rem-lines)
b790: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 63 6d ....... cm
b7a0: 64 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 d....... (
b7b0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
b7c0: 73 65 20 72 65 6d 2d 6c 69 6e 65 73 20 22 2d 22 se rem-lines "-"
b7d0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 6e )))..... (n
b7e0: 65 65 64 2d 72 75 6e 20 20 20 20 28 3e 20 6c 61 eed-run (> la
b7f0: 73 74 2d 63 68 61 6e 67 65 20 6c 61 73 74 2d 72 st-change last-r
b800: 75 6e 29 29 29 0a 09 09 09 09 20 28 70 72 69 6e un)))..... (prin
b810: 74 20 22 6c 61 73 74 2d 63 68 61 6e 67 65 3a 20 t "last-change:
b820: 22 20 6c 61 73 74 2d 63 68 61 6e 67 65 20 22 20 " last-change "
b830: 6c 61 73 74 2d 72 75 6e 3a 20 22 20 6c 61 73 74 last-run: " last
b840: 2d 72 75 6e 20 22 20 6e 65 65 64 2d 72 75 6e 3a -run " need-run:
b850: 20 22 20 6e 65 65 64 2d 72 75 6e 29 0a 09 09 09 " need-run)....
b860: 09 20 28 69 66 20 6e 65 65 64 2d 72 75 6e 0a 09 . (if need-run..
b870: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
b880: 6b 65 79 2d 6d 73 67 20 20 20 20 60 28 28 6d 65 key-msg `((me
b890: 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 ssage . ,(conc
b8a0: 72 75 6c 65 74 79 70 65 20 22 3a 22 20 6d 65 73 ruletype ":" mes
b8b0: 73 61 67 65 29 29 0a 09 09 09 09 09 09 09 20 20 sage))........
b8c0: 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 6e 65 77 (runname . ,new
b8d0: 2d 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 -runname).......
b8e0: 09 20 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c . (runtrans . ,
b8f0: 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 runtrans).......
b900: 09 20 20 28 61 63 74 69 6f 6e 20 20 20 2e 20 2c . (action . ,
b910: 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 09 20 action)........
b920: 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 (areas . ,ar
b930: 65 61 29 0a 09 09 09 09 09 09 09 20 20 3b 3b 28 ea)........ ;;(
b940: 74 61 72 67 65 74 20 20 20 2e 20 2c 28 6c 69 73 target . ,(lis
b950: 74 20 6e 65 77 2d 74 61 72 67 65 74 29 29 20 3b t new-target)) ;
b960: 3b 20 6f 76 65 72 72 69 64 69 6e 67 20 77 69 74 ; overriding wit
b970: 68 20 72 65 73 75 6c 74 20 66 72 6f 6d 20 72 75 h result from ru
b980: 6e 69 6e 67 20 74 68 65 20 73 63 72 69 70 74 0a ning the script.
b990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9c0: 20 20 20 20 20 20 20 20 20 20 29 29 0a 09 09 09 ))....
b9d0: 09 09 09 09 28 61 76 61 6c 20 20 20 20 20 20 20 ....(aval
b9e0: 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
b9f0: 6b 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 kup mtconf "area
ba00: 73 22 20 61 72 65 61 29 20 22 22 29 29 0a 20 20 s" area) "")).
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 09 09 09 28 61 76 61 6c 2d 61 6c 69 73 74 ...(aval-alist
ba40: 20 28 63 6f 6d 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c (common:val->al
ba50: 69 73 74 20 61 76 61 6c 29 29 0a 0a 09 09 09 09 ist aval))......
ba60: 09 09 09 28 74 61 72 67 65 74 73 20 28 6d 61 70 ...(targets (map
ba70: 2d 74 61 72 67 65 74 73 20 6d 74 63 6f 6e 66 20 -targets mtconf
ba80: 61 76 61 6c 2d 61 6c 69 73 74 20 72 75 6e 6b 65 aval-alist runke
ba90: 79 20 61 72 65 61 20 63 6f 6e 74 6f 75 72 29 29 y area contour))
baa0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
bab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bac0: 20 20 20 20 20 20 20 20 20 20 28 70 70 20 74 61 (pp ta
bad0: 72 67 65 74 73 29 0a 09 09 09 09 20 20 20 20 20 rgets).....
bae0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
baf0: 6d 62 64 61 20 28 74 61 72 67 65 74 29 20 0a 20 mbda (target) .
bb00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb10: 20 20 20 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 28 63 72 65 61 74 65 2d 72 75 6e 2d (create-run-
bb40: 70 6b 74 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f pkt mtconf actio
bb50: 6e 20 61 72 65 61 20 72 75 6e 6b 65 79 20 74 61 n area runkey ta
bb60: 72 67 65 74 20 6e 65 77 2d 72 75 6e 6e 61 6d 65 rget new-runname
bb70: 20 6d 6f 64 65 2d 70 61 74 74 0a 20 20 20 20 20 mode-patt.
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 20 20 20 20 20 20 20 20 20 20 20
bbb0: 20 74 61 67 2d 65 78 70 72 20 70 6b 74 73 64 69 tag-expr pktsdi
bbc0: 72 20 72 65 61 73 6f 6e 20 63 6f 6e 74 6f 75 72 r reason contour
bbd0: 20 73 63 68 65 64 20 64 62 64 65 73 74 20 61 70 sched dbdest ap
bbe0: 70 65 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 pend.
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 72 75 6e 74 72 runtr
bc20: 61 6e 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ans).
bc30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc50: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
bc60: 70 61 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 65 packets-generate
bc70: 64 20 28 2b 20 70 61 63 6b 65 74 73 2d 67 65 6e d (+ packets-gen
bc80: 65 72 61 74 65 64 20 31 29 29 0a 20 20 20 20 20 erated 1)).
bc90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 29 20 74 ) t
bcc0: 61 72 67 65 74 73 29 0a 09 09 09 09 09 3b 3b 20 argets)......;;
bcd0: 41 64 64 20 66 69 6c 74 65 72 20 66 6f 72 20 74 Add filter for t
bce0: 61 72 67 65 74 73 0a 0a 20 20 20 20 20 20 20 20 argets..
bcf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
bd10: 3b 28 63 72 65 61 74 65 2d 72 75 6e 2d 70 6b 74 ;(create-run-pkt
bd20: 20 6d 74 63 6f 6e 66 20 61 63 74 69 6f 6e 20 61 mtconf action a
bd30: 72 65 61 20 72 75 6e 6b 65 79 20 74 61 72 67 65 rea runkey targe
bd40: 74 20 72 75 6e 6e 61 6d 65 0a 20 20 20 20 20 20 t runname.
bd50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd70: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
bd80: 20 20 70 6b 74 73 64 69 72 20 72 65 61 73 6f 6e pktsdir reason
bd90: 20 63 6f 6e 74 6f 75 72 20 64 62 64 65 73 74 20 contour dbdest
bda0: 61 70 70 65 6e 64 0a 20 20 20 20 20 20 20 20 20 append.
bdb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bdc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
bdd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
bde0: 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 20 20 20 untrans).....
bdf0: 20 20 20 20 28 70 72 69 6e 74 20 22 6b 65 79 2d (print "key-
be00: 6d 73 67 3a 20 22 20 6b 65 79 2d 6d 73 67 29 0a msg: " key-msg).
be10: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 28 70 75 .... ;;(pu
be20: 73 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 sh-run-spec toru
be30: 6e 20 63 6f 6e 74 6f 75 72 0a 09 09 09 09 3b 3b n contour.....;;
be40: 09 09 20 20 20 20 20 20 28 69 66 20 6f 70 74 69 .. (if opti
be50: 6f 6e 61 6c 20 20 3b 3b 20 77 65 20 6e 65 65 64 onal ;; we need
be60: 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 64 to be able to d
be70: 69 66 66 65 72 65 6e 74 69 61 74 65 20 73 61 6d ifferentiate sam
be80: 65 20 63 6f 6e 74 6f 75 72 2c 20 64 69 66 66 65 e contour, diffe
be90: 72 65 6e 74 20 62 65 68 61 76 69 6f 72 2e 20 0a rent behavior. .
bea0: 09 09 09 09 3b 3b 09 09 09 20 20 28 63 6f 6e 63 ....;;... (conc
beb0: 20 72 75 6e 6b 65 79 20 22 3a 22 20 6f 70 74 69 runkey ":" opti
bec0: 6f 6e 61 6c 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 onal) ;; NOTE:
bed0: 4e 4f 54 20 43 4f 4d 50 4c 45 54 45 4c 59 20 49 NOT COMPLETELY I
bee0: 4d 50 4c 45 4d 45 4e 54 45 44 2e 20 44 4f 20 4e MPLEMENTED. DO N
bef0: 4f 54 20 55 53 45 0a 09 09 09 09 3b 3b 09 09 09 OT USE.....;;...
bf00: 20 20 72 75 6e 6b 65 79 29 0a 09 09 09 09 3b 3b runkey).....;;
bf10: 09 09 20 20 20 20 20 20 6b 65 79 2d 6d 73 67 29 .. key-msg)
bf20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
bf30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf40: 20 20 20 20 20 20 20 20 29 29 29 29 29 20 0a 20 ))))) .
bf50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf70: 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 70 61 (if (>= pa
bf80: 63 6b 65 74 73 2d 67 65 6e 65 72 61 74 65 64 20 ckets-generated
bf90: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
bfa0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
bfb0: 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 mtconf "setup" "
bfc0: 6d 61 78 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f max_packets_per_
bfd0: 72 75 6e 22 29 29 29 20 28 70 72 69 6e 74 20 22 run"))) (print "
bfe0: 53 6b 69 70 70 69 6e 67 20 61 72 65 61 3a 20 22 Skipping area: "
bff0: 20 61 72 65 61 20 22 20 61 6e 64 20 74 61 72 67 area " and targ
c000: 65 74 3a 20 22 20 72 75 6e 6b 65 79 20 22 20 64 et: " runkey " d
c010: 75 65 20 74 6f 20 70 61 63 6b 65 74 73 2d 67 65 ue to packets-ge
c020: 6e 65 72 61 74 65 64 3a 20 22 20 70 61 63 6b 65 nerated: " packe
c030: 74 73 2d 67 65 6e 65 72 61 74 65 64 20 22 20 68 ts-generated " h
c040: 69 67 68 65 72 20 74 68 61 6e 20 22 20 28 63 6f igher than " (co
c050: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 nfigf:lookup mtc
c060: 6f 6e 66 20 22 73 65 74 75 70 22 20 22 6d 61 78 onf "setup" "max
c070: 5f 70 61 63 6b 65 74 73 5f 70 65 72 5f 72 75 6e _packets_per_run
c080: 22 29 29 29 29 20 20 20 20 0a 0a 20 20 20 20 20 ")))) ..
c090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c0a0: 20 20 29 20 28 66 69 6c 74 65 72 20 28 6c 61 6d ) (filter (lam
c0b0: 62 64 61 20 28 78 29 20 28 69 66 20 28 6e 6f 74 bda (x) (if (not
c0c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
c0d0: 2d 61 72 65 61 22 29 29 20 23 74 20 28 69 66 20 -area")) #t (if
c0e0: 28 73 74 72 69 6e 67 3d 20 78 20 28 61 72 67 73 (string= x (args
c0f0: 3a 67 65 74 2d 61 72 67 20 22 2d 61 72 65 61 22 :get-arg "-area"
c100: 29 29 20 23 74 20 23 66 29 29 29 20 61 6c 6c 2d )) #t #f))) all-
c110: 61 72 65 61 73 29 29 0a 09 09 20 20 20 20 20 20 areas))...
c120: 20 29 20 76 61 6c 2d 61 6c 69 73 74 29 29 20 3b ) val-alist)) ;
c130: 3b 20 69 74 65 72 61 74 65 20 6f 76 65 72 20 74 ; iterate over t
c140: 68 65 20 70 61 72 61 6d 20 73 70 6c 69 74 20 62 he param split b
c150: 79 20 3b 5c 73 2a 0a 0a 09 09 20 20 20 20 20 3b y ;\s*.... ;
c160: 3b 20 66 6f 73 73 69 6c 20 73 63 6d 20 62 61 73 ; fossil scm bas
c170: 65 64 20 74 72 69 67 67 65 72 73 0a 09 09 20 20 ed triggers...
c180: 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 28 28 66 ;;... ((f
c190: 6f 73 73 69 6c 29 0a 09 09 20 20 20 20 20 20 28 ossil)... (
c1a0: 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 for-each...
c1b0: 20 20 28 6c 61 6d 62 64 61 20 28 66 73 70 65 63 (lambda (fspec
c1c0: 29 0a 09 09 09 20 28 70 72 69 6e 74 20 22 66 73 ).... (print "fs
c1d0: 70 65 63 3a 20 22 20 66 73 70 65 63 29 0a 09 09 pec: " fspec)...
c1e0: 09 20 28 6c 65 74 2a 20 28 28 75 72 6c 20 20 20 . (let* ((url
c1f0: 20 20 20 20 20 20 28 73 79 6d 62 6f 6c 2d 3e 73 (symbol->s
c200: 74 72 69 6e 67 20 28 63 61 72 20 66 73 70 65 63 tring (car fspec
c210: 29 29 29 20 3b 3b 20 54 48 49 53 20 43 4f 55 4c ))) ;; THIS COUL
c220: 44 20 42 45 20 54 52 4f 55 42 4c 45 2e 20 41 64 D BE TROUBLE. Ad
c230: 64 20 6f 70 74 69 6f 6e 20 74 6f 20 72 65 61 64 d option to read
c240: 69 6e 67 20 6c 69 6e 65 20 74 6f 20 72 65 74 75 ing line to retu
c250: 72 6e 20 61 73 20 73 74 72 69 6e 67 2e 0a 09 09 rn as string....
c260: 09 09 28 62 72 61 6e 63 68 20 20 20 20 20 20 28 ..(branch (
c270: 63 64 72 20 66 73 70 65 63 29 29 0a 09 09 09 09 cdr fspec)).....
c280: 28 75 72 6c 2d 69 73 2d 66 69 6c 65 20 28 73 74 (url-is-file (st
c290: 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 28 2f 7c ring-match "^(/|
c2a0: 66 69 6c 65 3a 29 2e 2a 24 22 20 75 72 6c 29 29 file:).*$" url))
c2b0: 0a 09 09 09 09 28 66 6e 61 6d 65 20 20 20 20 20 .....(fname
c2c0: 20 20 28 63 6f 6e 63 20 28 63 6f 6d 6d 6f 6e 3a (conc (common:
c2d0: 67 65 74 2d 73 69 67 6e 61 74 75 72 65 20 75 72 get-signature ur
c2e0: 6c 29 20 22 2e 66 6f 73 73 69 6c 22 29 29 0a 09 l) ".fossil"))..
c2f0: 09 09 09 28 66 64 69 72 20 20 20 20 20 20 20 20 ...(fdir
c300: 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
c310: 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
c320: 29 20 22 2f 6d 74 75 74 69 6c 5f 63 61 63 68 65 ) "/mtutil_cache
c330: 22 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 69 "))).... ;; (i
c340: 66 20 28 6e 6f 74 20 75 72 6c 2d 69 73 2d 66 69 f (not url-is-fi
c350: 6c 65 29 20 3b 3b 20 6e 65 65 64 20 74 6f 20 73 le) ;; need to s
c360: 79 6e 63 20 66 69 72 73 74 20 2d 2d 2d 20 66 6f ync first --- fo
c370: 72 20 6e 6f 77 2c 20 63 6c 6f 6e 65 20 27 65 6d r now, clone 'em
c380: 20 61 6c 6c 2e 0a 09 09 09 20 20 20 28 66 6f 73 all..... (fos
c390: 73 69 6c 3a 63 6c 6f 6e 65 2d 6f 72 2d 73 79 6e sil:clone-or-syn
c3a0: 63 20 75 72 6c 20 66 6e 61 6d 65 20 66 64 69 72 c url fname fdir
c3b0: 29 20 3b 3b 20 29 0a 09 09 09 20 20 20 28 6c 65 ) ;; ).... (le
c3c0: 74 2d 76 61 6c 75 65 73 20 28 28 28 64 61 74 65 t-values (((date
c3d0: 74 69 6d 65 20 6e 6f 64 65 29 0a 09 09 09 09 09 time node)......
c3e0: 20 28 66 6f 73 73 69 6c 3a 6c 61 73 74 2d 63 68 (fossil:last-ch
c3f0: 61 6e 67 65 2d 6e 6f 64 65 2d 61 6e 64 2d 74 69 ange-node-and-ti
c400: 6d 65 20 66 64 69 72 20 66 6e 61 6d 65 20 62 72 me fdir fname br
c410: 61 6e 63 68 29 29 29 0a 09 09 09 20 20 20 20 20 anch)))....
c420: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 72 74 (if (null? start
c430: 74 69 6d 65 73 29 0a 09 09 09 09 20 28 70 75 73 times)..... (pus
c440: 68 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e h-run-spec torun
c450: 20 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a contour runkey.
c460: 09 09 09 09 09 09 60 28 28 6d 65 73 73 61 67 65 ......`((message
c470: 20 20 2e 20 2c 28 63 6f 6e 63 20 22 66 6f 73 73 . ,(conc "foss
c480: 69 6c 3a 22 20 62 72 61 6e 63 68 20 22 2d 6e 65 il:" branch "-ne
c490: 76 65 72 72 75 6e 22 29 29 0a 09 09 09 09 09 09 verrun")).......
c4a0: 20 20 28 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 28 (runname . ,(
c4b0: 63 6f 6e 63 20 72 75 6e 6e 61 6d 65 20 22 2d 22 conc runname "-"
c4c0: 20 6e 6f 64 65 29 29 0a 09 09 09 09 09 09 20 20 node)).......
c4d0: 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e (runtrans . ,run
c4e0: 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 20 28 trans)....... (
c4f0: 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 areas . ,area
c500: 73 29 0a 09 09 09 09 09 09 20 20 3b 3b 20 28 74 s)....... ;; (t
c510: 61 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b 65 arget . ,runke
c520: 79 29 0a 09 09 09 09 09 09 20 20 28 61 63 74 69 y)....... (acti
c530: 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a on . ,action).
c540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c570: 20 20 29 29 0a 09 09 09 09 20 28 69 66 20 28 3e ))..... (if (>
c580: 20 64 61 74 65 74 69 6d 65 20 6c 61 73 74 2d 72 datetime last-r
c590: 75 6e 29 20 3b 3b 20 63 68 61 6e 67 65 20 74 69 un) ;; change ti
c5a0: 6d 65 20 69 73 20 67 72 65 61 74 65 72 20 74 68 me is greater th
c5b0: 61 6e 20 6c 61 73 74 2d 72 75 6e 20 74 69 6d 65 an last-run time
c5c0: 0a 09 09 09 09 20 20 20 20 20 28 70 75 73 68 2d ..... (push-
c5d0: 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 run-spec torun c
c5e0: 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 ontour runkey...
c5f0: 09 09 09 09 20 20 20 20 60 28 28 6d 65 73 73 61 .... `((messa
c600: 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 22 66 6f ge . ,(conc "fo
c610: 73 73 69 6c 3a 22 20 62 72 61 6e 63 68 20 22 2d ssil:" branch "-
c620: 22 20 6e 6f 64 65 29 29 0a 09 09 09 09 09 09 20 " node)).......
c630: 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 2e (runname .
c640: 20 2c 28 63 6f 6e 63 20 72 75 6e 6e 61 6d 65 20 ,(conc runname
c650: 22 2d 22 20 6e 6f 64 65 29 29 0a 09 09 09 09 09 "-" node))......
c660: 09 20 20 20 20 20 20 28 72 75 6e 74 72 61 6e 73 . (runtrans
c670: 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a 09 09 . ,runtrans)...
c680: 09 09 09 09 20 20 20 20 20 20 28 61 72 65 61 73 .... (areas
c690: 20 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 . ,areas)...
c6a0: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 74 61 .... ;; (ta
c6b0: 72 67 65 74 20 20 20 2e 20 2c 72 75 6e 6b 65 79 rget . ,runkey
c6c0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 61 )....... (a
c6d0: 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 6f ction . ,actio
c6e0: 6e 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 n)....... (
c6f0: 62 72 61 6e 63 68 20 20 20 2e 20 2c 62 72 61 6e branch . ,bran
c700: 63 68 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ch).......
c710: 28 75 72 6c 20 20 20 20 20 20 2e 20 2c 75 72 6c (url . ,url
c720: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 63 )....... (c
c730: 6c 6f 6e 65 20 20 20 20 2e 20 2c 28 63 6f 6e 63 lone . ,(conc
c740: 20 66 64 69 72 20 22 2f 22 20 66 6e 61 6d 65 29 fdir "/" fname)
c750: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
c760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c780: 20 20 20 20 20 20 20 20 29 29 29 29 0a 09 09 09 ))))....
c790: 20 20 20 20 20 28 70 72 69 6e 74 20 22 47 6f 74 (print "Got
c7a0: 20 64 61 74 65 74 69 6d 65 3d 22 20 64 61 74 65 datetime=" date
c7b0: 74 69 6d 65 20 22 20 6e 6f 64 65 3d 22 20 6e 6f time " node=" no
c7c0: 64 65 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 de))))...
c7d0: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 0a 09 09 20 val-alist))....
c7e0: 20 20 20 20 3b 3b 20 73 65 6e 73 6f 72 20 6c 6f ;; sensor lo
c7f0: 6f 6b 69 6e 67 20 66 6f 72 20 6f 6e 65 20 6f 72 oking for one or
c800: 20 6d 6f 72 65 20 66 69 6c 65 73 20 6e 65 77 65 more files newe
c810: 72 20 74 68 61 6e 20 72 65 66 65 72 65 6e 63 65 r than reference
c820: 0a 09 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 ... ;;...
c830: 20 20 28 28 66 69 6c 65 20 66 69 6c 65 2d 6f 72 ((file file-or
c840: 29 20 3b 3b 20 6f 6e 65 20 6f 72 20 6d 6f 72 65 ) ;; one or more
c850: 20 66 69 6c 65 73 20 6d 75 73 74 20 62 65 20 6e files must be n
c860: 65 77 65 72 20 74 68 61 6e 20 74 68 65 20 72 65 ewer than the re
c870: 66 65 72 65 6e 63 65 0a 09 09 20 20 20 20 20 20 ference...
c880: 28 6c 65 74 2a 20 28 28 79 6f 75 6e 67 65 73 74 (let* ((youngest
c890: 64 61 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d dat (common:get-
c8a0: 79 6f 75 6e 67 65 73 74 20 28 63 6f 6d 6d 6f 6e youngest (common
c8b0: 3a 62 61 73 68 2d 67 6c 6f 62 20 66 69 6c 65 2d :bash-glob file-
c8c0: 67 6c 6f 62 73 29 29 29 0a 09 09 09 20 20 20 20 globs)))....
c8d0: 20 28 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 63 (youngestmod (c
c8e0: 61 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 29 ar youngestdat))
c8f0: 29 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 )....;; (print "
c900: 79 6f 75 6e 67 65 73 74 6d 6f 64 3a 20 22 20 79 youngestmod: " y
c910: 6f 75 6e 67 65 73 74 6d 6f 64 20 22 20 73 74 61 oungestmod " sta
c920: 72 74 74 69 6d 65 73 3a 20 22 20 73 74 61 72 74 rttimes: " start
c930: 74 69 6d 65 73 29 0a 09 09 09 28 69 66 20 28 6e times)....(if (n
c940: 75 6c 6c 3f 20 73 74 61 72 74 74 69 6d 65 73 29 ull? starttimes)
c950: 20 3b 3b 20 74 68 69 73 20 74 61 72 67 65 74 20 ;; this target
c960: 68 61 73 20 6e 65 76 65 72 20 62 65 65 6e 20 72 has never been r
c970: 75 6e 0a 09 09 09 20 20 20 20 28 70 75 73 68 2d un.... (push-
c980: 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 run-spec torun c
c990: 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 ontour runkey...
c9a0: 09 09 09 20 20 20 60 28 28 6d 65 73 73 61 67 65 ... `((message
c9b0: 20 20 2e 20 22 66 69 6c 65 3a 6e 65 76 65 72 72 . "file:neverr
c9c0: 75 6e 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 un")...... (
c9d0: 61 63 74 69 6f 6e 20 20 20 2e 20 2c 61 63 74 69 action . ,acti
c9e0: 6f 6e 29 0a 09 09 09 09 09 20 20 20 20 20 28 72 on)...... (r
c9f0: 75 6e 74 72 61 6e 73 20 2e 20 2c 72 75 6e 74 72 untrans . ,runtr
ca00: 61 6e 73 29 0a 09 09 09 09 09 20 20 20 20 20 3b ans)...... ;
ca10: 3b 20 28 74 61 72 67 65 74 20 20 20 2e 20 2c 72 ; (target . ,r
ca20: 75 6e 6b 65 79 29 0a 09 09 09 09 09 20 20 20 20 unkey)......
ca30: 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 (areas . ,ar
ca40: 65 61 73 29 0a 09 09 09 09 09 20 20 20 20 20 28 eas)...... (
ca50: 72 75 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e 6e runname . ,runn
ca60: 61 6d 65 29 29 29 0a 09 09 09 3b 3b 20 28 66 6f ame)))....;; (fo
ca70: 72 2d 65 61 63 68 0a 09 09 09 3b 3b 20 20 28 6c r-each....;; (l
ca80: 61 6d 62 64 61 20 28 73 74 61 72 74 74 69 6d 65 ambda (starttime
ca90: 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 ) ;; look at the
caa0: 20 74 69 6d 65 20 74 68 65 20 6c 61 73 74 20 72 time the last r
cab0: 75 6e 20 77 61 73 20 6b 69 63 6b 65 64 20 6f 66 un was kicked of
cac0: 66 20 66 6f 72 20 74 68 69 73 20 63 6f 6e 74 6f f for this conto
cad0: 75 72 0a 09 09 09 3b 3b 20 20 20 20 28 69 66 20 ur....;; (if
cae0: 28 3e 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 (> youngestmod (
caf0: 63 64 72 20 73 74 61 72 74 74 69 6d 65 29 29 0a cdr starttime)).
cb00: 09 09 09 3b 3b 20 09 20 20 20 28 62 65 67 69 6e ...;; . (begin
cb10: 0a 09 09 09 3b 3b 20 09 20 20 20 20 20 28 70 72 ....;; . (pr
cb20: 69 6e 74 20 22 73 74 61 72 74 74 69 6d 65 20 79 int "starttime y
cb30: 6f 75 6e 67 65 72 20 74 68 61 6e 20 79 6f 75 6e ounger than youn
cb40: 67 65 73 74 6d 6f 64 3a 20 22 20 73 74 61 72 74 gestmod: " start
cb50: 74 69 6d 65 20 22 20 59 6f 75 6e 67 65 73 74 6d time " Youngestm
cb60: 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d 6f od: " youngestmo
cb70: 64 29 0a 09 09 09 20 20 20 20 28 69 66 20 28 3e d).... (if (>
cb80: 20 79 6f 75 6e 67 65 73 74 6d 6f 64 20 6c 61 73 youngestmod las
cb90: 74 2d 72 75 6e 29 0a 09 09 09 09 28 70 75 73 68 t-run).....(push
cba0: 2d 72 75 6e 2d 73 70 65 63 20 74 6f 72 75 6e 20 -run-spec torun
cbb0: 63 6f 6e 74 6f 75 72 20 72 75 6e 6b 65 79 0a 09 contour runkey..
cbc0: 09 09 09 09 20 20 20 20 20 20 20 60 28 28 6d 65 .... `((me
cbd0: 73 73 61 67 65 20 20 2e 20 2c 28 63 6f 6e 63 20 ssage . ,(conc
cbe0: 72 75 6c 65 74 79 70 65 20 22 3a 22 20 28 63 61 ruletype ":" (ca
cbf0: 64 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 29 dr youngestdat))
cc00: 29 0a 09 09 09 09 09 09 20 28 61 63 74 69 6f 6e )....... (action
cc10: 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a 09 09 . ,action)...
cc20: 09 09 09 09 20 3b 3b 20 28 74 61 72 67 65 74 20 .... ;; (target
cc30: 20 20 2e 20 2c 72 75 6e 6b 65 79 29 0a 09 09 09 . ,runkey)....
cc40: 09 09 09 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 ... (runtrans .
cc50: 2c 72 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 ,runtrans)......
cc60: 09 20 28 61 72 65 61 73 20 20 20 20 2e 20 2c 61 . (areas . ,a
cc70: 72 65 61 73 29 0a 09 09 09 09 09 09 20 28 72 75 reas)....... (ru
cc80: 6e 6e 61 6d 65 20 20 2e 20 2c 72 75 6e 6e 61 6d nname . ,runnam
cc90: 65 29 0a 09 09 09 09 09 09 20 29 29 29 29 29 29 e)....... ))))))
cca0: 0a 0a 09 09 20 20 20 20 20 3b 3b 20 61 6c 6c 20 .... ;; all
ccb0: 67 6c 6f 62 62 65 64 20 66 69 6c 65 73 20 6d 75 globbed files mu
ccc0: 73 74 20 62 65 20 6e 65 77 65 72 20 74 68 61 6e st be newer than
ccd0: 20 74 68 65 20 72 65 66 65 72 65 6e 63 65 0a 09 the reference..
cce0: 09 20 20 20 20 20 3b 3b 0a 09 09 20 20 20 20 20 . ;;...
ccf0: 28 28 66 69 6c 65 2d 61 6e 64 29 20 3b 3b 20 61 ((file-and) ;; a
cd00: 6c 6c 20 66 69 6c 65 73 20 6d 75 73 74 20 62 65 ll files must be
cd10: 20 6e 65 77 65 72 20 74 68 61 6e 20 74 68 65 20 newer than the
cd20: 72 65 66 65 72 65 6e 63 65 0a 09 09 20 20 20 20 reference...
cd30: 20 20 28 6c 65 74 2a 20 28 28 79 6f 75 6e 67 65 (let* ((younge
cd40: 73 74 64 61 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 stdat (common:ge
cd50: 74 2d 79 6f 75 6e 67 65 73 74 20 66 69 6c 65 2d t-youngest file-
cd60: 67 6c 6f 62 73 29 29 0a 09 09 09 20 20 20 20 20 globs))....
cd70: 28 79 6f 75 6e 67 65 73 74 6d 6f 64 20 28 63 61 (youngestmod (ca
cd80: 72 20 79 6f 75 6e 67 65 73 74 64 61 74 29 29 0a r youngestdat)).
cd90: 09 09 09 20 20 20 20 20 28 73 75 63 63 65 73 73 ... (success
cda0: 20 20 20 20 20 23 74 29 29 20 3b 3b 20 61 6e 79 #t)) ;; any
cdb0: 20 63 61 73 65 73 20 6f 66 20 6e 6f 74 20 74 72 cases of not tr
cdc0: 75 65 2c 20 73 65 74 20 66 6c 61 67 20 74 6f 20 ue, set flag to
cdd0: 23 66 20 66 6f 72 20 41 4e 44 0a 09 09 09 3b 3b #f for AND....;;
cde0: 20 28 70 72 69 6e 74 20 22 79 6f 75 6e 67 65 73 (print "younges
cdf0: 74 6d 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 tmod: " youngest
ce00: 6d 6f 64 20 22 20 73 74 61 72 74 74 69 6d 65 73 mod " starttimes
ce10: 3a 20 22 20 73 74 61 72 74 74 69 6d 65 73 29 0a : " starttimes).
ce20: 09 09 09 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 ...(if (null? st
ce30: 61 72 74 74 69 6d 65 73 29 20 3b 3b 20 74 68 69 arttimes) ;; thi
ce40: 73 20 74 61 72 67 65 74 20 68 61 73 20 6e 65 76 s target has nev
ce50: 65 72 20 62 65 65 6e 20 72 75 6e 0a 09 09 09 20 er been run....
ce60: 20 20 20 28 70 75 73 68 2d 72 75 6e 2d 73 70 65 (push-run-spe
ce70: 63 20 74 6f 72 75 6e 20 63 6f 6e 74 6f 75 72 20 c torun contour
ce80: 72 75 6e 6b 65 79 0a 09 09 09 09 09 20 20 20 60 runkey...... `
ce90: 28 28 6d 65 73 73 61 67 65 20 20 2e 20 22 66 69 ((message . "fi
cea0: 6c 65 3a 6e 65 76 65 72 72 75 6e 22 29 0a 09 09 le:neverrun")...
ceb0: 09 09 09 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 ... (runname
cec0: 20 20 2e 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 09 . ,runname)...
ced0: 09 09 09 20 20 20 20 20 28 72 75 6e 74 72 61 6e ... (runtran
cee0: 73 20 2e 20 2c 72 75 6e 74 72 61 6e 73 29 0a 09 s . ,runtrans)..
cef0: 09 09 09 09 20 20 20 20 20 28 61 72 65 61 73 20 .... (areas
cf00: 20 20 20 2e 20 2c 61 72 65 61 73 29 0a 09 09 09 . ,areas)....
cf10: 09 09 20 20 20 20 20 3b 3b 20 28 74 61 72 67 65 .. ;; (targe
cf20: 74 20 20 20 2e 20 2c 72 75 6e 6b 65 79 29 0a 09 t . ,runkey)..
cf30: 09 09 09 09 20 20 20 20 20 28 61 63 74 69 6f 6e .... (action
cf40: 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 29 29 0a . ,action))).
cf50: 09 09 09 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 ... ;; NB// I
cf60: 20 74 68 69 6e 6b 20 74 68 69 73 20 69 73 20 77 think this is w
cf70: 72 6f 6e 67 2e 20 49 74 20 73 68 6f 75 6c 64 20 rong. It should
cf80: 62 65 20 6c 6f 6f 6b 69 6e 67 20 61 74 20 6c 61 be looking at la
cf90: 73 74 2d 72 75 6e 20 6f 6e 6c 79 2e 0a 09 09 09 st-run only.....
cfa0: 20 20 20 20 28 69 66 20 28 3e 20 79 6f 75 6e 67 (if (> young
cfb0: 65 73 74 6d 6f 64 20 6c 61 73 74 2d 72 75 6e 29 estmod last-run)
cfc0: 20 3b 3b 20 57 41 49 54 21 21 20 53 68 6f 75 6c ;; WAIT!! Shoul
cfd0: 64 6e 27 74 20 66 69 6c 65 2d 61 6e 64 20 62 65 dn't file-and be
cfe0: 20 6c 6f 6f 6b 69 6e 67 20 61 74 20 74 68 65 20 looking at the
cff0: 2a 6f 6c 64 65 73 74 2a 20 66 69 6c 65 20 28 74 *oldest* file (t
d000: 68 75 73 20 61 6c 6c 20 61 72 65 20 79 6f 75 6e hus all are youn
d010: 67 65 72 20 74 68 61 6e 20 2e 2e 2e 29 0a 09 09 ger than ...)...
d020: 09 09 0a 09 09 09 09 3b 3b 20 09 09 09 20 20 20 .......;; ...
d030: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 3b (for-each.....;
d040: 3b 20 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 ; ... (lambd
d050: 61 20 28 73 74 61 72 74 74 69 6d 65 29 20 3b 3b a (starttime) ;;
d060: 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 69 6d look at the tim
d070: 65 20 74 68 65 20 6c 61 73 74 20 72 75 6e 20 77 e the last run w
d080: 61 73 20 6b 69 63 6b 65 64 20 6f 66 66 20 66 6f as kicked off fo
d090: 72 20 74 68 69 73 20 63 6f 6e 74 6f 75 72 0a 09 r this contour..
d0a0: 09 09 09 3b 3b 20 09 09 09 20 20 20 20 20 20 20 ...;; ...
d0b0: 28 69 66 20 28 3c 20 79 6f 75 6e 67 65 73 74 6d (if (< youngestm
d0c0: 6f 64 20 28 63 64 72 20 73 74 61 72 74 74 69 6d od (cdr starttim
d0d0: 65 29 29 0a 09 09 09 09 3b 3b 20 09 09 09 09 20 e)).....;; ....
d0e0: 20 20 28 73 65 74 21 20 73 75 63 63 65 73 73 20 (set! success
d0f0: 23 66 29 29 29 0a 09 09 09 09 3b 3b 20 09 09 09 #f))).....;; ...
d100: 20 20 20 20 20 73 74 61 72 74 74 69 6d 65 73 29 starttimes)
d110: 29 0a 09 09 09 09 3b 3b 20 09 09 09 28 69 66 20 ).....;; ...(if
d120: 73 75 63 63 65 73 73 0a 09 09 09 09 3b 3b 20 09 success.....;; .
d130: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
d140: 09 3b 3b 20 09 09 09 20 20 20 20 20 20 28 70 72 .;; ... (pr
d150: 69 6e 74 20 22 73 74 61 72 74 74 69 6d 65 20 79 int "starttime y
d160: 6f 75 6e 67 65 72 20 74 68 61 6e 20 79 6f 75 6e ounger than youn
d170: 67 65 73 74 6d 6f 64 3a 20 22 20 73 74 61 72 74 gestmod: " start
d180: 74 69 6d 65 20 22 20 59 6f 75 6e 67 65 73 74 6d time " Youngestm
d190: 6f 64 3a 20 22 20 79 6f 75 6e 67 65 73 74 6d 6f od: " youngestmo
d1a0: 64 29 0a 09 09 09 09 28 70 75 73 68 2d 72 75 6e d).....(push-run
d1b0: 2d 73 70 65 63 20 74 6f 72 75 6e 20 63 6f 6e 74 -spec torun cont
d1c0: 6f 75 72 20 72 75 6e 6b 65 79 0a 09 09 09 09 09 our runkey......
d1d0: 20 20 20 20 20 20 20 60 28 28 6d 65 73 73 61 67 `((messag
d1e0: 65 20 20 2e 20 2c 28 63 6f 6e 63 20 72 75 6c 65 e . ,(conc rule
d1f0: 74 79 70 65 20 22 3a 22 20 28 63 61 64 72 20 79 type ":" (cadr y
d200: 6f 75 6e 67 65 73 74 64 61 74 29 29 29 0a 09 09 oungestdat)))...
d210: 09 09 09 09 20 28 72 75 6e 6e 61 6d 65 20 20 2e .... (runname .
d220: 20 2c 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 ,runname)......
d230: 09 20 28 72 75 6e 74 72 61 6e 73 20 2e 20 2c 72 . (runtrans . ,r
d240: 75 6e 74 72 61 6e 73 29 0a 09 09 09 09 09 09 20 untrans).......
d250: 3b 3b 20 28 74 61 72 67 65 74 20 20 20 2e 20 2c ;; (target . ,
d260: 72 75 6e 6b 65 79 29 0a 09 09 09 09 09 09 20 28 runkey)....... (
d270: 61 72 65 61 73 20 20 20 20 2e 20 2c 61 72 65 61 areas . ,area
d280: 73 29 0a 09 09 09 09 09 09 20 28 61 63 74 69 6f s)....... (actio
d290: 6e 20 20 20 2e 20 2c 61 63 74 69 6f 6e 29 0a 09 n . ,action)..
d2a0: 09 09 09 09 09 20 29 29 29 29 29 29 0a 09 09 20 ..... ))))))...
d2b0: 20 20 20 20 28 65 6c 73 65 20 28 70 72 69 6e 74 (else (print
d2c0: 20 22 45 52 52 4f 52 3a 20 75 6e 72 65 63 6f 67 "ERROR: unrecog
d2d0: 6e 69 73 65 64 20 72 75 6c 65 20 5c 22 22 20 72 nised rule \"" r
d2e0: 75 6c 65 74 79 70 65 29 29 29 29 29 0a 09 20 20 uletype)))))..
d2f0: 20 20 20 20 20 6b 65 79 64 61 74 73 29 29 29 20 keydats)))
d300: 3b 3b 20 73 65 6e 73 65 20 72 75 6c 65 73 0a 09 ;; sense rules..
d310: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
d320: 79 73 20 72 67 63 6f 6e 66 29 29 0a 09 20 0a 09 ys rgconf)).. ..
d330: 20 3b 3b 20 6e 6f 77 20 68 61 76 65 20 74 6f 20 ;; now have to
d340: 72 75 6e 20 70 6f 70 75 6c 61 74 65 64 0a 09 20 run populated..
d350: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 28 6c 61 (for-each.. (la
d360: 6d 62 64 61 20 28 63 6f 6e 74 6f 75 72 29 0a 09 mbda (contour)..
d370: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 76 61 6c (let* ((cval
d380: 20 20 20 20 20 20 20 28 6f 72 20 28 63 6f 6e 66 (or (conf
d390: 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e igf:lookup mtcon
d3a0: 66 20 22 63 6f 6e 74 6f 75 72 73 22 20 63 6f 6e f "contours" con
d3b0: 74 6f 75 72 29 20 22 22 29 29 0a 09 09 20 20 20 tour) ""))...
d3c0: 28 63 76 61 6c 2d 61 6c 69 73 74 20 28 63 6f 6d (cval-alist (com
d3d0: 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 63 mon:val->alist c
d3e0: 76 61 6c 29 29 20 20 20 20 20 20 20 20 20 20 20 val))
d3f0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 42 45 57 ;; BEW
d400: 41 52 45 20 2e 2e 2e 20 4e 4f 54 20 74 68 65 20 ARE ... NOT the
d410: 73 61 6d 65 20 76 61 6c 2d 61 6c 69 73 74 20 61 same val-alist a
d420: 73 20 61 62 6f 76 65 21 0a 09 09 20 20 20 28 61 s above!... (a
d430: 72 65 61 73 20 20 20 20 20 20 28 76 61 6c 2d 61 reas (val-a
d440: 6c 69 73 74 2d 3e 61 72 65 61 73 20 63 76 61 6c list->areas cval
d450: 2d 61 6c 69 73 74 29 29 0a 09 09 20 20 20 28 73 -alist))... (s
d460: 65 6c 65 63 74 6f 72 20 20 20 28 61 6c 69 73 74 elector (alist
d470: 2d 72 65 66 20 27 73 65 6c 65 63 74 6f 72 20 63 -ref 'selector c
d480: 76 61 6c 2d 61 6c 69 73 74 29 29 0a 09 09 20 20 val-alist))...
d490: 20 28 6d 6f 64 65 2d 74 61 67 20 20 20 28 61 6e (mode-tag (an
d4a0: 64 20 73 65 6c 65 63 74 6f 72 20 28 73 74 72 69 d selector (stri
d4b0: 6e 67 2d 73 70 6c 69 74 2d 66 69 65 6c 64 73 20 ng-split-fields
d4c0: 22 2f 22 20 73 65 6c 65 63 74 6f 72 20 23 3a 69 "/" selector #:i
d4d0: 6e 66 69 78 29 29 29 0a 09 09 20 20 20 28 6d 6f nfix)))... (mo
d4e0: 64 65 2d 70 61 74 74 20 20 28 61 6e 64 20 6d 6f de-patt (and mo
d4f0: 64 65 2d 74 61 67 20 28 69 66 20 28 65 71 3f 20 de-tag (if (eq?
d500: 28 6c 65 6e 67 74 68 20 6d 6f 64 65 2d 74 61 67 (length mode-tag
d510: 29 20 32 29 28 63 61 64 72 20 6d 6f 64 65 2d 74 ) 2)(cadr mode-t
d520: 61 67 29 20 23 66 29 29 29 0a 09 09 20 20 20 28 ag) #f)))... (
d530: 74 61 67 2d 65 78 70 72 20 20 20 28 61 6e 64 20 tag-expr (and
d540: 6d 6f 64 65 2d 74 61 67 20 28 69 66 20 28 6e 75 mode-tag (if (nu
d550: 6c 6c 3f 20 6d 6f 64 65 2d 74 61 67 29 20 23 66 ll? mode-tag) #f
d560: 20 28 63 61 72 20 6d 6f 64 65 2d 74 61 67 29 29 (car mode-tag))
d570: 29 29 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e ))).. (prin
d580: 74 20 22 63 6f 6e 74 6f 75 72 3a 20 22 20 63 6f t "contour: " co
d590: 6e 74 6f 75 72 20 22 20 61 72 65 61 73 3d 22 20 ntour " areas="
d5a0: 61 72 65 61 73 20 22 20 63 76 61 6c 3d 22 20 63 areas " cval=" c
d5b0: 76 61 6c 29 0a 09 20 20 20 20 20 20 28 66 6f 72 val).. (for
d5c0: 2d 65 61 63 68 0a 09 20 20 20 20 20 20 20 28 6c -each.. (l
d5d0: 61 6d 62 64 61 20 28 72 75 6e 6b 65 79 64 61 74 ambda (runkeydat
d5e0: 73 65 74 29 20 0a 09 09 20 3b 3b 20 28 70 72 69 set) ... ;; (pri
d5f0: 6e 74 20 22 72 75 6e 6b 65 79 64 61 74 73 65 74 nt "runkeydatset
d600: 3a 20 22 29 28 70 70 20 72 75 6e 6b 65 79 64 61 : ")(pp runkeyda
d610: 74 73 65 74 29 0a 09 09 20 28 6c 65 74 20 28 28 tset)... (let ((
d620: 72 75 6e 6b 65 79 20 20 20 20 20 28 63 61 72 20 runkey (car
d630: 72 75 6e 6b 65 79 64 61 74 73 65 74 29 29 0a 09 runkeydatset))..
d640: 09 20 20 20 20 20 20 20 28 72 75 6e 6b 65 79 64 . (runkeyd
d650: 61 74 73 20 28 63 61 64 72 20 72 75 6e 6b 65 79 ats (cadr runkey
d660: 64 61 74 73 65 74 29 29 0a 20 20 20 20 20 20 20 datset)).
d670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d680: 29 0a 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 )... (for-each
d690: 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ... (lambda (
d6a0: 72 75 6e 6b 65 79 64 61 74 29 0a 09 09 20 20 20 runkeydat)...
d6b0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 (for-each...
d6c0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 (lambda (a
d6d0: 72 65 61 29 0a 09 09 09 20 28 69 66 20 28 61 72 rea).... (if (ar
d6e0: 65 61 2d 61 6c 6c 6f 77 65 64 3f 20 61 72 65 61 ea-allowed? area
d6f0: 20 61 72 65 61 73 20 72 75 6e 6b 65 79 20 63 6f areas runkey co
d700: 6e 74 6f 75 72 20 6d 6f 64 65 2d 70 61 74 74 29 ntour mode-patt)
d710: 20 3b 3b 20 69 73 20 74 68 69 73 20 61 72 65 61 ;; is this area
d720: 20 74 6f 20 62 65 20 68 61 6e 64 6c 65 64 20 28 to be handled (
d730: 66 72 6f 6d 20 61 72 65 61 73 3d 61 2c 62 2c 63 from areas=a,b,c
d740: 20 4f 52 20 75 73 69 6e 67 20 61 72 65 61 66 6e OR using areafn
d750: 3d 61 62 63 66 6e 20 61 6e 64 20 2a 61 72 65 61 =abcfn and *area
d760: 2d 63 68 65 63 6b 73 2a 20 2e 2e 2e 29 0a 20 20 -checks* ...).
d770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d780: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
d790: 20 28 28 61 76 61 6c 20 20 20 20 20 20 20 28 6f ((aval (o
d7a0: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
d7b0: 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 22 p mtconf "areas"
d7c0: 20 61 72 65 61 29 20 22 22 29 29 0a 20 20 20 20 area) "")).
d7d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d7f0: 28 61 76 61 6c 2d 61 6c 69 73 74 20 28 63 6f 6d (aval-alist (com
d800: 6d 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 61 mon:val->alist a
d810: 76 61 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 val)).
d820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d830: 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 6e 61 (runna
d840: 6d 65 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 me (alist-ref
d850: 20 27 72 75 6e 6e 61 6d 65 20 72 75 6e 6b 65 79 'runname runkey
d860: 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 dat)).
d870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d880: 20 20 20 20 20 20 20 20 20 20 28 72 75 6e 74 72 (runtr
d890: 61 6e 73 20 20 20 28 61 6c 69 73 74 2d 72 65 66 ans (alist-ref
d8a0: 20 27 72 75 6e 74 72 61 6e 73 20 72 75 6e 6b 65 'runtrans runke
d8b0: 79 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 ydat)).
d8c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d8d0: 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 .
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 20 20 20 20 20
d900: 28 72 65 61 73 6f 6e 20 20 20 20 20 28 61 6c 69 (reason (ali
d910: 73 74 2d 72 65 66 20 27 6d 65 73 73 61 67 65 20 st-ref 'message
d920: 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 20 runkeydat)).
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 20 20 20 20
d950: 28 73 63 68 65 64 20 20 20 20 20 20 28 61 6c 69 (sched (ali
d960: 73 74 2d 72 65 66 20 27 73 63 68 65 64 20 20 20 st-ref 'sched
d970: 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 20 runkeydat)).
d980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9a0: 28 61 63 74 69 6f 6e 20 20 20 20 20 28 61 6c 69 (action (ali
d9b0: 73 74 2d 72 65 66 20 27 61 63 74 69 6f 6e 20 20 st-ref 'action
d9c0: 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 20 runkeydat)).
d9d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d9f0: 28 64 62 64 65 73 74 20 20 20 20 20 28 61 6c 69 (dbdest (ali
da00: 73 74 2d 72 65 66 20 27 64 62 64 65 73 74 20 20 st-ref 'dbdest
da10: 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 20 runkeydat)).
da20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da40: 28 61 70 70 65 6e 64 20 20 20 20 20 28 61 6c 69 (append (ali
da50: 73 74 2d 72 65 66 20 27 61 70 70 65 6e 64 20 20 st-ref 'append
da60: 72 75 6e 6b 65 79 64 61 74 29 29 0a 20 20 20 20 runkeydat)).
da70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da90: 28 74 61 72 67 65 74 73 20 20 20 20 3b 3b 28 6f (targets ;;(o
daa0: 72 20 28 61 6c 69 73 74 2d 72 65 66 20 27 74 61 r (alist-ref 'ta
dab0: 72 67 65 74 20 20 72 75 6e 6b 65 79 64 61 74 29 rget runkeydat)
dac0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daf0: 20 20 20 20 20 28 6d 61 70 2d 74 61 72 67 65 74 (map-target
db00: 73 20 6d 74 63 6f 6e 66 20 61 76 61 6c 2d 61 6c s mtconf aval-al
db10: 69 73 74 20 72 75 6e 6b 65 79 20 61 72 65 61 20 ist runkey area
db20: 63 6f 6e 74 6f 75 72 29 29 29 20 3b 3b 20 6f 76 contour))) ;; ov
db30: 65 72 72 69 64 65 20 77 69 74 68 20 74 61 72 67 erride with targ
db40: 65 74 20 69 66 20 66 6f 72 63 65 64 0a 20 20 20 et if forced.
db50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db70: 20 3b 3b 28 74 61 72 67 65 74 73 20 20 20 20 28 ;;(targets (
db80: 6f 72 20 28 61 6c 69 73 74 2d 72 65 66 20 27 74 or (alist-ref 't
db90: 61 72 67 65 74 20 20 72 75 6e 6b 65 79 64 61 74 arget runkeydat
dba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
dbb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dbc0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
dbd0: 20 20 20 20 20 20 20 20 28 6d 61 70 2d 74 61 72 (map-tar
dbe0: 67 65 74 73 20 6d 74 63 6f 6e 66 20 61 76 61 6c gets mtconf aval
dbf0: 2d 61 6c 69 73 74 20 72 75 6e 6b 65 79 20 61 72 -alist runkey ar
dc00: 65 61 20 63 6f 6e 74 6f 75 72 29 29 29 29 20 3b ea contour)))) ;
dc10: 3b 20 6f 76 65 72 72 69 64 65 20 77 69 74 68 20 ; override with
dc20: 74 61 72 67 65 74 20 69 66 20 66 6f 72 63 65 64 target if forced
dc30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dc40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dc50: 3b 3b 20 4e 45 45 44 20 54 4f 20 45 58 50 41 4e ;; NEED TO EXPAN
dc60: 44 20 52 55 4e 4b 45 59 20 3d 3e 20 41 4c 4c 20 D RUNKEY => ALL
dc70: 54 41 52 47 45 54 53 20 4d 41 50 50 45 44 20 41 TARGETS MAPPED A
dc80: 4e 44 20 54 48 45 4e 20 46 4f 52 45 41 43 48 20 ND THEN FOREACH
dc90: 2e 2e 2e 2e 20 0a 20 20 20 20 20 20 20 20 20 20 .... .
dca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dcb0: 20 20 20 20 20 3b 3b 28 70 72 69 6e 74 20 22 54 ;;(print "T
dcc0: 61 72 67 65 74 73 3a 20 22 20 74 61 72 67 65 74 argets: " target
dcd0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
dce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dcf0: 20 20 3b 3b 28 70 72 69 6e 74 20 22 61 6c 69 73 ;;(print "alis
dd00: 74 3a 20 22 20 28 61 6c 69 73 74 2d 72 65 66 20 t: " (alist-ref
dd10: 27 74 61 72 67 65 74 20 72 75 6e 6b 65 79 64 61 'target runkeyda
dd20: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
dd30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd40: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
dd50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
dd70: 6d 62 64 61 20 28 74 61 72 67 65 74 29 0a 20 20 mbda (target).
dd80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dda0: 28 70 72 69 6e 74 20 22 43 72 65 61 74 69 6e 67 (print "Creating
ddb0: 20 70 6b 74 20 66 6f 72 20 72 75 6e 6b 65 79 3d pkt for runkey=
ddc0: 22 20 72 75 6e 6b 65 79 20 22 20 74 61 72 67 65 " runkey " targe
ddd0: 74 3d 22 20 74 61 72 67 65 74 20 22 20 63 6f 6e t=" target " con
dde0: 74 6f 75 72 3d 22 20 63 6f 6e 74 6f 75 72 20 22 tour=" contour "
ddf0: 20 61 72 65 61 3d 22 20 61 72 65 61 20 22 20 61 area=" area " a
de00: 63 74 69 6f 6e 3d 22 20 61 63 74 69 6f 6e 20 22 ction=" action "
de10: 20 74 61 67 2d 65 78 70 72 3d 22 20 74 61 67 2d tag-expr=" tag-
de20: 65 78 70 72 20 22 20 6d 6f 64 65 2d 70 61 74 74 expr " mode-patt
de30: 3d 22 20 6d 6f 64 65 2d 70 61 74 74 29 0a 20 20 =" mode-patt).
de40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de60: 28 69 66 20 28 63 61 73 65 20 28 6f 72 20 28 61 (if (case (or (a
de70: 6e 64 20 61 63 74 69 6f 6e 20 28 73 74 72 69 6e nd action (strin
de80: 67 2d 3e 73 79 6d 62 6f 6c 20 61 63 74 69 6f 6e g->symbol action
de90: 29 29 20 27 6e 6f 61 63 74 69 6f 6e 29 20 20 3b )) 'noaction) ;
dea0: 3b 20 65 6e 73 75 72 65 20 77 65 20 68 61 76 65 ; ensure we have
deb0: 20 74 68 65 20 6e 65 65 64 65 64 20 64 61 74 61 the needed data
dec0: 20 74 6f 20 72 75 6e 20 74 68 69 73 20 61 63 74 to run this act
ded0: 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 ion.
dee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
def0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f ((no
df00: 61 63 74 69 6f 6e 29 20 20 20 20 20 20 20 20 20 action)
df10: 20 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 #f).
df20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
df40: 72 75 6e 29 20 20 20 20 20 20 20 20 20 20 20 20 run)
df50: 20 20 20 20 28 61 6e 64 20 72 75 6e 6e 61 6d 65 (and runname
df60: 20 72 65 61 73 6f 6e 29 29 0a 20 20 20 20 20 20 reason)).
df70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df90: 20 20 28 28 73 79 6e 63 20 73 79 6e 63 2d 70 72 ((sync sync-pr
dfa0: 65 70 65 6e 64 29 20 20 28 61 6e 64 20 72 65 61 epend) (and rea
dfb0: 73 6f 6e 20 64 62 64 65 73 74 29 29 0a 20 20 20 son dbdest)).
dfc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dfd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dfe0: 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 20 (else
dff0: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 0a #f)).
e000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e020: 20 20 20 20 20 20 3b 3b 20 69 6e 73 74 65 61 64 ;; instead
e030: 20 6f 66 20 75 6e 77 72 61 70 70 69 6e 67 20 74 of unwrapping t
e040: 68 65 20 72 75 6e 6b 65 79 64 61 74 20 61 6c 69 he runkeydat ali
e050: 73 74 2c 20 70 61 73 73 20 69 74 20 64 69 72 65 st, pass it dire
e060: 63 74 6c 79 20 74 6f 20 63 72 65 61 74 65 2d 72 ctly to create-r
e070: 75 6e 2d 70 6b 74 0a 20 20 20 20 20 20 20 20 20 un-pkt.
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 20 20 20 20 20 20 28 63 72 (cr
e0a0: 65 61 74 65 2d 72 75 6e 2d 70 6b 74 20 6d 74 63 eate-run-pkt mtc
e0b0: 6f 6e 66 20 61 63 74 69 6f 6e 20 61 72 65 61 20 onf action area
e0c0: 72 75 6e 6b 65 79 20 74 61 72 67 65 74 20 72 75 runkey target ru
e0d0: 6e 6e 61 6d 65 20 6d 6f 64 65 2d 70 61 74 74 0a nname mode-patt.
e0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 20 20
e110: 20 20 20 20 20 20 74 61 67 2d 65 78 70 72 20 70 tag-expr p
e120: 6b 74 73 64 69 72 20 72 65 61 73 6f 6e 20 63 6f ktsdir reason co
e130: 6e 74 6f 75 72 20 73 63 68 65 64 20 64 62 64 65 ntour sched dbde
e140: 73 74 20 61 70 70 65 6e 64 20 0a 20 20 20 20 20 st append .
e150: 20 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 72 75 6e 74 72 61 6e 73 29 20 0a 20 20 20 20 runtrans) .
e190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e1b0: 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a (print "ERROR:
e1c0: 20 4d 69 73 73 69 6e 67 20 69 6e 66 6f 20 74 6f Missing info to
e1d0: 20 6d 61 6b 65 20 61 20 22 20 61 63 74 69 6f 6e make a " action
e1e0: 20 22 20 63 61 6c 6c 3a 20 72 75 6e 6b 65 79 3d " call: runkey=
e1f0: 22 20 72 75 6e 6b 65 79 20 22 20 63 6f 6e 74 6f " runkey " conto
e200: 75 72 3d 22 20 63 6f 6e 74 6f 75 72 20 22 20 61 ur=" contour " a
e210: 72 65 61 3d 22 20 61 72 65 61 20 20 22 20 74 61 rea=" area " ta
e220: 67 2d 65 78 70 72 3d 22 20 74 61 67 2d 65 78 70 g-expr=" tag-exp
e230: 72 20 22 20 6d 6f 64 65 2d 70 61 74 74 3d 22 20 r " mode-patt="
e240: 6d 6f 64 65 2d 70 61 74 74 20 22 20 64 62 64 65 mode-patt " dbde
e250: 73 74 3d 22 20 64 62 64 65 73 74 29 0a 20 20 20 st=" dbdest).
e260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e280: 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 )).
e290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2a0: 20 20 20 20 20 20 74 61 72 67 65 74 73 29 29 0a targets)).
e2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
e2d0: 69 6e 74 20 22 4e 4f 54 45 3a 20 73 6b 69 70 70 int "NOTE: skipp
e2e0: 69 6e 67 20 22 20 72 75 6e 6b 65 79 64 61 74 20 ing " runkeydat
e2f0: 22 20 66 6f 72 20 61 72 65 61 20 5c 22 22 20 61 " for area \"" a
e300: 72 65 61 20 22 5c 22 2c 20 6e 6f 74 20 69 6e 20 rea "\", not in
e310: 22 20 61 72 65 61 73 29 29 29 0a 20 20 20 20 20 " areas))).
e320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e330: 20 20 61 6c 6c 2d 61 72 65 61 73 29 29 0a 09 09 all-areas))...
e340: 20 20 20 20 72 75 6e 6b 65 79 64 61 74 73 29 29 runkeydats))
e350: 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ).. (let (
e360: 28 72 65 73 20 28 63 6f 6e 66 69 67 66 3a 67 65 (res (configf:ge
e370: 74 2d 73 65 63 74 69 6f 6e 20 74 6f 72 75 6e 20 t-section torun
e380: 63 6f 6e 74 6f 75 72 29 29 29 20 3b 3b 20 65 61 contour))) ;; ea
e390: 63 68 20 63 6f 6e 74 6f 75 72 20 2f 20 74 61 72 ch contour / tar
e3a0: 67 65 74 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 get... ;; (print
e3b0: 20 22 72 65 73 3d 22 20 72 65 73 29 0a 09 09 20 "res=" res)...
e3c0: 72 65 73 29 29 29 29 0a 09 20 20 28 68 61 73 68 res)))).. (hash
e3d0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 6f 72 75 -table-keys toru
e3e0: 6e 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e n)))))))..(defin
e3f0: 65 20 28 70 6b 74 2d 3e 63 6d 64 6c 69 6e 65 20 e (pkt->cmdline
e400: 70 6b 74 61 29 0a 20 20 28 6c 65 74 2a 20 28 28 pkta). (let* ((
e410: 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 2d 61 6c param-mapping-al
e420: 69 73 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ist (common:get-
e430: 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 20 66 6c param-mapping fl
e440: 61 76 6f 72 3a 20 27 73 77 69 74 63 68 2d 73 79 avor: 'switch-sy
e450: 6d 62 6f 6c 29 29 0a 20 20 20 20 20 20 20 20 20 mbol)).
e460: 28 61 63 74 69 6f 6e 20 20 20 20 20 20 20 20 28 (action (
e470: 6f 72 20 28 6c 6f 6f 6b 75 70 2d 61 63 74 69 6f or (lookup-actio
e480: 6e 2d 62 79 2d 6b 65 79 20 28 61 6c 69 73 74 2d n-by-key (alist-
e490: 72 65 66 20 27 41 20 70 6b 74 61 29 29 20 22 6e ref 'A pkta)) "n
e4a0: 6f 61 63 74 69 6f 6e 22 29 29 0a 09 20 28 61 63 oaction")).. (ac
e4b0: 74 69 6f 6e 2d 70 61 72 61 6d 20 20 28 63 61 73 tion-param (cas
e4c0: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
e4d0: 6c 20 61 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 l action).
e4e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e4f0: 20 20 20 20 28 28 2d 73 65 74 2d 73 74 61 74 65 ((-set-state
e500: 2d 73 74 61 74 75 73 29 20 28 63 6f 6e 63 20 28 -status) (conc (
e510: 61 6c 69 73 74 2d 72 65 66 20 27 6c 20 70 6b 74 alist-ref 'l pkt
e520: 61 29 20 22 20 22 29 29 0a 20 20 20 20 20 20 20 a) " ")).
e530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e540: 20 20 20 28 65 6c 73 65 20 22 22 29 29 29 29 0a (else "")))).
e550: 20 20 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 64 (fold (lambd
e560: 61 20 28 61 20 72 65 73 29 0a 09 20 20 20 20 28 a (a res).. (
e570: 6c 65 74 2a 20 28 28 6b 65 79 20 28 63 61 72 20 let* ((key (car
e580: 61 29 29 20 3b 3b 20 67 65 74 20 74 68 65 20 6b a)) ;; get the k
e590: 65 79 20 6e 61 6d 65 0a 09 09 20 20 20 28 76 61 ey name... (va
e5a0: 6c 20 28 63 64 72 20 61 29 29 0a 09 09 20 20 20 l (cdr a))...
e5b0: 28 70 61 72 20 28 6f 72 20 28 6c 6f 6f 6b 75 70 (par (or (lookup
e5c0: 2d 70 61 72 61 6d 2d 62 79 2d 6b 65 79 20 6b 65 -param-by-key ke
e5d0: 79 29 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 63 y) ;; need to c
e5e0: 68 65 63 6b 20 61 6c 73 6f 20 69 66 20 69 74 20 heck also if it
e5f0: 69 73 20 61 20 73 77 69 74 63 68 0a 09 09 09 20 is a switch....
e600: 20 20 20 28 6c 6f 6f 6b 75 70 2d 70 61 72 61 6d (lookup-param
e610: 2d 62 79 2d 6b 65 79 20 6b 65 79 20 69 6e 6c 73 -by-key key inls
e620: 74 3a 20 2a 73 77 69 74 63 68 2d 6b 65 79 73 2a t: *switch-keys*
e630: 29 29 29 29 0a 09 20 20 20 20 20 20 28 70 72 69 )))).. (pri
e640: 6e 74 20 22 6b 65 79 3a 20 22 20 6b 65 79 20 22 nt "key: " key "
e650: 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 70 61 val: " val " pa
e660: 72 3a 20 22 20 70 61 72 29 0a 09 20 20 20 20 20 r: " par)..
e670: 20 3b 3b 28 69 66 20 28 61 6e 64 20 70 61 72 20 ;;(if (and par
e680: 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 20 28 (not (string= (
e690: 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 6b symbol->string k
e6a0: 65 79 29 20 22 47 22 29 29 29 0a 09 20 20 20 20 ey) "G")))..
e6b0: 20 20 28 69 66 20 28 61 6e 64 20 70 61 72 29 0a (if (and par).
e6c0: 09 09 20 20 28 63 6f 6e 63 20 72 65 73 20 22 20 .. (conc res "
e6d0: 22 20 28 61 6c 69 73 74 2d 72 65 66 20 28 73 74 " (alist-ref (st
e6e0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 70 61 72 ring->symbol par
e6f0: 29 20 70 61 72 61 6d 2d 6d 61 70 70 69 6e 67 2d ) param-mapping-
e700: 61 6c 69 73 74 20 65 71 3f 20 70 61 72 29 20 22 alist eq? par) "
e710: 20 22 20 76 61 6c 29 0a 09 09 20 20 28 69 66 20 " val)... (if
e720: 28 61 6c 69 73 74 2d 72 65 66 20 6b 65 79 20 2a (alist-ref key *
e730: 61 64 64 69 74 69 6f 6e 61 6c 2d 63 61 72 64 73 additional-cards
e740: 2a 29 20 3b 3b 20 74 68 65 73 65 20 63 61 72 64 *) ;; these card
e750: 73 20 64 6f 20 6e 6f 74 20 74 72 61 6e 73 6c 61 s do not transla
e760: 74 65 20 74 6f 20 70 61 72 61 6d 65 74 65 72 73 te to parameters
e770: 20 6f 72 20 73 77 69 74 63 68 65 73 0a 09 09 20 or switches...
e780: 20 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 res...
e790: 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e (begin....(prin
e7a0: 74 20 22 45 52 52 4f 52 3a 20 55 6e 6b 6e 6f 77 t "ERROR: Unknow
e7b0: 6e 20 6b 65 79 20 69 6e 20 70 61 63 6b 65 74 20 n key in packet
e7c0: 5c 22 22 20 6b 65 79 20 22 5c 22 20 77 69 74 68 \"" key "\" with
e7d0: 20 76 61 6c 75 65 20 5c 22 22 20 76 61 6c 20 22 value \"" val "
e7e0: 5c 22 22 29 0a 09 09 09 72 65 73 29 29 29 29 29 \"")....res)))))
e7f0: 0a 09 20 20 28 63 6f 6e 63 20 22 6d 65 67 61 74 .. (conc "megat
e800: 65 73 74 20 22 20 28 69 66 20 28 6e 6f 74 20 28 est " (if (not (
e810: 6d 65 6d 62 65 72 20 61 63 74 69 6f 6e 20 27 28 member action '(
e820: 22 73 79 6e 63 22 29 29 29 0a 09 09 09 09 28 63 "sync"))).....(c
e830: 6f 6e 63 20 61 63 74 69 6f 6e 20 22 20 22 20 61 onc action " " a
e840: 63 74 69 6f 6e 2d 70 61 72 61 6d 29 0a 09 09 09 ction-param)....
e850: 09 22 22 29 29 0a 09 20 20 70 6b 74 61 29 29 29 ."")).. pkta)))
e860: 0a 0a 3b 3b 20 28 75 73 65 20 74 72 61 63 65 29 ..;; (use trace)
e870: 28 74 72 61 63 65 20 70 6b 74 2d 3e 63 6d 64 6c (trace pkt->cmdl
e880: 69 6e 65 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 ine)..(define (w
e890: 72 69 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 rite-pkt pktsdir
e8a0: 20 75 75 69 64 20 70 6b 74 29 0a 20 20 28 69 66 uuid pkt). (if
e8b0: 20 70 6b 74 73 64 69 72 0a 20 20 20 20 20 20 28 pktsdir. (
e8c0: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
e8d0: 69 6c 65 0a 09 20 20 28 63 6f 6e 63 20 70 6b 74 ile.. (conc pkt
e8e0: 73 64 69 72 20 22 2f 22 20 75 75 69 64 20 22 2e sdir "/" uuid ".
e8f0: 70 6b 74 22 29 0a 09 28 6c 61 6d 62 64 61 20 28 pkt")..(lambda (
e900: 29 0a 09 20 20 28 70 72 69 6e 74 20 70 6b 74 29 ).. (print pkt)
e910: 29 29 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 )). (print
e920: 22 45 52 52 4f 52 3a 20 63 61 6e 6e 6f 74 20 70 "ERROR: cannot p
e930: 72 6f 63 65 73 73 20 63 6f 6d 6d 61 6e 64 73 20 rocess commands
e940: 77 69 74 68 6f 75 74 20 61 20 70 6b 74 73 20 64 without a pkts d
e950: 69 72 65 63 74 6f 72 79 22 29 29 29 0a 0a 28 64 irectory")))..(d
e960: 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 69 66 2d efine (check-if-
e970: 6d 6f 64 65 70 61 74 74 2d 64 65 66 69 6e 65 64 modepatt-defined
e980: 20 20 70 6b 74 61 20 6e 6f 74 69 66 69 63 61 74 pkta notificat
e990: 69 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 ion-hook pktfile
e9a0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 ). (let* ((star
e9b0: 74 2d 64 69 72 20 28 61 6c 69 73 74 2d 72 65 66 t-dir (alist-ref
e9c0: 20 27 53 20 70 6b 74 61 29 29 0a 09 20 28 74 61 'S pkta)).. (ta
e9d0: 72 67 65 74 20 28 6f 72 20 28 61 6c 69 73 74 2d rget (or (alist-
e9e0: 72 65 66 20 27 52 20 70 6b 74 61 29 20 28 61 6c ref 'R pkta) (al
e9f0: 69 73 74 2d 72 65 66 20 27 74 20 70 6b 74 61 29 ist-ref 't pkta)
ea00: 29 29 0a 09 20 28 70 61 74 74 20 28 61 6c 69 73 )).. (patt (alis
ea10: 74 2d 72 65 66 20 27 6f 20 70 6b 74 61 29 29 0a t-ref 'o pkta)).
ea20: 09 20 28 75 75 69 64 20 20 20 20 28 61 6c 69 73 . (uuid (alis
ea30: 74 2d 72 65 66 20 27 5a 20 70 6b 74 61 29 29 0a t-ref 'Z pkta)).
ea40: 09 20 28 63 6d 64 20 28 63 6f 6e 63 20 22 6d 65 . (cmd (conc "me
ea50: 67 61 74 65 73 74 20 2d 73 68 6f 77 2d 72 75 6e gatest -show-run
ea60: 63 6f 6e 66 69 67 20 2d 74 61 72 67 65 74 20 22 config -target "
ea70: 20 74 61 72 67 65 74 20 22 20 2d 73 74 61 72 74 target " -start
ea80: 2d 64 69 72 20 22 20 73 74 61 72 74 2d 64 69 72 -dir " start-dir
ea90: 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 68 61 )).. (res (ha
eaa0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
eab0: 09 09 20 20 65 78 6e 0a 09 09 20 20 23 66 0a 09 .. exn... #f..
eac0: 09 20 20 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 . (print "Runni
ead0: 6e 67 20 22 20 63 6d 64 29 0a 09 09 20 20 28 77 ng " cmd)... (w
eae0: 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 ith-input-from-p
eaf0: 69 70 65 20 63 6d 64 20 72 65 61 64 2d 6c 69 6e ipe cmd read-lin
eb00: 65 73 29 29 29 29 20 0a 20 20 20 20 28 6c 65 74 es)))) . (let
eb10: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
eb20: 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 20 28 res)).. (
eb30: 74 61 69 6c 20 28 63 64 72 20 72 65 73 29 29 29 tail (cdr res)))
eb40: 0a 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 . (if (stri
eb50: 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 68 65 64 20 ng-contains hed
eb60: 70 61 74 74 29 0a 09 20 20 23 74 0a 09 20 20 28 patt).. #t.. (
eb70: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 69 6c 29 0a if (null? tail).
eb80: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
eb90: 28 69 66 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e (if notification
eba0: 2d 68 6f 6f 6b 0a 09 09 20 20 20 20 28 6c 65 74 -hook... (let
ebb0: 2a 20 28 28 6e 6f 74 69 66 69 63 61 74 69 6f 6e * ((notification
ebc0: 2d 63 6d 64 20 28 63 6f 6e 63 20 6e 6f 74 69 66 -cmd (conc notif
ebd0: 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 22 20 2d ication-hook " -
ebe0: 2d 70 6b 74 20 22 20 70 6b 74 66 69 6c 65 20 22 -pkt " pktfile "
ebf0: 20 2d 2d 6d 73 67 20 49 4e 56 41 4c 49 44 5f 4d --msg INVALID_M
ec00: 4f 44 45 50 41 54 54 22 29 29 29 0a 09 09 20 20 ODEPATT")))...
ec10: 20 20 20 20 28 70 72 69 6e 74 20 22 52 75 6e 6e (print "Runn
ec20: 69 6e 67 20 22 20 6e 6f 74 69 66 69 63 61 74 69 ing " notificati
ec30: 6f 6e 2d 63 6d 64 29 0a 09 09 20 20 20 20 20 20 on-cmd)...
ec40: 28 73 79 73 74 65 6d 20 6e 6f 74 69 66 69 63 61 (system notifica
ec50: 74 69 6f 6e 2d 63 6d 64 29 29 29 20 0a 09 09 23 tion-cmd))) ...#
ec60: 66 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 f).. (loop
ec70: 28 63 61 72 20 74 61 69 6c 29 20 28 63 64 72 20 (car tail) (cdr
ec80: 74 61 69 6c 29 29 29 29 29 29 29 0a 0a 28 64 65 tail)))))))..(de
ec90: 66 69 6e 65 20 28 63 68 65 63 6b 2d 69 66 2d 74 fine (check-if-t
eca0: 61 72 67 65 74 2d 64 65 66 69 6e 65 64 20 70 6b arget-defined pk
ecb0: 74 61 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d ta notification-
ecc0: 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 29 0a 20 20 hook pktfile).
ecd0: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 64 69 (let* ((start-di
ece0: 72 20 28 61 6c 69 73 74 2d 72 65 66 20 27 53 20 r (alist-ref 'S
ecf0: 70 6b 74 61 29 29 0a 09 20 28 74 61 72 67 65 74 pkta)).. (target
ed00: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 52 20 70 (alist-ref 'R p
ed10: 6b 74 61 29 29 0a 09 20 28 75 75 69 64 20 20 20 kta)).. (uuid
ed20: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 5a 20 70 (alist-ref 'Z p
ed30: 6b 74 61 29 29 0a 09 20 28 63 6d 64 20 28 63 6f kta)).. (cmd (co
ed40: 6e 63 20 22 6d 65 67 61 74 65 73 74 20 2d 6c 69 nc "megatest -li
ed50: 73 74 2d 74 61 72 67 65 74 73 20 2d 73 74 61 72 st-targets -star
ed60: 74 2d 64 69 72 20 22 20 73 74 61 72 74 2d 64 69 t-dir " start-di
ed70: 72 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 68 r)).. (res (h
ed80: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
ed90: 0a 09 09 20 20 65 78 6e 0a 09 09 20 20 23 66 0a ... exn... #f.
eda0: 09 09 20 20 28 70 72 69 6e 74 20 22 52 75 6e 6e .. (print "Runn
edb0: 69 6e 67 20 22 20 63 6d 64 29 0a 09 09 20 20 28 ing " cmd)... (
edc0: 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d with-input-from-
edd0: 70 69 70 65 20 63 6d 64 20 72 65 61 64 2d 6c 69 pipe cmd read-li
ede0: 6e 65 73 29 29 29 29 20 0a 20 20 20 20 28 69 66 nes)))) . (if
edf0: 20 28 6d 65 6d 62 65 72 20 74 61 72 67 65 74 20 (member target
ee00: 72 65 73 29 20 20 0a 09 23 74 20 0a 09 28 62 65 res) ..#t ..(be
ee10: 67 69 6e 20 0a 09 20 20 28 69 66 20 6e 6f 74 69 gin .. (if noti
ee20: 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 0a 09 20 fication-hook..
ee30: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 6f 74 (let* ((not
ee40: 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 20 28 63 ification-cmd (c
ee50: 6f 6e 63 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e onc notification
ee60: 2d 68 6f 6f 6b 20 22 20 2d 2d 70 6b 74 20 22 20 -hook " --pkt "
ee70: 20 70 6b 74 66 69 6c 65 20 22 20 2d 2d 6d 73 67 pktfile " --msg
ee80: 20 49 4e 56 41 4c 49 44 5f 54 41 52 47 45 54 22 INVALID_TARGET"
ee90: 29 29 29 0a 09 09 28 70 72 69 6e 74 20 22 52 75 )))...(print "Ru
eea0: 6e 6e 69 6e 67 20 22 20 6e 6f 74 69 66 69 63 61 nning " notifica
eeb0: 74 69 6f 6e 2d 63 6d 64 29 0a 09 09 28 73 79 73 tion-cmd)...(sys
eec0: 74 65 6d 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e tem notification
eed0: 2d 63 6d 64 29 29 29 0a 09 20 20 23 66 29 29 29 -cmd))).. #f)))
eee0: 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 76 61 6c )...(define (val
eef0: 69 64 61 74 65 2d 63 6d 64 20 63 6d 64 20 70 6b idate-cmd cmd pk
ef00: 74 61 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d ta notification-
ef10: 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 29 0a 20 20 hook pktfile).
ef20: 28 6c 65 74 20 28 28 72 65 74 20 23 74 29 29 20 (let ((ret #t))
ef30: 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 . (if (string
ef40: 2d 63 6f 6e 74 61 69 6e 73 20 63 6d 64 20 22 2d -contains cmd "-
ef50: 72 65 71 74 61 72 67 22 29 20 0a 09 28 69 66 20 reqtarg") ..(if
ef60: 28 63 68 65 63 6b 2d 69 66 2d 74 61 72 67 65 74 (check-if-target
ef70: 2d 64 65 66 69 6e 65 64 20 70 6b 74 61 20 6e 6f -defined pkta no
ef80: 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 tification-hook
ef90: 70 6b 74 66 69 6c 65 29 0a 09 20 20 20 20 28 62 pktfile).. (b
efa0: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 70 72 69 egin.. (pri
efb0: 6e 74 20 22 54 61 72 67 65 74 20 69 73 20 76 61 nt "Target is va
efc0: 6c 69 64 22 29 0a 09 20 20 20 20 20 20 28 69 66 lid").. (if
efd0: 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e (string-contain
efe0: 73 20 63 6d 64 20 22 2d 6d 6f 64 65 70 61 74 74 s cmd "-modepatt
eff0: 22 29 0a 09 09 20 20 28 69 66 20 28 63 68 65 63 ")... (if (chec
f000: 6b 2d 69 66 2d 6d 6f 64 65 70 61 74 74 2d 64 65 k-if-modepatt-de
f010: 66 69 6e 65 64 20 70 6b 74 61 20 6e 6f 74 69 66 fined pkta notif
f020: 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 ication-hook pkt
f030: 66 69 6c 65 29 0a 09 09 20 20 20 20 20 20 28 70 file)... (p
f040: 72 69 6e 74 20 22 4d 6f 64 65 70 61 74 74 20 69 rint "Modepatt i
f050: 73 20 76 61 6c 69 64 22 29 0a 09 09 20 20 20 20 s valid")...
f060: 20 20 28 73 65 74 21 20 72 65 74 20 23 66 29 29 (set! ret #f))
f070: 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 72 65 )).. (set! re
f080: 74 20 23 66 29 29 0a 09 28 69 66 20 28 73 74 72 t #f))..(if (str
f090: 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 63 6d 64 ing-contains cmd
f0a0: 20 22 2d 6d 6f 64 65 70 61 74 74 22 29 0a 09 20 "-modepatt")..
f0b0: 20 20 20 28 69 66 20 28 63 68 65 63 6b 2d 69 66 (if (check-if
f0c0: 2d 6d 6f 64 65 70 61 74 74 2d 64 65 66 69 6e 65 -modepatt-define
f0d0: 64 20 70 6b 74 61 20 6e 6f 74 69 66 69 63 61 74 d pkta notificat
f0e0: 69 6f 6e 2d 68 6f 6f 6b 20 70 6b 74 66 69 6c 65 ion-hook pktfile
f0f0: 29 0a 09 09 28 70 72 69 6e 74 20 22 4d 6f 64 65 )...(print "Mode
f100: 70 61 74 74 20 69 73 20 76 61 6c 69 64 22 29 0a patt is valid").
f110: 09 09 28 73 65 74 21 20 72 65 74 20 23 66 29 29 ..(set! ret #f))
f120: 29 29 20 0a 20 20 20 20 72 65 74 29 29 0a 0a 20 )) . ret))..
f130: 20 20 0a 3b 3b 20 63 6f 6c 6c 65 63 74 20 61 6c .;; collect al
f140: 6c 20 6e 65 65 64 65 64 20 64 61 74 61 20 61 6e l needed data an
f150: 64 20 63 72 65 61 74 65 20 72 75 6e 20 70 6b 74 d create run pkt
f160: 73 20 66 6f 72 20 63 6f 6e 74 6f 75 72 73 20 77 s for contours w
f170: 69 74 68 20 63 68 61 6e 67 65 64 20 69 6e 70 75 ith changed inpu
f180: 74 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 ts.;;.(define (d
f190: 69 73 70 61 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 ispatch-commands
f1a0: 20 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 mtconf toppath)
f1b0: 0a 20 20 3b 3b 20 77 65 20 61 72 65 20 65 78 70 . ;; we are exp
f1c0: 65 63 74 69 6e 67 20 61 20 64 69 72 65 63 74 6f ecting a directo
f1d0: 72 79 20 22 6c 6f 67 73 22 2c 20 63 68 65 63 6b ry "logs", check
f1e0: 20 61 6e 64 20 63 72 65 61 74 65 20 69 74 2c 20 and create it,
f1f0: 63 72 65 61 74 65 20 74 68 65 20 6c 6f 67 20 69 create the log i
f200: 6e 20 2f 74 6d 70 20 69 66 20 6e 6f 74 20 61 62 n /tmp if not ab
f210: 6c 65 20 74 6f 20 63 72 65 61 74 65 20 6c 6f 67 le to create log
f220: 73 20 64 69 72 0a 20 20 28 6c 65 74 20 28 28 6c s dir. (let ((l
f230: 6f 67 64 69 72 0a 09 20 28 69 66 20 28 69 66 20 ogdir.. (if (if
f240: 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 3f (not (directory?
f250: 20 22 6c 6f 67 73 22 29 29 0a 09 09 20 28 68 61 "logs"))... (ha
f260: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
f270: 09 09 20 20 65 78 6e 0a 09 09 20 20 23 66 0a 09 .. exn... #f..
f280: 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 . (create-direc
f290: 74 6f 72 79 20 22 6c 6f 67 73 22 29 0a 09 09 20 tory "logs")...
f2a0: 20 23 74 29 0a 09 09 20 23 74 29 0a 09 20 20 20 #t)... #t)..
f2b0: 20 20 22 6c 6f 67 73 22 0a 09 20 20 20 20 20 22 "logs".. "
f2c0: 2f 74 6d 70 22 29 29 0a 09 28 63 70 75 6c 6f 61 /tmp"))..(cpuloa
f2d0: 64 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 64 d (alist-ref 'ad
f2e0: 6a 2d 70 72 6f 63 2d 6c 6f 61 64 20 28 63 6f 6d j-proc-load (com
f2f0: 6d 6f 6e 3a 67 65 74 2d 6e 6f 72 6d 61 6c 69 7a mon:get-normaliz
f300: 65 64 2d 63 70 75 2d 6c 6f 61 64 20 23 66 29 29 ed-cpu-load #f))
f310: 29 0a 09 28 6d 61 78 6c 6f 61 64 20 28 73 74 72 )..(maxload (str
f320: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 ing->number (or
f330: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
f340: 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 mtconf "setup" "
f350: 6d 61 78 6c 6f 61 64 22 29 0a 09 09 09 09 20 20 maxload").....
f360: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b (configf:look
f370: 75 70 20 6d 74 63 6f 6e 66 20 22 6a 6f 62 74 6f up mtconf "jobto
f380: 6f 6c 73 22 20 22 6d 61 78 6c 6f 61 64 22 29 20 ols" "maxload")
f390: 3b 3b 20 72 65 73 70 65 63 74 20 76 61 6c 75 65 ;; respect value
f3a0: 20 75 73 65 64 20 62 79 20 4d 65 67 61 74 65 73 used by Megates
f3b0: 74 20 63 61 6c 6c 73 0a 09 09 09 09 20 20 20 20 t calls.....
f3c0: 20 22 31 2e 31 22 29 29 29 0a 09 28 6e 6f 74 69 "1.1")))..(noti
f3d0: 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 28 69 fication-hook (i
f3e0: 66 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 f (configf:looku
f3f0: 70 20 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 p mtconf "setup"
f400: 20 22 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 "notification-h
f410: 6f 6f 6b 22 29 0a 09 09 09 20 20 20 20 20 20 20 ook")....
f420: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
f430: 6d 74 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 mtconf "setup" "
f440: 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f notification-hoo
f450: 6b 22 29 0a 09 09 09 20 20 20 20 20 20 20 23 66 k").... #f
f460: 29 29 29 0a 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a ))). (common:
f470: 77 69 74 68 2d 71 75 65 75 65 2d 64 62 0a 20 20 with-queue-db.
f480: 20 20 20 6d 74 63 6f 6e 66 0a 20 20 20 20 20 28 mtconf. (
f490: 6c 61 6d 62 64 61 20 28 70 6b 74 73 64 69 72 73 lambda (pktsdirs
f4a0: 20 70 6b 74 73 64 69 72 20 70 64 62 29 0a 20 20 pktsdir pdb).
f4b0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 67 63 (let* ((rgc
f4c0: 6f 6e 66 64 61 74 20 28 66 69 6e 64 2d 61 6e 64 onfdat (find-and
f4d0: 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f -read-config (co
f4e0: 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e nc toppath "/run
f4f0: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 configs.config")
f500: 29 29 0a 09 20 20 20 20 20 20 28 72 67 63 6f 6e )).. (rgcon
f510: 66 20 20 20 20 28 63 61 72 20 72 67 63 6f 6e 66 f (car rgconf
f520: 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 61 72 dat)).. (ar
f530: 65 61 73 20 20 20 20 20 28 63 6f 6e 66 69 67 66 eas (configf
f540: 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 6d 74 63 :get-section mtc
f550: 6f 6e 66 20 22 61 72 65 61 73 22 29 29 0a 09 20 onf "areas"))..
f560: 20 20 20 20 20 28 63 6f 6e 74 6f 75 72 73 20 20 (contours
f570: 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 (configf:get-sec
f580: 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 63 6f 6e tion mtconf "con
f590: 74 6f 75 72 73 22 29 29 0a 09 20 20 20 20 20 20 tours"))..
f5a0: 28 70 6b 74 73 20 20 20 20 20 20 28 66 69 6e 64 (pkts (find
f5b0: 2d 70 6b 74 73 20 70 64 62 20 27 28 63 6d 64 29 -pkts pdb '(cmd)
f5c0: 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 28 74 '())).. (t
f5d0: 6f 72 75 6e 20 20 20 20 20 28 6d 61 6b 65 2d 68 orun (make-h
f5e0: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 74 ash-table)) ;; t
f5f0: 61 72 67 65 74 20 3d 3e 20 28 20 2e 2e 2e 20 69 arget => ( ... i
f600: 6e 66 6f 20 2e 2e 2e 20 29 0a 09 20 20 20 20 20 nfo ... )..
f610: 20 28 72 67 65 6e 74 61 72 67 73 20 28 68 61 73 (rgentargs (has
f620: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 67 63 h-table-keys rgc
f630: 6f 6e 66 29 29 29 20 3b 3b 20 74 68 65 73 65 20 onf))) ;; these
f640: 61 72 65 20 74 68 65 20 74 61 72 67 65 74 73 20 are the targets
f650: 72 65 67 69 73 74 65 72 65 64 20 66 6f 72 20 61 registered for a
f660: 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 74 72 69 utomatically tri
f670: 67 67 65 72 69 6e 67 0a 20 20 20 20 20 20 20 20 ggering.
f680: 20 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 (sqlite3:set-bu
f690: 73 79 2d 68 61 6e 64 6c 65 72 21 20 28 64 62 69 sy-handler! (dbi
f6a0: 3a 64 62 2d 63 6f 6e 6e 20 70 64 62 29 20 28 73 :db-conn pdb) (s
f6b0: 71 6c 69 74 65 33 3a 6d 61 6b 65 2d 62 75 73 79 qlite3:make-busy
f6c0: 2d 74 69 6d 65 6f 75 74 20 31 30 30 30 30 29 29 -timeout 10000))
f6d0: 0a 09 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 .. (for-each..
f6e0: 28 6c 61 6d 62 64 61 20 28 70 6b 74 64 61 74 29 (lambda (pktdat)
f6f0: 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 70 6b .. (let* ((pk
f700: 74 61 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 ta (alist-ref
f710: 20 27 61 70 6b 74 20 70 6b 74 64 61 74 29 29 0a 'apkt pktdat)).
f720: 09 09 20 20 20 28 61 63 74 69 6f 6e 20 20 28 61 .. (action (a
f730: 6c 69 73 74 2d 72 65 66 20 27 41 20 70 6b 74 61 list-ref 'A pkta
f740: 29 29 0a 09 09 20 20 20 28 63 6d 64 6c 69 6e 65 ))... (cmdline
f750: 20 28 70 6b 74 2d 3e 63 6d 64 6c 69 6e 65 20 70 (pkt->cmdline p
f760: 6b 74 61 29 29 0a 09 09 20 20 20 28 75 75 69 64 kta))... (uuid
f770: 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 (alist-ref '
f780: 5a 20 70 6b 74 61 29 29 0a 09 09 20 20 20 28 75 Z pkta))... (u
f790: 73 65 72 20 20 20 20 28 61 6c 69 73 74 2d 72 65 ser (alist-re
f7a0: 66 20 27 55 20 70 6b 74 61 29 29 0a 09 09 20 20 f 'U pkta))...
f7b0: 20 28 61 72 65 61 20 20 20 20 28 61 6c 69 73 74 (area (alist
f7c0: 2d 72 65 66 20 27 47 20 70 6b 74 61 29 29 0a 09 -ref 'G pkta))..
f7d0: 09 20 20 20 28 6c 6f 67 66 20 20 20 20 28 63 6f . (logf (co
f7e0: 6e 63 20 6c 6f 67 64 69 72 20 22 2f 22 20 75 75 nc logdir "/" uu
f7f0: 69 64 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 0a id "-run.log")).
f800: 09 09 20 20 20 28 70 6b 74 66 69 6c 65 20 28 63 .. (pktfile (c
f810: 6f 6e 63 20 70 6b 74 73 64 69 72 20 22 2f 22 20 onc pktsdir "/"
f820: 75 75 69 64 20 22 2e 70 6b 74 22 29 29 0a 09 09 uuid ".pkt"))...
f830: 20 20 20 28 66 75 6c 6c 63 6d 64 20 28 63 6f 6e (fullcmd (con
f840: 63 20 22 4e 42 46 41 4b 45 5f 4c 4f 47 3d 22 20 c "NBFAKE_LOG="
f850: 6c 6f 67 66 20 22 20 6e 62 66 61 6b 65 20 22 20 logf " nbfake "
f860: 63 6d 64 6c 69 6e 65 29 29 29 0a 09 20 20 20 20 cmdline)))..
f870: 20 20 28 69 66 20 28 63 68 65 63 6b 2d 61 63 63 (if (check-acc
f880: 65 73 73 20 75 73 65 72 20 6d 74 63 6f 6e 66 20 ess user mtconf
f890: 61 63 74 69 6f 6e 20 61 72 65 61 29 0a 09 09 20 action area)...
f8a0: 20 28 69 66 20 28 61 6e 64 20 28 3e 20 63 70 75 (if (and (> cpu
f8b0: 6c 6f 61 64 20 6d 61 78 6c 6f 61 64 29 0a 09 09 load maxload)...
f8c0: 09 20 20 20 28 6d 65 6d 62 65 72 20 61 63 74 69 . (member acti
f8d0: 6f 6e 20 27 28 22 72 75 6e 22 20 22 61 72 63 68 on '("run" "arch
f8e0: 69 76 65 22 29 29 29 20 3b 3b 20 64 6f 20 6e 6f ive"))) ;; do no
f8f0: 74 20 72 75 6e 20 61 72 63 68 69 76 65 20 6f 72 t run archive or
f900: 20 72 75 6e 20 69 66 20 6c 6f 61 64 20 69 73 20 run if load is
f910: 6f 76 65 72 20 74 68 65 20 73 70 65 63 69 66 69 over the specifi
f920: 65 64 20 6c 69 6d 69 74 0a 09 09 20 20 20 20 20 ed limit...
f930: 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e (begin....(prin
f940: 74 20 22 57 41 52 4e 49 4e 47 3a 20 63 70 75 6c t "WARNING: cpul
f950: 6f 61 64 20 74 6f 6f 20 68 69 67 68 2c 20 73 6b oad too high, sk
f960: 69 70 70 69 6e 67 20 70 72 6f 63 65 73 73 69 6e ipping processin
f970: 67 20 6f 66 20 22 20 75 75 69 64 20 22 20 64 75 g of " uuid " du
f980: 65 20 74 6f 20 22 20 63 70 75 6c 6f 61 64 20 22 e to " cpuload "
f990: 20 3e 20 22 20 6d 61 78 6c 6f 61 64 29 0a 09 09 > " maxload)...
f9a0: 09 28 69 66 20 6e 6f 74 69 66 69 63 61 74 69 6f .(if notificatio
f9b0: 6e 2d 68 6f 6f 6b 0a 09 09 09 20 20 20 20 28 6c n-hook.... (l
f9c0: 65 74 2a 20 28 28 6e 6f 74 69 66 69 63 61 74 69 et* ((notificati
f9d0: 6f 6e 2d 63 6d 64 20 28 63 6f 6e 63 20 6e 6f 74 on-cmd (conc not
f9e0: 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 22 ification-hook "
f9f0: 20 2d 2d 70 6b 74 20 22 20 70 6b 74 66 69 6c 65 --pkt " pktfile
fa00: 20 22 20 2d 2d 6d 73 67 20 48 49 47 48 5f 4c 4f " --msg HIGH_LO
fa10: 41 44 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 AD")))....
fa20: 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 6e 67 20 (print "Running
fa30: 22 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 " notification-c
fa40: 6d 64 29 20 0a 09 09 09 20 20 20 20 20 20 28 73 md) .... (s
fa50: 79 73 74 65 6d 20 6e 6f 74 69 66 69 63 61 74 69 ystem notificati
fa60: 6f 6e 2d 63 6d 64 29 29 29 29 0a 09 09 20 20 20 on-cmd))))...
fa70: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 3b 3b 20 (begin....;;
fa80: 69 66 20 6d 6f 64 65 70 61 74 74 20 75 73 65 64 if modepatt used
fa90: 20 63 68 65 6b 20 69 66 20 69 74 20 69 73 20 64 chek if it is d
faa0: 65 66 69 6e 65 64 20 66 6f 72 20 74 68 65 20 74 efined for the t
fab0: 61 72 67 65 74 2e 20 49 66 20 2d 72 65 71 74 61 arget. If -reqta
fac0: 72 67 20 63 68 65 63 6b 20 69 66 20 74 61 72 67 rg check if targ
fad0: 65 74 20 65 78 69 73 74 2e 0a 09 09 09 28 69 66 et exist.....(if
fae0: 20 28 76 61 6c 69 64 61 74 65 2d 63 6d 64 20 66 (validate-cmd f
faf0: 75 6c 6c 63 6d 64 20 70 6b 74 61 20 6e 6f 74 69 ullcmd pkta noti
fb00: 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 20 70 6b fication-hook pk
fb10: 74 66 69 6c 65 29 0a 09 09 09 20 20 20 20 28 62 tfile).... (b
fb20: 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 70 egin.... (p
fb30: 72 69 6e 74 20 22 52 55 4e 4e 49 4e 47 3a 20 22 rint "RUNNING: "
fb40: 20 66 75 6c 6c 63 6d 64 29 0a 09 09 09 20 20 20 fullcmd)....
fb50: 20 20 20 28 73 79 73 74 65 6d 20 66 75 6c 6c 63 (system fullc
fb60: 6d 64 29 20 3b 3b 20 72 65 70 6c 61 63 65 20 77 md) ;; replace w
fb70: 69 74 68 20 70 72 6f 63 65 73 73 20 2e 2e 2e 0a ith process ....
fb80: 09 09 09 20 20 20 20 20 20 28 6d 61 72 6b 2d 70 ... (mark-p
fb90: 72 6f 63 65 73 73 65 64 20 70 64 62 20 28 6c 69 rocessed pdb (li
fba0: 73 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 69 st (alist-ref 'i
fbb0: 64 20 70 6b 74 64 61 74 29 29 29 0a 09 09 09 20 d pktdat)))....
fbc0: 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 (let-values
fbd0: 20 28 28 28 61 63 6b 2d 75 75 69 64 20 61 63 6b (((ack-uuid ack
fbe0: 2d 70 6b 74 29 0a 09 09 09 09 09 20 20 20 20 28 -pkt)...... (
fbf0: 61 64 64 2d 7a 2d 63 61 72 64 0a 09 09 09 09 09 add-z-card......
fc00: 20 20 20 20 20 28 63 6f 6e 73 74 72 75 63 74 2d (construct-
fc10: 73 64 61 74 20 27 50 20 75 75 69 64 0a 09 09 09 sdat 'P uuid....
fc20: 09 09 09 09 20 20 20 20 20 27 54 20 28 63 61 73 .... 'T (cas
fc30: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
fc40: 6c 20 61 63 74 69 6f 6e 29 0a 09 09 09 09 09 09 l action).......
fc50: 09 09 20 20 28 28 72 75 6e 29 20 22 72 75 6e 73 .. ((run) "runs
fc60: 74 61 72 74 22 29 0a 09 09 09 09 09 09 09 09 20 tart").........
fc70: 20 28 28 73 79 6e 63 29 20 22 73 79 6e 63 73 74 ((sync) "syncst
fc80: 61 72 74 22 29 20 20 20 20 3b 3b 20 65 78 61 6d art") ;; exam
fc90: 70 6c 65 20 6f 66 20 74 72 61 6e 73 6c 61 74 69 ple of translati
fca0: 6e 67 20 72 75 6e 20 2d 3e 20 72 75 6e 73 74 61 ng run -> runsta
fcb0: 72 74 0a 09 09 09 09 09 09 09 09 20 20 28 65 6c rt......... (el
fcc0: 73 65 20 20 20 61 63 74 69 6f 6e 29 29 0a 09 09 se action))...
fcd0: 09 09 09 09 09 20 20 20 20 20 27 47 20 28 61 6c ..... 'G (al
fce0: 69 73 74 2d 72 65 66 20 27 47 20 70 6b 74 61 29 ist-ref 'G pkta)
fcf0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 63 20 ........ 'c
fd00: 28 61 6c 69 73 74 2d 72 65 66 20 27 63 20 70 6b (alist-ref 'c pk
fd10: 74 61 29 20 3b 3b 20 54 48 49 53 20 49 53 20 57 ta) ;; THIS IS W
fd20: 52 4f 4e 47 21 20 53 48 4f 55 4c 44 20 42 45 20 RONG! SHOULD BE
fd30: 27 63 0a 09 09 09 09 09 09 09 20 20 20 20 20 27 'c........ '
fd40: 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 74 20 t (alist-ref 't
fd50: 70 6b 74 61 29 29 29 29 29 0a 09 09 09 09 28 77 pkta))))).....(w
fd60: 72 69 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 rite-pkt pktsdir
fd70: 20 61 63 6b 2d 75 75 69 64 20 61 63 6b 2d 70 6b ack-uuid ack-pk
fd80: 74 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 t)).... (if
fd90: 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f notification-ho
fda0: 6f 6b 0a 09 09 09 09 20 20 28 6c 65 74 2a 20 28 ok..... (let* (
fdb0: 28 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d (notification-cm
fdc0: 64 20 28 63 6f 6e 63 20 6e 6f 74 69 66 69 63 61 d (conc notifica
fdd0: 74 69 6f 6e 2d 68 6f 6f 6b 20 22 20 2d 2d 70 6b tion-hook " --pk
fde0: 74 20 22 20 70 6b 74 66 69 6c 65 20 22 20 2d 2d t " pktfile " --
fdf0: 6d 73 67 20 52 55 4e 5f 4c 41 55 4e 43 48 45 44 msg RUN_LAUNCHED
fe00: 20 2d 2d 63 6f 6e 74 6f 75 72 20 22 20 28 63 61 --contour " (ca
fe10: 61 72 20 20 63 6f 6e 74 6f 75 72 73 29 20 22 20 ar contours) "
fe20: 2d 2d 6c 6f 67 5f 70 61 74 68 20 22 20 6c 6f 67 --log_path " log
fe30: 66 20 29 29 29 0a 09 09 09 09 20 20 20 20 28 70 f )))..... (p
fe40: 72 69 6e 74 20 22 52 75 6e 6e 69 6e 67 20 22 20 rint "Running "
fe50: 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 63 6d 64 notification-cmd
fe60: 29 09 09 09 09 0a 09 09 09 09 20 20 20 20 28 73 )......... (s
fe70: 79 73 74 65 6d 20 6e 6f 74 69 66 69 63 61 74 69 ystem notificati
fe80: 6f 6e 2d 63 6d 64 29 29 29 29 0a 09 09 09 20 20 on-cmd))))....
fe90: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
fea0: 20 20 28 6d 61 72 6b 2d 70 72 6f 63 65 73 73 65 (mark-processe
feb0: 64 20 70 64 62 20 28 6c 69 73 74 20 28 61 6c 69 d pdb (list (ali
fec0: 73 74 2d 72 65 66 20 27 69 64 20 70 6b 74 64 61 st-ref 'id pktda
fed0: 74 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 6c t))).... (l
fee0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 61 63 6b et-values (((ack
fef0: 2d 75 75 69 64 20 61 63 6b 2d 70 6b 74 29 0a 09 -uuid ack-pkt)..
ff00: 09 09 09 09 20 20 20 20 28 61 64 64 2d 7a 2d 63 .... (add-z-c
ff10: 61 72 64 0a 09 09 09 09 09 20 20 20 20 20 28 63 ard...... (c
ff20: 6f 6e 73 74 72 75 63 74 2d 73 64 61 74 20 27 50 onstruct-sdat 'P
ff30: 20 75 75 69 64 0a 09 09 09 09 09 09 09 20 20 20 uuid........
ff40: 20 20 27 54 20 22 69 6e 76 61 6c 69 64 2d 69 6e 'T "invalid-in
ff50: 70 75 74 22 0a 09 09 09 09 09 09 09 20 20 20 20 put"........
ff60: 20 27 63 20 28 61 6c 69 73 74 2d 72 65 66 20 27 'c (alist-ref '
ff70: 6f 20 70 6b 74 61 29 20 3b 3b 20 54 48 49 53 20 o pkta) ;; THIS
ff80: 49 53 20 57 52 4f 4e 47 21 20 53 48 4f 55 4c 44 IS WRONG! SHOULD
ff90: 20 42 45 20 27 63 0a 09 09 09 09 09 09 09 20 20 BE 'c........
ffa0: 20 20 20 27 74 20 28 61 6c 69 73 74 2d 72 65 66 't (alist-ref
ffb0: 20 27 74 20 70 6b 74 61 29 29 29 29 29 0a 09 09 't pkta)))))...
ffc0: 09 09 28 77 72 69 74 65 2d 70 6b 74 20 70 6b 74 ..(write-pkt pkt
ffd0: 73 64 69 72 20 61 63 6b 2d 75 75 69 64 20 61 63 sdir ack-uuid ac
ffe0: 6b 2d 70 6b 74 29 29 29 29 29 29 0a 09 09 20 20 k-pkt))))))...
fff0: 28 62 65 67 69 6e 20 3b 3b 20 61 63 63 65 73 73 (begin ;; access
10000 20 64 65 6e 69 65 64 21 20 4d 61 72 6b 20 61 73 denied! Mark as
10010 20 73 75 63 68 0a 09 09 20 20 20 20 28 6d 61 72 such... (mar
10020 6b 2d 70 72 6f 63 65 73 73 65 64 20 70 64 62 20 k-processed pdb
10030 28 6c 69 73 74 20 28 61 6c 69 73 74 2d 72 65 66 (list (alist-ref
10040 20 27 69 64 20 70 6b 74 64 61 74 29 29 29 0a 09 'id pktdat)))..
10050 09 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 . (let-values
10060 20 28 28 28 61 63 6b 2d 75 75 69 64 20 61 63 6b (((ack-uuid ack
10070 2d 70 6b 74 29 0a 09 09 09 09 20 20 28 61 64 64 -pkt)..... (add
10080 2d 7a 2d 63 61 72 64 0a 09 09 09 09 20 20 20 28 -z-card..... (
10090 63 6f 6e 73 74 72 75 63 74 2d 73 64 61 74 20 27 construct-sdat '
100a0 50 20 75 75 69 64 0a 09 09 09 09 09 09 20 20 20 P uuid.......
100b0 27 54 20 22 61 63 63 65 73 73 2d 64 65 6e 69 65 'T "access-denie
100c0 64 22 0a 09 09 09 09 09 09 20 20 20 27 63 20 28 d"....... 'c (
100d0 61 6c 69 73 74 2d 72 65 66 20 27 6f 20 70 6b 74 alist-ref 'o pkt
100e0 61 29 20 3b 3b 20 54 48 49 53 20 49 53 20 57 52 a) ;; THIS IS WR
100f0 4f 4e 47 21 20 53 48 4f 55 4c 44 20 42 45 20 27 ONG! SHOULD BE '
10100 63 0a 09 09 09 09 09 09 20 20 20 27 74 20 28 61 c....... 't (a
10110 6c 69 73 74 2d 72 65 66 20 27 74 20 70 6b 74 61 list-ref 't pkta
10120 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 77 )))))... (w
10130 72 69 74 65 2d 70 6b 74 20 70 6b 74 73 64 69 72 rite-pkt pktsdir
10140 20 61 63 6b 2d 75 75 69 64 20 61 63 6b 2d 70 6b ack-uuid ack-pk
10150 74 29 29 0a 09 09 20 20 20 20 28 69 66 20 6e 6f t))... (if no
10160 74 69 66 69 63 61 74 69 6f 6e 2d 68 6f 6f 6b 0a tification-hook.
10170 09 09 09 28 6c 65 74 2a 20 28 28 6e 6f 74 69 66 ...(let* ((notif
10180 69 63 61 74 69 6f 6e 2d 63 6d 64 20 28 63 6f 6e ication-cmd (con
10190 63 20 6e 6f 74 69 66 69 63 61 74 69 6f 6e 2d 68 c notification-h
101a0 6f 6f 6b 20 22 20 2d 2d 70 6b 74 20 22 20 70 6b ook " --pkt " pk
101b0 74 66 69 6c 65 20 22 20 2d 2d 6d 73 67 20 41 43 tfile " --msg AC
101c0 43 45 53 53 5f 44 45 4e 49 45 44 22 29 29 29 0a CESS_DENIED"))).
101d0 09 09 09 20 20 28 70 72 69 6e 74 20 22 52 75 6e ... (print "Run
101e0 6e 69 6e 67 20 22 20 6e 6f 74 69 66 69 63 61 74 ning " notificat
101f0 69 6f 6e 2d 63 6d 64 29 0a 09 09 09 20 20 28 73 ion-cmd).... (s
10200 79 73 74 65 6d 20 6e 6f 74 69 66 69 63 61 74 69 ystem notificati
10210 6f 6e 2d 63 6d 64 29 29 29 29 29 29 29 0a 09 20 on-cmd)))))))..
10220 20 70 6b 74 73 29 29 29 29 29 29 0a 0a 0a 28 64 pkts))))))...(d
10230 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 61 63 63 efine (check-acc
10240 65 73 73 20 75 73 65 72 20 6d 74 63 6f 6e 66 20 ess user mtconf
10250 61 63 74 69 6f 6e 20 61 72 65 61 29 0a 20 20 3b action area). ;
10260 3b 20 4e 4f 54 45 3a 20 4e 65 65 64 20 63 6f 6e ; NOTE: Need con
10270 74 72 6f 6c 20 6f 76 65 72 20 64 65 66 61 75 6c trol over defaul
10280 74 73 2e 20 45 2e 67 2e 20 64 65 66 61 75 6c 74 ts. E.g. default
10290 20 6d 69 67 68 74 20 62 65 20 6e 6f 20 61 63 63 might be no acc
102a0 65 73 73 0a 20 20 28 6c 65 74 2a 20 28 28 61 63 ess. (let* ((ac
102b0 63 65 73 73 2d 63 74 72 6c 20 28 68 61 73 68 2d cess-ctrl (hash-
102c0 74 61 62 6c 65 2d 65 78 69 73 74 73 3f 20 6d 74 table-exists? mt
102d0 63 6f 6e 66 20 22 61 63 63 65 73 73 22 29 29 20 conf "access"))
102e0 20 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 ;; if there is
102f0 61 6e 20 61 63 63 65 73 73 20 73 65 63 74 69 6f an access sectio
10300 6e 20 74 68 65 20 64 65 66 61 75 6c 74 20 69 73 n the default is
10310 20 74 6f 20 52 45 51 55 49 52 45 20 65 6e 61 62 to REQUIRE enab
10320 6c 65 6d 65 6e 74 2f 61 63 63 65 73 73 0a 09 20 lement/access..
10330 28 61 63 63 65 73 73 2d 6c 69 73 74 20 28 6d 61 (access-list (ma
10340 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 p (lambda (x)...
10350 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 . (string-sp
10360 6c 69 74 20 78 20 22 3a 22 29 29 0a 09 09 09 20 lit x ":"))....
10370 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
10380 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (or (configf:loo
10390 6b 75 70 20 6d 74 63 6f 6e 66 20 22 61 63 63 65 kup mtconf "acce
103a0 73 73 22 20 61 72 65 61 29 20 3b 3b 20 75 73 65 ss" area) ;; use
103b0 72 69 64 3a 72 69 67 68 74 73 74 79 70 65 20 75 rid:rightstype u
103c0 73 65 72 69 64 32 3a 72 69 67 68 74 73 74 79 70 serid2:rightstyp
103d0 65 32 20 2e 2e 2e 0a 09 09 09 09 09 20 20 20 20 e2 .........
103e0 20 28 69 66 20 61 63 63 65 73 73 2d 63 74 72 6c (if access-ctrl
103f0 0a 09 09 09 09 09 09 20 22 2a 3a 6e 6f 6e 65 22 ....... "*:none"
10400 20 20 3b 3b 20 6e 6f 62 6f 64 79 20 68 61 73 20 ;; nobody has
10410 61 63 63 65 73 73 20 62 79 20 64 65 66 61 75 6c access by defaul
10420 74 0a 09 09 09 09 09 09 20 22 2a 3a 61 6c 6c 22 t....... "*:all"
10430 29 29 29 29 29 0a 09 20 28 61 63 63 65 73 73 2d ))))).. (access-
10440 74 79 70 65 73 2d 64 61 74 20 28 63 6f 6e 66 69 types-dat (confi
10450 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 6d gf:get-section m
10460 74 63 6f 6e 66 20 22 61 63 63 65 73 73 74 79 70 tconf "accesstyp
10470 65 73 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 es"))). (debu
10480 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 g:print 2 *defau
10490 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 68 lt-log-port* "Ch
104a0 65 63 6b 69 6e 67 20 61 63 63 65 73 73 20 69 6e ecking access in
104b0 20 22 20 61 63 63 65 73 73 2d 6c 69 73 74 20 22 " access-list "
104c0 20 77 69 74 68 20 61 63 63 65 73 73 2d 63 74 72 with access-ctr
104d0 6c 20 22 20 61 63 63 65 73 73 2d 63 74 72 6c 20 l " access-ctrl
104e0 22 20 66 6f 72 20 61 72 65 61 20 22 20 61 72 65 " for area " are
104f0 61 29 0a 20 20 20 20 28 69 66 20 61 63 63 65 73 a). (if acces
10500 73 2d 63 74 72 6c 0a 09 28 6c 65 74 2a 20 28 28 s-ctrl..(let* ((
10510 75 73 65 72 2d 61 63 63 65 73 73 20 20 20 20 20 user-access
10520 28 6f 72 20 28 61 73 73 6f 63 20 75 73 65 72 20 (or (assoc user
10530 61 63 63 65 73 73 2d 6c 69 73 74 29 0a 09 09 09 access-list)....
10540 09 20 20 20 20 28 61 73 73 6f 63 20 22 2a 22 20 . (assoc "*"
10550 20 61 63 63 65 73 73 2d 6c 69 73 74 29 29 29 0a access-list))).
10560 09 20 20 20 20 20 20 20 28 61 63 63 65 73 73 2d . (access-
10570 74 79 70 65 20 20 20 28 69 66 20 75 73 65 72 2d type (if user-
10580 61 63 63 65 73 73 0a 09 09 09 09 09 09 09 09 09 access..........
10590 09 09 09 20 20 28 63 61 64 72 20 75 73 65 72 2d ... (cadr user-
105a0 61 63 63 65 73 73 29 0a 20 20 20 20 20 20 20 20 access).
105b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
105c0 20 20 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 #f))..
105d0 28 61 63 63 65 73 73 2d 74 79 70 65 73 20 20 20 (access-types
105e0 20 28 6c 65 74 20 28 28 72 65 73 20 28 61 6c 69 (let ((res (ali
105f0 73 74 2d 72 65 66 20 61 63 63 65 73 73 2d 74 79 st-ref access-ty
10600 70 65 20 61 63 63 65 73 73 2d 74 79 70 65 73 2d pe access-types-
10610 64 61 74 20 65 71 75 61 6c 3f 29 29 29 0a 09 09 dat equal?)))...
10620 09 09 20 20 28 69 66 20 72 65 73 20 28 63 61 72 .. (if res (car
10630 20 72 65 73 29 20 72 65 73 29 29 29 0a 09 20 20 res) res)))..
10640 20 20 20 20 20 28 61 6c 6c 6f 77 65 64 2d 61 63 (allowed-ac
10650 74 69 6f 6e 73 20 28 73 74 72 69 6e 67 2d 73 70 tions (string-sp
10660 6c 69 74 20 28 6f 72 20 61 63 63 65 73 73 2d 74 lit (or access-t
10670 79 70 65 73 20 22 22 29 29 29 29 0a 09 20 20 28 ypes "")))).. (
10680 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
10690 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
106a0 20 22 47 6f 74 20 22 20 61 6c 6c 6f 77 65 64 2d "Got " allowed-
106b0 61 63 74 69 6f 6e 73 20 22 20 66 6f 72 20 75 73 actions " for us
106c0 65 72 20 22 20 75 73 65 72 20 22 20 77 68 65 72 er " user " wher
106d0 65 20 61 63 63 65 73 73 2d 74 79 70 65 73 3d 22 e access-types="
106e0 20 61 63 63 65 73 73 2d 74 79 70 65 73 20 22 20 access-types "
106f0 61 63 63 65 73 73 2d 74 79 70 65 3d 22 20 61 63 access-type=" ac
10700 63 65 73 73 2d 74 79 70 65 29 0a 09 20 20 28 63 cess-type).. (c
10710 6f 6e 64 0a 09 20 20 20 28 28 61 6e 64 20 61 63 ond.. ((and ac
10720 63 65 73 73 2d 74 79 70 65 73 20 28 6d 65 6d 62 cess-types (memb
10730 65 72 20 61 63 74 69 6f 6e 20 61 6c 6c 6f 77 65 er action allowe
10740 64 2d 61 63 74 69 6f 6e 73 29 29 0a 09 20 20 20 d-actions))..
10750 20 3b 3b 20 28 70 72 69 6e 74 20 22 41 63 63 65 ;; (print "Acce
10760 73 73 20 67 72 61 6e 74 65 64 20 66 6f 72 20 22 ss granted for "
10770 20 75 73 65 72 20 22 20 66 6f 72 20 22 20 61 63 user " for " ac
10780 74 69 6f 6e 29 0a 09 20 20 20 20 23 74 29 0a 09 tion).. #t)..
10790 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 3b 3b (else.. ;;
107a0 20 28 70 72 69 6e 74 20 22 41 63 63 65 73 73 20 (print "Access
107b0 64 65 6e 69 65 64 20 66 6f 72 20 22 20 75 73 65 denied for " use
107c0 72 20 22 20 66 6f 72 20 22 20 61 63 74 69 6f 6e r " for " action
107d0 29 0a 09 20 20 20 20 23 66 29 29 29 29 29 29 0a ).. #f)))))).
107e0 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c .(define (open-l
107f0 6f 67 66 69 6c 65 20 6c 6f 67 70 61 74 68 29 0a ogfile logpath).
10800 20 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 (condition-cas
10810 65 0a 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67 e. (let* ((log
10820 2d 64 69 72 20 28 6f 72 20 28 70 61 74 68 6e 61 -dir (or (pathna
10830 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6f 67 me-directory log
10840 70 61 74 68 29 20 22 2e 22 29 29 29 0a 20 20 20 path) "."))).
10850 20 20 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 (if (not (dire
10860 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6f ctory-exists? lo
10870 67 2d 64 69 72 29 29 0a 20 20 20 20 20 20 20 20 g-dir)).
10880 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
10890 6d 6b 64 69 72 20 2d 70 20 22 20 6c 6f 67 2d 64 mkdir -p " log-d
108a0 69 72 29 29 29 0a 20 20 20 20 20 28 6f 70 65 6e ir))). (open
108b0 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 -output-file log
108c0 70 61 74 68 29 29 0a 20 20 20 28 65 78 6e 20 28 path)). (exn (
108d0 29 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 67 ). (debug
108e0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
108f0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
10900 2a 20 22 43 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 * "Could not ope
10910 6e 20 6c 6f 67 20 66 69 6c 65 20 66 6f 72 20 77 n log file for w
10920 72 69 74 65 3a 20 22 6c 6f 67 70 61 74 68 29 0a rite: "logpath).
10930 20 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 (define
10940 2a 64 69 64 73 6f 6d 65 74 68 69 6e 67 2a 20 23 *didsomething* #
10950 74 29 20 20 0a 20 20 20 20 20 20 20 20 28 65 78 t) . (ex
10960 69 74 20 31 29 29 29 29 0a 0a 0a 28 64 65 66 69 it 1))))...(defi
10970 6e 65 20 28 67 65 74 2d 70 6b 74 73 2d 64 69 72 ne (get-pkts-dir
10980 20 6d 74 63 6f 6e 66 29 0a 20 20 28 6c 65 74 20 mtconf). (let
10990 28 28 70 6b 74 73 64 69 72 73 20 20 28 63 6f 6e ((pktsdirs (con
109a0 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f figf:lookup mtco
109b0 6e 66 20 22 73 65 74 75 70 22 20 22 70 6b 74 73 nf "setup" "pkts
109c0 64 69 72 73 22 29 29 0a 09 28 70 6b 74 73 64 69 dirs"))..(pktsdi
109d0 72 20 20 20 28 69 66 20 70 6b 74 73 64 69 72 73 r (if pktsdirs
109e0 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 (car (string-sp
109f0 6c 69 74 20 70 6b 74 73 64 69 72 73 20 22 20 22 lit pktsdirs " "
10a00 29 29 20 23 66 29 29 29 0a 20 20 20 20 70 6b 74 )) #f))). pkt
10a10 73 64 69 72 29 29 0a 0a 28 6c 65 74 20 28 28 64 sdir))..(let ((d
10a20 65 62 75 67 63 6f 6e 74 72 6f 6c 66 20 28 63 6f ebugcontrolf (co
10a30 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d nc (get-environm
10a40 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 48 4f ent-variable "HO
10a50 4d 45 22 29 20 22 2f 2e 6d 74 75 74 69 6c 72 63 ME") "/.mtutilrc
10a60 22 29 29 29 0a 20 20 28 69 66 20 28 63 6f 6d 6d "))). (if (comm
10a70 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
10a80 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 0a 20 debugcontrolf).
10a90 20 20 20 20 20 28 6c 6f 61 64 20 64 65 62 75 67 (load debug
10aa0 63 6f 6e 74 72 6f 6c 66 29 29 29 0a 0a 28 69 66 controlf)))..(if
10ab0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
10ac0 2d 6c 6f 67 22 29 20 3b 3b 20 72 65 64 69 72 65 -log") ;; redire
10ad0 63 74 20 74 68 65 20 6c 6f 67 20 61 6c 77 61 79 ct the log alway
10ae0 73 20 77 68 65 6e 20 61 20 73 65 72 76 65 72 0a s when a server.
10af0 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 (handle-exce
10b00 70 74 69 6f 6e 73 0a 09 65 78 6e 0a 09 28 62 65 ptions..exn..(be
10b10 67 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 45 gin.. (print "E
10b20 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 RROR: Failed to
10b30 73 77 69 74 63 68 20 74 6f 20 6c 6f 67 20 6f 75 switch to log ou
10b40 74 70 75 74 2e 20 22 20 28 28 63 6f 6e 64 69 74 tput. " ((condit
10b50 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
10b60 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
10b70 61 67 65 29 20 65 78 6e 29 29 0a 09 20 20 29 0a age) exn)).. ).
10b80 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 6c (let* ((tl
10b90 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
10ba0 20 22 2d 6c 6f 67 22 29 29 20 20 20 3b 3b 20 72 "-log")) ;; r
10bb0 75 6e 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 un launch:setup
10bc0 69 66 20 2d 73 65 72 76 65 72 2c 20 65 6e 73 75 if -server, ensu
10bd0 72 65 20 77 65 20 64 6f 20 4e 4f 54 20 72 75 6e re we do NOT run
10be0 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 69 66 launch:setup if
10bf0 20 2d 6c 6f 67 20 73 70 65 63 69 66 69 65 64 0a -log specified.
10c00 09 20 20 20 20 20 28 6c 6f 67 66 20 28 61 72 67 . (logf (arg
10c10 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 22 s:get-arg "-log"
10c20 29 29 20 3b 3b 20 75 73 65 20 2d 6c 6f 67 20 75 )) ;; use -log u
10c30 6e 6c 65 73 73 20 77 65 20 61 72 65 20 61 20 73 nless we are a s
10c40 65 72 76 65 72 2c 20 74 68 65 6e 20 63 72 61 66 erver, then craf
10c50 74 20 61 20 6c 6f 67 66 69 6c 65 20 6e 61 6d 65 t a logfile name
10c60 0a 09 20 20 20 20 20 28 6f 75 70 20 20 28 6f 70 .. (oup (op
10c70 65 6e 2d 6c 6f 67 66 69 6c 65 20 6c 6f 67 66 29 en-logfile logf)
10c80 29 29 0a 09 3b 28 69 66 20 28 6e 6f 74 20 28 61 ))..;(if (not (a
10c90 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
10ca0 67 22 29 29 0a 09 3b 20 20 20 20 28 68 61 73 68 g"))..; (hash
10cb0 2d 74 61 62 6c 65 2d 73 65 74 21 20 61 72 67 73 -table-set! args
10cc0 3a 61 72 67 2d 68 61 73 68 20 22 2d 6c 6f 67 22 :arg-hash "-log"
10cd0 20 6c 6f 67 66 29 29 20 3b 3b 20 66 61 6b 65 20 logf)) ;; fake
10ce0 6f 75 74 20 66 75 74 75 72 65 20 71 75 65 72 69 out future queri
10cf0 65 73 20 6f 66 20 2d 6c 6f 67 0a 09 28 70 72 69 es of -log..(pri
10d00 6e 74 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d nt *default-log-
10d10 70 6f 72 74 2a 20 22 53 65 6e 64 69 6e 67 20 6c port* "Sending l
10d20 6f 67 20 6f 75 74 70 75 74 20 74 6f 20 22 20 6c og output to " l
10d30 6f 67 66 29 0a 09 28 73 65 74 21 20 2a 64 65 66 ogf)..(set! *def
10d40 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 6f ault-log-port* o
10d50 75 70 29 0a 29 29 29 0a 0a 28 69 66 20 2a 61 63 up).)))..(if *ac
10d60 74 69 6f 6e 2a 0a 20 20 20 20 28 63 61 73 65 20 tion*. (case
10d70 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
10d80 2a 61 63 74 69 6f 6e 2a 29 0a 20 20 20 20 20 20 *action*).
10d90 28 28 72 75 6e 20 72 65 6d 6f 76 65 20 72 65 72 ((run remove rer
10da0 75 6e 20 72 65 72 75 6e 2d 63 6c 65 61 6e 20 72 un rerun-clean r
10db0 65 72 75 6e 2d 61 6c 6c 20 73 65 74 2d 73 73 20 erun-all set-ss
10dc0 61 72 63 68 69 76 65 20 6b 69 6c 6c 20 6c 69 73 archive kill lis
10dd0 74 20 6b 69 6c 6c 2d 72 75 6e 20 6b 69 6c 6c 2d t kill-run kill-
10de0 72 65 72 75 6e 20 6c 6f 63 6b 20 75 6e 6c 6f 63 rerun lock unloc
10df0 6b 29 0a 20 20 20 20 20 20 20 20 20 20 0a 20 20 k). .
10e00 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 (let* ((mtc
10e10 6f 6e 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 onfdat (simple-s
10e20 65 74 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 etup (args:get-a
10e30 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 rg "-start-dir")
10e40 29 29 0a 09 20 20 20 20 20 20 28 6d 74 63 6f 6e )).. (mtcon
10e50 66 20 20 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 f (car mtconf
10e60 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 61 72 dat)).. (ar
10e70 65 61 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 ea (args:ge
10e80 74 2d 61 72 67 20 22 2d 61 72 65 61 22 29 29 20 t-arg "-area"))
10e90 3b 3b 20 6c 6f 6f 6b 20 75 70 20 74 68 65 20 61 ;; look up the a
10ea0 72 65 61 20 74 6f 20 64 69 73 70 61 74 63 68 20 rea to dispatch
10eb0 74 6f 20 66 72 6f 6d 20 5b 61 72 65 61 73 5d 20 to from [areas]
10ec0 73 65 63 74 69 6f 6e 0a 09 20 20 20 20 20 20 28 section.. (
10ed0 61 72 65 61 73 65 63 20 20 20 28 69 66 20 61 72 areasec (if ar
10ee0 65 61 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b ea (configf:look
10ef0 75 70 20 6d 74 63 6f 6e 66 20 22 61 72 65 61 73 up mtconf "areas
10f00 22 20 61 72 65 61 29 20 23 66 29 29 0a 09 20 20 " area) #f))..
10f10 20 20 20 20 28 61 72 65 61 64 61 74 20 20 20 28 (areadat (
10f20 69 66 20 61 72 65 61 73 65 63 20 28 63 6f 6d 6d if areasec (comm
10f30 6f 6e 3a 76 61 6c 2d 3e 61 6c 69 73 74 20 61 72 on:val->alist ar
10f40 65 61 73 65 63 29 20 23 66 29 29 0a 09 20 20 20 easec) #f))..
10f50 20 20 20 28 61 72 65 61 2d 70 61 74 68 20 28 69 (area-path (i
10f60 66 20 61 72 65 61 64 61 74 20 28 61 6c 69 73 74 f areadat (alist
10f70 2d 72 65 66 20 27 70 61 74 68 20 61 72 65 61 64 -ref 'path aread
10f80 61 74 29 20 23 66 29 29 0a 09 20 20 20 20 20 20 at) #f))..
10f90 28 70 6b 74 73 64 69 72 73 20 20 28 63 6f 6e 66 (pktsdirs (conf
10fa0 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e igf:lookup mtcon
10fb0 66 20 22 73 65 74 75 70 22 20 22 70 6b 74 73 64 f "setup" "pktsd
10fc0 69 72 73 22 29 29 0a 09 20 20 20 20 20 20 28 70 irs")).. (p
10fd0 6b 74 73 64 69 72 20 20 20 28 69 66 20 70 6b 74 ktsdir (if pkt
10fe0 73 64 69 72 73 20 28 63 61 72 20 28 73 74 72 69 sdirs (car (stri
10ff0 6e 67 2d 73 70 6c 69 74 20 70 6b 74 73 64 69 72 ng-split pktsdir
11000 73 20 22 20 22 29 29 20 23 66 29 29 0a 09 20 20 s " ")) #f))..
11010 20 20 20 20 28 61 64 6a 61 72 67 73 20 20 20 28 (adjargs (
11020 68 61 73 68 2d 74 61 62 6c 65 2d 63 6f 70 79 20 hash-table-copy
11030 61 72 67 73 3a 61 72 67 2d 68 61 73 68 29 29 0a args:arg-hash)).
11040 09 20 20 20 20 20 20 28 6e 65 77 2d 73 73 20 20 . (new-ss
11050 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
11060 22 2d 6e 65 77 22 29 29 29 0a 09 20 3b 3b 20 63 "-new"))).. ;; c
11070 68 65 63 6b 20 61 20 66 65 77 20 74 68 69 6e 67 heck a few thing
11080 73 0a 09 20 28 63 6f 6e 64 0a 09 20 20 28 28 61 s.. (cond.. ((a
11090 6e 64 20 61 72 65 61 20 28 6e 6f 74 20 61 72 65 nd area (not are
110a0 61 2d 70 61 74 68 29 29 0a 09 20 20 20 28 70 72 a-path)).. (pr
110b0 69 6e 74 20 22 45 52 52 4f 52 3a 20 74 68 65 20 int "ERROR: the
110c0 73 70 65 63 69 66 69 65 64 20 61 72 65 61 20 77 specified area w
110d0 61 73 20 6e 6f 74 20 66 6f 75 6e 64 20 69 6e 20 as not found in
110e0 74 68 65 20 5b 61 72 65 61 73 5d 20 74 61 62 6c the [areas] tabl
110f0 65 2e 20 41 72 65 61 20 6e 61 6d 65 3d 22 20 61 e. Area name=" a
11100 72 65 61 29 0a 09 20 20 20 28 65 78 69 74 20 31 rea).. (exit 1
11110 29 29 0a 09 20 20 28 28 6e 6f 74 20 61 72 65 61 )).. ((not area
11120 29 0a 09 20 20 20 28 70 72 69 6e 74 20 22 45 52 ).. (print "ER
11130 52 4f 52 3a 20 6e 6f 20 61 72 65 61 20 73 70 65 ROR: no area spe
11140 63 69 66 69 65 64 2e 20 55 73 65 20 2d 61 72 65 cified. Use -are
11150 61 20 3c 61 72 65 61 6e 61 6d 65 3e 22 29 0a 09 a <areaname>")..
11160 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 (exit 1))..
11170 28 65 6c 73 65 0a 09 20 20 20 28 6c 65 74 2a 20 (else.. (let*
11180 28 28 75 73 72 2d 61 64 6d 69 6e 20 28 63 68 65 ((usr-admin (che
11190 63 6b 2d 61 63 63 65 73 73 20 28 63 75 72 72 65 ck-access (curre
111a0 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 6d 74 nt-user-name) mt
111b0 63 6f 6e 66 20 22 6f 76 65 72 72 69 64 65 22 20 conf "override"
111c0 61 72 65 61 29 29 0a 09 09 09 09 09 28 75 73 65 area))......(use
111d0 72 20 28 69 66 20 28 61 6e 64 20 75 73 72 2d 61 r (if (and usr-a
111e0 64 6d 69 6e 20 28 61 72 67 73 3a 67 65 74 2d 61 dmin (args:get-a
111f0 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 75 73 rg "-override-us
11200 65 72 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 er")).
11210 20 20 20 20 20 20 20 20 20 20 28 61 72 67 73 3a (args:
11220 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 get-arg "-overri
11230 64 65 2d 75 73 65 72 22 29 0a 09 09 09 09 09 09 de-user").......
11240 09 09 09 20 20 28 63 75 72 72 65 6e 74 2d 75 73 ... (current-us
11250 65 72 2d 6e 61 6d 65 29 29 29 29 0a 20 20 20 20 er-name)))).
11260 20 20 20 3b 20 28 70 72 69 6e 74 20 22 75 73 65 ; (print "use
11270 72 20 31 32 33 20 22 20 75 73 72 2d 61 64 6d 69 r 123 " usr-admi
11280 6e 20 29 0a 20 20 20 20 20 20 20 20 3b 28 65 78 n ). ;(ex
11290 69 74 20 31 29 0a 20 20 20 20 20 28 69 66 20 28 it 1). (if (
112a0 61 6e 64 20 28 6e 6f 74 20 75 73 72 2d 61 64 6d and (not usr-adm
112b0 69 6e 29 20 28 61 72 67 73 3a 67 65 74 2d 61 72 in) (args:get-ar
112c0 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 75 73 65 g "-override-use
112d0 72 22 29 29 0a 20 20 20 20 20 20 20 20 20 28 62 r")). (b
112e0 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
112f0 20 28 70 72 69 6e 74 20 20 75 73 65 72 20 22 20 (print user "
11300 64 6f 65 73 20 6e 6f 74 20 68 61 76 65 20 61 63 does not have ac
11310 63 65 73 73 20 74 6f 20 6f 76 65 72 72 69 64 65 cess to override
11320 20 75 73 65 72 22 29 0a 20 20 20 20 20 20 20 20 user").
11330 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 (exit 1)))..
11340 20 28 69 66 20 28 63 68 65 63 6b 2d 61 63 63 65 (if (check-acce
11350 73 73 20 75 73 65 72 20 6d 74 63 6f 6e 66 20 2a ss user mtconf *
11360 61 63 74 69 6f 6e 2a 20 61 72 65 61 29 3b 3b 20 action* area);;
11370 63 68 65 63 6b 20 72 69 67 68 74 73 0a 09 09 20 check rights...
11380 28 70 72 69 6e 74 20 22 41 63 63 65 73 73 20 67 (print "Access g
11390 72 61 6e 74 65 64 20 66 6f 72 20 22 20 2a 61 63 ranted for " *ac
113a0 74 69 6f 6e 2a 20 22 20 61 63 74 69 6f 6e 20 62 tion* " action b
113b0 79 20 22 20 75 73 65 72 29 0a 09 09 20 28 62 65 y " user)... (be
113c0 67 69 6e 0a 09 09 20 20 20 28 70 72 69 6e 74 20 gin... (print
113d0 22 41 63 63 65 73 73 20 64 65 6e 69 65 64 20 66 "Access denied f
113e0 6f 72 20 22 20 2a 61 63 74 69 6f 6e 2a 20 22 20 or " *action* "
113f0 61 63 74 69 6f 6e 20 62 79 20 22 20 75 73 65 72 action by " user
11400 29 0a 09 09 20 20 20 28 65 78 69 74 20 31 29 29 )... (exit 1))
11410 29 29 29 29 0a 09 20 0a 09 20 3b 3b 20 28 66 6f )))).. .. ;; (fo
11420 72 2d 65 61 63 68 0a 09 20 3b 3b 20 20 28 6c 61 r-each.. ;; (la
11430 6d 62 64 61 20 28 6b 65 79 29 0a 09 20 3b 3b 20 mbda (key).. ;;
11440 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d (if (not (mem
11450 62 65 72 20 6b 65 79 20 2a 6c 65 67 61 6c 2d 70 ber key *legal-p
11460 61 72 61 6d 73 2a 29 29 0a 09 20 3b 3b 20 09 28 arams*)).. ;; .(
11470 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
11480 65 21 20 61 64 6a 61 72 67 73 20 6b 65 79 29 29 e! adjargs key))
11490 29 20 3b 3b 20 77 65 20 6e 65 65 64 20 74 6f 20 ) ;; we need to
114a0 64 65 6c 65 74 65 20 61 6e 79 20 70 61 72 61 6d delete any param
114b0 73 20 69 6e 74 65 6e 64 65 64 20 66 6f 72 20 6d s intended for m
114c0 74 75 74 69 6c 0a 09 20 3b 3b 20 20 28 68 61 73 tutil.. ;; (has
114d0 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 64 6a h-table-keys adj
114e0 61 72 67 73 29 29 0a 09 20 28 6c 65 74 2d 76 61 args)).. (let-va
114f0 6c 75 65 73 20 28 28 28 75 75 69 64 20 70 6b 74 lues (((uuid pkt
11500 29 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6d 6d )... (comm
11510 61 6e 64 2d 6c 69 6e 65 2d 3e 70 6b 74 20 2a 61 and-line->pkt *a
11520 63 74 69 6f 6e 2a 20 61 64 6a 61 72 67 73 20 23 ction* adjargs #
11530 66 20 61 72 65 61 2d 70 61 74 68 3a 20 61 72 65 f area-path: are
11540 61 2d 70 61 74 68 20 6e 65 77 2d 73 73 3a 20 6e a-path new-ss: n
11550 65 77 2d 73 73 29 29 29 0a 20 20 20 20 20 20 20 ew-ss))).
11560 20 20 20 20 28 70 72 69 6e 74 20 22 72 75 6e 20 (print "run
11570 6c 6f 67 20 40 20 22 20 28 63 6f 6e 63 20 28 63 log @ " (conc (c
11580 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
11590 29 20 22 2f 22 20 75 75 69 64 20 22 2d 22 20 2a ) "/" uuid "-" *
115a0 61 63 74 69 6f 6e 2a 20 22 2e 6c 6f 67 22 29 29 action* ".log"))
115b0 0a 09 20 20 20 28 77 72 69 74 65 2d 70 6b 74 20 .. (write-pkt
115c0 70 6b 74 73 64 69 72 20 75 75 69 64 20 70 6b 74 pktsdir uuid pkt
115d0 29 29 29 29 0a 20 20 20 20 20 20 28 28 64 69 73 )))). ((dis
115e0 70 61 74 63 68 20 69 6d 70 6f 72 74 20 72 75 6e patch import run
115f0 67 65 6e 20 70 72 6f 63 65 73 73 29 0a 20 20 20 gen process).
11600 20 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f (let* ((mtco
11610 6e 66 64 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 nfdat (simple-se
11620 74 75 70 20 28 61 72 67 73 3a 67 65 74 2d 61 72 tup (args:get-ar
11630 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 29 29 g "-start-dir"))
11640 29 0a 09 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 ).. (mtconf
11650 20 20 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 (car mtconfd
11660 61 74 29 29 0a 09 20 20 20 20 20 20 28 74 6f 70 at)).. (top
11670 70 61 74 68 20 20 20 28 63 6f 6e 66 69 67 66 3a path (configf:
11680 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 73 lookup mtconf "s
11690 63 72 61 74 63 68 64 61 74 22 20 22 74 6f 70 70 cratchdat" "topp
116a0 61 74 68 22 29 29 29 0a 09 20 28 63 61 73 65 20 ath"))).. (case
116b0 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
116c0 2a 61 63 74 69 6f 6e 2a 29 0a 09 20 20 20 28 28 *action*).. ((
116d0 70 72 6f 63 65 73 73 29 20 20 28 62 65 67 69 6e process) (begin
116e0 0a 09 09 09 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 .... (common:loa
116f0 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 d-pkts-to-db mtc
11700 6f 6e 66 29 0a 09 09 09 20 28 67 65 6e 65 72 61 onf).... (genera
11710 74 65 2d 72 75 6e 2d 70 6b 74 73 20 6d 74 63 6f te-run-pkts mtco
11720 6e 66 20 74 6f 70 70 61 74 68 29 0a 09 09 09 20 nf toppath)....
11730 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 64 2d 70 6b 74 (common:load-pkt
11740 73 2d 74 6f 2d 64 62 20 6d 74 63 6f 6e 66 29 0a s-to-db mtconf).
11750 09 09 09 20 28 64 69 73 70 61 74 63 68 2d 63 6f ... (dispatch-co
11760 6d 6d 61 6e 64 73 20 6d 74 63 6f 6e 66 20 74 6f mmands mtconf to
11770 70 70 61 74 68 29 29 29 0a 09 20 20 20 28 28 69 ppath))).. ((i
11780 6d 70 6f 72 74 29 20 20 20 28 63 6f 6d 6d 6f 6e mport) (common
11790 3a 6c 6f 61 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 :load-pkts-to-db
117a0 20 6d 74 63 6f 6e 66 29 29 20 3b 3b 20 69 6d 70 mtconf)) ;; imp
117b0 6f 72 74 20 70 6b 74 73 0a 09 20 20 20 28 28 72 ort pkts.. ((r
117c0 75 6e 67 65 6e 29 20 20 20 28 67 65 6e 65 72 61 ungen) (genera
117d0 74 65 2d 72 75 6e 2d 70 6b 74 73 20 6d 74 63 6f te-run-pkts mtco
117e0 6e 66 20 74 6f 70 70 61 74 68 29 29 0a 09 20 20 nf toppath))..
117f0 20 28 28 64 69 73 70 61 74 63 68 29 20 28 64 69 ((dispatch) (di
11800 73 70 61 74 63 68 2d 63 6f 6d 6d 61 6e 64 73 20 spatch-commands
11810 6d 74 63 6f 6e 66 20 74 6f 70 70 61 74 68 29 29 mtconf toppath))
11820 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6d 69 73 ))). ;; mis
11830 63 0a 20 20 20 20 20 20 28 28 73 68 6f 77 29 0a c. ((show).
11840 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c (if (> (l
11850 65 6e 67 74 68 20 72 65 6d 61 72 67 73 29 20 30 ength remargs) 0
11860 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 6d 74 ).. (let* ((mt
11870 63 6f 6e 66 64 61 74 20 28 73 69 6d 70 6c 65 2d confdat (simple-
11880 73 65 74 75 70 20 28 61 72 67 73 3a 67 65 74 2d setup (args:get-
11890 61 72 67 20 22 2d 73 74 61 72 74 2d 64 69 72 22 arg "-start-dir"
118a0 29 29 29 0a 09 09 20 20 28 6d 74 63 6f 6e 66 20 )))... (mtconf
118b0 20 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 (car mtconfda
118c0 74 29 29 0a 09 09 20 20 28 73 65 63 74 2d 64 61 t))... (sect-da
118d0 74 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 t (configf:get-s
118e0 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 28 63 ection mtconf (c
118f0 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 0a 09 ar remargs))))..
11900 20 20 20 20 20 28 69 66 20 73 65 63 74 2d 64 61 (if sect-da
11910 74 0a 09 09 20 28 66 6f 72 2d 65 61 63 68 0a 09 t... (for-each..
11920 09 20 20 28 6c 61 6d 62 64 61 20 28 65 6e 74 72 . (lambda (entr
11930 79 29 0a 09 09 20 20 20 20 28 69 66 20 28 3e 20 y)... (if (>
11940 28 6c 65 6e 67 74 68 20 65 6e 74 72 79 29 20 31 (length entry) 1
11950 29 0a 09 09 09 28 70 72 69 6e 74 20 28 63 61 72 )....(print (car
11960 20 65 6e 74 72 79 29 20 22 20 20 20 22 20 28 63 entry) " " (c
11970 61 64 72 20 65 6e 74 72 79 29 29 0a 09 09 09 28 adr entry))....(
11980 70 72 69 6e 74 20 28 63 61 72 20 65 6e 74 72 79 print (car entry
11990 29 29 29 29 0a 09 09 20 20 73 65 63 74 2d 64 61 ))))... sect-da
119a0 74 29 0a 09 09 20 28 70 72 69 6e 74 20 22 4e 6f t)... (print "No
119b0 20 73 65 63 74 69 6f 6e 20 5c 22 22 20 28 63 61 section \"" (ca
119c0 72 20 72 65 6d 61 72 67 73 29 20 22 5c 22 20 66 r remargs) "\" f
119d0 6f 75 6e 64 22 29 29 29 0a 09 20 20 20 28 70 72 ound"))).. (pr
119e0 69 6e 74 20 22 45 52 52 4f 52 3a 20 6c 69 73 74 int "ERROR: list
119f0 20 72 65 71 75 69 72 65 73 20 73 65 63 74 69 6f requires sectio
11a00 6e 20 70 61 72 61 6d 65 74 65 72 3b 20 61 72 65 n parameter; are
11a10 61 73 2c 20 73 65 74 75 70 20 6f 72 20 63 6f 6e as, setup or con
11a20 74 6f 75 72 73 22 29 29 29 0a 20 20 20 20 20 20 tours"))).
11a30 28 28 67 65 6e 64 6f 74 29 0a 20 20 20 20 20 20 ((gendot).
11a40 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e 66 64 (let* ((mtconfd
11a50 61 74 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 at (simple-setup
11a60 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11a70 2d 73 74 61 72 74 2d 64 69 72 22 29 29 29 0a 09 -start-dir")))..
11a80 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 (mtconf
11a90 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 (car mtconfdat)
11aa0 29 29 0a 09 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 61 )).. (common:loa
11ab0 64 2d 70 6b 74 73 2d 74 6f 2d 64 62 20 6d 74 63 d-pkts-to-db mtc
11ac0 6f 6e 66 20 75 73 65 2d 6c 74 3a 20 23 74 29 20 onf use-lt: #t)
11ad0 3b 3b 20 6e 65 65 64 20 74 6f 20 4e 4f 54 20 64 ;; need to NOT d
11ae0 6f 20 74 68 69 73 20 62 79 20 64 65 66 61 75 6c o this by defaul
11af0 74 20 2e 2e 2e 0a 09 20 28 63 6f 6d 6d 6f 6e 3a t ..... (common:
11b00 77 69 74 68 2d 71 75 65 75 65 2d 64 62 0a 09 20 with-queue-db..
11b10 20 6d 74 63 6f 6e 66 0a 09 20 20 28 6c 61 6d 62 mtconf.. (lamb
11b20 64 61 20 28 70 6b 74 73 64 69 72 73 20 70 6b 74 da (pktsdirs pkt
11b30 73 64 69 72 20 63 6f 6e 6e 29 0a 09 20 20 20 20 sdir conn)..
11b40 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
11b50 20 20 20 20 20 20 20 20 20 70 6b 74 73 70 65 63 pktspec
11b60 20 64 69 73 70 6c 61 79 2d 66 69 65 6c 64 73 20 display-fields
11b70 0a 09 20 20 20 20 28 6d 61 6b 65 2d 72 65 70 6f .. (make-repo
11b80 72 74 20 22 6f 75 74 2e 64 6f 74 22 20 63 6f 6e rt "out.dot" con
11b90 6e 0a 09 09 09 20 27 28 28 63 6d 64 20 20 20 20 n.... '((cmd
11ba0 20 20 2e 20 28 28 70 61 72 65 6e 74 20 2e 20 50 . ((parent . P
11bb0 29 0a 09 09 09 09 09 28 75 73 65 72 20 20 20 2e )......(user .
11bc0 20 4d 29 0a 09 09 09 09 09 28 74 61 72 67 65 74 M)......(target
11bd0 20 2e 20 74 29 29 29 0a 09 09 09 20 20 20 28 72 . t))).... (r
11be0 75 6e 73 74 61 72 74 20 2e 20 28 28 70 61 72 65 unstart . ((pare
11bf0 6e 74 20 2e 20 50 29 0a 09 09 09 09 09 28 74 61 nt . P)......(ta
11c00 72 67 65 74 20 2e 20 74 29 29 29 0a 09 09 09 20 rget . t)))....
11c10 20 20 28 72 75 6e 74 79 70 65 20 2e 20 28 28 70 (runtype . ((p
11c20 61 72 65 6e 74 20 2e 20 50 29 29 29 29 20 3b 3b arent . P)))) ;;
11c30 20 70 6b 74 73 70 65 63 0a 09 09 09 20 27 28 50 pktspec.... '(P
11c40 20 55 20 74 29 20 20 20 20 20 20 20 20 20 20 20 U t)
11c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c70 20 20 20 20 20 20 20 20 20 20 3b 3b 20 0a 09 09 ;; ...
11c80 09 20 29 29 29 29 29 20 20 3b 3b 20 6e 6f 20 70 . ))))) ;; no p
11c90 74 79 70 65 73 20 6c 69 73 74 65 64 20 28 70 74 types listed (pt
11ca0 79 70 65 73 20 61 72 65 20 73 74 72 69 6e 67 73 ypes are strings
11cb0 20 6f 66 20 70 6b 74 20 74 79 70 65 73 20 74 6f of pkt types to
11cc0 20 72 65 61 64 20 66 72 6f 6d 20 64 62 0a 20 20 read from db.
11cd0 20 20 20 20 28 28 64 62 29 0a 20 20 20 20 20 20 ((db).
11ce0 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 (if (null? rema
11cf0 72 67 73 29 0a 09 20 20 20 28 70 72 69 6e 74 20 rgs).. (print
11d00 22 45 52 52 4f 52 3a 20 6d 69 73 73 69 6e 67 20 "ERROR: missing
11d10 73 75 62 20 63 6f 6d 6d 61 6e 64 20 66 6f 72 20 sub command for
11d20 64 62 20 63 6f 6d 6d 61 6e 64 22 29 0a 09 20 20 db command")..
11d30 20 28 6c 65 74 20 28 28 73 75 62 63 6d 64 20 28 (let ((subcmd (
11d40 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 0a 09 car remargs)))..
11d50 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
11d60 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 75 62 63 6d ng->symbol subcm
11d70 64 29 0a 09 20 20 20 20 20 20 20 28 28 70 67 73 d).. ((pgs
11d80 63 68 65 6d 61 29 0a 09 09 28 6c 65 74 2a 20 28 chema)...(let* (
11d90 28 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 28 63 (install-home (c
11da0 6f 6d 6d 6f 6e 3a 67 65 74 2d 69 6e 73 74 61 6c ommon:get-instal
11db0 6c 2d 61 72 65 61 29 29 0a 09 09 20 20 20 20 20 l-area))...
11dc0 20 20 28 73 63 68 65 6d 61 2d 66 69 6c 65 20 20 (schema-file
11dd0 28 63 6f 6e 63 20 69 6e 73 74 61 6c 6c 2d 68 6f (conc install-ho
11de0 6d 65 20 22 2f 73 68 61 72 65 2f 64 62 2f 6d 74 me "/share/db/mt
11df0 2d 70 67 2e 73 71 6c 22 29 29 29 0a 09 09 20 20 -pg.sql")))...
11e00 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (if (common:file
11e10 2d 65 78 69 73 74 73 3f 20 73 63 68 65 6d 61 2d -exists? schema-
11e20 66 69 6c 65 29 0a 09 09 20 20 20 20 20 20 28 73 file)... (s
11e30 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 2f 62 69 ystem (conc "/bi
11e40 6e 2f 63 61 74 20 22 20 73 63 68 65 6d 61 2d 66 n/cat " schema-f
11e50 69 6c 65 29 29 29 29 29 0a 09 20 20 20 20 20 20 ile)))))..
11e60 20 28 28 73 71 6c 69 74 65 33 73 63 68 65 6d 61 ((sqlite3schema
11e70 29 0a 09 09 28 6c 65 74 2a 20 28 28 69 6e 73 74 )...(let* ((inst
11e80 61 6c 6c 2d 68 6f 6d 65 20 28 63 6f 6d 6d 6f 6e all-home (common
11e90 3a 67 65 74 2d 69 6e 73 74 61 6c 6c 2d 61 72 65 :get-install-are
11ea0 61 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 63 a))... (sc
11eb0 68 65 6d 61 2d 66 69 6c 65 20 20 28 63 6f 6e 63 hema-file (conc
11ec0 20 69 6e 73 74 61 6c 6c 2d 68 6f 6d 65 20 22 2f install-home "/
11ed0 73 68 61 72 65 2f 64 62 2f 6d 74 2d 73 71 6c 69 share/db/mt-sqli
11ee0 74 65 33 2e 73 71 6c 22 29 29 29 0a 09 09 20 20 te3.sql")))...
11ef0 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (if (common:file
11f00 2d 65 78 69 73 74 73 3f 20 73 63 68 65 6d 61 2d -exists? schema-
11f10 66 69 6c 65 29 0a 09 09 20 20 20 20 20 20 28 73 file)... (s
11f20 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 2f 62 69 ystem (conc "/bi
11f30 6e 2f 63 61 74 20 22 20 73 63 68 65 6d 61 2d 66 n/cat " schema-f
11f40 69 6c 65 29 29 29 29 29 0a 09 20 20 20 20 20 20 ile)))))..
11f50 20 28 28 6a 75 6e 6b 29 0a 09 09 28 72 6d 74 3a ((junk)...(rmt:
11f60 67 65 74 2d 6b 65 79 73 29 29 29 29 29 29 0a 20 get-keys)))))).
11f70 20 20 20 28 28 74 73 65 6e 64 29 0a 20 20 20 20 ((tsend).
11f80 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 (if (null? re
11f90 6d 61 72 67 73 29 0a 09 20 20 20 20 20 20 28 70 margs).. (p
11fa0 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 6d 69 73 rint "ERROR: mis
11fb0 73 69 6e 67 20 64 61 74 61 20 74 6f 20 73 65 6e sing data to sen
11fc0 64 20 74 6f 20 74 72 69 67 67 65 72 20 6c 69 73 d to trigger lis
11fd0 74 65 6e 65 72 73 22 29 0a 09 20 20 20 20 20 20 teners")..
11fe0 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 20 20 (let* ((msg
11ff0 20 20 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 (car remargs))
12000 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12010 20 20 20 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 (mtconfdat (s
12020 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 imple-setup (arg
12030 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
12040 74 2d 64 69 72 22 29 29 29 0a 20 20 20 20 20 20 t-dir"))).
12050 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 74 63 (mtc
12060 6f 6e 66 20 20 20 20 28 63 61 72 20 6d 74 63 6f onf (car mtco
12070 6e 66 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 nfdat)).
12080 20 20 20 20 20 20 20 20 20 20 28 74 69 6d 65 2d (time-
12090 6f 75 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 out (if (args:g
120a0 65 74 2d 61 72 67 20 22 2d 74 69 6d 65 2d 6f 75 et-arg "-time-ou
120b0 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t").
120c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
120d0 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
120e0 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
120f0 72 67 20 22 2d 74 69 6d 65 2d 6f 75 74 22 29 29 rg "-time-out"))
12100 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12120 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 5)).
12130 20 20 20 20 20 20 20 28 6c 69 73 74 65 6e 65 72 (listener
12140 73 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 s (configf:get-s
12150 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 22 6c ection mtconf "l
12160 69 73 74 65 6e 65 72 73 22 29 29 0a 20 20 20 20 isteners")).
12170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 75 (u
12180 73 65 72 2d 69 6e 66 6f 20 20 28 75 73 65 72 2d ser-info (user-
12190 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 75 72 information (cur
121a0 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 29 0a rent-user-id))).
121b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121c0 20 20 28 70 72 65 76 2d 73 65 65 6e 20 28 6d 61 (prev-seen (ma
121d0 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
121e0 20 3b 3b 20 63 61 74 63 68 20 64 75 70 6c 69 63 ;; catch duplic
121f0 61 74 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 ates.
12200 20 20 28 69 66 20 75 73 65 72 2d 69 6e 66 6f 0a (if user-info.
12210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
12220 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
12230 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
12240 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
12250 62 64 61 20 28 6c 69 73 74 65 6e 65 72 29 0a 20 bda (listener).
12260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12270 6c 65 74 20 28 28 68 6f 73 74 2d 70 6f 72 74 20 let ((host-port
12280 28 63 61 72 20 6c 69 73 74 65 6e 65 72 29 29 0a (car listener)).
12290 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
122a0 20 20 20 20 20 20 28 61 74 74 72 69 62 20 28 76 (attrib (v
122b0 61 6c 2d 3e 61 6c 69 73 74 20 28 63 61 64 72 20 al->alist (cadr
122c0 6c 69 73 74 65 6e 65 72 29 29 29 29 0a 20 20 20 listener)))).
122d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
122e0 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 if (and (equal?
122f0 6d 73 67 20 22 74 69 6d 65 2d 74 6f 2d 64 69 65 msg "time-to-die
12300 22 29 20 28 6e 6f 74 20 28 63 61 6e 2d 75 73 65 ") (not (can-use
12310 72 2d 6b 69 6c 6c 2d 6c 69 73 74 6e 65 72 20 75 r-kill-listner u
12320 73 65 72 2d 69 6e 66 6f 20 61 74 74 72 69 62 29 ser-info attrib)
12330 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
12340 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
12350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12360 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
12370 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
12380 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 65 72 -log-port* "User
12390 20 22 20 28 63 61 72 20 75 73 65 72 2d 69 6e 66 " (car user-inf
123a0 6f 29 20 22 20 69 73 20 6e 6f 74 20 61 6c 6c 6f o) " is not allo
123b0 77 65 64 20 74 6f 20 73 65 6e 64 20 6d 65 73 73 wed to send mess
123c0 61 67 65 20 27 22 20 6d 73 67 22 27 22 29 0a 20 age '" msg"'").
123d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
123e0 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a (exit 1))).
123f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12400 20 20 28 70 72 69 6e 74 20 22 73 65 6e 64 69 6e (print "sendin
12410 67 20 22 20 6d 73 67 20 22 20 74 6f 20 22 20 68 g " msg " to " h
12420 6f 73 74 2d 70 6f 72 74 20 29 0a 20 20 20 20 20 ost-port ).
12430 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 (op
12440 65 6e 2d 73 65 6e 64 2d 63 6c 6f 73 65 2d 6e 6e en-send-close-nn
12450 20 68 6f 73 74 2d 70 6f 72 74 20 6d 73 67 20 61 host-port msg a
12460 74 74 72 69 62 20 74 69 6d 65 6f 75 74 3a 20 74 ttrib timeout: t
12470 69 6d 65 2d 6f 75 74 20 29 29 29 0a 20 20 20 20 ime-out ))).
12480 20 20 20 20 20 20 20 20 20 20 6c 69 73 74 65 6e listen
12490 65 72 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ers)).
124a0 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
124b0 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
124c0 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
124d0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
124e0 2a 20 22 43 6f 75 6c 64 20 6e 6f 74 20 49 64 65 * "Could not Ide
124f0 6e 74 69 66 79 20 65 78 65 63 75 74 69 6e 67 20 ntify executing
12500 75 73 65 72 2e 20 57 69 6c 6c 20 6e 6f 74 20 73 user. Will not s
12510 65 6e 64 20 61 6e 79 20 6d 65 73 73 61 67 65 22 end any message"
12520 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12530 20 28 65 78 69 74 20 31 29 29 29 29 29 29 0a 20 (exit 1)))))).
12540 20 20 20 20 28 28 74 71 75 65 72 79 29 0a 20 20 ((tquery).
12550 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
12560 72 65 6d 61 72 67 73 29 0a 09 20 20 20 20 20 20 remargs)..
12570 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 6d (print "ERROR: m
12580 69 73 73 69 6e 67 20 64 61 74 61 20 74 6f 20 73 issing data to s
12590 65 6e 64 20 74 6f 20 74 72 69 67 67 65 72 20 6c end to trigger l
125a0 69 73 74 65 6e 65 72 73 22 29 0a 09 20 20 20 20 isteners")..
125b0 20 20 28 6c 65 74 2a 20 28 28 6d 73 67 20 20 20 (let* ((msg
125c0 20 20 20 20 28 63 61 72 20 72 65 6d 61 72 67 73 (car remargs
125d0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
125e0 20 20 20 20 20 28 6d 74 63 6f 6e 66 64 61 74 20 (mtconfdat
125f0 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 (simple-setup (a
12600 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 rgs:get-arg "-st
12610 61 72 74 2d 64 69 72 22 29 29 29 0a 20 20 20 20 art-dir"))).
12620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
12630 74 63 6f 6e 66 20 20 20 20 28 63 61 72 20 6d 74 tconf (car mt
12640 63 6f 6e 66 64 61 74 29 29 0a 20 20 20 20 20 20 confdat)).
12650 20 20 20 20 20 20 20 20 20 20 20 20 28 74 69 6d (tim
12660 65 2d 6f 75 74 20 20 28 69 66 20 28 61 72 67 73 e-out (if (args
12670 3a 67 65 74 2d 61 72 67 20 22 2d 74 69 6d 65 2d :get-arg "-time-
12680 6f 75 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 out").
12690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
126a0 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e (string->
126b0 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
126c0 2d 61 72 67 20 22 2d 74 69 6d 65 2d 6f 75 74 22 -arg "-time-out"
126d0 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
126e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
126f0 20 20 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 5)).
12700 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 65 6e (listen
12710 65 72 73 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 ers (configf:get
12720 2d 73 65 63 74 69 6f 6e 20 6d 74 63 6f 6e 66 20 -section mtconf
12730 22 6c 69 73 74 65 6e 65 72 73 22 29 29 0a 20 20 "listeners")).
12740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12750 28 75 73 65 72 2d 69 6e 66 6f 20 20 28 75 73 65 (user-info (use
12760 72 2d 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 28 63 r-information (c
12770 75 72 72 65 6e 74 2d 75 73 65 72 2d 69 64 29 29 urrent-user-id))
12780 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12790 20 20 20 20 28 70 72 65 76 2d 73 65 65 6e 20 28 (prev-seen (
127a0 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
127b0 29 29 20 3b 3b 20 63 61 74 63 68 20 64 75 70 6c )) ;; catch dupl
127c0 69 63 61 74 65 73 0a 20 20 20 20 20 20 20 20 20 icates.
127d0 20 20 20 20 28 69 66 20 75 73 65 72 2d 69 6e 66 (if user-inf
127e0 6f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 o.
127f0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
12800 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a (for-each.
12810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
12820 61 6d 62 64 61 20 28 6c 69 73 74 65 6e 65 72 29 ambda (listener)
12830 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12840 20 28 6c 65 74 20 28 28 68 6f 73 74 2d 70 6f 72 (let ((host-por
12850 74 20 28 63 61 72 20 6c 69 73 74 65 6e 65 72 29 t (car listener)
12860 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12870 20 20 20 20 20 20 20 20 28 61 74 74 72 69 62 20 (attrib
12880 28 76 61 6c 2d 3e 61 6c 69 73 74 20 28 63 61 64 (val->alist (cad
12890 72 20 6c 69 73 74 65 6e 65 72 29 29 29 29 0a 20 r listener)))).
128a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
128b0 20 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c (if (and (equal
128c0 3f 20 6d 73 67 20 22 74 69 6d 65 2d 74 6f 2d 64 ? msg "time-to-d
128d0 69 65 22 29 20 28 6e 6f 74 20 28 63 61 6e 2d 75 ie") (not (can-u
128e0 73 65 72 2d 6b 69 6c 6c 2d 6c 69 73 74 6e 65 72 ser-kill-listner
128f0 20 75 73 65 72 2d 69 6e 66 6f 20 61 74 74 72 69 user-info attri
12900 62 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 b))).
12910 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
12920 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12930 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
12940 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
12950 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 lt-log-port* "Us
12960 65 72 20 22 20 28 63 61 72 20 75 73 65 72 2d 69 er " (car user-i
12970 6e 66 6f 29 20 22 20 69 73 20 6e 6f 74 20 61 6c nfo) " is not al
12980 6c 6f 77 65 64 20 74 6f 20 73 65 6e 64 20 6d 65 lowed to send me
12990 73 73 61 67 65 20 27 22 20 6d 73 67 22 27 22 29 ssage '" msg"'")
129a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
129b0 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 29 (exit 1))
129c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
129d0 20 20 20 20 28 70 72 69 6e 74 20 22 73 65 6e 64 (print "send
129e0 69 6e 67 20 22 20 6d 73 67 20 22 20 74 6f 20 22 ing " msg " to "
129f0 20 68 6f 73 74 2d 70 6f 72 74 20 29 0a 20 20 20 host-port ).
12a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12a10 6f 70 65 6e 2d 73 65 6e 64 2d 72 65 63 65 69 76 open-send-receiv
12a20 65 2d 6e 6e 20 68 6f 73 74 2d 70 6f 72 74 20 6d e-nn host-port m
12a30 73 67 20 61 74 74 72 69 62 20 74 69 6d 65 6f 75 sg attrib timeou
12a40 74 3a 20 74 69 6d 65 2d 6f 75 74 20 29 29 29 0a t: time-out ))).
12a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 69 li
12a60 73 74 65 6e 65 72 73 29 29 0a 20 20 20 20 20 20 steners)).
12a70 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
12a80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
12a90 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
12aa0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
12ab0 70 6f 72 74 2a 20 22 43 6f 75 6c 64 20 6e 6f 74 port* "Could not
12ac0 20 49 64 65 6e 74 69 66 79 20 65 78 65 63 75 74 Identify execut
12ad0 69 6e 67 20 75 73 65 72 2e 20 57 69 6c 6c 20 6e ing user. Will n
12ae0 6f 74 20 73 65 6e 64 20 61 6e 79 20 6d 65 73 73 ot send any mess
12af0 61 67 65 22 29 0a 20 20 20 20 20 20 20 20 20 20 age").
12b00 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 (exit 1))))
12b10 29 29 0a 0a 20 20 20 20 28 28 74 71 75 65 72 79 )).. ((tquery
12b20 6c 69 73 74 65 6e 29 0a 20 20 20 20 20 20 20 28 listen). (
12b30 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 61 72 67 if (null? remarg
12b40 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 70 s). (p
12b50 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 75 73 65 rint "ERROR: use
12b60 61 67 65 20 66 6f 72 20 74 6c 69 73 74 65 6e 20 age for tlisten
12b70 69 73 20 5c 22 6d 74 75 74 69 6c 20 74 6c 69 73 is \"mtutil tlis
12b80 74 65 6e 20 70 6f 72 74 6e 75 6d 5c 22 22 29 0a ten portnum\"").
12b90 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
12ba0 28 28 70 6f 72 74 6e 75 6d 20 28 73 74 72 69 6e ((portnum (strin
12bb0 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 72 g->number (car r
12bc0 65 6d 61 72 67 73 29 29 29 29 0a 20 20 20 20 20 emargs)))).
12bd0 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 .
12be0 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
12bf0 70 6f 72 74 6e 75 6d 29 0a 20 20 20 20 20 20 20 portnum).
12c00 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
12c10 20 22 45 52 52 4f 52 3a 20 74 68 65 20 70 6f 72 "ERROR: the por
12c20 74 6e 75 6d 62 65 72 20 70 61 72 61 6d 65 74 65 tnumber paramete
12c30 72 20 6d 75 73 74 20 62 65 20 61 20 6e 75 6d 62 r must be a numb
12c40 65 72 2c 20 79 6f 75 20 67 61 76 65 3a 20 22 20 er, you gave: "
12c50 28 63 61 72 20 72 65 6d 61 72 67 73 29 29 0a 20 (car remargs)).
12c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12c70 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
12c80 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
12c90 6f 74 20 28 69 73 2d 70 6f 72 74 2d 69 6e 2d 75 ot (is-port-in-u
12ca0 73 65 20 70 6f 72 74 6e 75 6d 29 29 20 20 0a 20 se portnum)) .
12cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12cc0 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 65 (let* ((re
12cd0 70 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 6e p (start-n
12ce0 6e 2d 73 65 72 76 65 72 20 70 6f 72 74 6e 75 6d n-server portnum
12cf0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
12d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d10 20 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 69 6d (mtconfdat (sim
12d20 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 73 3a ple-setup (args:
12d30 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 74 2d get-arg "-start-
12d40 64 69 72 22 29 29 29 0a 20 20 20 20 20 20 20 20 dir"))).
12d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d60 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 20 20 (mtconf
12d70 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 74 29 (car mtconfdat)
12d80 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12da0 28 63 6f 6e 74 61 63 74 20 20 20 28 63 6f 6e 66 (contact (conf
12db0 69 67 66 3a 6c 6f 6f 6b 75 70 20 6d 74 63 6f 6e igf:lookup mtcon
12dc0 66 20 22 6c 69 73 74 65 6e 65 72 22 20 22 6f 77 f "listener" "ow
12dd0 6e 65 72 22 29 29 0a 20 20 20 20 20 20 20 20 20 ner")).
12de0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12df0 20 20 20 20 20 28 73 63 72 69 70 74 20 20 20 20 (script
12e00 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
12e10 6d 74 63 6f 6e 66 20 22 6c 69 73 74 65 6e 65 72 mtconf "listener
12e20 22 20 22 73 63 72 69 70 74 22 29 29 29 0a 20 20 " "script"))).
12e30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e40 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 4c (print "L
12e50 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 istening on port
12e60 20 22 20 70 6f 72 74 6e 75 6d 20 22 20 66 6f 72 " portnum " for
12e70 20 6d 65 73 73 61 67 65 73 2e 22 29 0a 20 20 20 messages.").
12e80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e90 20 20 20 20 20 20 28 73 65 74 2d 73 69 67 6e 61 (set-signa
12ea0 6c 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 l-handler! signa
12eb0 6c 2f 69 6e 74 20 20 28 6c 61 6d 62 64 61 20 28 l/int (lambda (
12ec0 73 69 67 6e 75 6d 29 20 0a 09 09 09 09 09 09 09 signum) ........
12ed0 09 09 09 09 09 09 09 09 28 73 65 74 21 20 2a 74 ........(set! *t
12ee0 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 ime-to-exit* #t)
12ef0 0a 20 20 09 09 09 09 09 09 09 09 09 09 09 09 09 . .............
12f00 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
12f10 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
12f20 6f 67 2d 70 6f 72 74 2a 20 22 52 65 63 65 69 76 og-port* "Receiv
12f30 65 64 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e ed signal " sign
12f40 75 6d 20 22 20 73 65 6e 64 69 6e 67 20 65 6d 61 um " sending ema
12f50 69 6c 20 62 65 66 6f 72 20 65 78 69 74 69 6e 67 il befor exiting
12f60 20 21 21 22 29 0a 20 20 09 09 09 09 09 09 09 09 !!"). ........
12f70 09 09 09 09 09 09 28 6c 65 74 20 28 28 65 6d 61 ......(let ((ema
12f80 69 6c 2d 62 6f 64 79 20 28 6d 74 75 74 3a 73 74 il-body (mtut:st
12f90 6d 6c 2d 3e 73 74 72 69 6e 67 20 28 73 3a 62 6f ml->string (s:bo
12fa0 64 79 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 dy..............
12fb0 09 09 09 09 09 09 09 09 09 28 73 3a 70 20 28 63 .........(s:p (c
12fc0 6f 6e 63 20 22 52 65 63 65 69 76 65 64 20 73 69 onc "Received si
12fd0 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 22 2e gnal " signum ".
12fe0 20 4c 69 73 74 65 72 20 68 61 73 20 62 65 65 6e Lister has been
12ff0 20 74 65 72 6d 69 6e 61 74 65 64 20 6f 6e 20 68 terminated on h
13000 6f 73 74 20 22 20 28 67 65 74 2d 65 6e 76 69 72 ost " (get-envir
13010 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
13020 22 48 4f 53 54 22 29 20 22 2e 20 22 29 29 29 29 "HOST") ". "))))
13030 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
13040 09 09 09 09 09 20 20 20 20 20 20 20 20 28 73 65 ..... (se
13050 6e 64 6d 61 69 6c 20 63 6f 6e 74 61 63 74 20 22 ndmail contact "
13060 4c 69 73 74 6e 65 72 20 68 61 73 20 62 65 65 6e Listner has been
13070 20 74 65 72 6d 69 6e 61 74 65 64 2e 22 20 65 6d terminated." em
13080 61 69 6c 2d 62 6f 64 79 20 20 75 73 65 5f 68 74 ail-body use_ht
13090 6d 6c 3a 20 23 74 29 29 0a 20 20 20 20 20 20 20 ml: #t)).
130a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
130b0 20 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a (exit))).
130c0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 28 ...............(
130d0 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c set-signal-handl
130e0 65 72 21 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 er! signal/term
130f0 20 28 6c 61 6d 62 64 61 20 28 73 69 67 6e 75 6d (lambda (signum
13100 29 20 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 ) ..............
13110 09 09 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f ..(set! *time-to
13120 2d 65 78 69 74 2a 20 23 74 29 0a 20 20 09 09 09 -exit* #t). ...
13130 09 09 09 09 09 09 09 09 09 09 09 28 64 65 62 75 ...........(debu
13140 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
13150 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
13160 74 2a 20 22 52 65 63 65 69 76 65 64 20 73 69 67 t* "Received sig
13170 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 22 20 73 nal " signum " s
13180 65 6e 64 69 6e 67 20 65 6d 61 69 6c 20 62 65 66 ending email bef
13190 6f 72 20 65 78 69 74 69 6e 67 20 21 21 22 29 0a or exiting !!").
131a0 20 20 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ..............
131b0 28 6c 65 74 20 28 28 65 6d 61 69 6c 2d 62 6f 64 (let ((email-bod
131c0 79 20 28 6d 74 75 74 3a 73 74 6d 6c 2d 3e 73 74 y (mtut:stml->st
131d0 72 69 6e 67 20 28 73 3a 62 6f 64 79 0a 09 09 09 ring (s:body....
131e0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ................
131f0 09 09 09 28 73 3a 70 20 28 63 6f 6e 63 20 22 52 ...(s:p (conc "R
13200 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c 20 22 eceived signal "
13210 20 73 69 67 6e 75 6d 20 22 2e 20 4c 69 73 74 65 signum ". Liste
13220 72 20 68 61 73 20 62 65 65 6e 20 74 65 72 6d 69 r has been termi
13230 6e 61 74 65 64 20 6f 6e 20 68 6f 73 74 20 22 20 nated on host "
13240 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
13250 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 53 54 22 -variable "HOST"
13260 29 20 22 2e 20 22 29 29 29 29 29 29 0a 20 20 20 ) ". ")))))).
13270 20 20 20 20 20 20 20 20 20 20 09 09 09 09 09 20 .....
13280 20 20 20 20 20 20 20 28 73 65 6e 64 6d 61 69 6c (sendmail
13290 20 63 6f 6e 74 61 63 74 20 22 4c 69 73 74 6e 65 contact "Listne
132a0 72 20 68 61 73 20 62 65 65 6e 20 74 65 72 6d 69 r has been termi
132b0 6e 61 74 65 64 2e 22 20 65 6d 61 69 6c 2d 62 6f nated." email-bo
132c0 64 79 20 20 75 73 65 5f 68 74 6d 6c 3a 20 23 74 dy use_html: #t
132d0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
132e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
132f0 20 28 65 78 69 74 29 29 29 0a 0a 20 20 20 20 20 (exit)))..
13300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13310 20 20 20 20 3b 28 73 65 74 2d 73 69 67 6e 61 6c ;(set-signal
13320 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c -handler! signal
13330 2f 74 65 72 6d 20 73 70 65 63 69 61 6c 2d 73 69 /term special-si
13340 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 29 0a 20 20 gnal-handler).
13350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13360 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
13370 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13380 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 73 (let loop ((ins
13390 74 72 20 28 6e 6e 2d 72 65 63 76 20 72 65 70 29 tr (nn-recv rep)
133a0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
133b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
133c0 3b 3b 28 6e 6e 2d 73 65 6e 64 20 72 65 70 20 22 ;;(nn-send rep "
133d0 33 2e 39 22 29 0a 20 20 20 20 20 20 20 20 20 20 3.9").
133e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
133f0 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 (with-input-f
13400 72 6f 6d 2d 70 69 70 65 20 28 63 6f 6e 63 20 22 rom-pipe (conc "
13410 2f 75 73 72 2f 62 69 6e 2f 75 70 74 69 6d 65 20 /usr/bin/uptime
13420 7c 20 63 75 74 20 2d 64 27 3a 27 20 2d 66 34 20 | cut -d':' -f4
13430 7c 20 61 77 6b 20 27 7b 70 72 69 6e 74 20 24 31 | awk '{print $1
13440 7d 27 20 7c 20 63 75 74 20 2d 64 27 2c 27 20 2d }' | cut -d',' -
13450 66 31 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 f1").
13460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13470 20 20 09 28 6c 61 6d 62 64 61 28 29 0a 20 20 20 .(lambda().
13480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13490 20 20 20 20 20 20 20 20 20 20 09 09 28 6c 65 74 ..(let
134a0 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 loop ((inl (rea
134b0 64 2d 6c 69 6e 65 29 29 29 0a 20 20 20 20 20 20 d-line))).
134c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
134d0 20 20 20 20 09 09 09 09 28 69 66 20 28 6e 6f 74 ....(if (not
134e0 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e (eof-object? in
134f0 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l)).
13500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13510 20 20 09 09 09 09 28 62 65 67 69 6e 0a 20 20 20 ....(begin.
13520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13530 20 20 20 20 20 20 20 20 20 20 20 20 20 09 09 09 ...
13540 3b 3b 28 70 72 69 6e 74 20 22 66 64 6b 37 33 3a ;;(print "fdk73:
13550 20 22 20 69 6e 6c 20 22 3a 22 29 0a 20 20 20 20 " inl ":").
13560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13570 20 20 20 20 20 20 20 20 20 20 20 20 09 09 09 3b ...;
13580 3b 28 73 65 74 21 20 63 75 72 72 65 6e 74 2d 6c ;(set! current-l
13590 69 73 74 2d 63 69 61 66 20 28 61 70 70 65 6e 64 ist-ciaf (append
135a0 21 20 63 75 72 72 65 6e 74 2d 6c 69 73 74 2d 63 ! current-list-c
135b0 69 61 66 20 28 6c 69 73 74 20 28 73 74 72 69 6e iaf (list (strin
135c0 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 5c 5c g-substitute "\\
135d0 73 2b 24 22 20 22 22 20 69 6e 6c 29 29 29 29 0a s+$" "" inl)))).
135e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
135f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13600 09 09 09 28 6e 6e 2d 73 65 6e 64 20 72 65 70 20 ...(nn-send rep
13610 69 6e 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 inl).
13620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13630 20 20 20 20 20 09 09 09 28 6c 6f 6f 70 28 72 65 ...(loop(re
13640 61 64 2d 6c 69 6e 65 29 29 29 0a 20 20 20 20 20 ad-line))).
13650 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13660 20 20 20 20 20 09 09 09 09 29 29 0a 0a 20 20 20 ....))..
13670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13680 20 20 20 20 20 20 20 20 20 20 09 29 0a 20 20 20 .).
13690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
136a0 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 ).
136b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
136c0 20 20 20 20 20 20 20 20 20 3b 3b 28 70 72 69 6e ;;(prin
136d0 74 20 28 69 73 79 73 20 22 2f 75 73 72 2f 62 69 t (isys "/usr/bi
136e0 6e 2f 75 70 74 69 6d 65 22 20 66 6f 72 65 61 63 n/uptime" foreac
136f0 68 2d 73 74 64 6f 75 74 2d 74 68 75 6e 6b 3a 20 h-stdout-thunk:
13700 66 6f 72 65 61 63 68 2d 73 74 64 6f 75 74 29 29 foreach-stdout))
13710 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
13730 65 74 20 28 28 63 74 69 6d 65 20 28 64 61 74 65 et ((ctime (date
13740 2d 3e 73 74 72 69 6e 67 20 28 63 75 72 72 65 6e ->string (curren
13750 74 2d 64 61 74 65 29 29 29 29 20 0a 20 20 20 20 t-date)))) .
13760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13770 20 20 20 20 20 20 20 20 20 28 69 66 20 20 28 65 (if (e
13780 71 75 61 6c 3f 20 69 6e 73 74 72 20 22 74 69 6d qual? instr "tim
13790 65 2d 74 6f 2d 64 69 65 22 29 0a 20 20 20 20 20 e-to-die").
137a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
137b0 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 20 (begin
137c0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
137d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
137e0 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
137f0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
13800 20 63 74 69 6d 65 20 22 20 72 65 63 65 69 76 65 ctime " receive
13810 64 20 27 22 20 69 6e 73 74 72 20 22 27 2e 20 54 d '" instr "'. T
13820 69 6d 65 20 74 6f 20 73 75 63 69 64 65 2e 22 20 ime to sucide."
13830 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
13840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13850 20 28 6c 65 74 20 28 28 70 69 64 20 20 28 63 75 (let ((pid (cu
13860 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
13870 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
13880 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13890 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
138a0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
138b0 72 74 2a 20 22 4b 69 6c 6c 69 6e 67 20 63 75 72 rt* "Killing cur
138c0 72 65 6e 74 20 70 72 6f 63 65 73 73 20 28 70 69 rent process (pi
138d0 64 3d 22 20 70 69 64 20 22 29 22 29 0a 20 20 20 d=" pid ")").
138e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
138f0 20 20 20 20 20 20 20 20 20 20 20 20 28 73 79 73 (sys
13900 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 tem (conc "kill
13910 22 20 70 69 64 29 29 29 29 20 20 0a 20 20 20 20 " pid)))) .
13920 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13930 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
13940 09 09 09 09 09 09 09 09 28 64 65 62 75 67 3a 70 ........(debug:p
13950 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
13960 6c 6f 67 2d 70 6f 72 74 2a 20 63 74 69 6d 65 20 log-port* ctime
13970 22 20 72 65 63 65 69 76 65 64 20 22 20 69 6e 73 " received " ins
13980 74 72 20 29 0a 09 09 09 09 09 09 09 09 3b 28 6e tr ).........;(n
13990 6e 2d 73 65 6e 64 20 72 65 70 20 22 6f 6b 22 29 n-send rep "ok")
139a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
139b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
139c0 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
139d0 3f 20 69 6e 73 74 72 20 22 70 69 6e 67 22 29 29 ? instr "ping"))
139e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
139f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13a00 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
13a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13a20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
13a30 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
13a40 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 63 ault-log-port* c
13a50 74 69 6d 65 20 22 20 72 75 6e 6e 69 6e 67 20 5c time " running \
13a60 22 22 20 73 63 72 69 70 74 20 22 20 22 20 69 6e "" script " " in
13a70 73 74 72 20 22 5c 22 22 29 0a 20 20 20 20 20 20 str "\"").
13a80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 28 ;(
13aa0 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 73 63 72 system (conc scr
13ab0 69 70 74 20 22 20 27 22 20 69 6e 73 74 72 20 22 ipt " '" instr "
13ac0 27 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 '")).
13ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13ae0 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 (proc
13af0 65 73 73 2d 72 75 6e 20 73 63 72 69 70 74 20 28 ess-run script (
13b00 6c 69 73 74 20 20 69 6e 73 74 72 20 29 29 20 20 list instr ))
13b10 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b30 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
13b40 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
13b50 67 2d 70 6f 72 74 2a 20 63 74 69 6d 65 20 22 20 g-port* ctime "
13b60 64 6f 6e 65 22 20 29 29 0a 20 20 20 20 20 20 20 done" )).
13b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b80 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
13b90 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
13ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13bb0 20 20 20 20 20 20 09 20 28 69 66 20 28 6e 6f 74 . (if (not
13bc0 20 28 65 71 75 61 6c 3f 20 69 6e 73 74 72 20 22 (equal? instr "
13bd0 6c 6f 61 64 22 29 29 0a 20 20 20 20 20 20 20 20 load")).
13be0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13bf0 20 20 20 20 20 20 20 20 20 20 20 09 20 09 28 70 . .(p
13c00 72 69 6e 74 20 22 43 68 65 63 6b 69 6e 67 20 6c rint "Checking l
13c10 6f 61 64 22 29 0a 0a 20 20 20 20 20 20 20 20 20 oad")..
13c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c30 20 20 20 20 20 20 20 20 20 20 09 20 29 20 0a 20 . ) .
13c40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c60 20 20 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 )..
13c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c80 20 20 20 20 20 20 20 29 0a 0a 20 20 20 20 20 20 )..
13c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13ca0 20 20 20 20 20 20 20 20 20 20 29 29 29 0a 20 20 ))).
13cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13cc0 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
13cd0 6e 6e 2d 72 65 63 76 20 72 65 70 29 29 29 29 0a nn-recv rep)))).
13ce0 09 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 .. (print
13cf0 22 45 52 52 4f 52 3a 20 50 6f 72 74 20 22 20 70 "ERROR: Port " p
13d00 6f 72 74 6e 75 6d 20 22 20 61 6c 72 65 61 64 79 ortnum " already
13d10 20 69 6e 20 75 73 65 2e 20 54 72 79 20 61 6e 6f in use. Try ano
13d20 74 68 65 72 20 70 6f 72 74 22 29 29 29 29 29 29 ther port"))))))
13d30 29 0a 20 20 20 20 20 20 0a 0a 0a 0a 20 20 20 20 ). ....
13d40 20 20 28 28 74 6c 69 73 74 65 6e 29 0a 20 20 20 ((tlisten).
13d50 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
13d60 65 6d 61 72 67 73 29 0a 20 20 20 20 20 20 20 20 emargs).
13d70 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 (print "ERROR
13d80 3a 20 75 73 65 61 67 65 20 66 6f 72 20 74 6c 69 : useage for tli
13d90 73 74 65 6e 20 69 73 20 5c 22 6d 74 75 74 69 6c sten is \"mtutil
13da0 20 74 6c 69 73 74 65 6e 20 70 6f 72 74 6e 75 6d tlisten portnum
13db0 5c 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 \"").
13dc0 28 6c 65 74 20 28 28 70 6f 72 74 6e 75 6d 20 28 (let ((portnum (
13dd0 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
13de0 63 61 72 20 72 65 6d 61 72 67 73 29 29 29 29 0a car remargs)))).
13df0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 .
13e00 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
13e10 28 6e 6f 74 20 70 6f 72 74 6e 75 6d 29 0a 20 20 (not portnum).
13e20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13e30 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 74 68 print "ERROR: th
13e40 65 20 70 6f 72 74 6e 75 6d 62 65 72 20 70 61 72 e portnumber par
13e50 61 6d 65 74 65 72 20 6d 75 73 74 20 62 65 20 61 ameter must be a
13e60 20 6e 75 6d 62 65 72 2c 20 79 6f 75 20 67 61 76 number, you gav
13e70 65 3a 20 22 20 28 63 61 72 20 72 65 6d 61 72 67 e: " (car remarg
13e80 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
13e90 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
13ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13eb0 69 66 20 28 6e 6f 74 20 28 69 73 2d 70 6f 72 74 if (not (is-port
13ec0 2d 69 6e 2d 75 73 65 20 70 6f 72 74 6e 75 6d 29 -in-use portnum)
13ed0 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ) .
13ee0 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
13ef0 20 28 28 72 65 70 20 20 20 20 20 20 20 28 73 74 ((rep (st
13f00 61 72 74 2d 6e 6e 2d 73 65 72 76 65 72 20 70 6f art-nn-server po
13f10 72 74 6e 75 6d 29 29 0a 20 20 20 20 20 20 20 20 rtnum)).
13f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f30 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 64 61 74 (mtconfdat
13f40 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 (simple-setup (
13f50 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
13f60 74 61 72 74 2d 64 69 72 22 29 29 29 0a 20 20 20 tart-dir"))).
13f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f80 20 20 20 20 20 20 20 20 20 20 20 28 6d 74 63 6f (mtco
13f90 6e 66 20 20 20 20 28 63 61 72 20 6d 74 63 6f 6e nf (car mtcon
13fa0 66 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 fdat)).
13fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13fc0 20 20 20 20 20 28 63 6f 6e 74 61 63 74 20 20 20 (contact
13fd0 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
13fe0 6d 74 63 6f 6e 66 20 22 6c 69 73 74 65 6e 65 72 mtconf "listener
13ff0 22 20 22 6f 77 6e 65 72 22 29 29 0a 20 20 20 20 " "owner")).
14000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14010 20 20 20 20 20 20 20 20 20 20 28 73 63 72 69 70 (scrip
14020 74 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f t (configf:lo
14030 6f 6b 75 70 20 6d 74 63 6f 6e 66 20 22 6c 69 73 okup mtconf "lis
14040 74 65 6e 65 72 22 20 22 73 63 72 69 70 74 22 29 tener" "script")
14050 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
14060 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 (pri
14070 6e 74 20 22 4c 69 73 74 65 6e 69 6e 67 20 6f 6e nt "Listening on
14080 20 70 6f 72 74 20 22 20 70 6f 72 74 6e 75 6d 20 port " portnum
14090 22 20 66 6f 72 20 6d 65 73 73 61 67 65 73 2e 22 " for messages."
140a0 29 0a 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 28 73 65 74 2d (set-
140c0 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 20 signal-handler!
140d0 73 69 67 6e 61 6c 2f 69 6e 74 20 20 28 6c 61 6d signal/int (lam
140e0 62 64 61 20 28 73 69 67 6e 75 6d 29 20 0a 09 09 bda (signum) ...
140f0 09 09 09 09 09 09 09 09 09 09 09 09 09 28 73 65 .............(se
14100 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 t! *time-to-exit
14110 2a 20 23 74 29 0a 20 20 09 09 09 09 09 09 09 09 * #t). ........
14120 09 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 ......(debug:pri
14130 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
14140 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
14150 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c 20 22 eceived signal "
14160 20 73 69 67 6e 75 6d 20 22 20 73 65 6e 64 69 6e signum " sendin
14170 67 20 65 6d 61 69 6c 20 62 65 66 6f 72 20 65 78 g email befor ex
14180 69 74 69 6e 67 20 21 21 22 29 0a 20 20 09 09 09 iting !!"). ...
14190 09 09 09 09 09 09 09 09 09 09 09 28 6c 65 74 20 ...........(let
141a0 28 28 65 6d 61 69 6c 2d 62 6f 64 79 20 28 6d 74 ((email-body (mt
141b0 75 74 3a 73 74 6d 6c 2d 3e 73 74 72 69 6e 67 20 ut:stml->string
141c0 28 73 3a 62 6f 64 79 0a 09 09 09 09 09 09 09 09 (s:body.........
141d0 09 09 09 09 09 09 09 09 09 09 09 09 09 09 28 73 ..............(s
141e0 3a 70 20 28 63 6f 6e 63 20 22 52 65 63 65 69 76 :p (conc "Receiv
141f0 65 64 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e ed signal " sign
14200 75 6d 20 22 2e 20 4c 69 73 74 65 72 20 68 61 73 um ". Lister has
14210 20 62 65 65 6e 20 74 65 72 6d 69 6e 61 74 65 64 been terminated
14220 20 6f 6e 20 68 6f 73 74 20 22 20 28 67 65 74 2d on host " (get-
14230 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
14240 61 62 6c 65 20 22 48 4f 53 54 22 29 20 22 2e 20 able "HOST") ".
14250 22 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ")))))).
14260 20 20 20 20 20 09 09 09 09 09 20 20 20 20 20 20 .....
14270 20 20 28 73 65 6e 64 6d 61 69 6c 20 63 6f 6e 74 (sendmail cont
14280 61 63 74 20 22 4c 69 73 74 6e 65 72 20 68 61 73 act "Listner has
14290 20 62 65 65 6e 20 74 65 72 6d 69 6e 61 74 65 64 been terminated
142a0 2e 22 20 65 6d 61 69 6c 2d 62 6f 64 79 20 20 75 ." email-body u
142b0 73 65 5f 68 74 6d 6c 3a 20 23 74 29 29 0a 20 20 se_html: #t)).
142c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
142d0 20 20 20 20 20 20 20 20 20 20 20 20 28 65 78 69 (exi
142e0 74 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 09 t)))............
142f0 09 09 09 09 28 73 65 74 2d 73 69 67 6e 61 6c 2d ....(set-signal-
14300 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f handler! signal/
14310 74 65 72 6d 20 20 28 6c 61 6d 62 64 61 20 28 73 term (lambda (s
14320 69 67 6e 75 6d 29 20 0a 09 09 09 09 09 09 09 09 ignum) .........
14330 09 09 09 09 09 09 09 28 73 65 74 21 20 2a 74 69 .......(set! *ti
14340 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a me-to-exit* #t).
14350 20 20 09 09 09 09 09 09 09 09 09 09 09 09 09 09 ..............
14360 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
14370 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
14380 67 2d 70 6f 72 74 2a 20 22 52 65 63 65 69 76 65 g-port* "Receive
14390 64 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 d signal " signu
143a0 6d 20 22 20 73 65 6e 64 69 6e 67 20 65 6d 61 69 m " sending emai
143b0 6c 20 62 65 66 6f 72 20 65 78 69 74 69 6e 67 20 l befor exiting
143c0 21 21 22 29 0a 20 20 09 09 09 09 09 09 09 09 09 !!"). .........
143d0 09 09 09 09 09 28 6c 65 74 20 28 28 65 6d 61 69 .....(let ((emai
143e0 6c 2d 62 6f 64 79 20 28 6d 74 75 74 3a 73 74 6d l-body (mtut:stm
143f0 6c 2d 3e 73 74 72 69 6e 67 20 28 73 3a 62 6f 64 l->string (s:bod
14400 79 0a 09 09 09 09 09 09 09 09 09 09 09 09 09 09 y...............
14410 09 09 09 09 09 09 09 09 28 73 3a 70 20 28 63 6f ........(s:p (co
14420 6e 63 20 22 52 65 63 65 69 76 65 64 20 73 69 67 nc "Received sig
14430 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 22 2e 20 nal " signum ".
14440 4c 69 73 74 65 72 20 68 61 73 20 62 65 65 6e 20 Lister has been
14450 74 65 72 6d 69 6e 61 74 65 64 20 6f 6e 20 68 6f terminated on ho
14460 73 74 20 22 20 28 67 65 74 2d 65 6e 76 69 72 6f st " (get-enviro
14470 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
14480 48 4f 53 54 22 29 20 22 2e 20 22 29 29 29 29 29 HOST") ". ")))))
14490 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 09 ). .
144a0 09 09 09 09 20 20 20 20 20 20 20 20 28 73 65 6e .... (sen
144b0 64 6d 61 69 6c 20 63 6f 6e 74 61 63 74 20 22 4c dmail contact "L
144c0 69 73 74 6e 65 72 20 68 61 73 20 62 65 65 6e 20 istner has been
144d0 74 65 72 6d 69 6e 61 74 65 64 2e 22 20 65 6d 61 terminated." ema
144e0 69 6c 2d 62 6f 64 79 20 20 75 73 65 5f 68 74 6d il-body use_htm
144f0 6c 3a 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 l: #t)).
14500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14510 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a (exit)))..
14520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14530 20 20 20 20 20 20 20 20 20 3b 28 73 65 74 2d 73 ;(set-s
14540 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 20 73 ignal-handler! s
14550 69 67 6e 61 6c 2f 74 65 72 6d 20 73 70 65 63 69 ignal/term speci
14560 61 6c 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 al-signal-handle
14570 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
14580 20 20 20 20 20 20 20 20 20 20 20 20 0a 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 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
145b0 28 28 69 6e 73 74 72 20 28 6e 6e 2d 72 65 63 76 ((instr (nn-recv
145c0 20 72 65 70 29 29 29 0a 20 20 20 20 20 20 20 20 rep))).
145d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
145e0 20 20 20 20 20 28 6e 6e 2d 73 65 6e 64 20 72 65 (nn-send re
145f0 70 20 22 6f 6b 22 29 0a 20 20 20 20 20 20 20 20 p "ok").
14600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14610 20 20 20 20 20 28 6c 65 74 20 28 28 63 74 69 6d (let ((ctim
14620 65 20 28 64 61 74 65 2d 3e 73 74 72 69 6e 67 20 e (date->string
14630 28 63 75 72 72 65 6e 74 2d 64 61 74 65 29 29 29 (current-date)))
14640 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
14650 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14660 28 69 66 20 20 28 65 71 75 61 6c 3f 20 69 6e 73 (if (equal? ins
14670 74 72 20 22 74 69 6d 65 2d 74 6f 2d 64 69 65 22 tr "time-to-die"
14680 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
14690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146a0 28 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 20 (begin .
146b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146c0 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
146d0 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
146e0 67 2d 70 6f 72 74 2a 20 63 74 69 6d 65 20 22 20 g-port* ctime "
146f0 72 65 63 65 69 76 65 64 20 27 22 20 69 6e 73 74 received '" inst
14700 72 20 22 27 2e 20 54 69 6d 65 20 74 6f 20 73 75 r "'. Time to su
14710 63 69 64 65 2e 22 20 29 0a 20 20 20 20 20 20 20 cide." ).
14720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14730 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 (let ((p
14740 69 64 20 20 28 63 75 72 72 65 6e 74 2d 70 72 6f id (current-pro
14750 63 65 73 73 2d 69 64 29 29 29 0a 20 20 20 20 20 cess-id))).
14760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14770 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
14780 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
14790 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 69 6c 6c -log-port* "Kill
147a0 69 6e 67 20 63 75 72 72 65 6e 74 20 70 72 6f 63 ing current proc
147b0 65 73 73 20 28 70 69 64 3d 22 20 70 69 64 20 22 ess (pid=" pid "
147c0 29 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 )").
147d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
147e0 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc
147f0 20 22 6b 69 6c 6c 20 22 20 70 69 64 29 29 29 29 "kill " pid))))
14800 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14820 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 28 (begin.........(
14830 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
14840 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
14850 20 63 74 69 6d 65 20 22 20 72 65 63 65 69 76 65 ctime " receive
14860 64 20 22 20 69 6e 73 74 72 20 29 0a 09 09 09 09 d " instr ).....
14870 09 09 09 09 3b 28 6e 6e 2d 73 65 6e 64 20 72 65 ....;(nn-send re
14880 70 20 22 6f 6b 22 29 0a 20 20 20 20 20 20 20 20 p "ok").
14890 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
148a0 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
148b0 20 28 65 71 75 61 6c 3f 20 69 6e 73 74 72 20 22 (equal? instr "
148c0 70 69 6e 67 22 29 29 0a 20 20 20 20 20 20 20 20 ping")).
148d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
148e0 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
148f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14900 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14910 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14920 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
14930 70 6f 72 74 2a 20 63 74 69 6d 65 20 22 20 72 75 port* ctime " ru
14940 6e 6e 69 6e 67 20 5c 22 22 20 73 63 72 69 70 74 nning \"" script
14950 20 22 20 22 20 69 6e 73 74 72 20 22 5c 22 22 29 " " instr "\"")
14960 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14980 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 (system (
14990 63 6f 6e 63 20 73 63 72 69 70 74 20 22 20 27 22 conc script " '"
149a0 20 69 6e 73 74 72 20 22 27 20 26 22 29 29 0a 20 instr "' &")).
149b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
149c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
149d0 20 20 20 20 20 3b 28 70 72 6f 63 65 73 73 2d 72 ;(process-r
149e0 75 6e 20 73 63 72 69 70 74 20 28 6c 69 73 74 20 un script (list
149f0 20 69 6e 73 74 72 20 29 29 20 20 0a 20 20 20 20 instr )) .
14a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
14a30 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
14a40 74 2a 20 63 74 69 6d 65 20 22 20 64 6f 6e 65 22 t* ctime " done"
14a50 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 )).
14a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a70 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
14a80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14aa0 20 09 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 . (if (not (equ
14ab0 61 6c 3f 20 69 6e 73 74 72 20 22 6c 6f 61 64 22 al? instr "load"
14ac0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
14ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14ae0 20 20 20 20 20 20 09 20 09 28 70 72 69 6e 74 20 . .(print
14af0 22 43 68 65 63 6b 69 6e 67 20 6c 6f 61 64 22 29 "Checking load")
14b00 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
14b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b20 20 20 20 20 20 09 20 29 20 0a 20 20 20 20 20 20 . ) .
14b30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b40 20 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 0a )..
14b50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b70 20 20 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 )..
14b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14b90 20 20 20 20 20 29 29 29 0a 20 20 20 20 20 20 20 ))).
14ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14bb0 20 20 20 20 28 6c 6f 6f 70 20 28 6e 6e 2d 72 65 (loop (nn-re
14bc0 63 76 20 72 65 70 29 29 29 29 0a 09 09 20 20 20 cv rep))))...
14bd0 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
14be0 52 3a 20 50 6f 72 74 20 22 20 70 6f 72 74 6e 75 R: Port " portnu
14bf0 6d 20 22 20 61 6c 72 65 61 64 79 20 69 6e 20 75 m " already in u
14c00 73 65 2e 20 54 72 79 20 61 6e 6f 74 68 65 72 20 se. Try another
14c10 70 6f 72 74 22 29 29 29 29 29 29 29 0a 20 20 20 port"))))))).
14c20 20 20 20 28 28 67 61 74 68 65 72 29 20 3b 3b 20 ((gather) ;;
14c30 67 61 74 68 65 72 20 61 6c 6c 20 61 72 65 61 20 gather all area
14c40 64 62 27 73 20 69 6e 74 6f 20 2f 74 6d 70 2f 24 db's into /tmp/$
14c50 55 53 45 52 5f 6d 65 67 61 74 65 73 74 2f 61 6c USER_megatest/al
14c60 6c 64 62 73 0a 20 20 20 20 20 20 20 28 6c 65 74 ldbs. (let
14c70 2a 20 28 28 6d 74 63 6f 6e 66 64 61 74 20 28 73 * ((mtconfdat (s
14c80 69 6d 70 6c 65 2d 73 65 74 75 70 20 28 61 72 67 imple-setup (arg
14c90 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 74 61 72 s:get-arg "-star
14ca0 74 2d 64 69 72 22 29 29 29 0a 20 20 20 20 20 20 t-dir"))).
14cb0 20 20 20 20 20 20 20 20 28 6d 74 63 6f 6e 66 20 (mtconf
14cc0 20 20 20 28 63 61 72 20 6d 74 63 6f 6e 66 64 61 (car mtconfda
14cd0 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
14ce0 20 20 28 61 72 65 61 73 20 20 20 20 20 28 67 65 (areas (ge
14cf0 74 2d 61 72 65 61 2d 6e 61 6d 65 73 20 6d 74 63 t-area-names mtc
14d00 6f 6e 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 onf))).
14d10 28 70 72 69 6e 74 20 22 61 72 65 61 73 3a 20 22 (print "areas: "
14d20 20 61 72 65 61 73 29 29 29 0a 20 20 20 20 20 20 areas))).
14d30 0a 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 . (else.
14d40 20 20 20 20 28 6c 65 74 20 28 28 61 6c 6c 2d 61 (let ((all-a
14d50 63 74 69 6f 6e 73 20 28 73 6f 72 74 20 28 6d 61 ctions (sort (ma
14d60 70 20 63 6f 6e 63 20 28 64 65 6c 65 74 65 2d 64 p conc (delete-d
14d70 75 70 6c 69 63 61 74 65 73 20 28 61 70 70 65 6e uplicates (appen
14d80 64 20 2a 6f 74 68 65 72 2d 61 63 74 69 6f 6e 73 d *other-actions
14d90 2a 20 28 6d 61 70 20 63 61 72 20 2a 61 63 74 69 * (map car *acti
14da0 6f 6e 2d 6b 65 79 73 2a 29 29 29 29 20 73 74 72 on-keys*)))) str
14db0 69 6e 67 3c 3d 3f 29 29 29 0a 09 20 28 70 72 69 ing<=?))).. (pri
14dc0 6e 74 20 22 75 6e 72 65 63 6f 67 6e 69 73 65 64 nt "unrecognised
14dd0 20 61 63 74 69 6f 6e 3a 20 5c 22 22 20 2a 61 63 action: \"" *ac
14de0 74 69 6f 6e 2a 20 22 5c 22 2c 20 74 72 79 20 6f tion* "\", try o
14df0 6e 65 20 6f 66 3b 20 5c 22 22 20 28 73 74 72 69 ne of; \"" (stri
14e00 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 ng-intersperse a
14e10 6c 6c 2d 61 63 74 69 6f 6e 73 20 22 5c 22 2c 20 ll-actions "\",
14e20 5c 22 22 29 20 22 5c 22 22 29 29 29 0a 20 20 20 \"") "\""))).
14e30 20 20 20 0a 20 20 20 20 20 20 29 29 20 3b 3b 20 . )) ;;
14e40 74 68 65 20 65 6e 64 0a 20 20 20 20 20 20 20 20 the end.
14e50 20 20 20 20 20 0a 0a 3b 3b 20 49 66 20 48 54 54 ..;; If HTT
14e60 50 5f 48 4f 53 54 20 69 73 20 64 65 66 69 6e 65 P_HOST is define
14e70 64 20 74 68 65 6e 20 77 65 20 6d 75 73 74 20 62 d then we must b
14e80 65 20 69 6e 20 74 68 65 20 63 67 69 20 65 6e 76 e in the cgi env
14e90 69 72 6f 6e 6d 65 6e 74 0a 3b 3b 20 73 6f 20 72 ironment.;; so r
14ea0 75 6e 20 73 74 6d 6c 20 61 6e 64 20 65 78 69 74 un stml and exit
14eb0 0a 3b 3b 0a 28 69 66 20 28 67 65 74 2d 65 6e 76 .;;.(if (get-env
14ec0 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
14ed0 65 20 22 48 54 54 50 5f 48 4f 53 54 22 29 0a 20 e "HTTP_HOST").
14ee0 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
14ef0 28 73 74 6d 6c 3a 6d 61 69 6e 20 23 66 29 0a 20 (stml:main #f).
14f00 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 (exit)))..(
14f10 69 66 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 if (or (args:get
14f20 2d 61 72 67 20 22 2d 72 65 70 6c 22 29 0a 09 28 -arg "-repl")..(
14f30 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
14f40 6f 61 64 22 29 29 0a 20 20 20 20 28 62 65 67 69 oad")). (begi
14f50 6e 0a 20 20 20 20 20 20 28 69 6d 70 6f 72 74 20 n. (import
14f60 65 78 74 72 61 73 29 20 3b 3b 20 6d 69 67 68 74 extras) ;; might
14f70 20 6e 6f 74 20 62 65 20 6e 65 65 64 65 64 0a 20 not be needed.
14f80 20 20 20 20 20 3b 3b 20 28 69 6d 70 6f 72 74 20 ;; (import
14f90 63 73 69 29 0a 20 20 20 20 20 20 28 69 6d 70 6f csi). (impo
14fa0 72 74 20 72 65 61 64 6c 69 6e 65 29 0a 20 20 20 rt readline).
14fb0 20 20 20 28 69 6d 70 6f 72 74 20 61 70 72 6f 70 (import aprop
14fc0 6f 73 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 6d os). ;; (im
14fd0 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c port (prefix sql
14fe0 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 20 ite3 sqlite3:))
14ff0 3b 3b 20 64 6f 65 73 6e 27 74 20 77 6f 72 6b 20 ;; doesn't work
15000 2e 2e 2e 0a 20 20 20 20 20 20 0a 20 20 20 20 20 .... .
15010 20 28 69 6e 73 74 61 6c 6c 2d 68 69 73 74 6f 72 (install-histor
15020 79 2d 66 69 6c 65 20 28 67 65 74 2d 65 6e 76 69 y-file (get-envi
15030 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
15040 20 22 48 4f 4d 45 22 29 20 22 2e 6d 74 75 74 69 "HOME") ".mtuti
15050 6c 5f 68 69 73 74 6f 72 79 22 29 20 3b 3b 20 20 l_history") ;;
15060 5b 68 6f 6d 65 64 69 72 5d 20 5b 66 69 6c 65 6e [homedir] [filen
15070 61 6d 65 5d 20 5b 6e 6c 69 6e 65 73 5d 29 0a 20 ame] [nlines]).
15080 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 69 6e (current-in
15090 70 75 74 2d 70 6f 72 74 20 28 6d 61 6b 65 2d 72 put-port (make-r
150a0 65 61 64 6c 69 6e 65 2d 70 6f 72 74 20 22 6d 74 eadline-port "mt
150b0 75 74 69 6c 3e 20 22 29 29 0a 20 20 20 20 20 20 util> ")).
150c0 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
150d0 67 20 22 2d 72 65 70 6c 22 29 0a 09 20 20 28 72 g "-repl").. (r
150e0 65 70 6c 29 0a 09 20 20 28 6c 6f 61 64 20 28 61 epl).. (load (a
150f0 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f rgs:get-arg "-lo
15100 61 64 22 29 29 29 29 29 0a 0a 23 7c 0a 28 64 65 ad")))))..#|.(de
15110 66 69 6e 65 20 6d 74 63 6f 6e 66 20 28 63 61 72 fine mtconf (car
15120 20 28 73 69 6d 70 6c 65 2d 73 65 74 75 70 20 23 (simple-setup #
15130 66 29 29 29 0a 28 64 65 66 69 6e 65 20 64 61 74 f))).(define dat
15140 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 71 75 (common:with-qu
15150 65 75 65 2d 64 62 20 6d 74 63 6f 6e 66 20 28 6c eue-db mtconf (l
15160 61 6d 62 64 61 20 28 63 6f 6e 6e 29 28 67 65 74 ambda (conn)(get
15170 2d 70 6b 74 73 20 63 6f 6e 6e 20 27 28 29 29 29 -pkts conn '()))
15180 29 29 0a 28 70 70 20 28 70 6b 74 73 23 66 6c 61 )).(pp (pkts#fla
15190 74 74 65 6e 2d 61 6c 6c 20 64 61 74 20 27 28 28 tten-all dat '((
151a0 63 6d 64 20 2e 20 28 28 70 61 72 65 6e 74 20 2e cmd . ((parent .
151b0 20 50 29 28 75 72 6c 20 2e 20 4d 29 29 29 28 72 P)(url . M)))(r
151c0 75 6e 74 79 70 65 20 2e 20 28 28 70 61 72 65 6e untype . ((paren
151d0 74 20 2e 20 50 29 29 29 29 20 27 69 64 20 27 67 t . P)))) 'id 'g
151e0 72 6f 75 70 2d 69 64 20 27 75 75 69 64 20 27 70 roup-id 'uuid 'p
151f0 61 72 65 6e 74 20 27 70 6b 74 2d 74 79 70 65 20 arent 'pkt-type
15200 27 70 6b 74 20 27 70 72 6f 63 65 73 73 65 64 29 'pkt 'processed)
15210 29 0a 7c 23 0a ).|#.