48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
typed-records
z3)
(import stml2
)
(module commonmod
*
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
(prefix base64 base64:)
|
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
typed-records
z3)
(import stml2
)
(module commonmod
(
common:get-toppath
common:generic-ssh
common:file-exists?
common:with-env-vars
common:nice-path
common:get-fields
;; globals
*configdat*
*db-access-allowed*
*db-cache-path*
*toppath*
keys:target-set-args
getenv
setenv
safe-setenv
get-area-path-signature
common:simple-file-lock
common:low-noise-print
common:get-create-writeable-dir
common:real-path
val->alist
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
ports
(prefix base64 base64:)
|
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
(define *fdb* #f)
(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
;; environment vars handy stuff from common.scm
;;
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (or (substring-index "!" key)
(substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
(substring-index "." key)) ;; periods are not allowed in environment variables
(debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
(if (and (string? val)
(string? key))
|
>
|
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
(define *fdb* #f)
(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
;; environment vars handy stuff from common.scm
;;
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (or (substring-index "!" key)
(substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
(substring-index "." key)) ;; periods are not allowed in environment variables
(debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
(if (and (string? val)
(string? key))
|
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
|
;; convert string a=1; b=2; c=a silly thing; d=
(let ((valstr (lookup cfgdat section var)))
(if valstr
(val->alist valstr)
'()))) ;; should it return empty list or #f to indicate not set?
(define (get-section cfgdat section)
(hash-table-ref/default cfgdat section '()))
(define (common:make-tmpdir-name areapath tmpadj)
(let* ((area (pathname-file areapath))
(dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
(unless (directory-exists? dname)
(create-directory dname #t))
dname))
|
<
<
<
|
588
589
590
591
592
593
594
595
596
597
598
599
600
601
|
;; convert string a=1; b=2; c=a silly thing; d=
(let ((valstr (lookup cfgdat section var)))
(if valstr
(val->alist valstr)
'()))) ;; should it return empty list or #f to indicate not set?
(define (common:make-tmpdir-name areapath tmpadj)
(let* ((area (pathname-file areapath))
(dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
(unless (directory-exists? dname)
(create-directory dname #t))
dname))
|