Overview
Context
Changes
Modified db.scm
from [b8582e66d4]
to [261d702a1b].
︙ | | |
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
-
-
+
+
|
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data* '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex* (make-mutex))
(define *cache-on* #f)
(define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(define (open-db #!key (path #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc (if path path *toppath*) "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
|
︙ | | |
Modified launch.scm
from [ec07a7aa76]
to [6528b06ddb].
︙ | | |
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
|
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
|
(exit 4)))))))
;; set up the very basics needed for doing anything here.
(define (setup-for-run)
;; would set values for KEYS in the environment here for better support of env-override but
;; have chicken/egg scenario. need to read megatest.config then read it again. Going to
;; pass on that idea for now.
(set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override"))
(set! *configdat* (if (car *configinfo*)(car *configinfo*) #f))
(set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f))
(if *toppath*
(setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
(debug:print 0 "ERROR: failed to find the top path to your run setup."))
(find-and-read-config (if (args:get-arg "-config")
(args:get-arg "-config")
"megatest.config")
environ-patt: "env-override"))
;; (*configdat* (if (car *configinfo*)(car *configinfo*) #f))
;; (*toppath* (if (car *configinfo*)(cadr *configinfo*) #f)))
;; (if *toppath*
;; (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
;; (debug:print 0 "ERROR: failed to find the top path to your run setup."))
*toppath*)
(define (get-best-disk confdat)
(let* ((disks (hash-table-ref/default confdat "disks" #f))
(best #f)
(bestsize 0))
(if disks
(for-each
|
︙ | | |
Modified process.scm
from [71a058a91c]
to [833fe6b14b].
︙ | | |
74
75
76
77
78
79
80
81
|
74
75
76
77
78
79
80
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
107
108
109
110
111
112
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let loop ((i 0))
(let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
(if (eq? pid-val 0)
(begin
(thread-sleep! 2)
(loop (+ i 1)))
(values pid-val exit-status exit-code))))))
;;======================================================================
;; A persistent shell to which we can send many commands
;; WATCH for flush issues!
;; ALWAYS call with > /dev/null OR > logfile to cmd
;;======================================================================
(define (cmdshell:make-shell cmd . params)
;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
(handle-exceptions
exn
(begin
(print "ERROR: Failed to run command: " cmd " " (string-intersperse params " "))
#f)
(let-values (((fh fho pid) (if (null? params)
(process cmd)
(process cmd params))))
(vector fh fho pid))))
;; WARNING!! This will fail horribly if varname or varvalue have escaped or quoted portions
(define (cmdshell:set-env-var cmdshell varname varvalue)
(with-output-to-port (vector-ref cmdshell 1)
(lambda ()
(print "export " varname "=" varvalue))))
(define (cmdshell:run-cmd cmdshell cmd)
(with-output-to-port (vector-ref cmdshell 1)
(lambda ()
(print cmd))))
;; (close-input-port fh)
;; (close-output-port fho)
|