[padb-devel] [padb] r272 committed - Merged cleanup changes r169:r271 into the trunk
codesite-noreply at google.com
codesite-noreply at google.com
Thu Oct 1 20:38:51 BST 2009
Revision: 272
Author: apittman
Date: Thu Oct 1 12:38:38 2009
Log: Merged cleanup changes r169:r271 into the trunk
http://code.google.com/p/padb/source/detail?r=272
Added:
/trunk/src/report.pl
Modified:
/trunk/src
/trunk/src/Makefile
/trunk/src/padb
=======================================
--- /dev/null
+++ /trunk/src/report.pl Thu Oct 1 12:38:38 2009
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+# Takes the source code and the output of perlcritic and make a
+# per-function report on the state of the source. Very
+# rough-and-ready but it helps in it's own little way.
+
+my $line = 1;
+
+my %calls;
+my %subs;
+
+my @builtin =
+ qw(basename Dumper qw Configure dclone join defined delete print shift
close accept confess A new thaw add
+ remove count flush handles printf split dirname);
+
+my %builtin;
+
+foreach (@builtin) {
+ $builtin{$_}++;
+}
+
+my $current_fn;
+
+my %fns;
+my @fns;
+my @calls;
+my %refs;
+
+my $PH;
+
+open $PH, '<', 'padb';
+
+while (<$PH>) {
+ if ( m{\A[^#]*?(\w+)\(}x and not defined $builtin{$1} ) {
+ push @{ $calls{$1} }, $line;
+ $calls[$line] = $1;
+
+ } elsif (m{\Asub\s+(\w+)}) {
+ $current_fn = $1;
+
+ $fns{$current_fn}{start} = $line;
+ push @fns, $current_fn;
+ } elsif ( m{\A\}} and defined $current_fn ) {
+
+ $fns{$current_fn}{end} = $line;
+ $current_fn = undef;
+ } elsif (m{\\\&(\w+)}) {
+ $refs{$1} = 1;
+ }
+
+ $line++;
+}
+
+close $PH;
+
+my $PPH;
+open $PPH, '<', 'pc';
+
+my @pc_names = qw(brutal cruel harsh stern gentle);
+
+my @errors;
+while (<$PPH>) {
+ if (m{\A(\d+)\:[ ]\((\d)\)[ ](.*)\Z}x) {
+ push @{ $errors[$1] }, "$pc_names[$2-1]($2): $3";
+ } else {
+ printf "?? $_\n";
+ }
+}
+
+foreach my $fn (@fns) {
+ foreach my $line ( $fns{$fn}{start} .. $fns{$fn}{end} ) {
+
+ if ( defined $errors[$line] ) {
+ @{ $fns{$fn}{errors}{ $line - $fns{$fn}{start} } } =
+ @{ $errors[$line] };
+ }
+ next unless defined( $calls[$line] );
+ $fns{ $calls[$line] }{called_by}{$fn}++;
+ $fns{$fn}{calls}{ $calls[$line] }++;
+ }
+}
+
+foreach my $fn (@fns) {
+ printf("Function: $fn $fns{$fn}{start}\n");
+
+ if ( defined $refs{$fn} ) {
+ printf("\tIs dereferenced\n");
+ }
+ foreach my $cf ( sort keys %{ $fns{$fn}{called_by} } ) {
+ printf("\tIs called by:\t$cf ($fns{$fn}{called_by}{$cf} times)\n");
+ }
+ foreach my $cf ( sort keys %{ $fns{$fn}{calls} } ) {
+ printf("\tCalls:\t\t$cf ($fns{$fn}{calls}{$cf} times)\n");
+ }
+ foreach my $el ( sort { $a <=> $b } keys %{ $fns{$fn}{errors} } ) {
+ foreach my $error ( @{ $fns{$fn}{errors}{$el} } ) {
+
+ #printf("\tError:\t\t$fns{$fn}{errors}{$el} ($el)\n");
+ printf("\tError:\t\t$error ($el)\n");
+ }
+ }
+ printf("\n");
+}
+
+exit 0;
=======================================
--- /trunk/src/Makefile Tue Sep 1 13:09:16 2009
+++ /trunk/src/Makefile Thu Oct 1 12:38:38 2009
@@ -27,3 +27,14 @@
/bin/cp ${FILES} padb-${VERSION}
svnversion > padb-${VERSION}/svnversion
tar -czf padb-${VERSION}.tgz padb-${VERSION}
+
+tidy:
+ perltidy -b -ce -w -se padb
+
+pc: padb
+ perlcritic --brutal --verbose "%l: (%s) %m\n" padb > .pc.tmp || true
+ /bin/mv .pc.tmp pc
+
+report: pc
+ ./report.pl pc | tee report
+
=======================================
--- /trunk/src/padb Tue Sep 1 13:07:04 2009
+++ /trunk/src/padb Thu Oct 1 12:38:38 2009
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# padb. a simple parallel debugging aid.
@@ -24,9 +24,9 @@
# Revision history
# Version 3.0
-# * Full-duplex communication between inner and outer processes, padb
-# no longer simply sends request on the command line and processes
-# the response but is truly interactive between the inner and outer
+# * Full-duplex communication between inner and outer processes, padb no
+# longer simply sends request on the command line and processes the
+# response but is truly interactive between the inner and outer
# processes. This avails greater flexibility in what can be achieved
# and hopefully helps with scalability as well.
# * Enabled warnings (-w) by default. Fixed lots of warnings, mostly
@@ -34,22 +34,23 @@
# * Much more complete separation into "modes" of operation, most options
# are now mode specific rather than simply using global variables or
# global conf options.
-# * Overhaul of the allfns (mode) callbacks and in particular their
parameters
+# * Overhaul of the allfns (mode) callbacks and in particular their
+# parameters
# * Performance improvements.
-# * Simplify the slurm_find_pids() function to just return the output
-# of scontrol listpids
+# * Simplify the slurm_find_pids() function to just return the output of
+# scontrol listpids
# * Take the old process-tree walking code from slurm_find_pids() and make
-# it independant and call it for all resource managers. This allows
scripts
-# which call parallel applications to be bypassed and the applications
-# themselves targetted.
-# * Added "port-range" option to limit port usage in case people try and
use
-# padb with firewalls enabled.
+# it independant and call it for all resource managers. This allows
+# scripts which call parallel applications to be bypassed and the
+# applications themselves targetted.
+# * Added "port-range" option to limit port usage in case people try and
+# use padb with firewalls enabled.
#
# Version 2.5
# * First Non-Quadrics version
# * Various stability/bug fixes.
-# * Deadlock detect at the MPI Layer rather than the Elan layer
-# if running with a patched MPI (Work in progress)
+# * Deadlock detect at the MPI Layer rather than the Elan layer if running
+# with a patched MPI (Work in progress)
# * Completely new build and packing procedure to go with the new
# maintainer.
# * Added "orte" to the list of resource managers supported
@@ -57,97 +58,109 @@
# * inner_main() now uses callbacks for resource manager support.
# * --signal now takes names rather than numbers.
# * Check job is valid when using the --full-report option.
-# * Add a --proc-summary option to replace --proc-info --proc-format
-# This gives a very efficient "job top" program.
-
+# * Add a --proc-summary option to replace --proc-info --proc-format This
+# gives a very efficient "job top" program.
# Version 2.2
-# * Add a --core-stack option along with --core and --exe to extract stack
-# traces from core files.
+# * Add a --core-stack option along with --core and --exe to extract stack
+# traces from core files.
#
# Version 2.1
-# * Add some magic to return complex perl data structures back from the
inner
-# callback functions to the output callback function.
(nfreeze/base64_encode).
-# * Add "MPI watch" functionality to allow viewing of MPI state in a
vmstat
-# like fashion.
-# * Add a --list-rmgrs option to list active resource managers and their
jobs.
+# * Add some magic to return complex perl data structures back from the
+# inner callback functions to the output callback
+# function. (nfreeze/base64_encode).
+# * Add "MPI watch" functionality to allow viewing of MPI state in a
+# vmstat like fashion.
+# * Add a --list-rmgrs option to list active resource managers and their
+# jobs.
# * Add support for "local-qsnet" as a way of launching jobs.
# * Add support for "local-fd" as a way of launching jobs.
# * Add support for "mpd" as a way of launching jobs.
-# * Add support for "lsf-rms" as a way of launching jobs. Note the
lsf/rms
-# integration means this is highly unlikely to work for everyone.
-# * Add a -Olsf-job-offset option for finding lsf jobs in the rms
database.
+# * Add support for "lsf-rms" as a way of launching jobs. Note the
+# lsf/rms integration means this is highly unlikely to work for
+# everyone.
+# * Add a -Olsf-job-offset option for finding lsf jobs in the rms
+# * database.
# * Support for MPI message queues as well as libelan queues (-Q)
# * Add a -Ominfo=<exe> option for finding the new minfo.x command.
# * Add a -Ompi-dll=<dll.so> option for overriding the debugger dll.
# * Extend the gdb handling code to allow further expansion in the future.
# * Make the strip-below and strip-above functions configurable.
-# * Add support for loading settings from the environment or a config
file.
-# * Add support for "local" as a resource manager to target hand-crafted
capabilities.
+# * Add support for loading settings from the environment or a config
+# file.
+# * Add support for "local" as a resource manager to target hand-crafted
+# capabilities.
# * Ignore case when matching stats names.
# * Correct printing of debug information from the inner.
# * Try and remove warnings when run with -w (still disabled)
# * Un-break it on slurm systems without RMS installed.
# * Preliminary threading support (courtesy of LLNL)
# * Show per-rail sdram usage of processes.
-# * Look at all descendant processes of slurmstepd rather than direct
descendants
-# and try and avoid scripts (perl/sh/bash/xterm)
-# * Use the new scontrol listpids and %A options to squeue for finding
processes
-# on slurm systems (1.2.0 and above).
+# * Look at all descendant processes of slurmstepd rather than direct
+# descendants and try and avoid scripts (perl/sh/bash/xterm)
+# * Use the new scontrol listpids and %A options to squeue for finding
+# processes on slurm systems (1.2.0 and above).
# * Don't show usage on command line errors.
-# * Only pass command line options onto the inner if it is going to
handle them
+# * Only pass command line options onto the inner if it is going to handle
+# * them
#
# Version 2.0
-# * Removed the -OscriptDir option as it's no longer used, use -Oedb
instead.
+# * Removed the -OscriptDir option as it's no longer used, use -Oedb
+# instead.
# * Corrected the way tally statistics were being added.
# * Added a --show-jobs option to show possible jobs in a resource manager
# independent way.
-# * Added a --local-stats option to show message statistics for all
processes
-# on the local node.
-# * Added a --proc-format option which allows specific entries from /proc
to be
-# reported on a per-vp basis.
-# * Ported to slurm only systems where the RMS kernel module isn't
present.
-# * Removed the padb-helper.pl file and folded it's functionality into
padb
-# itself. Padb is now self-contained.
+# * Added a --local-stats option to show message statistics for all
+# processes on the local node.
+# * Added a --proc-format option which allows specific entries from /proc
+# to be reported on a per-vp basis.
+# * Ported to slurm only systems where the RMS kernel module isn't
+# present.
+# * Removed the padb-helper.pl file and folded it's functionality into
+# padb itself. Padb is now self-contained.
# * Removed the padb.gdb file from the kit, it's generated at run-time if
# needed.
# * Various readability fixes and small performance improvements.
-# * Added a --kill option along with --signal which can be used to send
signals
-# to any process in the parallel job.
+# * Added a --kill option along with --signal which can be used to send
+# signals to any process in the parallel job.
#
# Version 1.6
-# * Add a --proc-info option to show the contents of files from /proc for
a
-# given rank
+# * Add a --proc-info option to show the contents of files from /proc for
+# a given rank
# * Increase the RMS_EXITTIMEOUT value from 10 to 30 seconds and make it a
# configuration option.
#
# Version 1.5
-# * Try and load edb from where padb is installed. This should allow it
to run
-# on elan3 systems where the qsnetdefault link is set to elan3.
-# * GNAT:8110 Proper use of English in the group deadlock detection
report.
-# * Target the correct process if there are multiple processes for each
vp.
-# Use the pid of the process which called elan_baseInit()
-# * GNAT 7945: Fix messages on stderr about integer overflow on 32 bit
machines
+# * Try and load edb from where padb is installed. This should allow it to
+# run on elan3 systems where the qsnetdefault link is set to elan3.
+# * GNAT:8110 Proper use of English in the group deadlock detection
+# report.
+# * Target the correct process if there are multiple processes for each
+# vp. Use the pid of the process which called elan_baseInit()
+# * GNAT 7945: Fix messages on stderr about integer overflow on 32 bit
+# machines
# * Remove warnings when -w is turned on.
-# * Re-work the stack trace tree generation code do work via a
intermediate
-# data structure to make the code easier to parse.
+# * Re-work the stack trace tree generation code do work via a
+# intermediate data structure to make the code easier to parse.
# * Report errors loading stats from a running job cleanly.
# * Better backwards compatibility with older RMS releases.
-# * Add a padb-treeview script to the release, this takes most of it's
code
-# from padb and uses tk to provide the user with a X based view of the
stack
-# traces.
+# * Add a padb-treeview script to the release, this takes most of it's
+# code from padb and uses tk to provide the user with a X based view of
+# the stack traces.
# * Changes to edb so the stats loading code can run on elan3 systems.
#
# Version 1.4
# * Bumped version number to 1.4
-# * Change the format of tree based stack traces, it now uses a more
logical
-# indention style.
+# * Change the format of tree based stack traces, it now uses a more
+# logical indention style.
# * Discover and report if application stats are incomplete.
-# * Allow the use of -r with -s to view statistics from an individual
process.
-# Update -S (which does the same thing) to parse the stats in padb as
well.
+# * Allow the use of -r with -s to view statistics from an individual
+# process. Update -S (which does the same thing) to parse the stats in
+# padb as well.
# * Improved error handling in the case where jobs complete whilst padb is
-# running, sample the job state before and after going parallel and do
the
-# right thing accordingly.
-# * Much improved error output, only report an error if something bad
happened.
+# running, sample the job state before and after going parallel and do
+# the right thing accordingly.
+# * Much improved error output, only report an error if something bad
+# happened.
# * Changes to the code as required to enable padb to run cleanly with
# warnings (-w) enabled.
# * Added a -Ostats-name= option to allow the extraction of one specific
@@ -156,43 +169,47 @@
# parallel to make it more resilient.
#
# Version 1.3
-# * Strip stack traces below main when possible, add a
--nostrip-below-main
-# option to turn this off.
+# * Strip stack traces below main when possible, add a
+# --nostrip-below-main option to turn this off.
# * Strip stack traces above elan_waitWord when possible, add a
# --nostrip-above-wait option to turn this off.
-# * Added a -Ogdb-retry-count=N option. Defaults to three as before but
is now
-# tunable.
-# * Parse communication statistics in padb directly now rather then
relying on
-# edb to do it for us
+# * Added a -Ogdb-retry-count=N option. Defaults to three as before but is
+# now tunable.
+# * Parse communication statistics in padb directly now rather then
+# relying on edb to do it for us
# * Allow reading of stats from file (-s -i )
# * Perform group deadlock detection in padb directly rather than in edb,
# improved the output and handling of corner cases.
-# * Initial version of a "one process per line" method of statistics
reporting.
-# * Better catching and reporting of errors when running parallel
programs.
+# * Initial version of a "one process per line" method of statistics
+# reporting.
+# * Better catching and reporting of errors when running parallel
+# programs.
# * Bumped the version number to 1.3
#
# Version 1.2
-# * Converted padb to use long command line options. The short ones still
work
-# but now have long alternatives
-# * Removed the need to set -OscriptDir= when running in non-default
locations
-# * Added a --full-report=<jobId> option to gather all possible
information
+# * Converted padb to use long command line options. The short ones still
+# work but now have long alternatives
+# * Removed the need to set -OscriptDir= when running in non-default
+# locations
+# * Added a --full-report=<jobId> option to gather all possible
+# information
# * General tidy ups in the stack trace tree generation code.
-# * Now reports processes that aren't present when generating stack
traces.
-# * Now reports errors properly when there are errors launching the
parallel
-# job
+# * Now reports processes that aren't present when generating stack
+# traces.
+# * Now reports errors properly when there are errors launching the
+# parallel job
# * Calls edb directly rather than using a helper script when possible
# (statistics reports).
# * Incremented version number from 1.0 to 1.2.
#
-
# TODO:
#
# * More testing with -w turned on.
# * Multi-pass argument handling, --kill also accepts --signal for example,
-# this should really be done at the getopt layer. Also proper usage
-# info for these secondary args.
-# * Paramater checking of secondary args, signal has a hacky
implementation and
-# port-range doesn't have any checking currently.
+# this should really be done at the getopt layer. Also proper usage info
+# for these secondary args.
+# * Paramater checking of secondary args, signal has a hacky implementation
+# and port-range doesn't have any checking currently.
# * libunwind support? lighter weight than gdb and possibly more reliable.
# * Maybe PMI would help?
# * POD? generated man page?
@@ -204,6 +221,7 @@
###############################################################################
+use warnings;
use strict;
use Getopt::Long;
use File::Basename;
@@ -250,17 +268,18 @@
# Main.
my $prog = basename $0;
-my $version = "3.0-rc1";
+my $version = '3.0-rc1';
my %conf;
my $secret;
-# Config options the inner knows about, only forward options if they are
in this list.
-my @inner_conf = qw(edb edbopt minfo rmgr scripts slurm_job_step verbose);
-
-# More config options the inner knows about, these are forwarded on the
command line
-# rather than over the sockets.
+# Config options the inner knows about, only forward options if they are in
+# this list.
+my @inner_conf = qw(edb edbopt minfo rmgr scripts slurm_job_step);
+
+# More config options the inner knows about, these are forwarded on the
+# command line rather than over the sockets.
my @inner_conf_cmd = qw(port_range outer);
###############################################################################
@@ -270,8 +289,8 @@
###############################################################################
# A hash of supported resource managers, each of which provides a number of
-# functions for querying the state of the machine. This keeps the core
-# of the code tidy. Note that this is only for the "outer" instance of
the
+# functions for querying the state of the machine. This keeps the core of
+# the code tidy. Note that this is only for the "outer" instance of the
# program, the inner version does things differently.
# Function Args Returns Required Description
@@ -288,70 +307,70 @@
my %rmgr;
$rmgr{rms} = {
- 'is_installed' => \&rms_is_installed,
- 'get_active_jobs' => \&rms_get_jobs,
- 'job_is_running' => \&rms_job_is_running,
- 'job_to_key' => \&rms_job_to_key,
- 'setup_pcmd' => \&rms_setup_pcmd,
- 'find_pids' => \&rms_find_pids,
+ is_installed => \&rms_is_installed,
+ get_active_jobs => \&rms_get_jobs,
+ job_is_running => \&rms_job_is_running,
+ job_to_key => \&rms_job_to_key,
+ setup_pcmd => \&rms_setup_pcmd,
+ find_pids => \&rms_find_pids,
};
$rmgr{mpd} = {
- 'is_installed' => \&mpd_is_installed,
- 'get_active_jobs' => \&mpd_get_jobs,
- 'setup_pcmd' => \&mpd_setup_pcmd,
- 'cleanup_pcmd' => \&mpd_cleanup_pcmd,
- 'find_pids' => \&mpd_find_pids,
- 'require_inner_callback' => 1,
+ is_installed => \&mpd_is_installed,
+ get_active_jobs => \&mpd_get_jobs,
+ setup_pcmd => \&mpd_setup_pcmd,
+ cleanup_pcmd => \&mpd_cleanup_pcmd,
+ find_pids => \&mpd_find_pids,
+ require_inner_callback => 1,
};
$rmgr{orte} = {
- 'is_installed' => \&open_is_installed,
- 'get_active_jobs' => \&open_get_jobs,
- 'setup_pcmd' => \&open_setup_pcmd,
- 'cleanup_pcmd' => \&open_cleanup_pcmd,
- 'find_pids' => \&open_find_pids,
+ is_installed => \&open_is_installed,
+ get_active_jobs => \&open_get_jobs,
+ setup_pcmd => \&open_setup_pcmd,
+ cleanup_pcmd => \&open_cleanup_pcmd,
+ find_pids => \&open_find_pids,
};
-$rmgr{"lsf-rms"} = {
- 'is_installed' => \&lsf_is_installed,
- 'get_active_jobs' => \&lsf_get_jobs,
- 'setup_pcmd' => \&lsf_setup_pcmd,
- 'inner_rmgr' => "rms",
+$rmgr{'lsf-rms'} = {
+ is_installed => \&lsf_is_installed,
+ get_active_jobs => \&lsf_get_jobs,
+ setup_pcmd => \&lsf_setup_pcmd,
+ inner_rmgr => 'rms',
};
$rmgr{slurm} = {
- 'is_installed' => \&slurm_is_installed,
- 'get_active_jobs' => \&slurm_get_jobs,
- 'job_is_running' => \&slurm_job_is_running,
- 'setup_pcmd' => \&slurm_setup_pcmd,
- 'find_pids' => \&slurm_find_pids,
- 'require_inner_callback' => 1,
+ is_installed => \&slurm_is_installed,
+ get_active_jobs => \&slurm_get_jobs,
+ job_is_running => \&slurm_job_is_running,
+ setup_pcmd => \&slurm_setup_pcmd,
+ find_pids => \&slurm_find_pids,
+ require_inner_callback => 1,
};
$rmgr{local} = {
- 'get_active_jobs' => \&local_get_jobs,
- 'job_is_running' => \&local_job_is_running,
- 'setup_pcmd' => \&local_setup_pcmd,
- 'find_pids' => \&local_find_pids,
- 'require_inner_callback' => 1,
+ get_active_jobs => \&local_get_jobs,
+ job_is_running => \&local_job_is_running,
+ setup_pcmd => \&local_setup_pcmd,
+ find_pids => \&local_find_pids,
+ require_inner_callback => 1,
};
-$rmgr{"local-qsnet"} = {
- 'is_installed' => \&local_q_is_installed,
- 'get_active_jobs' => \&local_q_get_jobs,
- 'job_is_running' => \&local_job_is_running,
- 'setup_pcmd' => \&local_setup_pcmd,
- 'inner_rmgr' => "local",
- 'require_inner_callback' => 1,
+$rmgr{'local-qsnet'} = {
+ is_installed => \&local_q_is_installed,
+ get_active_jobs => \&local_q_get_jobs,
+ job_is_running => \&local_job_is_running,
+ setup_pcmd => \&local_setup_pcmd,
+ inner_rmgr => 'local',
+ require_inner_callback => 1,
};
-$rmgr{"local-fd"} = {
- 'get_active_jobs' => \&local_fd_get_jobs,
- 'job_is_running' => \&local_job_is_running,
- 'setup_pcmd' => \&local_setup_pcmd,
- 'inner_rmgr' => "local",
- 'require_inner_callback' => 1,
+$rmgr{'local-fd'} = {
+ get_active_jobs => \&local_fd_get_jobs,
+ job_is_running => \&local_job_is_running,
+ setup_pcmd => \&local_setup_pcmd,
+ inner_rmgr => 'local',
+ require_inner_callback => 1,
};
###############################################################################
@@ -360,11 +379,11 @@
#
###############################################################################
-# If changing any of these defaults also check the inner code as some
-# of these settings affect that program as well and padb will only
-# pass on settings on the command line, not the entire config hash.
-# The reason they are listed here as well is so that padb -O help
-# works and gives the correct defaults.
+# If changing any of these defaults also check the inner code as some of
+# these settings affect that program as well and padb will only pass on
+# settings on the command line, not the entire config hash. The reason
+# they are listed here as well is so that padb -O help works and gives the
+# correct defaults.
my %allfns;
@@ -376,33 +395,32 @@
# Debug options.
$conf{verbose} = 0;
-# Valid values are "none" "missing" or "all". Anything not recognised
-# is treated as "all".
-$conf{check_signon} = "all";
+# Valid values are "none" "missing" or "all". Anything not recognised is
+# treated as "all".
+$conf{check_signon} = 'all';
# Output options.
-$conf{interval} = 10;
-$conf{watch_clears_screen} = 1;
-$conf{scripts} = "bash,sh,dash,ash,perl,xterm";
+$conf{interval} = '10s';
+$conf{watch_clears_screen} = 'enabled';
+$conf{scripts} = 'bash,sh,dash,ash,perl,xterm';
$conf{lsf_job_offset} = 1;
-$conf{local_fd_name} = "/dev/null";
-$conf{inner_callback} = 0;
-
-# These two are used by deadlock and QsNet group
-# code, they need migrating in the group code
-# when I have access to a test system again.
+$conf{local_fd_name} = '/dev/null';
+$conf{inner_callback} = 'disabled';
+
+# These two are used by deadlock and QsNet group code, they need migrating
+# in the group code when I have access to a test system again.
#$conf{"show-group-members"} = 0;
#$conf{"show-all-groups"} = 0;
# Tuning options.
-$conf{prun_timeout} = 120;
-$conf{prun_exittimeout} = 120;
+$conf{prun_timeout} = '2m';
+$conf{prun_exittimeout} = '2m';
$conf{rmgr} = undef;
$conf{slurm_job_step} = 0;
# These settings are passed onto inner only.
-$conf{edbopt} = "";
+$conf{edbopt} = undef;
$conf{edb} = find_edb();
$conf{minfo} = find_minfo();
@@ -410,18 +428,104 @@
# Option to define a list of ports used by padb.
$conf{port_range} = undef;
-$conf{tree_width} = 4;
+$conf{tree_width} = '4';
+
+# Config options which take boolean values.
+my @conf_bool = qw(watch_clears_screen inner_callback);
+
+# Config options which take a time value.
+my @conf_time = qw(prun_exittimeout prun_timeout interval);
+
+# Config options which take an integer.
+my @conf_int = qw(lsf_job_offset slurm_job_step tree_width);
my $norc = 0;
-my $configfile = "/etc/padb.conf";
+my $configfile = '/etc/padb.conf';
+
+# Standard regexpes for splitting on comma, equals and spaces. Note the
+# space regexp matches multiple whitespace characters.
+my $COMMA = qr{,}x;
+my $EQUALS = qr{=}x;
+my $SPACE = qr{\s+}x;
+my $COLON = qr{:}x;
+
+my $EMPTY_STRING = q{};
+
+# Enable sorting in Data::Dumper for clarity.
+$Data::Dumper::Sortkeys = 1;
+$Data::Dumper::Quotekeys = 0;
+
+sub check_and_convert_bool {
+ my ($str) = @_;
+ my @yes = qw(1 yes on enabled);
+ my @no = qw(0 no off disabled);
+ my %bool_table;
+ map { $bool_table{$_} = 1 } @yes;
+ map { $bool_table{$_} = 0 } @no;
+
+ if ( defined $bool_table{$str} ) {
+ return $bool_table{$str};
+ }
+ printf {*STDERR} "Boolean value \"%s\" not recognised, aborting.\n",
$str;
+ exit 1;
+}
+
+sub check_and_convert_time {
+ my ($str) = @_;
+ if (
+ $str =~ m{\A # Start of line
+ (\d+) # A number
+ (s|m)? # With an option s or m suffix.
+ \z}x
+ )
+ {
+ if ( defined $2 and $2 eq 'm' ) {
+ return $1 * 60;
+ }
+ return $1;
+ }
+ printf {*STDERR} "Time value \"%s\" not recognised, aborting.\n", $str;
+ exit 1;
+}
+
+sub check_int {
+ my ($str) = @_;
+
+ return
+ if (
+ $str =~ m{\A # Start of line
+ \d+ # A number
+ \z}x
+ );
+
+ printf {*STDERR} "Integer value \"%s\" not recognised, aborting.\n",
$str;
+ exit 1;
+}
+
+sub check_signal {
+ my ($signal) = @_;
+
+ my $s = uc $signal;
+ my %sig_names;
+ foreach ( split $SPACE, $Config{sig_name} ) {
+ $sig_names{$_} = 1;
+ }
+
+ if ( not defined $sig_names{$s} ) {
+ printf {*STDERR} "Error: signal \"%s\" is invalid, aborting.\n",
+ $signal;
+ exit 1;
+ }
+ return $s;
+}
# Look for edb in the default install location only.
sub find_edb {
- return "/usr/lib/qsnet/elan4/bin/"
- if ( -d "/usr/lib/qsnet/elan4/bin/" );
- return "/usr/lib64/qsnet/elan4/bin/"
- if ( -d "/usr/lib64/qsnet/elan4/bin/" );
- return "edb";
+ return '/usr/lib/qsnet/elan4/bin/'
+ if ( -d '/usr/lib/qsnet/elan4/bin/' );
+ return '/usr/lib64/qsnet/elan4/bin/'
+ if ( -d '/usr/lib64/qsnet/elan4/bin/' );
+ return 'edb';
}
# Look for minfo.x in the same directory as padb.
@@ -437,13 +541,13 @@
###############################################################################
sub show_version {
- printf("$prog version $version\n\n");
- printf("Written by Ashley Pittman\n");
- printf("http://padb.pittman.org.uk\n");
+ print "$prog version $version\n\n";
+ print "Written by Ashley Pittman\n";
+ print "http://padb.pittman.org.uk\n";
exit 0;
}
-my $usage = <<EOF;
+my $usage = <<'EOF';
Usage: padb [-hv] [-c|-C|-t] -g|-q|-s|-x|-X [-O <opt>=<val>
[,<opt>=<val>...]] [-i <file>] [-r <rank>] [-u <user>]
-a|-A|<jobid ...>
@@ -458,8 +562,8 @@
XXXX
--full-report=<JOBID> Generate a full report of job state.
- --nostrip-below-main Don\'t strip stack traces below main.
- --nostrip-above-wait Don\'t strip stack traces about elan_waitWord.
+ --no-strip-below-main Don't strip stack traces below main.
+ --no-strip-above-wait Don't strip stack traces about elan_waitWord.
--proc-format Specify information to show about processes.
@@ -505,45 +609,45 @@
-v --verbose Verbose.
-V --version Show version number and exit.
-h --help print this usage message.
+
EOF
sub usage {
chomp $usage;
- my $extra = "";
+ my $extra = $EMPTY_STRING;
$extra .= "Modes of operation\n";
- foreach my $arg ( sort( keys %allfns ) ) {
+ foreach my $arg ( sort keys %allfns ) {
next unless ( defined $allfns{$arg}{help} );
next if ( defined $allfns{$arg}{qsnet} );
if ( defined $allfns{$arg}{arg_short} ) {
$extra .= "-$allfns{$arg}{arg_short}";
} else {
- $extra .= " ";
- }
- $extra .= sprintf( " --%-18s%s.\n",
- $allfns{$arg}{arg_long},
- $allfns{$arg}{help} );
+ $extra .= ' ';
+ }
+ $extra .= sprintf " --%-18s%s.\n",
+ $allfns{$arg}{arg_long},
+ $allfns{$arg}{help};
}
$extra .= "\nQsNet specific modes\n";
- foreach my $arg ( sort( keys %allfns ) ) {
+ foreach my $arg ( sort keys %allfns ) {
next unless ( defined $allfns{$arg}{help} );
next unless ( defined $allfns{$arg}{qsnet} );
if ( defined $allfns{$arg}{arg_short} ) {
$extra .= "-$allfns{$arg}{arg_short}";
} else {
- $extra .= " ";
- }
- $extra .= sprintf( " --%-18s%s.\n",
- $allfns{$arg}{arg_long},
- $allfns{$arg}{help} );
+ $extra .= ' ';
+ }
+ $extra .= sprintf " --%-18s%s.\n",
+ $allfns{$arg}{arg_long},
+ $allfns{$arg}{help};
}
- $usage =~ s!XXXX!$extra!;
-
- print STDERR <<EOF;
-$usage
-EOF
+ $usage =~ s{XXXX}
+ {$extra}xms;
+
+ print {*STDERR} $usage;
exit 1;
}
@@ -553,7 +657,7 @@
#
###############################################################################
-my $user = getpwuid($<);
+my $target_user = getpwuid $<;
my $rank_rng;
my @target_groups;
@@ -574,143 +678,229 @@
my $exe_name;
my $input_file;
-my $compress;
-my $compress_C;
-my $tree;
-
-my @config_options;
+my $output_compress;
+my $output_compress_long;
+my $output_tree;
+
+my %config_options;
my %ic_names;
my %ic_names_cmd;
-# Populated in the outer args section so that outer code
-# can access secondary comamnd line argunments by name.
-my %secondary_args;
-
-# Debugging: this function is called periodically with
-# a mode, an abritary ref and a string, it can either print simply
-# the string or call dumper on the ref as well.
-# Enable with --debug=type1,type2=all
-my %debugModes;
-my $start_time = time();
+# Debugging: this function is called periodically with a mode, an abritary
+# ref and a string, it can either print simply the string or call dumper on
+# the ref as well. Enable with --debug=type1,type2=all
+my %debug_modes;
+my $start_time = time;
sub debug_log {
my ( $type, $handle, $str, @params ) = @_;
- if ( not exists $debugModes{$type} ) {
- printf("Unknown debug mode: $type\n");
- exit(1);
- }
- return unless $debugModes{$type};
- my $time = time() - $start_time;
- printf( "DEBUG ($type): %3d: $str\n", $time, @params );
- return if $debugModes{$type} eq "basic";
+ if ( not exists $debug_modes{$type} ) {
+ print "Unknown debug mode: $type\n";
+ exit 1;
+ }
+ return unless $debug_modes{$type};
+ my $time = time - $start_time;
+ printf "DEBUG ($type): %3d: $str\n", $time, @params;
+ return if $debug_modes{$type} eq 'basic';
return unless defined $handle;
- print Dumper $handle;
+ print Data::Dumper->Dump( [$handle], [$type] );
+ return;
}
# Valid debug modes, a full list is maintained here so using unexpected
# ones can generate warnings.
-$debugModes{full_duplex} = undef;
-$debugModes{show_cmd} = undef;
-$debugModes{all} = undef;
-$debugModes{tree} = undef;
-$debugModes{verbose} = undef;
-$debugModes{signon} = undef;
-$debugModes{rmgr} = undef;
-$debugModes{ctree} = undef;
-$debugModes{tdata} = undef;
+$debug_modes{full_duplex} = undef;
+$debug_modes{show_cmd} = undef;
+$debug_modes{all} = undef;
+$debug_modes{tree} = undef;
+$debug_modes{verbose} = undef;
+$debug_modes{signon} = undef;
+$debug_modes{rmgr} = undef;
+$debug_modes{ctree} = undef;
+$debug_modes{tdata} = undef;
+$debug_modes{config} = undef;
+
+sub slurp_file {
+ my ($file) = @_;
+ open my $FD, '<', $file or return;
+ my @contents = <$FD>;
+ close $FD;
+ return @contents;
+}
+
+sub slurp_cmd {
+ my ($cmd) = @_;
+ open my $CFD, '-|', "$cmd 2>/dev/null" or return;
+ my @out = <$CFD>;
+ close $CFD;
+ return @out;
+}
+
+sub slurp_dir {
+ my ($dir) = @_;
+ opendir my $DIR, $dir or return;
+ my @files = readdir $DIR;
+ closedir $DIR;
+ return @files;
+}
+
+sub get_process_list {
+ my ($user) = @_;
+ my $uid = getpwnam $user;
+ return unless defined $uid;
+ my @pids = slurp_dir('/proc');
+ my @userpids;
+ foreach my $pid (@pids) {
+ next unless ( $pid =~ m{\A\d+\z}xms );
+ my ( undef, undef, undef, undef, $owner ) = stat "/proc/$pid";
+
+ # Check the stat worked, it's possible for processes to dissapear
+ # Take care to check for defined rather than true as root has a uid
+ # of zero.
+ next unless defined $owner;
+ next unless $owner == $uid;
+ push @userpids, $pid;
+ }
+ return @userpids;
+}
sub parse_args_outer {
- Getopt::Long::Configure("bundling");
+ Getopt::Long::Configure( 'bundling', 'pass_through' );
my $debugflag;
my @ranks;
my %optionhash = (
- "verbose|v+" => \$conf{verbose},
- "user|u=s" => \$user,
- "rank|r=s" => \@ranks,
- "group-id=s" => \@target_groups,
- "help|h" => \&usage,
- "all|a" => \$all,
- "any|A" => \$any,
- "version|V" => \&show_version,
- "compress|c" => \$compress,
- "compress-long|C" => \$compress_C,
- "tree|t" => \$tree,
- "input-file|file|i=s" => \$input_file,
- "config-option|O=s" => \@config_options,
- "full-report=s" => \$full_report,
- "core-stack" => \$core_stack,
- "core=s" => \$core_name,
- "exe=s" => \$exe_name,
- "list-rmgrs" => \$list_rmgrs,
- "watch" => \$watch,
- "local-stats" => \$local_stats,
- "show-jobs" => \$show_jobs,
- "norc" => \$norc,
- "config-file=s" => \$configfile,
- "debug=s" => \$debugflag,
+ 'verbose|v+' => \$conf{verbose},
+ 'user|u=s' => \$target_user,
+ 'rank|r=s' => \@ranks,
+ 'group-id=s' => \@target_groups,
+ 'help|h' => \&usage,
+ 'all|a' => \$all,
+ 'any|A' => \$any,
+ 'version|V' => \&show_version,
+ 'compress|c' => \$output_compress,
+ 'compress-long|C' => \$output_compress_long,
+ 'tree|t' => \$output_tree,
+ 'input-file|file|i=s' => \$input_file,
+ 'full-report=s' => \$full_report,
+ 'core-stack' => \$core_stack,
+ 'core=s' => \$core_name,
+ 'exe=s' => \$exe_name,
+ 'list-rmgrs' => \$list_rmgrs,
+ 'watch' => \$watch,
+ 'local-stats' => \$local_stats,
+ 'show-jobs' => \$show_jobs,
+ 'norc' => \$norc,
+ 'config-file=s' => \$configfile,
+ 'debug=s' => \$debugflag,
);
+ # The primary modes, one of these only must be set.
my %config_hash;
+
foreach my $arg ( keys %allfns ) {
- $optionhash{ $allfns{$arg}{arg} } = \$config_hash{$arg};
- if ( defined $allfns{$arg}{secondary} ) {
- foreach my $sec ( @{ $allfns{$arg}{secondary} } ) {
- $sec->{value} = $sec->{default};
- $optionhash{ $sec->{arg} } = \$sec->{value};
- }
- }
- if ( defined $allfns{$arg}{options_i} ) {
- foreach my $o ( keys( %{ $allfns{$arg}{options_i} } ) ) {
- $conf{mode_options}{$arg}{$o} =
$allfns{$arg}{options_i}{$o};
- $conf{mode_options_reverse}{$o}{$arg} = 1;
- }
+
+ # Set the primary mode in the hash.
+ $optionhash{ to_arg( $allfns{$arg} ) } = \$config_hash{$arg};
+ }
+
+ # Parse the options once to pick up the mode and any single letter
+ # options which might be bundled with it.
+ GetOptions(%optionhash);
+
+ Getopt::Long::Configure( 'default', 'bundling' );
+
+ my $mode;
+
+ foreach my $arg ( keys %config_hash ) {
+ next unless defined $config_hash{$arg};
+ $mode = $arg;
+ $have_allfns_option++;
+ }
+
+ # The secondary args, specify all of them for now as we only call
+ # GetOptions once.
+ my %sec_args;
+
+ # Set any extra options this mode may or may not accept.
+ if ( defined $mode and defined $allfns{$mode}{secondary} ) {
+ foreach my $sec ( @{ $allfns{$mode}{secondary} } ) {
+ $optionhash{ to_arg($sec) } = \$sec_args{ $sec->{arg_long} };
}
}
- GetOptions(%optionhash) or exit(1);
+ # Set this for the second iteration only so that GetOptions can abort
+ # correctly if they are called without a value.
+ $optionhash{'config-option|O=s'} = \%config_options;
+
+ GetOptions(%optionhash) or exit 1;
if ( defined $debugflag ) {
- foreach my $f ( split( ",", $debugflag ) ) {
- my ( $name, $v ) = split( "=", $f );
- if ( exists $debugModes{$name} ) {
- $debugModes{$name} = defined($v) ? $v : "basic";
+ foreach my $f ( split $COMMA, $debugflag ) {
+ my ( $name, $v ) = split $EQUALS, $f;
+ if ( exists $debug_modes{$name} ) {
+ $debug_modes{$name} = defined $v ? $v : 'basic';
} else {
- printf("Attempt to set unknown debug flag \"$name\".\n");
+ print "Attempt to set unknown debug flag \"$name\".\n";
}
}
- if ( $debugModes{all} ) {
- foreach my $mode ( keys(%debugModes) ) {
- if ( not defined $debugModes{$mode} ) {
- $debugModes{$mode} = $debugModes{all};
+ if ( $debug_modes{all} ) {
+ foreach my $mode ( keys %debug_modes ) {
+ if ( not defined $debug_modes{$mode} ) {
+ $debug_modes{$mode} = $debug_modes{all};
}
}
}
}
-
- my $mode;
-
- foreach my $arg ( keys %config_hash ) {
- next unless defined $config_hash{$arg};
- $mode = $arg;
- $have_allfns_option++;
- }
if (@ranks) {
- $rank_rng = rng_convert_from_user( shift(@ranks) );
+ $rank_rng = rng_convert_from_user( shift @ranks );
foreach my $rank (@ranks) {
rng_merge( $rank_rng, rng_convert_from_user($rank) );
}
}
***The diff for this file has been truncated for email.***
More information about the padb-devel
mailing list