Megatest

Diff
Login

Differences From Artifact [f9dfbe5500]:

To Artifact [f525bcbf17]:


83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
               (list result (if normalexit? exitstatus -1))))))))

(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 " "))
     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     (debug:print 5 *default-log-port* "exn=" (condition->list exn))
     #f)
   (let-values (((fh fho pid) (if (null? params)
				  (process cmd)
				  (process cmd params))))
       (let loop ((curr (read-line fh))







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
               (list result (if normalexit? exitstatus -1))))))))

(define (process:cmd-run-proc-each-line cmd proc . params)
  ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "ERROR:  Failed to run command: " cmd " " (string-intersperse params " "))
     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     (debug:print 5 *default-log-port* "exn=" (condition->list exn))
     #f)
   (let-values (((fh fho pid) (if (null? params)
				  (process cmd)
				  (process cmd params))))
       (let loop ((curr (read-line fh))
193
194
195
196
197
198
199



200
201
202
203
204
205
206
207
208
209
210
211
212
213
214





215
216
217
218
219
220
221
222
223
224
225
226
227
   (common:file-exists? (conc "/proc/" pid))
   (let-values (((rpid exit-type exit-signal)(process-wait pid #t)))
       (and (number? rpid)
	    (equal? rpid pid)))))

(define (process:alive-on-host? host pid)
  (let ((cmd (conc "ssh " host " ps -o pid= -p " pid)))



    (handle-exceptions
	exn
      (begin
	(debug:print 0 *default-log-port* "failed to identify if process " pid ", on host " host " is alive. exn=" exn)
	#f) ;; anything goes wrong - assume the process in NOT running.
     (with-input-from-pipe 
      cmd
      (lambda ()
	(let loop ((inl (read-line)))
	  (if (eof-object? inl)
	      #f
	      (let* ((clean-str (string-substitute "^[^\\d]*([0-9]+)[^\\d]*$" "\\1" inl))
		     (innum     (string->number clean-str)))
		(and innum
		     (eq? pid innum))))))))))






(define (process:get-sub-pids pid)
  (with-input-from-pipe
   (conc "pstree -A -p " pid) ;; | tr 'a-z\\-+`()\\.' ' ' " pid)
   (lambda ()
     (let loop ((inl (read-line))
		(res '()))
       (if (eof-object? inl)
	   (reverse res)
	   (let ((nums (map string->number
			    (string-split-fields "\\d+" inl))))
	     (loop (read-line)
		   (append res nums))))))))







>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>













193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
   (common:file-exists? (conc "/proc/" pid))
   (let-values (((rpid exit-type exit-signal)(process-wait pid #t)))
       (and (number? rpid)
	    (equal? rpid pid)))))

(define (process:alive-on-host? host pid)
  (let ((cmd (conc "ssh " host " ps -o pid= -p " pid)))
    (common:generic-ssh
     cmd
   ;; 
   ;; handle-exceptions
   ;; 	exn
   ;;  (begin
   ;; 	(debug:print 0 *default-log-port* "failed to identify if process " pid ", on host " host " is alive. exn=" exn)
   ;; 	#f) ;; anything goes wrong - assume the process in NOT running.
   ;;  (with-input-from-pipe 
   ;;   cmd
     (lambda ()
       (let loop ((inl (read-line)))
	 (if (eof-object? inl)
	     #f
	     (let* ((clean-str (string-substitute "^[^\\d]*([0-9]+)[^\\d]*$" "\\1" inl))
		    (innum     (string->number clean-str)))
	       (and innum
		    (eq? pid innum))))))
     #f
     (lambda ()
       (debug:print 0 *default-log-port* "failed to identify if process "
		    pid", on host "host" is alive. exn="exn)))))


(define (process:get-sub-pids pid)
  (with-input-from-pipe
   (conc "pstree -A -p " pid) ;; | tr 'a-z\\-+`()\\.' ' ' " pid)
   (lambda ()
     (let loop ((inl (read-line))
		(res '()))
       (if (eof-object? inl)
	   (reverse res)
	   (let ((nums (map string->number
			    (string-split-fields "\\d+" inl))))
	     (loop (read-line)
		   (append res nums))))))))