Artifact
e745c7478e55940e65921daa2af221c7e802f2fd:
0000: 3b 3b 20 20 43 6f 70 79 72 69 67 68 74 20 32 30 ;; Copyright 20
0010: 30 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 06-2017, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d 3d 3d 3d nses/>...;;=====
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0340: 3d 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e 66 =.;; read a conf
0350: 69 67 20 66 69 6c 65 2c 20 6c 6f 61 64 69 6e 67 ig file, loading
0360: 20 6f 6e 6c 79 20 74 68 65 20 73 65 63 74 69 6f only the sectio
0370: 6e 20 70 65 72 74 69 6e 65 6e 74 0a 3b 3b 20 74 n pertinent.;; t
0380: 6f 20 74 68 69 73 20 72 75 6e 20 66 69 65 6c 64 o this run field
0390: 31 76 61 6c 2f 66 69 65 6c 64 32 76 61 6c 2f 66 1val/field2val/f
03a0: 69 65 6c 64 33 76 61 6c 20 2e 2e 2e 0a 3b 3b 3d ield3val ....;;=
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03f0: 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 66 6f 72 6d =====..(use form
0400: 61 74 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 at directory-uti
0410: 6c 73 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 ls)..(declare (u
0420: 6e 69 74 20 72 75 6e 63 6f 6e 66 69 67 29 29 0a nit runconfig)).
0430: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0440: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
0450: 20 28 75 73 65 73 20 64 65 62 75 67 70 72 69 6e (uses debugprin
0460: 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 t)).(declare (us
0470: 65 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 0a es commonmod))..
0480: 28 69 6d 70 6f 72 74 20 63 6f 6d 6d 6f 6e 6d 6f (import commonmo
0490: 64 0a 09 64 65 62 75 67 70 72 69 6e 74 29 0a 0a d..debugprint)..
04a0: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
04b0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
04c0: 28 64 65 66 69 6e 65 20 28 72 75 6e 63 6f 6e 66 (define (runconf
04d0: 69 67 3a 72 65 61 64 20 66 6e 61 6d 65 20 74 61 ig:read fname ta
04e0: 72 67 65 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 rget environ-pat
04f0: 74 29 0a 20 20 28 6c 65 74 20 28 28 68 74 20 28 t). (let ((ht (
0500: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0510: 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 67 65 )). (if targe
0520: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 t (hash-table-se
0530: 74 21 20 68 74 20 74 61 72 67 65 74 20 27 28 29 t! ht target '()
0540: 29 29 0a 20 20 20 20 28 72 65 61 64 2d 63 6f 6e )). (read-con
0550: 66 69 67 20 66 6e 61 6d 65 20 68 74 20 23 74 20 fig fname ht #t
0560: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e environ-patt: en
0570: 76 69 72 6f 6e 2d 70 61 74 74 20 73 65 63 74 69 viron-patt secti
0580: 6f 6e 73 3a 20 28 69 66 20 74 61 72 67 65 74 20 ons: (if target
0590: 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 (list "default"
05a0: 74 61 72 67 65 74 29 20 23 66 29 29 29 29 0a 0a target) #f))))..
05b0: 3b 3b 20 4e 42 2f 2f 20 74 6f 20 70 72 6f 63 65 ;; NB// to proce
05c0: 73 73 20 61 20 72 75 6e 63 6f 6e 66 69 67 20 65 ss a runconfig e
05d0: 6e 73 75 72 65 20 74 6f 20 75 73 65 20 65 6e 76 nsure to use env
05e0: 69 72 6f 6e 2d 70 61 74 74 20 77 69 74 68 20 74 iron-patt with t
05f0: 61 72 67 65 74 21 0a 3b 3b 0a 28 64 65 66 69 6e arget!.;;.(defin
0600: 65 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 e (setup-env-def
0610: 61 75 6c 74 73 20 66 6e 61 6d 65 20 72 75 6e 2d aults fname run-
0620: 69 64 20 61 6c 72 65 61 64 79 2d 73 65 65 6e 20 id already-seen
0630: 6b 65 79 76 61 6c 73 20 23 21 6b 65 79 20 28 65 keyvals #!key (e
0640: 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 28 nviron-patt #f)(
0650: 63 68 61 6e 67 65 2d 65 6e 76 20 23 74 29 29 0a change-env #t)).
0660: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 (let* ((keys
0670: 20 20 28 6d 61 70 20 63 61 72 20 6b 65 79 76 61 (map car keyva
0680: 6c 73 29 29 0a 09 20 28 74 68 65 6b 65 79 20 20 ls)).. (thekey
0690: 28 69 66 20 6b 65 79 76 61 6c 73 20 0a 09 09 20 (if keyvals ...
06a0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
06b0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
06c0: 61 6d 62 64 61 20 28 78 29 28 69 66 20 78 20 78 ambda (x)(if x x
06d0: 20 22 2d 6e 61 2d 22 29 29 20 28 6d 61 70 20 63 "-na-")) (map c
06e0: 61 64 72 20 6b 65 79 76 61 6c 73 29 29 20 22 2f adr keyvals)) "/
06f0: 22 29 0a 09 09 20 20 20 20 20 20 28 6f 72 20 28 ")... (or (
0700: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
0710: 74 61 72 67 65 74 29 0a 09 09 09 20 20 28 67 65 target).... (ge
0720: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
0730: 72 69 61 62 6c 65 20 22 4d 54 5f 54 41 52 47 45 riable "MT_TARGE
0740: 54 22 29 0a 09 09 09 20 20 28 62 65 67 69 6e 0a T").... (begin.
0750: 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
0760: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
0770: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
0780: 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c setup-env-defaul
0790: 74 73 20 63 61 6c 6c 65 64 20 77 69 74 68 20 6e ts called with n
07a0: 6f 20 72 75 6e 2d 69 64 20 6f 72 20 2d 74 61 72 o run-id or -tar
07b0: 67 65 74 20 6f 72 20 2d 72 65 71 74 61 72 67 22 get or -reqtarg"
07c0: 29 0a 09 09 09 20 20 20 20 22 6e 6f 74 68 69 6e ).... "nothin
07d0: 67 20 6d 61 74 63 68 65 73 20 74 68 69 73 20 49 g matches this I
07e0: 20 68 6f 70 65 22 29 29 29 29 0a 09 20 3b 3b 20 hope")))).. ;;
07f0: 57 68 79 20 77 61 73 20 73 79 73 74 65 6d 20 64 Why was system d
0800: 69 73 61 6c 6c 6f 77 65 64 20 69 6e 20 74 68 65 isallowed in the
0810: 20 72 65 61 64 69 6e 67 20 6f 66 20 74 68 65 20 reading of the
0820: 72 75 6e 63 6f 6e 66 69 67 73 20 66 69 6c 65 3f runconfigs file?
0830: 0a 09 20 3b 3b 20 4e 4f 54 45 3a 20 53 68 6f 75 .. ;; NOTE: Shou
0840: 6c 64 20 62 65 20 73 65 74 74 69 6e 67 20 65 6e ld be setting en
0850: 76 20 76 61 72 73 20 62 61 73 65 64 20 6f 6e 20 v vars based on
0860: 28 74 61 72 67 65 74 7c 64 65 66 61 75 6c 74 29 (target|default)
0870: 0a 09 20 28 63 6f 6e 66 64 61 74 20 20 20 28 72 .. (confdat (r
0880: 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 66 6e unconfig:read fn
0890: 61 6d 65 20 74 68 65 6b 65 79 20 65 6e 76 69 72 ame thekey envir
08a0: 6f 6e 2d 70 61 74 74 29 29 0a 09 20 28 77 68 61 on-patt)).. (wha
08b0: 74 66 6f 75 6e 64 20 28 6d 61 6b 65 2d 68 61 73 tfound (make-has
08c0: 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 66 69 6e h-table)).. (fin
08d0: 61 6c 64 61 74 20 20 28 6d 61 6b 65 2d 68 61 73 aldat (make-has
08e0: 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 73 65 63 h-table)).. (sec
08f0: 74 69 6f 6e 73 20 28 6c 69 73 74 20 22 64 65 66 tions (list "def
0900: 61 75 6c 74 22 20 74 68 65 6b 65 79 29 29 29 0a ault" thekey))).
0910: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 2a 74 61 (if (not *ta
0920: 72 67 65 74 2a 29 28 73 65 74 21 20 2a 74 61 72 rget*)(set! *tar
0930: 67 65 74 2a 20 74 68 65 6b 65 79 29 29 20 3b 3b get* thekey)) ;;
0940: 20 6d 61 79 20 73 61 76 65 20 61 20 64 62 20 61 may save a db a
0950: 63 63 65 73 73 20 6f 72 20 74 77 6f 20 62 75 74 ccess or two but
0960: 20 72 65 70 65 61 74 73 20 64 62 3a 67 65 74 2d repeats db:get-
0970: 74 61 72 67 65 74 20 63 6f 64 65 0a 20 20 20 20 target code.
0980: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a (debug:print 4 *
0990: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
09a0: 2a 20 22 55 73 69 6e 67 20 6b 65 79 3d 5c 22 22 * "Using key=\""
09b0: 20 74 68 65 6b 65 79 20 22 5c 22 22 29 0a 0a 20 thekey "\"")..
09c0: 20 20 20 28 69 66 20 63 68 61 6e 67 65 2d 65 6e (if change-en
09d0: 76 0a 09 28 66 6f 72 2d 65 61 63 68 20 3b 3b 20 v..(for-each ;;
09e0: 4e 42 2f 2f 20 54 68 69 73 20 63 61 6e 20 62 65 NB// This can be
09f0: 20 73 69 6d 70 6c 69 66 69 65 64 20 77 69 74 68 simplified with
0a00: 20 6e 65 77 20 63 6f 6e 74 65 6e 74 20 6f 66 20 new content of
0a10: 6b 65 79 76 61 6c 73 20 68 61 76 69 6e 67 20 61 keyvals having a
0a20: 6c 6c 20 74 68 61 74 20 69 73 20 6e 65 65 64 65 ll that is neede
0a30: 64 2e 0a 09 20 28 6c 61 6d 62 64 61 20 28 6b 65 d... (lambda (ke
0a40: 79 76 61 6c 29 0a 09 20 20 20 28 73 61 66 65 2d yval).. (safe-
0a50: 73 65 74 65 6e 76 20 28 63 61 72 20 6b 65 79 76 setenv (car keyv
0a60: 61 6c 29 28 63 61 64 72 20 6b 65 79 76 61 6c 29 al)(cadr keyval)
0a70: 29 29 0a 09 20 6b 65 79 76 61 6c 73 29 29 0a 09 )).. keyvals))..
0a80: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a . (for-each .
0a90: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
0aa0: 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 6c ction). (l
0ab0: 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 64 61 74 et ((section-dat
0ac0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
0ad0: 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 /default confdat
0ae0: 20 73 65 63 74 69 6f 6e 20 23 66 29 29 29 0a 09 section #f)))..
0af0: 20 28 69 66 20 73 65 63 74 69 6f 6e 2d 64 61 74 (if section-dat
0b00: 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 .. (for-each
0b10: 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
0b20: 20 28 65 6e 76 76 61 72 29 0a 09 09 28 6c 65 74 (envvar)...(let
0b30: 20 28 28 76 61 6c 20 28 63 61 64 72 20 28 61 73 ((val (cadr (as
0b40: 73 6f 63 20 65 6e 76 76 61 72 20 73 65 63 74 69 soc envvar secti
0b50: 6f 6e 2d 64 61 74 29 29 29 29 0a 09 09 28 68 61 on-dat))))...(ha
0b60: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 68 sh-table-set! wh
0b70: 61 74 66 6f 75 6e 64 20 73 65 63 74 69 6f 6e 20 atfound section
0b80: 28 2b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (+ (hash-table-r
0b90: 65 66 2f 64 65 66 61 75 6c 74 20 77 68 61 74 66 ef/default whatf
0ba0: 6f 75 6e 64 20 73 65 63 74 69 6f 6e 20 30 29 20 ound section 0)
0bb0: 31 29 29 0a 09 09 28 69 66 20 28 61 6e 64 20 28 1))...(if (and (
0bc0: 73 74 72 69 6e 67 3f 20 65 6e 76 76 61 72 29 0a string? envvar).
0bd0: 09 09 09 20 28 73 74 72 69 6e 67 3f 20 76 61 6c ... (string? val
0be0: 29 0a 09 09 09 20 63 68 61 6e 67 65 2d 65 6e 76 ).... change-env
0bf0: 29 0a 09 09 20 20 20 20 28 73 61 66 65 2d 73 65 )... (safe-se
0c00: 74 65 6e 76 20 65 6e 76 76 61 72 20 76 61 6c 29 tenv envvar val)
0c10: 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d )...(hash-table-
0c20: 73 65 74 21 20 66 69 6e 61 6c 64 61 74 20 65 6e set! finaldat en
0c30: 76 76 61 72 20 76 61 6c 29 29 29 0a 09 20 20 20 vvar val)))..
0c40: 20 20 20 28 6d 61 70 20 63 61 72 20 73 65 63 74 (map car sect
0c50: 69 6f 6e 2d 64 61 74 29 29 29 29 29 0a 20 20 20 ion-dat))))).
0c60: 20 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 20 20 sections).
0c70: 28 69 66 20 61 6c 72 65 61 64 79 2d 73 65 65 6e (if already-seen
0c80: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
0c90: 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
0ca0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b ult-log-port* "K
0cb0: 65 79 20 73 65 74 74 69 6e 67 73 20 66 6f 75 6e ey settings foun
0cc0: 64 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 2e d in runconfigs.
0cd0: 63 6f 6e 66 69 67 3a 22 29 0a 09 20 20 28 66 6f config:").. (fo
0ce0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
0cf0: 66 75 6c 6c 6b 65 79 29 0a 09 09 20 20 20 20 20 fullkey)...
0d00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0d10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
0d20: 74 2a 20 28 66 6f 72 6d 61 74 20 23 66 20 22 7e t* (format #f "~
0d30: 32 30 61 20 7e 61 5c 6e 22 20 66 75 6c 6c 6b 65 20a ~a\n" fullke
0d40: 79 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 y (hash-table-re
0d50: 66 2f 64 65 66 61 75 6c 74 20 77 68 61 74 66 6f f/default whatfo
0d60: 75 6e 64 20 66 75 6c 6c 6b 65 79 20 30 29 29 29 und fullkey 0)))
0d70: 29 0a 09 09 20 20 20 20 73 65 63 74 69 6f 6e 73 )... sections
0d80: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
0d90: 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
0da0: 2d 70 6f 72 74 2a 20 22 2d 2d 2d 22 29 0a 09 20 -port* "---")..
0db0: 20 28 73 65 74 21 20 2a 61 6c 72 65 61 64 79 2d (set! *already-
0dc0: 73 65 65 6e 2d 72 75 6e 63 6f 6e 66 69 67 2d 69 seen-runconfig-i
0dd0: 6e 66 6f 2a 20 23 74 29 29 29 0a 20 20 20 20 3b nfo* #t))). ;
0de0: 3b 20 66 69 6e 61 6c 64 61 74 20 3b 3b 20 77 61 ; finaldat ;; wa
0df0: 73 20 72 65 74 75 72 6e 69 6e 67 20 74 68 69 73 s returning this
0e00: 20 22 66 69 6e 61 6c 64 61 74 22 20 77 68 69 63 "finaldat" whic
0e10: 68 20 77 6f 75 6c 64 20 62 65 20 67 6f 6f 64 20 h would be good
0e20: 62 75 74 20 63 6f 6e 66 6c 69 63 74 73 20 77 69 but conflicts wi
0e30: 74 68 20 6f 74 68 65 72 20 75 73 65 73 0a 20 20 th other uses.
0e40: 20 20 63 6f 6e 66 64 61 74 0a 20 20 20 20 29 29 confdat. ))
0e50: 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 2d 72 ..(define (set-r
0e60: 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 72 un-config-vars r
0e70: 75 6e 2d 69 64 20 6b 65 79 76 61 6c 73 20 74 61 un-id keyvals ta
0e80: 72 67 2d 66 72 6f 6d 2d 64 62 29 0a 20 20 28 70 rg-from-db). (p
0e90: 75 73 68 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 ush-directory *t
0ea0: 6f 70 70 61 74 68 2a 29 20 3b 3b 20 74 68 65 20 oppath*) ;; the
0eb0: 70 75 73 68 2f 70 6f 70 20 64 6f 65 73 6e 27 74 push/pop doesn't
0ec0: 20 61 70 70 65 61 72 20 74 6f 20 64 6f 20 61 6e appear to do an
0ed0: 79 74 68 69 6e 67 20 2e 2e 2e 0a 20 20 28 6c 65 ything .... (le
0ee0: 74 20 28 28 72 75 6e 63 6f 6e 66 69 67 66 20 28 t ((runconfigf (
0ef0: 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 2a 20 conc *toppath*
0f00: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
0f10: 66 69 67 22 29 29 0a 09 28 74 61 72 67 20 20 20 fig"))..(targ
0f20: 20 20 20 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a (or (common:
0f30: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
0f40: 0a 09 09 09 74 61 72 67 2d 66 72 6f 6d 2d 64 62 ....targ-from-db
0f50: 0a 09 09 09 28 67 65 74 2d 65 6e 76 69 72 6f 6e ....(get-environ
0f60: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d ment-variable "M
0f70: 54 5f 54 41 52 47 45 54 22 29 29 29 29 0a 20 20 T_TARGET")))).
0f80: 20 20 28 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 (pop-directory
0f90: 29 0a 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f ). (if (commo
0fa0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 n:file-exists? r
0fb0: 75 6e 63 6f 6e 66 69 67 66 29 0a 09 28 73 65 74 unconfigf)..(set
0fc0: 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 20 up-env-defaults
0fd0: 72 75 6e 63 6f 6e 66 69 67 66 20 72 75 6e 2d 69 runconfigf run-i
0fe0: 64 20 23 74 20 6b 65 79 76 61 6c 73 0a 09 09 09 d #t keyvals....
0ff0: 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 environ-patt
1000: 3a 20 28 63 6f 6e 63 20 22 28 64 65 66 61 75 6c : (conc "(defaul
1010: 74 22 0a 09 09 09 09 09 09 28 69 66 20 74 61 72 t".......(if tar
1020: 67 0a 09 09 09 09 09 09 20 20 20 20 28 63 6f 6e g....... (con
1030: 63 20 22 7c 22 20 74 61 72 67 20 22 29 22 29 0a c "|" targ ")").
1040: 09 09 09 09 09 09 20 20 20 20 22 29 22 29 29 29 ...... ")")))
1050: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
1060: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
1070: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 59 6f rt* "WARNING: Yo
1080: 75 20 64 6f 20 6e 6f 74 20 68 61 76 65 20 61 20 u do not have a
1090: 72 75 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 3a run config file:
10a0: 20 22 20 72 75 6e 63 6f 6e 66 69 67 66 29 29 29 " runconfigf)))
10b0: 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 28 61 20 28 )..;; given (a (
10c0: 62 20 63 29 20 64 29 20 72 65 74 75 72 6e 20 28 b c) d) return (
10d0: 28 61 20 62 20 64 29 28 61 20 63 20 64 29 29 0a (a b d)(a c d)).
10e0: 3b 3b 20 4e 4f 54 45 3a 20 74 68 69 73 20 66 65 ;; NOTE: this fe
10f0: 65 6c 73 20 6c 69 6b 65 20 69 74 20 68 61 73 20 els like it has
1100: 62 65 65 6e 20 64 6f 6e 65 20 62 65 66 6f 72 65 been done before
1110: 20 2d 20 70 65 72 68 61 70 73 20 77 69 74 68 20 - perhaps with
1120: 69 74 65 6d 73 20 68 61 6e 64 6c 69 6e 67 3f 0a items handling?.
1130: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 63 ;;.(define (runc
1140: 6f 6e 66 69 67 3a 63 6f 6d 62 69 6e 61 74 69 6f onfig:combinatio
1150: 6e 73 20 69 6e 6c 73 74 29 0a 20 20 28 6c 65 74 ns inlst). (let
1160: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
1170: 20 69 6e 6c 73 74 29 29 0a 09 20 20 20 20 20 28 inlst)).. (
1180: 74 61 6c 20 28 63 64 72 20 69 6e 6c 73 74 29 29 tal (cdr inlst))
1190: 0a 09 20 20 20 20 20 28 72 65 73 20 27 28 29 29 .. (res '())
11a0: 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ). ;; (print
11b0: 22 72 65 73 3a 20 22 20 72 65 73 20 22 20 68 65 "res: " res " he
11c0: 64 3a 20 22 20 68 65 64 29 0a 20 20 20 20 28 69 d: " hed). (i
11d0: 66 20 28 6c 69 73 74 3f 20 68 65 64 29 0a 09 28 f (list? hed)..(
11e0: 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 69 66 let ((newres (if
11f0: 20 28 6e 75 6c 6c 3f 20 72 65 73 29 20 3b 3b 20 (null? res) ;;
1200: 66 69 72 73 74 20 74 69 6d 65 20 74 68 72 6f 75 first time throu
1210: 67 68 20 63 6f 6e 76 65 72 74 20 69 6e 63 6f 6d gh convert incom
1220: 69 6e 67 20 69 74 65 6d 73 20 74 6f 20 6c 69 73 ing items to lis
1230: 74 20 6f 66 20 69 74 65 6d 73 0a 09 09 09 20 20 t of items....
1240: 28 6d 61 70 20 6c 69 73 74 20 68 65 64 29 0a 09 (map list hed)..
1250: 09 09 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e .. (apply appen
1260: 64 0a 09 09 09 09 20 28 6d 61 70 20 28 6c 61 6d d..... (map (lam
1270: 62 64 61 20 28 72 29 20 20 3b 3b 20 69 74 65 72 bda (r) ;; iter
1280: 61 74 65 20 6f 76 65 72 20 69 74 65 6d 73 20 69 ate over items i
1290: 6e 20 72 65 73 0a 09 09 09 09 09 28 6d 61 70 20 n res......(map
12a0: 28 6c 61 6d 62 64 61 20 28 68 29 20 3b 3b 20 69 (lambda (h) ;; i
12b0: 74 65 72 61 74 65 20 6f 76 65 72 20 69 74 65 6d terate over item
12c0: 73 20 69 6e 20 68 65 64 0a 09 09 09 09 09 20 20 s in hed......
12d0: 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 20 28 (append r (
12e0: 6c 69 73 74 20 68 29 29 29 0a 09 09 09 09 09 20 list h)))......
12f0: 20 20 20 20 68 65 64 29 29 0a 09 09 09 09 20 20 hed)).....
1300: 20 20 20 20 72 65 73 29 29 29 29 29 0a 09 20 20 res)))))..
1310: 3b 3b 20 28 70 72 69 6e 74 20 22 6e 65 77 72 65 ;; (print "newre
1320: 73 31 3a 20 22 20 6e 65 77 72 65 73 29 0a 09 20 s1: " newres)..
1330: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (if (null? tal)
1340: 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 .. newres..
1350: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
1360: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n
1370: 65 77 72 65 73 29 29 29 0a 09 28 6c 65 74 20 28 ewres)))..(let (
1380: 28 6e 65 77 72 65 73 20 28 69 66 20 28 6e 75 6c (newres (if (nul
1390: 6c 3f 20 72 65 73 29 0a 09 09 09 20 20 28 6c 69 l? res).... (li
13a0: 73 74 20 28 6c 69 73 74 20 68 65 64 29 29 0a 09 st (list hed))..
13b0: 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 .. (map (lambda
13c0: 20 28 72 29 0a 09 09 09 09 20 28 61 70 70 65 6e (r)..... (appen
13d0: 64 20 72 20 28 6c 69 73 74 20 68 65 64 29 29 29 d r (list hed)))
13e0: 0a 09 09 09 20 20 20 20 20 20 20 72 65 73 29 29 .... res))
13f0: 29 29 0a 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 )).. ;; (print
1400: 22 6e 65 77 72 65 73 32 3a 20 22 20 6e 65 77 72 "newres2: " newr
1410: 65 73 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c es).. (if (null
1420: 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 6e 65 ? tal).. ne
1430: 77 72 65 73 0a 09 20 20 20 20 20 20 28 6c 6f 6f wres.. (loo
1440: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
1450: 74 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 tal) newres)))))
1460: 29 0a 0a 3b 3b 20 6d 75 6c 74 69 2d 70 61 72 74 )..;; multi-part
1470: 20 65 78 70 61 6e 64 0a 3b 3b 20 47 69 76 65 6e expand.;; Given
1480: 20 61 2f 62 2c 63 2c 64 2f 65 2c 66 20 72 65 74 a/b,c,d/e,f ret
1490: 75 72 6e 20 61 2f 62 2f 65 20 61 2f 62 2f 66 20 urn a/b/e a/b/f
14a0: 61 2f 63 2f 65 20 61 2f 63 2f 66 20 61 2f 64 2f a/c/e a/c/f a/d/
14b0: 65 20 61 2f 64 2f 66 0a 3b 3b 0a 28 64 65 66 69 e a/d/f.;;.(defi
14c0: 6e 65 20 28 72 75 6e 63 6f 6e 66 69 67 3a 65 78 ne (runconfig:ex
14d0: 70 61 6e 64 20 74 61 72 67 65 74 29 0a 20 20 28 pand target). (
14e0: 6c 65 74 2a 20 28 28 70 61 72 74 73 20 28 6d 61 let* ((parts (ma
14f0: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 p (lambda (x)...
1500: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
1510: 70 6c 69 74 20 78 20 22 2c 22 29 29 0a 09 09 20 plit x ","))...
1520: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 (string-spli
1530: 74 20 74 61 72 67 65 74 20 22 2f 22 29 29 29 29 t target "/"))))
1540: 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 . (map (lambd
1550: 61 20 28 78 29 0a 09 20 20 20 28 73 74 72 69 6e a (x).. (strin
1560: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 78 20 g-intersperse x
1570: 22 2f 22 29 29 0a 09 20 28 72 75 6e 63 6f 6e 66 "/")).. (runconf
1580: 69 67 3a 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 20 ig:combinations
1590: 70 61 72 74 73 29 29 29 29 0a 0a 3b 3b 20 6d 75 parts))))..;; mu
15a0: 6c 74 69 2d 74 61 72 67 65 74 20 65 78 70 61 6e lti-target expan
15b0: 73 69 6f 6e 0a 3b 3b 20 61 2f 62 2f 63 2f 78 2c sion.;; a/b/c/x,
15c0: 79 2c 7a 20 61 2f 62 2f 64 2f 78 2c 79 20 3d 3e y,z a/b/d/x,y =>
15d0: 20 61 2f 62 2f 63 2f 78 20 61 2f 62 2f 63 2f 79 a/b/c/x a/b/c/y
15e0: 20 61 2f 62 2f 63 2f 7a 20 61 2f 62 2f 64 2f 78 a/b/c/z a/b/d/x
15f0: 20 61 2f 62 2f 64 2f 79 0a 3b 3b 20 0a 28 64 65 a/b/d/y.;; .(de
1600: 66 69 6e 65 20 28 72 75 6e 63 6f 6e 66 69 67 3a fine (runconfig:
1610: 65 78 70 61 6e 64 2d 74 61 72 67 65 74 20 74 61 expand-target ta
1620: 72 67 65 74 2d 73 74 72 73 29 0a 20 20 28 64 65 rget-strs). (de
1630: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a lete-duplicates.
1640: 20 20 20 28 61 70 70 6c 79 20 61 70 70 65 6e 64 (apply append
1650: 20 28 6d 61 70 20 72 75 6e 63 6f 6e 66 69 67 3a (map runconfig:
1660: 65 78 70 61 6e 64 20 28 73 74 72 69 6e 67 2d 73 expand (string-s
1670: 70 6c 69 74 20 74 61 72 67 65 74 2d 73 74 72 73 plit target-strs
1680: 20 22 20 22 29 29 29 29 29 0a 0a 23 7c 0a 20 20 " ")))))..#|.
1690: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 72 67 65 (if (null? targe
16a0: 74 2d 73 74 72 73 29 0a 20 20 20 20 20 20 27 28 t-strs). '(
16b0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ). (let loo
16c0: 70 20 28 28 68 65 64 20 28 63 61 72 20 74 61 72 p ((hed (car tar
16d0: 67 65 74 2d 73 74 72 73 29 29 0a 09 09 20 28 74 get-strs))... (t
16e0: 61 6c 20 28 63 64 72 20 74 61 72 67 65 74 2d 73 al (cdr target-s
16f0: 74 72 73 29 29 0a 09 09 20 28 72 65 73 20 27 28 trs))... (res '(
1700: 29 29 29 0a 09 3b 3b 20 66 69 72 73 74 20 62 72 )))..;; first br
1710: 65 61 6b 20 61 6c 6c 20 70 61 72 74 73 20 69 6e eak all parts in
1720: 74 6f 20 69 6e 64 69 76 69 64 75 61 6c 20 74 61 to individual ta
1730: 72 67 65 74 20 70 61 74 74 65 72 6e 73 0a 09 28 rget patterns..(
1740: 69 66 20 28 73 74 72 69 6e 67 2d 69 6e 64 65 78 if (string-index
1750: 20 68 65 64 20 22 20 22 29 20 3b 3b 20 74 68 69 hed " ") ;; thi
1760: 73 20 69 73 20 61 20 6d 75 6c 74 69 2d 74 61 72 s is a multi-tar
1770: 67 65 74 20 74 61 72 67 65 74 0a 09 20 20 20 20 get target..
1780: 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 61 (let ((newres (a
1790: 70 70 65 6e 64 20 28 73 74 72 69 6e 67 2d 73 70 ppend (string-sp
17a0: 6c 69 74 20 68 65 64 20 22 20 22 29 20 72 65 73 lit hed " ") res
17b0: 29 29 29 0a 09 20 20 20 20 20 20 28 72 75 6e 63 ))).. (runc
17c0: 6f 6e 66 69 67 3a 65 78 70 61 6e 64 2d 74 61 72 onfig:expand-tar
17d0: 67 65 74 20 6e 65 77 72 65 73 29 29 0a 09 20 20 get newres))..
17e0: 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 69 6e (if (string-in
17f0: 64 65 78 20 68 65 64 20 22 2c 22 29 20 3b 3b 20 dex hed ",") ;;
1800: 74 68 69 73 20 69 73 20 61 20 6d 75 6c 74 69 2d this is a multi-
1810: 74 61 72 67 65 74 20 77 68 65 72 65 20 6f 6e 65 target where one
1820: 20 6f 72 20 6d 6f 72 65 20 70 61 72 74 73 20 61 or more parts a
1830: 72 65 20 63 6f 6d 6d 61 20 73 65 70 61 72 61 74 re comma separat
1840: 65 64 0a 09 09 20 20 0a 7c 23 0a ed... .|#.