Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -568,11 +568,11 @@ dir (conc (current-directory) "/" dir)))) (define (get-cpu-load) (car (common:get-cpu-load))) -;; (let* ((load-res (cmd-run->list "uptime")) +;; (let* ((load-res (process:cmd-run->list "uptime")) ;; (load-rx (regexp "load average:\\s+(\\d+)")) ;; (cpu-load #f)) ;; (for-each (lambda (l) ;; (let ((match (string-search load-rx l))) ;; (if match @@ -623,21 +623,21 @@ (define (common:wait-for-normalized-load maxload #!key (msg #f)) (let ((num-cpus (common:get-num-cpus))) (common:wait-for-cpuload maxload num-cpus 15 msg: msg))) (define (get-uname . params) - (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params))))) + (let* ((uname-res (process:cmd-run->list (conc "uname " (if (null? params) "-a" (car params))))) (uname #f)) (if (null? (car uname-res)) "unknown" (caar uname-res)))) ;; for reasons I don't understand multiple calls to real-path in parallel threads ;; must be protected by mutexes ;; (define (common:real-path inpath) - ;; (cmd-run-with-stderr->list "readlink" "-f" inpath)) ;; cmd . params) + ;; (process:cmd-run-with-stderr->list "readlink" "-f" inpath)) ;; cmd . params) ;; (let-values ;; (((inp oup pid) (process "readlink" (list "-f" inpath)))) ;; (with-input-from-port inp ;; (let loop ((inl (read-line)) ;; (res #f)) @@ -657,11 +657,11 @@ (define (common:get-disk-space-used fpath) (with-input-from-pipe (conc "/usr/bin/du -s " fpath) read)) (define (get-df path) - (let* ((df-results (cmd-run->list (conc "df " path))) + (let* ((df-results (process:cmd-run->list (conc "df " path))) (space-rx (regexp "([0-9]+)\\s+([0-9]+)%")) (freespc #f)) ;; (write df-results) (for-each (lambda (l) (let ((match (string-search space-rx l))) Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -13,11 +13,11 @@ ;; Config file handling ;;====================================================================== (use regex regex-case) ;; directory-utils) (declare (unit configf)) -;; (declare (uses process)) +(declare (uses process)) (include "common_records.scm") ;; return list (path fullpath configname) (define (find-config configname #!key (toppath #f)) @@ -47,11 +47,11 @@ (handle-exceptions exn (begin (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment") #f) - (let ((cmdres (cmd-run->list (conc "echo " str)))) + (let ((cmdres (process:cmd-run->list (conc "echo " str)))) (if (null? cmdres) "" (caar cmdres))))) ;;====================================================================== ;; Make the regexp's needed globally available @@ -118,11 +118,11 @@ res)) res))) ;; Run a shell command and return the output as a string (define (shell cmd) - (let* ((output (cmd-run->list cmd)) + (let* ((output (process:cmd-run->list cmd)) (res (car output)) (status (cadr output))) (if (equal? status 0) (let ((outres (string-intersperse res @@ -238,11 +238,11 @@ #f #f))) (configf:key-sys-pr ( x key cmd ) (if allow-system (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((start-time (current-seconds)) - (cmdres (cmd-run->list cmd)) + (cmdres (process:cmd-run->list cmd)) (delta (- (current-seconds) start-time)) (status (cadr cmdres)) (res (car cmdres))) (debug:print-info 4 "" inl "\n => " (string-intersperse res "\n")) (if (not (eq? status 0)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2082,11 +2082,11 @@ (begin ;; no need to treat this as an error by default (debug:print 4 "WARNING: call to db:get-tests-for-run with bad run-id=" run-id) ;; (print-call-chain (current-error-port)) '()) (let* ((qryvalstr (case qryvals - ((shortlist) "id,run_id,testname,state,status,item_path") + ((shortlist) "id,run_id,testname,item_path,state,status") ((#f) db:test-record-qry-selector) ;; "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment") (else qryvals))) (res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) @@ -2426,11 +2426,11 @@ db "SELECT attemptnum FROM tests WHERE id=?;" #f test-id)))) -(define db:test-record-fields '("id" "run_id" "testname" "item_path" "state" "status" "event_time" +(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time" "host" "cpuload" "diskfree" "uname" "rundir" "item_path" "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived")) ;; fields *must* be a non-empty list ;; Index: process.scm ================================================================== --- process.scm +++ process.scm @@ -46,11 +46,11 @@ (close-input-port fh) (close-input-port fhe) (close-output-port fho) result))))) ;; ) -(define (cmd-run-proc-each-line cmd proc . params) +(define (process:cmd-run-proc-each-line cmd proc . params) ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) (handle-exceptions exn (begin (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) @@ -69,17 +69,17 @@ (close-input-port fh) (close-input-port fhe) (close-output-port fho) result)))))) -(define (cmd-run-proc-each-line-alt cmd proc) +(define (process:cmd-run-proc-each-line-alt cmd proc) (let* ((fh (open-input-pipe cmd)) (res (port-proc->list fh proc)) (status (close-input-pipe fh))) (if (eq? status 0) res #f))) -(define (cmd-run->list cmd) +(define (process:cmd-run->list cmd) (let* ((fh (open-input-pipe cmd)) (res (port->list fh)) (status (close-input-pipe fh))) (list res status)))