~ salmonella-environment-setup (master) /scripts/common/kill-orphan.scm

 1(use extras posix srfi-1 srfi-13)
 2
 3(define salmonella-home
 4  ;; Change this to the directory where salmonella builds run.  This
 5  ;; is the path on the Linux machines.
 6  "/home/chicken/salmonella/build/salmonella-run-publish/")
 7
 8(define max-attempts-to-kill 10)
 9
10(define (get-pids)
11  (filter-map string->number (directory "/proc")))
12
13(let ((pids (get-pids)))
14  (for-each
15   (lambda (pid)
16     (handle-exceptions exn
17        #f ;; ignore
18        (let* ((status-file (sprintf "/proc/~a/status" pid))
19               (parent-pid
20                (let loop ((lines (with-input-from-file status-file
21                                    read-lines)))
22                  (if (null? lines)
23                      #f
24                      (let ((line (car lines)))
25                        (if (string-prefix? "PPid:" line)
26                            (string->number (cadr (string-split line)))
27                            (loop (cdr lines)))))))
28               (command-line
29                (with-input-from-file (sprintf "/proc/~a/cmdline" pid)
30                  read-line)))
31          (if (and (eq? parent-pid 1)
32                   (string-prefix? salmonella-home command-line))
33              (let loop ((i 1))
34                (if (> i max-attempts-to-kill)
35                    (printf "Giving up at attempting to kill ~a\n" pid)
36                    (begin
37                      (printf "Killing ~a: ~a [cwd: ~a] (attempt ~a out of ~a)\n"
38                              command-line
39                              (read-symbolic-link (sprintf "/proc/~a/cwd" pid))
40                              pid i max-attempts-to-kill)
41                      (process-signal pid signal/kill)
42                      (when (memv pid (get-pids))
43                            (loop (fx+ i 1))))))))))
44   pids))