A.5 vc-check.setl

Source code: *

-- Report on Box processes (though this program is not part of the Box)
 
const pid_dir = `vc-pid';
 
const ps = filter(`/bin/ps alxwwj');
const lines = split(ps,`\n');
const header = split(lines(1));
const pstup = [split(line) : line in lines(2..) | #line > 0];
const pid_index = index(`PID');
const ppid_index = index(`PPID');
const command_index = index(`COMMAND');
const pid_map = {[tup(ppid_index),  -- main parent->child map
                  tup(pid_index)] : tup in pstup};
const finder = {[tup(pid_index), i] : tup = pstup(i)};
 
for name in split (filter (`/bin/echo '+pid_dir+`/*')) |
    name notin {`', pid_dir+`/*', pid_dir+`/vc-toplev'} loop
  root := getfile name;
  id := val root;
  if not is_integer id or id  0 or id  2**31 then
    printa (stderr, `Process id in file '+str name+` is invalid!');
  else
    name(pid_dir+`/') := `';
    if pexists id and root in range pid_map then
      printa (stderr, `Process tree for "'+name+`":');
      t := [format pstup(finder(root))];
      if root in domain pid_map then
        t +:= doit (root, 0);
      end if;
      n := 0 max/[#line : line in t];
      for j in [1,4..n] loop
        prot := false;
        for i in [#t,#t-1..1] loop
          c := t(i)(j);
          if c = `|' then
            if not prot and (mark (t(i), `\\\\'))(1) > j then
              t(i)(j) := ` ';
            end if;
          elseif c = `\\' then
            prot := true;
          else
            prot := false;
          end if;
        end for i;
      end for j;
      for line in t loop
        line(` $') := `';  -- fanatic
        printa (stderr, line);
      end for line;
    else
      printa (stderr, `Process '+root+` for "'+name+`" is gone.');
    end if;
  end if;
end for name;
 
name := pid_dir+`/vc-toplev';
if (root := getfile name)  om then
  id := val root;
  if not is_integer id or id  0 or id  2**31 then
    printa (stderr, `Process id in file '+str name+` is invalid!');
  else
    name(pid_dir+`/') := `';
    if pexists id then
      assert root in range pid_map;
      line := format pstup(finder(root));
      printa (stderr, `Primordial process for "'+name+`":');
      printa (stderr, line);
    else
      printa (stderr, `Process '+root+` for "'+name+`" is gone.');
    end if;
  end if;
else
  name(pid_dir+`/') := `';
  printa (stderr, `There is no record of the process for "'+name+`".');
end if;
 
if (filter (`uname'))(`Linux')  om then
  printa (stderr, `Try also "ps fxj" to check for orphaned processes.');
else
  printa (stderr, `Try also "ps xl" to check for orphaned processes.');
end if;
 
 
proc index (what);
  assert exists field = header(i) | field = what;
  return i;
end proc;
 
proc doit (parent, k);
  return [ ] +/ [ [k*`|  '+`\\_ '+format pstup(finder(child))] +
                 doit (child, k+1) : child in pid_map{parent} ];
end proc;
 
op format (tup);
  return tup(pid_index) + ` = '
          +/[field+` ' : field in tup(command_index..)];
end op;