23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
(declare (uses debugprint))
(declare (uses stml2))
(declare (uses pkts))
(declare (uses processmod))
(declare (uses mtargs))
(declare (uses configfmod))
(declare (uses hostinfo))
;; odd but it works?
(declare (uses itemsmod))
(module commonmod
*
|
>
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
(declare (uses debugprint))
(declare (uses stml2))
(declare (uses pkts))
(declare (uses processmod))
(declare (uses mtargs))
(declare (uses configfmod))
(declare (uses hostinfo))
(declare (uses keysmod))
;; odd but it works?
(declare (uses itemsmod))
(module commonmod
*
|
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
mtver
debugprint
stml2
pkts
processmod
(prefix mtargs args:)
configfmod
itemsmod
hostinfo
)
;;======================================================================
;; CONTENTS
;;
|
|
|
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
mtver
debugprint
stml2
pkts
processmod
(prefix mtargs args:)
configfmod
keysmod
itemsmod
hostinfo
)
;;======================================================================
;; CONTENTS
;;
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
;;
;; (define setenv set-environment-variable!)
;; (define unsetenv unset-environment-variable!)
;; (define getenv get-environment-variable)
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; Globals
;;
(define *server-loop-heart-beat* (current-seconds))
(define *watchdog* #f)
|
>
|
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
;;
;; (define setenv set-environment-variable!)
;; (define unsetenv unset-environment-variable!)
;; (define getenv get-environment-variable)
(define home (getenv "HOME"))
(define user (getenv "USER"))
(define keys:config-get-fields common:get-fields)
;; Globals
;;
(define *server-loop-heart-beat* (current-seconds))
(define *watchdog* #f)
|
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
|
(define (common:args-get-runname)
(let ((res (or (args:get-arg "-runname")
(args:get-arg ":runname")
(getenv "MT_RUNNAME"))))
;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
res))
(define (common:get-fields cfgdat)
(let ((fields (hash-table-ref/default cfgdat "fields" '())))
(map car fields)))
|
<
<
<
<
|
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
|
(define (common:args-get-runname)
(let ((res (or (args:get-arg "-runname")
(args:get-arg ":runname")
(getenv "MT_RUNNAME"))))
;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
res))
(define (common:args-get-target #!key (split #f)(exit-if-bad #f))
(let* ((keys (if (hash-table? *configdat*) (common:get-fields *configdat*) '()))
(numkeys (length keys))
(target (or (args:get-arg "-reqtarg")
(args:get-arg "-target")
(getenv "MT_TARGET")))
(tlist (if target (string-split target "/" #t) '()))
|
3569
3570
3571
3572
3573
3574
3575
3576
3577
|
;;
(define (server:expiration-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
(* 3600 (string->number tmo))
60)))
)
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
|
;;
(define (server:expiration-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
(* 3600 (string->number tmo))
60)))
(define (runs:get-mt-env-alist run-id runname target testname itempath)
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
`(("MT_TEST_NAME" . ,testname)
("MT_ITEMPATH" . ,itempath)
("MT_TARGET" . ,target)
("MT_RUNNAME" . ,runname)
("MT_RUN_AREA_HOME" . ,*toppath*)
,@(let* ((link-tree (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))
(if link-tree
(list (cons "MT_LINKTREE" link-tree)
(cons "MT_TEST_RUN_DIR"
(conc link-tree "/" target "/" runname "/" testname
(if (and (string? itempath) (not (equal? itempath "")))
(conc "/" itempath)
"")))
)
'()))
,@(map
(lambda (key)
(cons (car key) (cadr key)))
(keys:target->keyval (common:get-fields *configdat*) #;(rmt:get-keys) target))
,@(map (lambda (var)
(let ((val (configf:lookup *configdat* "env-override" var)))
(cons var val)))
(configf:section-vars *configdat* "env-override"))))
;;======================================================================
;; config file related routines
;;======================================================================
(define (keys:make-key/field-string confdat)
(let ((fields (configf:get-section confdat "fields")))
(string-join
(map (lambda (field)(conc (car field) " " (cadr field)))
fields)
",")))
)
|