Overview
| Comment: | Minor updates for pkt dumping |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-use-pkts |
| Files: | files | file ages | folders |
| SHA1: |
465e3734f8d5ac803d791d07e3787658 |
| User & Date: | mrwellan on 2017-05-25 17:11:19 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-05-25
| ||
| 23:16 | Merged in updates from v1.65 check-in: 5cd9ae113c user: matt tags: v1.65-use-pkts | |
| 17:11 | Minor updates for pkt dumping check-in: 465e3734f8 user: mrwellan tags: v1.65-use-pkts | |
| 08:56 | Dump pkts on processing configs IFF have parent (i.e. are in a server) check-in: ebd66b0fd3 user: matt tags: v1.65-use-pkts | |
Changes
Modified common.scm from [b2867d5ded] to [7f4a9cee8c].
| ︙ | ︙ | |||
2318 2319 2320 2321 2322 2323 2324 | ;;====================================================================== ;; Manage pkts, used in servers, tests and likely other contexts so put ;; in common ;;====================================================================== (define common:pkts-spec | | > > > > > | 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 |
;;======================================================================
;; Manage pkts, used in servers, tests and likely other contexts so put
;; in common
;;======================================================================
(define common:pkts-spec
'((default . ((parent . P)
(action . a)
(filename . f)))
(configf . ((parent . P)
(action . a)
(filename . f)))
(server . ((action . a)
(pid . d)
(ipaddr . i)
(port . p)
(parent . P)))
(test . ((cpuuse . c)
|
| ︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 |
"/lt/.pkts"))))
(pktsdirs (if pktsdirs-str
(string-split pktsdirs-str " ")
#f)))
pktsdirs))
(define (common:save-pkt pktalist-in mtconf use-lt #!key (add-only #f)) ;; add-only saves the pkt only if there is a parent already
| | | 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 |
"/lt/.pkts"))))
(pktsdirs (if pktsdirs-str
(string-split pktsdirs-str " ")
#f)))
pktsdirs))
(define (common:save-pkt pktalist-in mtconf use-lt #!key (add-only #f)) ;; add-only saves the pkt only if there is a parent already
(if (or add-only
(hash-table-exists? *pkts-info* 'last-parent))
(let* ((parent (hash-table-ref/default *pkts-info* 'last-parent #f))
(pktalist (if parent
(cons `(parent . ,parent)
pktalist-in)
pktalist-in)))
(let-values (((uuid pkt)
|
| ︙ | ︙ |
Modified configf.scm from [6b5f4a36ff] to [b8b42ff101].
| ︙ | ︙ | |||
227 228 229 230 231 232 233 |
;;
(define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f)
(sections #f) (settings (make-hash-table)) (keep-filenames #f)
(post-section-procs '()) (apply-wildcards #t))
(debug:print 9 *default-log-port* "START: " path)
(if *configdat*
(common:save-pkt `((action . read-config)
| | > | 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 |
;;
(define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f)
(sections #f) (settings (make-hash-table)) (keep-filenames #f)
(post-section-procs '()) (apply-wildcards #t))
(debug:print 9 *default-log-port* "START: " path)
(if *configdat*
(common:save-pkt `((action . read-config)
(f . ,path)
(T . configf))
*configdat* #t add-only: #t))
(if (and (not (port? path))
(not (file-exists? path))) ;; for case where we are handed a port
(begin
(debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory))
;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?
#f) ;; (if (not ht)(make-hash-table) ht))
|
| ︙ | ︙ |
Modified mtut.scm from [88cf3f259e] to [b9f248b489].
| ︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 |
((gendot)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat)))
(common:load-pkts-to-db mtconf use-lt: #t) ;; need to NOT do this by default ...
(common:with-queue-db
mtconf
(lambda (pktsdirs pktsdir conn)
| | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 |
((gendot)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat)))
(common:load-pkts-to-db mtconf use-lt: #t) ;; need to NOT do this by default ...
(common:with-queue-db
mtconf
(lambda (pktsdirs pktsdir conn)
(make-report "out.dot" conn common:pkts-spec '(action ipaddr port filename) ))
use-lt: #t)))
((db)
(if (null? remargs)
(print "ERROR: missing sub command for db command")
(let ((subcmd (car remargs)))
(case (string->symbol subcmd)
((pgschema)
|
| ︙ | ︙ |