81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+
|
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
(cmd (list-ref matchdat 3))
(poststr (list-ref matchdat 4))
(result #f)
(start-time (current-seconds))
(cmdsym (string->symbol cmdtype))
(fullcmd (case cmdsym
((scheme)(conc "(lambda (ht)" cmd ")"))
((system)(conc "(lambda (ht)(system \"" cmd "\"))"))
((shell) (conc "(lambda (ht)(shell \"" cmd "\"))"))
((getenv)(conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
((get)
((scheme scm) (conc "(lambda (ht)" cmd ")"))
((system) (conc "(lambda (ht)(system \"" cmd "\"))"))
((shell sh) (conc "(lambda (ht)(shell \"" cmd "\"))"))
((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
((getenv) (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
((get g)
(let* ((parts (string-split cmd))
(sect (car parts))
(var (cadr parts)))
(conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))")))
((runconfigs-get) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
;; (print "fullcmd=" fullcmd)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
|