ps_with_stack 1.0 KB

1234567891011121314151617181920212223242526272829303132333435363738
  1. #!/usr/bin/env perl
  2. use strict;
  3. open(my $ps, "-|", "ps -wwf");
  4. my $cols_known = 0;
  5. my $cmd_col = 0;
  6. my $pid_col = 0;
  7. while (<$ps>) {
  8. print;
  9. my @cols = split(/\s+/);
  10. if (!$cols_known && /CMD/) {
  11. # Parse relevant ps column headers
  12. for (my $i = 0; $i <= $#cols; $i++) {
  13. if ($cols[$i] eq "CMD") {
  14. $cmd_col = $i;
  15. }
  16. if ($cols[$i] eq "PID") {
  17. $pid_col = $i;
  18. }
  19. }
  20. $cols_known = 1;
  21. } else {
  22. my $pid = $cols[$pid_col];
  23. my $cmd = $cols[$cmd_col];
  24. # Match numeric PID and relative path command
  25. # -> The intention is only to dump stack traces for hangs in code under
  26. # test, which means we probably just built it and are executing by
  27. # relative path (e.g. ./my_test or foo/bar_test) rather then by absolute
  28. # path (e.g. /usr/bin/time) or PATH search (e.g. grep).
  29. if ($pid =~ /^[0-9]+$/ && $cmd =~ /^[^\/ ]+[\/]/) {
  30. print "Dumping stacks for $pid...\n";
  31. system("pstack $pid || gdb -batch -p $pid -ex 'thread apply all bt'");
  32. }
  33. }
  34. }
  35. close $ps;