15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
(require-extension (srfi 18) extras tcp rpc)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit common))
(include "common_records.scm")
;; (require-library margs)
;; (include "margs.scm")
;; (define old-exit exit)
;;
;; (define (exit . code)
;; (if (null? code)
;; (old-exit)
;; (old-exit code)))
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (and (string? val)(string? key))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
(setenv key val))
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)))
|
>
>
>
|
>
|
|
|
|
|
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
(require-extension (srfi 18) extras tcp rpc)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(declare (unit common))
(declare (uses keys))
(include "common_records.scm")
;; (require-library margs)
;; (include "margs.scm")
;; (define old-exit exit)
;;
;; (define (exit . code)
;; (if (null? code)
;; (old-exit)
;; (old-exit code)))
(define getenv get-environment-variable)
(define (safe-setenv key val)
(if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
(debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"")
(if (and (string? val)
(string? key))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
(setenv key val))
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; GLOBAL GLETCHES
;; CONTEXTS
|
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
|
((and (equal? args-testpatt "%") rtestpatt)
(debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
rtestpatt)
(else args-testpatt))))
(define (common:get-linktree)
(or (getenv "MT_LINKTREE")
(if *configdat*
(configf:lookup *configdat* "setup" "linktree"))))
(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))
|
|
|
>
>
>
>
>
|
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
|
((and (equal? args-testpatt "%") rtestpatt)
(debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
rtestpatt)
(else args-testpatt))))
(define (common:get-linktree)
(or (getenv "MT_LINKTREE")
(or (and *configdat*
(configf:lookup *configdat* "setup" "linktree"))
(if *toppath*
(conc *toppath* "/lt")
(if (file-exists? "megatest.config") ;; we are in the toppath (new area, mtutils compatible)
(conc (current-directory) "/lt")
#f)))))
(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))
|
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
|
(lambda ()
(for-each (lambda (keyval)
(let* ((key (car keyval))
(val (cdr keyval))
(delim (if (string-search whitesp val)
"\""
"")))
(print (if (member key ignorevars)
"# export "
"export ")
key "=" delim (mungeval val) delim)))
envvars)))))
;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
|
|
>
|
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
|
(lambda ()
(for-each (lambda (keyval)
(let* ((key (car keyval))
(val (cdr keyval))
(delim (if (string-search whitesp val)
"\""
"")))
(print (if (or (member key ignorevars)
(string-search ":" key)) ;; internal only values to be skipped.
"# export "
"export ")
key "=" delim (mungeval val) delim)))
envvars)))))
;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
|