Overview
| Comment: | more ... |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64-use-pkts |
| Files: | files | file ages | folders |
| SHA1: |
ed70e701f874a9aedabebe021c7ada21 |
| User & Date: | matt on 2017-05-15 05:27:58 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-05-15
| ||
| 05:30 | Use T not ptype check-in: 5921f8fed0 user: matt tags: v1.64-use-pkts | |
| 05:27 | more ... check-in: ed70e701f8 user: matt tags: v1.64-use-pkts | |
|
2017-05-14
| ||
| 23:43 | More josling around stuff for pkts usage... check-in: e71001dca1 user: matt tags: v1.64-use-pkts | |
Changes
Modified common.scm from [1880332e02] to [d009a40469].
| ︙ | ︙ | |||
73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
;; A hash table that can be accessed by #{scheme ...} calls in
;; config files. Allows communicating between confgs
;;
(define *user-hash-data* (make-hash-table))
(define *db-keys* #f)
(define *configinfo* #f) ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f) ;; run configs data
(define *configdat* #f) ;; megatest.config data
(define *configstatus* #f) ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath* #f)
(define *already-seen-runconfig-info* #f)
| > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 |
;; A hash table that can be accessed by #{scheme ...} calls in
;; config files. Allows communicating between confgs
;;
(define *user-hash-data* (make-hash-table))
(define *db-keys* #f)
(define *pkts-info* (make-hash-table)) ;; store stuff like the last parent here
(define *configinfo* #f) ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f) ;; run configs data
(define *configdat* #f) ;; megatest.config data
(define *configstatus* #f) ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath* #f)
(define *already-seen-runconfig-info* #f)
|
| ︙ | ︙ | |||
2317 2318 2319 2320 2321 2322 2323 |
view-cfgdat))
;;======================================================================
;; Manage pkts, used in servers, tests and likely other contexts so put
;; in common
;;======================================================================
| | > | | | | > | | | | | | | > > > > > > > > > > > > > > > > > > > > > > | 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 |
view-cfgdat))
;;======================================================================
;; Manage pkts, used in servers, tests and likely other contexts so put
;; in common
;;======================================================================
(define common:pkts-spec
'((default . ((parent . P)))
(server . ((action . a)
(pid . d)
(ipaddr . i)
(port . p)
(parent . P)))
(test . ((cpuuse . c)
(diskuse . d)
(item-path . i)
(runname . r)
(state . s)
(target . t)
(status . u)
(parent . P)))))
(define (common:get-pkts-dirs mtconf use-lt)
(let* ((pktsdirs-str (or (configf:lookup mtconf "setup" "pktsdirs")
(and use-lt
(conc *toppath* "/lt/.pkts"))))
(pktsdirs (if pktsdirs-str
(string-split pktsdirs-str " ")
#f)))
pktsdirs))
(define (common:save-pkt pktalist-in mtconf use-lt)
(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)
(alist->pkt pktalist common:pkts-spec)))
(hash-table-set! *pkts-info* 'last-parent uuid)
(let ((pktsdir (or (hash-table-ref/default *pkts-info* 'pkts-dir #f)
(let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
(pktsdir (car pktsdirs))) ;; assume it is there
(hash-table-set! *pkts-info* 'pkts-dir pktsdir)
pktsdir))))
(if (not (file-exists? pktsdir))
(create-directory pktsdir #t))
(with-output-to-file
(conc pktsdir "/" uuid ".pkt")
(lambda ()
(print pkt)))))))
(define (common:with-queue-db mtconf proc #!key (use-lt #f)(toppath-in #f))
(let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
(pktsdir (if pktsdirs (car pktsdirs) #f))
(toppath (or (configf:lookup mtconf "scratchdat" "toppath")
toppath-in))
(pdbpath (or (configf:lookup mtconf "setup" "pdbpath") pktsdir)))
(if (not (and pktsdir toppath pdbpath))
|
| ︙ | ︙ |
Modified server.scm from [31c308e9d8] to [66a7525f0a].
| ︙ | ︙ | |||
52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id transport-type)
(case transport-type
((http)(http-transport:launch))
;;((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
(else (debug:print-error 0 *default-log-port* "unknown server type " transport-type))))
;;======================================================================
| > > > > | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id transport-type)
(common:save-pkt `((action . start)
(ptype . server)
(pid . (current-process-id)))
*configdat* #t)
(case transport-type
((http)(http-transport:launch))
;;((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
(else (debug:print-error 0 *default-log-port* "unknown server type " transport-type))))
;;======================================================================
|
| ︙ | ︙ |