Artifact
f3494fab665b71a594e957c4106403f53da893f5:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 61 64 ========.;; read
0050: 20 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 a config file,
0060: 6c 6f 61 64 69 6e 67 20 6f 6e 6c 79 20 74 68 65 loading only the
0070: 20 73 65 63 74 69 6f 6e 20 70 65 72 74 69 6e 65 section pertine
0080: 6e 74 0a 3b 3b 20 74 6f 20 74 68 69 73 20 72 75 nt.;; to this ru
0090: 6e 20 66 69 65 6c 64 31 76 61 6c 2f 66 69 65 6c n field1val/fiel
00a0: 64 32 76 61 6c 2f 66 69 65 6c 64 33 76 61 6c 20 d2val/field3val
00b0: 2e 2e 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ....;;==========
00c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
00d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
00e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
00f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 ============..(u
0100: 73 65 20 66 6f 72 6d 61 74 29 0a 0a 28 64 65 63 se format)..(dec
0110: 6c 61 72 65 20 28 75 6e 69 74 20 72 75 6e 63 6f lare (unit runco
0120: 6e 66 69 67 29 29 0a 28 64 65 63 6c 61 72 65 20 nfig)).(declare
0130: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 0a (uses common))..
0140: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
0150: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0160: 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 70 ..(define (setup
0170: 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 20 64 62 -env-defaults db
0180: 20 66 6e 61 6d 65 20 72 75 6e 2d 69 64 20 61 6c fname run-id al
0190: 72 65 61 64 79 2d 73 65 65 6e 20 23 21 6b 65 79 ready-seen #!key
01a0: 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 (environ-patt #
01b0: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 f)). (let* ((ke
01c0: 79 73 20 20 20 20 28 72 64 62 3a 67 65 74 2d 6b ys (rdb:get-k
01d0: 65 79 73 20 64 62 29 29 0a 09 20 28 6b 65 79 76 eys db)).. (keyv
01e0: 61 6c 73 20 28 72 64 62 3a 67 65 74 2d 6b 65 79 als (rdb:get-key
01f0: 2d 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 -vals db run-id)
0200: 29 0a 09 20 28 74 68 65 6b 65 79 20 20 28 73 74 ).. (thekey (st
0210: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
0220: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 (map (lambda (x
0230: 29 28 69 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 )(if x x "-na-")
0240: 29 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 ) keyvals) "/"))
0250: 0a 09 20 3b 3b 20 57 68 79 20 77 61 73 20 73 79 .. ;; Why was sy
0260: 73 74 65 6d 20 64 69 73 61 6c 6c 6f 77 65 64 20 stem disallowed
0270: 69 6e 20 74 68 65 20 72 65 61 64 69 6e 67 20 6f in the reading o
0280: 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 f the runconfigs
0290: 20 66 69 6c 65 3f 0a 09 20 3b 3b 20 4e 4f 54 45 file?.. ;; NOTE
02a0: 3a 20 53 68 6f 75 6c 64 20 62 65 20 73 65 74 74 : Should be sett
02b0: 69 6e 67 20 65 6e 76 20 76 61 72 73 20 62 61 73 ing env vars bas
02c0: 65 64 20 6f 6e 20 28 74 61 72 67 65 74 7c 64 65 ed on (target|de
02d0: 66 61 75 6c 74 29 0a 09 20 28 63 6f 6e 66 64 61 fault).. (confda
02e0: 74 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 66 t (read-config f
02f0: 6e 61 6d 65 20 23 66 20 23 74 20 65 6e 76 69 72 name #f #t envir
0300: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ
0310: 2d 70 61 74 74 20 73 65 63 74 69 6f 6e 73 3a 20 -patt sections:
0320: 27 28 22 64 65 66 61 75 6c 74 22 20 74 68 65 6b '("default" thek
0330: 65 79 29 29 29 0a 09 20 28 77 68 61 74 66 6f 75 ey))).. (whatfou
0340: 6e 64 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 nd (make-hash-ta
0350: 62 6c 65 29 29 0a 09 20 28 73 65 63 74 69 6f 6e ble)).. (section
0360: 73 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 s (list "default
0370: 22 20 74 68 65 6b 65 79 29 29 29 0a 20 20 20 20 " thekey))).
0380: 28 69 66 20 28 6e 6f 74 20 2a 74 61 72 67 65 74 (if (not *target
0390: 2a 29 28 73 65 74 21 20 2a 74 61 72 67 65 74 2a *)(set! *target*
03a0: 20 74 68 65 6b 65 79 29 29 20 3b 3b 20 6d 61 79 thekey)) ;; may
03b0: 20 73 61 76 65 20 61 20 64 62 20 61 63 63 65 73 save a db acces
03c0: 73 20 6f 72 20 74 77 6f 20 62 75 74 20 72 65 70 s or two but rep
03d0: 65 61 74 73 20 64 62 3a 67 65 74 2d 74 61 72 67 eats db:get-targ
03e0: 65 74 20 63 6f 64 65 0a 20 20 20 20 28 64 65 62 et code. (deb
03f0: 75 67 3a 70 72 69 6e 74 20 34 20 22 55 73 69 6e ug:print 4 "Usin
0400: 67 20 6b 65 79 3d 5c 22 22 20 74 68 65 6b 65 79 g key=\"" thekey
0410: 20 22 5c 22 22 29 0a 0a 20 20 20 20 28 66 6f 72 "\"").. (for
0420: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 -each. (lamb
0430: 64 61 20 28 6b 65 79 20 76 61 6c 29 0a 20 20 20 da (key val).
0440: 20 20 20 20 28 73 65 74 65 6e 76 20 28 76 65 63 (setenv (vec
0450: 74 6f 72 2d 72 65 66 20 6b 65 79 20 30 29 20 76 tor-ref key 0) v
0460: 61 6c 29 29 0a 20 20 20 20 20 6b 65 79 73 20 6b al)). keys k
0470: 65 79 76 61 6c 73 29 0a 0a 20 20 20 20 28 66 6f eyvals).. (fo
0480: 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 r-each . (la
0490: 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 mbda (section).
04a0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 65 63 (let ((sec
04b0: 74 69 6f 6e 2d 64 61 74 20 28 68 61 73 68 2d 74 tion-dat (hash-t
04c0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
04d0: 20 63 6f 6e 66 64 61 74 20 73 65 63 74 69 6f 6e confdat section
04e0: 20 23 66 29 29 29 0a 09 20 28 69 66 20 73 65 63 #f))).. (if sec
04f0: 74 69 6f 6e 2d 64 61 74 0a 09 20 20 20 20 20 28 tion-dat.. (
0500: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 for-each ..
0510: 20 28 6c 61 6d 62 64 61 20 28 65 6e 76 76 61 72 (lambda (envvar
0520: 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d )...(hash-table-
0530: 73 65 74 21 20 77 68 61 74 66 6f 75 6e 64 20 73 set! whatfound s
0540: 65 63 74 69 6f 6e 20 28 2b 20 28 68 61 73 68 2d ection (+ (hash-
0550: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
0560: 74 20 77 68 61 74 66 6f 75 6e 64 20 73 65 63 74 t whatfound sect
0570: 69 6f 6e 20 30 29 20 31 29 29 0a 09 09 28 73 65 ion 0) 1))...(se
0580: 74 65 6e 76 20 65 6e 76 76 61 72 20 28 63 61 64 tenv envvar (cad
0590: 72 20 28 61 73 73 6f 63 20 65 6e 76 76 61 72 20 r (assoc envvar
05a0: 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 29 29 0a section-dat)))).
05b0: 09 20 20 20 20 20 20 28 6d 61 70 20 63 61 72 20 . (map car
05c0: 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 29 29 29 section-dat)))))
05d0: 0a 20 20 20 20 20 73 65 63 74 69 6f 6e 73 29 0a . sections).
05e0: 20 20 20 20 28 69 66 20 61 6c 72 65 61 64 79 2d (if already-
05f0: 73 65 65 6e 0a 09 28 62 65 67 69 6e 0a 09 20 20 seen..(begin..
0600: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
0610: 4b 65 79 20 73 65 74 74 69 6e 67 73 20 66 6f 75 Key settings fou
0620: 6e 64 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 2e nd in runconfig.
0630: 63 6f 6e 66 69 67 3a 22 29 0a 09 20 20 28 66 6f config:").. (fo
0640: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
0650: 66 75 6c 6c 6b 65 79 29 0a 09 09 20 20 20 20 20 fullkey)...
0660: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0670: 28 66 6f 72 6d 61 74 20 23 66 20 22 7e 32 30 61 (format #f "~20a
0680: 20 7e 61 5c 6e 22 20 66 75 6c 6c 6b 65 79 20 28 ~a\n" fullkey (
0690: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
06a0: 65 66 61 75 6c 74 20 77 68 61 74 66 6f 75 6e 64 efault whatfound
06b0: 20 66 75 6c 6c 6b 65 79 20 30 29 29 29 29 0a 09 fullkey 0))))..
06c0: 09 20 20 20 20 73 65 63 74 69 6f 6e 73 29 0a 09 . sections)..
06d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
06e0: 20 22 2d 2d 2d 22 29 0a 09 20 20 28 73 65 74 21 "---").. (set!
06f0: 20 2a 61 6c 72 65 61 64 79 2d 73 65 65 6e 2d 72 *already-seen-r
0700: 75 6e 63 6f 6e 66 69 67 2d 69 6e 66 6f 2a 20 23 unconfig-info* #
0710: 74 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t)))))..(define
0720: 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d (set-run-config-
0730: 76 61 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vars db run-id).
0740: 20 20 28 6c 65 74 20 28 28 72 75 6e 63 6f 6e 66 (let ((runconf
0750: 69 67 66 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 igf (conc *topp
0760: 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 ath* "/runconfig
0770: 73 2e 63 6f 6e 66 69 67 22 29 29 0a 09 28 74 61 s.config"))..(ta
0780: 72 67 20 20 20 20 20 20 20 28 6f 72 20 28 61 72 rg (or (ar
0790: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
07a0: 67 65 74 22 29 0a 09 09 09 28 61 72 67 73 3a 67 get")....(args:g
07b0: 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 et-arg "-reqtarg
07c0: 22 29 0a 09 09 09 28 64 62 3a 67 65 74 2d 74 61 ")....(db:get-ta
07d0: 72 67 65 74 20 64 62 20 72 75 6e 2d 69 64 29 29 rget db run-id))
07e0: 29 29 0a 20 20 20 20 28 69 66 20 28 66 69 6c 65 )). (if (file
07f0: 2d 65 78 69 73 74 73 3f 20 72 75 6e 63 6f 6e 66 -exists? runconf
0800: 69 67 66 29 0a 09 28 73 65 74 75 70 2d 65 6e 76 igf)..(setup-env
0810: 2d 64 65 66 61 75 6c 74 73 20 64 62 20 72 75 6e -defaults db run
0820: 63 6f 6e 66 69 67 66 20 72 75 6e 2d 69 64 20 23 configf run-id #
0830: 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 t environ-patt:
0840: 28 63 6f 6e 63 20 22 28 64 65 66 61 75 6c 74 22 (conc "(default"
0850: 0a 09 09 09 09 09 09 09 09 09 28 69 66 20 74 61 ..........(if ta
0860: 72 67 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 rg..........
0870: 28 63 6f 6e 63 20 22 7c 22 20 74 61 72 67 20 22 (conc "|" targ "
0880: 29 22 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 )")..........
0890: 20 22 29 22 29 29 29 0a 09 28 64 65 62 75 67 3a ")")))..(debug:
08a0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
08b0: 3a 20 59 6f 75 20 64 6f 20 6e 6f 74 20 68 61 76 : You do not hav
08c0: 65 20 61 20 72 75 6e 20 63 6f 6e 66 69 67 20 66 e a run config f
08d0: 69 6c 65 3a 20 22 20 72 75 6e 63 6f 6e 66 69 67 ile: " runconfig
08e0: 66 29 29 29 29 0a 20 f)))).