From: Andrew Deason Date: Fri, 21 Jan 2011 23:38:24 +0000 (-0600) Subject: Add afsload X-Git-Tag: openafs-devel-1_7_1~321 X-Git-Url: https://git.openafs.org/?p=openafs.git;a=commitdiff_plain;h=bbd505a8e191f69179f8dc245e0d7f96310db275 Add afsload Add afsload, a set of scripts used to synchronize the activity of numerous libuafs cache managers for testing/simulation purposes. Change-Id: I6f797d5968ea4ba3c29c1b13251f743c7d02d60d Reviewed-on: http://gerrit.openafs.org/4906 Tested-by: Derrick Brashear Reviewed-by: Derrick Brashear --- diff --git a/src/libuafs/afsload/README b/src/libuafs/afsload/README new file mode 100644 index 0000000..92ac8bf --- /dev/null +++ b/src/libuafs/afsload/README @@ -0,0 +1,69 @@ +afsload Prerequisites: + +- Text::ParseWords +- Number::Format +- Parallel::MPI::Simple (0.03) +- AFS::ukernel + +Text::ParseWords +-- + +This comes with Perl on most systems I've tried. But if it's not on yours, +you can get with from CPAN. + +Number::Format +-- + +This can be obtained from CPAN; nothing special required. + +Parallel::MPI::Simple +-- + +Before you install this, you must have some MPI implementation installed. Note +that you must compile Parallel::MPI::Simple against the same MPI implementation +that you run 'afsload' against. + +For OpenMPI, this involves installing the packages openmpi, openmpi-devel, and +openmpi-libs on RHEL5. For Debian Lenny, install openmpi-bin, openmpi-common, +libopenmpi1, libopenmpi-dev, and openmpi-doc if you want it. + +Now, Parallel::MPI::Simple itself you can get from CPAN, but the build process +requires some massaging. Download and unpack the source tarball manually, and +build like so. + +On RHEL5 with OpenMPI: + +$ perl Makefile.PL CCFLAGS=-I/usr/lib64/openmpi/1.4-gcc/include/ LIBS='-L/usr/lib64/openmpi/1.4-gcc/lib -Wl,-R/usr/lib64/openmpi/1.4-gcc/lib -lmpi' + +On Debian: + +$ perl Makefile.PL CCFLAGS=-I/usr/include/mpi + +then just 'make'/'make install' as normal. + +AFS::ukernel +-- + +To get this, you need to build OpenAFS on a machine that has SWiG +installed. If you build as normal when SWiG is installed, the module +will show up in $sysname/dest/root.perf/lib/perl for transarc paths. You +just need to put that somewhere in perl's @INC so perl can find it. (A +couple examples are /usr/lib/perl5/site_perl/5.8.8/ on RHEL5 and +/usr/local/lib/perl/5.10.0/ on Debian Lenny). + +afsload itself +-- + +Copy the contents of lib/ to /usr/local/lib/afsload/perl/. The files +afsload_run.pl and afsload_check.pl should go in /usr/local/lib/afsload/. The +'afsload' script can be copied to somewhere in your PATH. + +Running afsload may require setting the MPIRUN and LIBMPI environment +variables. On RHEL5 with OpenMPI, you probably want to run with the following +environment variables set: + +MPIRUN=/usr/lib64/openmpi/1.4-gcc/bin/mpirun +LIBMPI=/usr/lib64/openmpi/1.4-gcc/lib/libmpi.so.0 + +or configure the box such that running 'mpirun' runs that mpirun, and +/usr/lib/libmpi.so points to that libmpi.so.0. diff --git a/src/libuafs/afsload/afsload b/src/libuafs/afsload/afsload new file mode 100755 index 0000000..6ee0cdb --- /dev/null +++ b/src/libuafs/afsload/afsload @@ -0,0 +1,63 @@ +#!/bin/bash + +ALDIR="/usr/local/lib/afsload" +ALCHECK="$ALDIR/afsload_check.pl" +ALRUN="$ALDIR/afsload_run.pl" +ALPERL="perl -I$ALDIR/perl" + +if [ "x$MPIRUN" = "x" ] ; then + MPIRUN="mpirun" +fi +if [ "x$LIBMPI" = "x" ] ; then + LIBMPI="/usr/lib/libmpi.so" +fi + +usage() { + echo "Usage: $0 [-q] -p -t " >&2 + echo -e "\t-q\tquiet/quick (do not test conf consistency)" >&2 + echo -e "\t-p\tnumber of nodes/processes to run" >&2 + echo -e "\t-t\ttest configuration" >&2 + echo >&2 + exit 1 +} + +while getopts qp:t: opt ; do + case "$opt" in + q) quiet=1;; + p) procs="$OPTARG";; + t) conf="$OPTARG";; + [?]) usage;; + esac +done + +if [ "x$procs" = "x" ] || [ "x$conf" = "x" ] ; then + usage +fi + +procs=$((procs + 1)) + +if [ "x$quiet" = "x" ] ; then + if $ALPERL "$ALCHECK" -p "$procs" "$conf" ; then + : + else + exit 2 + fi +fi + +if which "$MPIRUN" >/dev/null 2>&1 ; then + : +else + echo >&2 + echo "Cannot find $MPIRUN; set the MPIRUN environment variable to " >&2 + echo "the mpirun command we should use." >&2 + exit 1 +fi + +if [ ! -f "$LIBMPI" ] ; then + echo >&2 + echo "Cannot find $LIBMPI; set the LIBMPI environment variable to " >&2 + echo "the libmpi.so that we should run against." >&2 + exit 1 +fi + +"$MPIRUN" -np "$procs" /bin/sh -c "LD_PRELOAD=$LIBMPI $ALPERL $ALRUN $conf" diff --git a/src/libuafs/afsload/afsload.pod b/src/libuafs/afsload/afsload.pod new file mode 100644 index 0000000..d7ed894 --- /dev/null +++ b/src/libuafs/afsload/afsload.pod @@ -0,0 +1,114 @@ +=head1 NAME + +afsload - AFS client load simulator + +=head1 SYNOPSYS + +B [B<-q>] B<-p> > B<-t> > + +=head1 DESCRIPTION + +afsload consists of a few scripts that can simulate several AFS clients +accessing AFS, for the purposes of simulating load on a fileserver or +general AFS cell infrastructure. The access to AFS is done via libuafs, +and the synchronization between nodes is done via MPI. + +The actual AFS actions performed depends on the contents of the given test +configuration file. See the documentation for L for the +format of the contents of that file. + +=head1 OPTIONS + +=over 4 + +=item B<-q> + +Enables "quiet" or "quick" mode. Normally the configuration file +specified is checked for validity. If you don't like the extra output +the checker gives, or you want to try to run a test configuration even +if it specifies errors, give this option. + +=item B<-p> > + +This dictates how many client nodes to run as part of the test run. Note +that the actual number of processes is a bit higher than this; this +specifies how many clients to simulate. + +=item B<-t> > + +This specifies the test configuration to use. See the documentation for +L and L for details on the +contents of this file. + +=back + +=head1 OUTPUT + +The output is in TAP format. Each step defined in the test configuration +is a single TAP test. If any node during that step fails, the test fails +and diagnostic information is printed. Each step is just identified by +the order it appears in the configuration file, unless the test +configuration gives that step a name. In which case, the given name also +identifies that step. + +Example output: + + $ afsload -p 20 -t test.conf + # Checking if config test.conf is valid for 21 processes... + # Config file test.conf has no fatal errors + 1..6 + ok 1 - Step 1 + ok 2 - Step 2 + not ok 3 - Step 3: Read contents of foo + # Failed test 'Step 3: Read contents of foo' + # in /usr/local/lib/afsload/afsload_run.pl at line 127. + # node 2 failed: + # On action 2: read(foo) + # errno: 2 + # error code: -1 + # error string: got: foo contents, expected: bad contents + ok 4 - Step 4 + ok 5 - Step 5 + ok 6 - Step 6 + # Looks like you failed 1 test of 6. + +Each failure tells you which action failed, and the errno, error code, +and error string the action failed with. The error code and error +string provided are up to each individual action (see +L), but errno is always just the errno value +immediately after the action failed. + +=head1 ENVIRONMENT + +B makes use of these environment variables: + +=over 4 + +=item MPIRUN + +Name or location of the B binary to run. This must match the MPI +implementation that the Parallel::MPI::Simple Perl module was compiled +against that afsload will use. + +Defaults to C if not specified. + +=item LIBMPI + +Location of the C library that we will be using. Due to +limitations of some MPI implementations and Perl XS modules, this +sometimes may need to be preloaded before running the MPI portion of +B. + +Defaults to C if not specified. + +=back + +=head1 AUTHORS + +Andrew Deason Eadeason@sinenomine.netE, Sine Nomine Associates. + +=head1 COPYRIGHT + +Copyright 2010-2011 Sine Nomine Associates. + +=cut diff --git a/src/libuafs/afsload/afsload_check.pl b/src/libuafs/afsload/afsload_check.pl new file mode 100755 index 0000000..c6a773c --- /dev/null +++ b/src/libuafs/afsload/afsload_check.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w + +use strict; + +use AFS::Load::Config; + +sub usage() { + print STDERR "Usage: $0 -p "; + exit(1); +} + +if ($#ARGV < 2) { + usage(); +} + +my $flag = $ARGV[0]; +my $np = $ARGV[1]; +my $conf_file = $ARGV[2]; + +if ($flag ne "-p") { + usage(); +} +if (!($np =~ m/^\d+$/)) { + usage(); +} + +print "# Checking if config $conf_file is valid for $np processes...\n"; + +AFS::Load::Config::check_conf($np, $conf_file); + +print "# Config file $conf_file has no fatal errors\n"; diff --git a/src/libuafs/afsload/afsload_run.pl b/src/libuafs/afsload/afsload_run.pl new file mode 100755 index 0000000..b5ee90f --- /dev/null +++ b/src/libuafs/afsload/afsload_run.pl @@ -0,0 +1,149 @@ +#!/usr/bin/perl -w + +use strict; + +use Parallel::MPI::Simple; + +use AFS::Load::Config; + +my @steps = (); +my %nodeconf = ( + 'logfile' => '/dev/null', + 'afsconfig' => '-cachedir cache.afsload.$RANK', +); + +MPI_Init(); + +if ($#ARGV < 0) { + print STDERR "Usage: $0 \n"; + exit(1); +} +my $conf_file = $ARGV[0]; + +my $rank = MPI_Comm_rank(MPI_COMM_WORLD); +my $size = MPI_Comm_size(MPI_COMM_WORLD); + +if ($size < 2) { + die("We only have $size processes; we must have at least 2 for a\n". + "director and at least one client node\n"); +} + +# $rank-1, because the 'director' has rank 0, and node rank 1 is specified as +# "node 0" in the configuration file. +AFS::Load::Config::load_conf($rank-1, $conf_file, \@steps, \%nodeconf) + or die("Error parsing configuration file\n"); + +if (scalar @steps < 1) { + die("No steps defined in the test config; nothing to run?\n"); +} + +if ($rank == 0) { + require Test::More; + Test::More->import(); + + Test::More::plan('tests', scalar @steps); + +} else { + + open STDOUT, '>>', $nodeconf{'logfile'} + or die("Error opening logfile ".$nodeconf{'logfile'}." for stdout\n"); + open STDERR, '>>', $nodeconf{'logfile'} + or die("Error opening logfile ".$nodeconf{'logfile'}." for stderr\n"); + + print "======= Starting node ".($rank-1)." at ".scalar(localtime())."\n\n"; + + require AFS::ukernel; + + AFS::ukernel::uafs_Setup("/afs") and die("uafs_Setup: $!\n"); + AFS::ukernel::uafs_ParseArgs($nodeconf{'afsconfig'}) and die("uafs_ParseArgs: $!\n"); + AFS::ukernel::uafs_Run() and die("uafs_Run: $!\n"); +} + +# one-index the steps, since Test::More test numbers start at 1 +my $nStep = 1; +my @allres; +for my $step (@steps) { + my @acts = @$step; + my $nAct = 1; + my @res = (); + + my $name = shift @acts; + if ($name) { + $name = "Step $nStep: $name"; + } else { + $name = "Step $nStep"; + } + + if ($rank > 0) { + # rank 0 is the director; for all other nodes, run the actual + # actions we're supposed to do + for my $actref (@acts) { + my $act = $$actref; + my @stat; + my $actstr = "unknown"; + + eval { $actstr = $act->str(); }; + if (not $@) { + eval { @stat = $act->do(); }; + } + + if ($@) { + push(@res, [-1, $nAct, $actstr, -1, "Internal error: $@"]); + } elsif ($stat[0]) { + push(@res, [int($!), $nAct, $actstr, @stat]); + } + $nAct++; + } + } + MPI_Barrier(MPI_COMM_WORLD); + # collect results from all nodes for this step + @allres = MPI_Gather(\@res, 0, MPI_COMM_WORLD); + + if ($rank == 0) { + my $tested = undef; + my $i = -1; + + # first array element will be for rank 0, which is the director, which + # will never have useful information + shift @allres; + + foreach my $resref (@allres) { + my @res = @$resref; + $i++; + if (scalar @res == 0) { + next; + } + + if (not $tested) { + fail("$name"); + $tested = 1; + } + + diag("node $i failed: "); + + foreach my $failref (@res) { + my @fail = @$failref; + diag("\tOn action $fail[1]: $fail[2]"); + diag("\t\terrno: $fail[0]"); + diag("\t\terror code: $fail[3]"); + if (length $fail[4] > 0) { + diag("\t\terror string: $fail[4]"); + } + } + } + + if (not $tested) { + pass("$name"); + } + + @allres = undef; + } + MPI_Barrier(MPI_COMM_WORLD); + $nStep++; +} + +if ($rank > 0) { + AFS::ukernel::uafs_Shutdown(); +} + +MPI_Finalize(); diff --git a/src/libuafs/afsload/examples/large.conf b/src/libuafs/afsload/examples/large.conf new file mode 100644 index 0000000..e489e51 --- /dev/null +++ b/src/libuafs/afsload/examples/large.conf @@ -0,0 +1,60 @@ +nodeconfig + node * afsconfig "-fakestat -cachedir /tmp/afsload/cache.$RANK" + node * logfile "/tmp/afsload/log.$RANK" +step + node * chdir "/afs/.localcell/afsload" +step + node 0 mkdir scratch +step + node * chdir scratch +step + node 0 creat foo "foo contents" + node 1 creat foo2 "foo2 contents" + node 2 creat foo3 "foo3 contents" +step +name "read newly created file" + node * read foo "foo contents" +step + node 0 cp 1M /dev/urandom foo.urandom +step + node * cat foo foo2 bar foo.urandom foo3 +step + node 1 truncwrite foo "different foo contents" +step + node * read foo "different foo contents" +step + node 0 append foo "123" +step + node * read foo "different foo contents123" +step + node 1 rename foo bar +step + node * read bar "different foo contents123" +step + node 0 hlink bar bar.link +step + node * read bar.link "different foo contents123" +step + node 0 truncwrite bar.link "bar contents" +step + node * read bar "bar contents" +step + node 0 unlink bar +step + node * read bar.link "bar contents" +step + node 0 slink bar.link bar.slink +step + node * read bar.slink "bar contents" +step + node 0 unlink bar.link +step + node * fail ENOENT access_r bar.slink +step + node * ignore unlink bar.slink +step + node 0 unlink foo.urandom foo2 foo3 +step + node * chdir .. +step + node 0 rmdir scratch diff --git a/src/libuafs/afsload/examples/simple.conf b/src/libuafs/afsload/examples/simple.conf new file mode 100644 index 0000000..eecfa9c --- /dev/null +++ b/src/libuafs/afsload/examples/simple.conf @@ -0,0 +1,16 @@ +nodeconfig + node * afsconfig "-fakestat -cachedir /tmp/afsload/cache.$RANK" + node * logfile "/tmp/afsload/log.$RANK" +step + node * chdir "/afs/.localcell/afsload" +step + node 0 creat foo "foo contents" +step +name "read newly created file" + node * read foo "foo contents" +step + node 1 truncwrite foo "different contents" +step + node 0 unlink foo +step + node * fail ENOENT access_r foo diff --git a/src/libuafs/afsload/lib/AFS/Load/Action.pm b/src/libuafs/afsload/lib/AFS/Load/Action.pm new file mode 100644 index 0000000..120cd1c --- /dev/null +++ b/src/libuafs/afsload/lib/AFS/Load/Action.pm @@ -0,0 +1,1371 @@ +package AFS::Load::Action; +use strict; +use POSIX; + +=head1 NAME + +AFS::Load::Action - test actions for afsload + +=head1 SYNOPSIS + + step + node * chdir "/afs/localcell/afsload" + step + node 0 creat file1 "file 1 contents" + node 1 creat file2 "file 2 contents" + step + node * read file1 "file 1 contents" + node * read file2 "file 2 contents" + step + node 0 unlink file1 + node 1 unlink file2 + +=head1 DESCRIPTION + +This module and submodule defines the actions that can be specified in an +afsload test configuration file. The name of each action is the first thing +that appears after the 'node' directive and the node range specification. +Everything after the action name are the arguments for that action, which +are different for every action. + +Each action is implemented as a small module in AFS::Load::Action::, +where is the name of the action. So, to implement a new action, simply +copy an existing action into a new module, and change the code. + +Each action typically performs one filesystem operation, or a small series of +filesystem operations forming one logical operation. Each action may succeed +or fail; in the case of a failure an action provides an error code and +optionally an error string. In many cases the error code is the resultant +errno value for a filesystem operation, but that is not necessary; errno is +even recorded and reported separately in the case of a failure in case it is +relevant and different from the given error code. + +The rest of this documentation just covers what each action does, and how to +use each one. + +=cut + +sub _interpret_impl($) { + my $name = shift; + my $class = "AFS::Load::Action::$name"; + if ($class->can('new')) { + return $class; + } + die("Unknown action '$name' in configuration"); +} + +sub parse($$$@) { + my $proto = shift; + my $nAct = shift; + + my $implname = shift; + my $impl = _interpret_impl($implname); + + my $ret = $impl->new(@_); + $ret->{NACT} = $nAct; + + return $ret; +} + +sub new($$) { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless $self, $class; + return $self; +} + +sub do($) { + my $self = shift; + my @ret = $self->doact(); + return @ret; +} + +1; + +=head1 chdir + +=head2 EXAMPLE + + step + node * chdir /afs/localcell/afsload + +=head2 DESCRIPTION + +The C action just changes the working directory for the specified client +node. Using this and specifying paths in other actions as short, relative paths +can make the test configuration easier to read and write. + +=head2 ARGUMENTS + +The only argument is the directory to chdir to. + +=head2 ERRORS + +The same errors as the uafs_chdir() call, which should be the same errors as +you might expect from a regular chdir() call. + +=cut + +package AFS::Load::Action::chdir; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 1) { + die("wrong number of args ($args) to chdir (should be 1)"); + } + $self->{DIR} = $_[0]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_chdir($self->{DIR}); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "chdir($self->{DIR})"; +} + +1; + +=head1 creat + +=head2 EXAMPLE + + step + node 0 creat file1 "file1 contents" + +=head2 DESCRIPTION + +Creates a file with the given filename with the given contents. + +=head2 ARGUMENTS + +The first argument is the file name to create, and the second argument is the +contents to write to the newly-created file. + +=head2 ERRORS + +Any error generated by uafs_open() or uafs_write() will cause an error. An +error will be generated if the file already exists. + +=cut + +package AFS::Load::Action::creat; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to creat (should be 2)"); + } + $self->{FILE} = $_[0]; + $self->{DATA} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $fd = AFS::ukernel::uafs_open($self->{FILE}, + POSIX::O_CREAT | POSIX::O_EXCL | POSIX::O_WRONLY, + 0644); + if ($fd < 0) { + return (int($!), 'open error'); + } + + my $code = AFS::ukernel::uafs_write($fd, $self->{DATA}); + if ($code < 0) { + my $errno_save = int($!); + AFS::ukernel::uafs_close($fd); + return ($errno_save, 'write error'); + } + + AFS::ukernel::uafs_close($fd); + + return (0,0); +} + +sub str($) { + my $self = shift; + return "creat($self->{FILE})"; +} + +1; + +=head1 read + +=head2 EXAMPLE + + step + node 0 read file1 "file1 contents" + +=head2 DESCRIPTION + +Opens and reads a file and verifies that the file contains certain contents. + +=head2 ARGUMENTS + +The first argument is the file name to read, and the second argument is the +expected contents of the file. + +=head2 ERRORS + +Any error generated by the underlying filesystem ops will cause an error. An +error will also be generated if the file has contents different than what was +specified or has a different length than the given string. In which case, what +was actually in the file up to the length in the given string will be reported +in the error message. + +=cut + +package AFS::Load::Action::read; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to read (should be 2)"); + } + $self->{FILE} = $_[0]; + $self->{DATA} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code; + my $str; + my @stat; + my $fd = AFS::ukernel::uafs_open($self->{FILE}, + POSIX::O_RDONLY, + 0644); + if ($fd < 0) { + return (int($!), 'open error'); + } + + ($code, @stat) = AFS::ukernel::uafs_fstat($fd); + if ($code < 0) { + my $errno_save = int($!); + AFS::ukernel::uafs_close($fd); + return ($errno_save, 'fstat error'); + } + + ($code, $str) = AFS::ukernel::uafs_read($fd, length $self->{DATA}); + if ($code < 0) { + my $errno_save = int($!); + AFS::ukernel::uafs_close($fd); + return ($errno_save, 'read error'); + } + + AFS::ukernel::uafs_close($fd); + + if ($str ne $self->{DATA}) { + my $lenstr = ''; + if ($stat[7] != length $self->{DATA}) { + $lenstr = " (total length $stat[7])"; + } + return (-1, "got: $str$lenstr, expected: $self->{DATA}"); + } + + if ($stat[7] != length $self->{DATA}) { + return (-1, "got file size: $stat[7], expected: ".(length $self->{DATA})); + } + + return (0,0); +} + +sub str($) { + my $self = shift; + return "read($self->{FILE})"; +} + +1; + +=head1 cat + +=head2 EXAMPLE + + step + node 0 cat file1 file2 + +=head2 DESCRIPTION + +Opens and reads the entire contents of all specified files, discarding any +read data. + +=head2 ARGUMENTS + +The argument list is a list of files to read. + +=head2 ERRORS + +Any error generated by the underlying filesystem ops will cause an error. +When an error occurs on reading one file, subsequent files will still be +attempted to be read, but an error will still be returned afterwards. + +=cut + +package AFS::Load::Action::cat; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args < 1) { + die("wrong number of args ($args) to cat (should be at least 1)"); + } + $self->{FILES} = [@_,]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code; + my $err = 0; + my $errstr = ''; + my $files = $self->{FILES}; + + for my $file (@$files) { + my $str; + my $fd = AFS::ukernel::uafs_open($file, + POSIX::O_RDONLY, + 0644); + if ($fd < 0) { + if ($err == 0) { + $err = int($!); + } + $errstr .= "$file: open error\n"; + next; + } + + $code = 1; + while ($code > 0) { + ($code, $str) = AFS::ukernel::uafs_read($fd, 16384); + if ($code < 0) { + if ($err == 0) { + $err = int($!); + } + $errstr .= "$file: read error\n"; + } + } + $str = undef; + + AFS::ukernel::uafs_close($fd); + } + + if ($errstr) { + return (-1, $errstr); + } + + return (0,0); +} + +sub str($) { + my $self = shift; + my $files = $self->{FILES}; + return "cat(".join(',', @$files).")"; +} + +1; + +=head1 cp + +=head2 EXAMPLE + + step + node 0 cp 10M /dev/urandom foo.urandom + +=head2 DESCRIPTION + +Copies file data up to a certain amount. + +=head2 ARGUMENTS + +The first argument is the maximum amount of data to copy. It is a number of +bytes, optionally followed by a size suffix: K, M, G, or T. You can specify +-1 or "ALL" to copy until EOF on the source is encountered. + +The second argument is the file to copy data out of. The third argument is the +destination file to copy into. The destination file may or may not exist; if it +exists, it is truncated before copying data. + +Either file may be a file on local disk, but at least one must be in AFS. The +file will be treated as a file on local disk only if it starts with a leading +slash, and does not start with /afs/. + +=head2 ERRORS + +Any error generated by the underlying filesystem ops will cause an error. + +=cut + +package AFS::Load::Action::cp; + +use strict; + +use Number::Format qw(round unformat_number); + +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 3) { + die("wrong number of args ($args) to cp (should be 3)"); + } + + my $len = shift; + $self->{SRC} = shift; + $self->{DST} = shift; + + $len = uc($len); + if ($len eq "ALL") { + $self->{LEN} = -1; + } else { + $self->{LEN} = round(unformat_number($len), 0); + if (not $self->{LEN}) { + die("Invalid format ($len) given to cp"); + } + } + + return $self; +} + +sub _isafs($) { + my $str = shift; + if ($str =~ m:^([^/]|/afs/):) { + # assume relative paths are in AFS + # and of course anything starting with /afs/ is in AFS + return 1; + } + return 0; +} + +sub _cpin_sysread($$) { + my ($inh, $len) = @_; + my $buf; + my $bytes = sysread($inh, $buf, $len); + + if (defined($bytes)) { + return ($bytes, $buf); + } + return (-1, undef); +} + +sub _cpout_syswrite($$) { + my ($outh, $str) = @_; + my $code; + $code = syswrite($outh, $str, length $str); + + if (defined($code)) { + return $code; + } + return -1; +} + +sub _cp_close($) { + my $fh = shift; + if (close($fh)) { + return 0; + } + return -1; +} + +sub doact($) { + my $self = shift; + my $code; + my $err = 0; + my $errstr = ''; + + my $inh; + my $outh; + my $readf; + my $writef; + my $inclosef; + my $outclosef; + + if (_isafs($self->{SRC})) { + $inh = AFS::ukernel::uafs_open($self->{SRC}, POSIX::O_RDONLY, 0644); + if ($inh < 0) { + return (int($!), "input open error (AFS)"); + } + + $readf = \&AFS::ukernel::uafs_read; + $inclosef = \&AFS::ukernel::uafs_close; + } else{ + open($inh, "< $self->{SRC}") or + return (int($!), "input open error (local)"); + + $readf = \&_cpin_sysread; + $inclosef = \&_cp_close; + } + + if (_isafs($self->{DST})) { + $outh = AFS::ukernel::uafs_open($self->{DST}, + POSIX::O_WRONLY | POSIX::O_TRUNC | POSIX::O_CREAT, + 0644); + if ($outh < 0) { + return (int($!), "output open error (AFS)"); + } + $writef = \&AFS::ukernel::uafs_write; + $outclosef = \&AFS::ukernel::uafs_close; + } else { + open($outh, "> $self->{DST}") or + return (int($!), "output open error(local)"); + $writef = \&_cpout_syswrite; + $outclosef = \&_cp_close; + } + + my $str; + my $remaining = $self->{LEN}; + while ($remaining) { + + my $len = 16384; + my $rbytes; + my $wbytes; + + if ($remaining > 0 && $remaining < $len) { + $len = $remaining; + } + + ($rbytes, $str) = &$readf($inh, $len); + if ($rbytes < 0) { + my $errno_save = int($!); + + &$inclosef($inh); + &$outclosef($outh); + + return ($errno_save, "read error"); + } + + if ($rbytes == 0) { + last; + } + + $wbytes = &$writef($outh, $str); + if ($wbytes != $rbytes) { + my $errno_save = int($!); + + &$inclosef($inh); + &$outclosef($outh); + + return ($errno_save, "write error ($wbytes/$rbytes)"); + } + + if ($remaining > 0) { + $remaining -= $rbytes; + } + } + + &$inclosef($inh); + if (&$outclosef($outh) != 0) { + return (int($!), "close error"); + } + + return (0,0); +} + +sub str($) { + my $self = shift; + return "cp(".join(',', $self->{LEN}, $self->{SRC}, $self->{DST}).")"; +} + +1; + +=head1 truncwrite + +=head2 EXAMPLE + + step + node 0 truncwrite file1 "different contents" + +=head2 DESCRIPTION + +Opens and truncates an existing file, then writes some data to it. + +=head2 ARGUMENTS + +The first argument is the file name to open and truncate, and the second +argument is the data to write to the file. + +=head2 ERRORS + +Any error generated by the underlying filesystem ops will cause an error. Note +that the file must already exist for this to succeed. + +=cut + +package AFS::Load::Action::truncwrite; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to truncwrite (should be 2)"); + } + $self->{FILE} = $_[0]; + $self->{DATA} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $fd = AFS::ukernel::uafs_open($self->{FILE}, + POSIX::O_WRONLY | POSIX::O_TRUNC, + 0644); + if ($fd < 0) { + return (int($!), 'open error'); + } + + my ($code) = AFS::ukernel::uafs_write($fd, $self->{DATA}); + if ($code < 0) { + my $errno_save = int($!); + AFS::ukernel::uafs_close($fd); + return ($errno_save, 'write error'); + } + + AFS::ukernel::uafs_close($fd); + + if ($code eq length $self->{DATA}) { + return (0,0); + } + + return (-1, "got: $code bytes written, expected: ".(length $self->{DATA})); +} + +sub str($) { + my $self = shift; + return "truncwrite($self->{FILE}, $self->{DATA})"; +} + +1; + +=head1 append + +=head2 EXAMPLE + + step + node 0 append file1 "more data" + +=head2 DESCRIPTION + +Opens an existing file, and appends some data to it. + +=head2 ARGUMENTS + +The first argument is the file name to open, and the second argument is the +data to append to the file. + +=head2 ERRORS + +Any error generated by the underlying filesystem ops will cause an error. Note +that the file must already exist for this to succeed. + +=cut + +package AFS::Load::Action::append; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to append (should be 2)"); + } + $self->{FILE} = $_[0]; + $self->{DATA} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $fd = AFS::ukernel::uafs_open($self->{FILE}, + POSIX::O_WRONLY | POSIX::O_APPEND, + 0644); + if ($fd < 0) { + return (int($!), 'open error'); + } + + my ($code) = AFS::ukernel::uafs_write($fd, $self->{DATA}); + if ($code < 0) { + my $errno_save = int($!); + AFS::ukernel::uafs_close($fd); + return ($errno_save, 'write error'); + } + + AFS::ukernel::uafs_close($fd); + + if ($code eq length $self->{DATA}) { + return (0,0); + } + + return (-1, "got: $code bytes written, expected: ".(length $self->{DATA})); +} + +sub str($) { + my $self = shift; + return "append($self->{FILE}, $self->{DATA})"; +} + +1; + +=head1 unlink + +=head2 EXAMPLE + + step + node 0 unlink file1 [file2] ... [fileN] + +=head2 DESCRIPTION + +Unlinks the specified file(s). + +=head2 ARGUMENTS + +All arguments are files to unlink. + +=head2 ERRORS + +Any error generated by the underlying uafs_unlink() call. An error will be +returned if unlinking any file generates an error, but we will attempt to +unlink all specified files. + +=cut + +package AFS::Load::Action::unlink; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args < 1) { + die("wrong number of args ($args) to unlink (should be at least 1)"); + } + $self->{FILES} = [@_]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $ret = 0; + my @errfiles = (); + my $files = $self->{FILES}; + + for my $file (@$files) { + my $code = AFS::ukernel::uafs_unlink($file); + if ($code) { + if (not length(@errfiles)) { + $ret = int($!); + } + push(@errfiles, $file); + } + } + + if (@errfiles) { + return ($ret, join(', ', @errfiles)); + } + return (0,0); +} + +sub str($) { + my $self = shift; + my $files = $self->{FILES}; + return "unlink(".(join(',', @$files)).")"; +} + +1; + +=head1 rename + +=head2 EXAMPLE + + step + node 0 rename file1 file2 + +=head2 DESCRIPTION + +Renames a file within a volume. + +=head2 ARGUMENTS + +The first argument is the file to move, and the second argument is the new +name to move it to. + +=head2 ERRORS + +Any error generated by the underlying uafs_rename() call. + +=cut + +package AFS::Load::Action::rename; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to rename (should be 2)"); + } + $self->{SRC} = $_[0]; + $self->{DST} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_rename($self->{SRC}, $self->{DST}); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "rename($self->{SRC}, $self->{DST})"; +} + +1; + +=head1 hlink + +=head2 EXAMPLE + + step + node 0 hlink file1 file2 + +=head2 DESCRIPTION + +Hard-links a file within a directory. + +=head2 ARGUMENTS + +The first argument is the source file, and the second argument is the name of +the new hard link. + +=head2 ERRORS + +Any error generated by the underlying uafs_link() call. + +=cut + +package AFS::Load::Action::hlink; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to hlink (should be 2)"); + } + $self->{SRC} = $_[0]; + $self->{DST} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_link($self->{SRC}, $self->{DST}); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "hlink($self->{SRC}, $self->{DST})"; +} + +1; + +=head1 slink + +=head2 EXAMPLE + + step + node 0 slink file1 file2 + +=head2 DESCRIPTION + +Symlinks a file within a directory. + +=head2 ARGUMENTS + +The first argument is the source file, and the second argument is the name of +the new symlink. + +=head2 ERRORS + +Any error generated by the underlying uafs_symlink() call. + +=cut + +package AFS::Load::Action::slink; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 2) { + die("wrong number of args ($args) to slink (should be 2)"); + } + $self->{SRC} = $_[0]; + $self->{DST} = $_[1]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_symlink($self->{SRC}, $self->{DST}); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "slink($self->{SRC}, $self->{DST})"; +} + +1; + +=head1 access_r + +=head2 EXAMPLE + + step + node 0 access_r file1 + +=head2 DESCRIPTION + +Verifies that a file exists and is readable. + +=head2 ARGUMENTS + +The only argument is a file to check readability. + +=head2 ERRORS + +Any error generated by the underlying uafs_open() call. + +=cut + +package AFS::Load::Action::access_r; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 1) { + die("wrong number of args ($args) to access_r (should be 1)"); + } + $self->{FILE} = $_[0]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $fd = AFS::ukernel::uafs_open($self->{FILE}, POSIX::O_RDONLY, 0644); + if ($fd < 0) { + return (int($!), ''); + } + AFS::ukernel::uafs_close($fd); + return (0,0); +} + +sub str($) { + my $self = shift; + return "access_r($self->{FILE})"; +} + +1; + +=head1 fail + +=head2 EXAMPLE + + step + node 0 fail ENOENT access_r file1 + +=head2 DESCRIPTION + +Verifies that another action fails with a specific error code. This is useful +when an easy way to specify an action is to specify when another action fails, +instead of needing to write a new action. + +For example, the above example runs the C action on file1, and +succeeds if the C action returns with an ENOENT error. + +=head2 ARGUMENTS + +The first argument is the error code that the subsequent action should fail +with. This can be a number, or an errno symbolic constant. The next argument +is the name of any other action, and the remaining arguments are whatever +arguments should be supplied to that action. + +=head2 ERRORS + +We only raise an error if the specified action generates a different error than +what was specified, or if no error was raised. In which case, the error that +was generated (if any) is reported. + +=cut + +package AFS::Load::Action::fail; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +use Errno; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $code = shift; + my $args = $#_ + 1; + if ($args < 2) { + die("wrong number of args ($args) to fail (should be at least 2)"); + } + + if (!($code =~ m/^\d$/)) { + my $nCode = eval("if (exists &Errno::$code) { return &Errno::$code; } else { return undef; }"); + if (!defined($nCode)) { + die("Invalid symbolic error name $code\n"); + } + $code = $nCode; + } + $self->{ERRCODE} = $code; + $self->{ACT} = AFS::Load::Action->parse(-1, @_); + + return $self; +} + +sub doact($) { + my $self = shift; + my @ret = $self->{ACT}->doact(); + + if ($ret[0] == $self->{ERRCODE}) { + return (0,0); + } + + return (-1, "got error: $ret[0] (string: $ret[1]), expected: $self->{ERRCODE}"); +} + +sub str($) { + my $self = shift; + return "fail(".$self->{ACT}->str().")"; +} + +1; + +=head1 ignore + +=head2 EXAMPLE + + step + node 0 ignore unlink file1 + +=head2 DESCRIPTION + +Performs another action, ignoring any given errors and always returning +success. + +=head2 ARGUMENTS + +The first argument is the name of any other action, and the remaining +arguments are whatever arguments should be supplied to that action. + +=head2 ERRORS + +None. + +=cut + +package AFS::Load::Action::ignore; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +use Errno; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args < 1) { + die("wrong number of args ($args) to ignore (should be at least 1)"); + } + + $self->{ACT} = AFS::Load::Action->parse(-1, @_); + + return $self; +} + +sub doact($) { + my $self = shift; + my @ret = $self->{ACT}->doact(); + + return (0,0); +} + +sub str($) { + my $self = shift; + return "ignore(".$self->{ACT}->str().")"; +} + +1; + +=head1 mkdir + +=head2 EXAMPLE + + step + node 0 mkdir dir1 + +=head2 DESCRIPTION + +Creates a directory. + +=head2 ARGUMENTS + +The only argument is the directory to create. + +=head2 ERRORS + +The same errors as the uafs_mkdir() call. + +=cut + +package AFS::Load::Action::mkdir; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 1) { + die("wrong number of args ($args) to mkdir (should be 1)"); + } + $self->{DIR} = $_[0]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_mkdir($self->{DIR}, 0775); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "mkdir($self->{DIR})"; +} + +1; + +=head1 rmdir + +=head2 EXAMPLE + + step + node 0 rmdir dir1 + +=head2 DESCRIPTION + +Removes a directory. + +=head2 ARGUMENTS + +The only argument is the directory to remove. + +=head2 ERRORS + +The same errors as the uafs_rmdir() call. + +=cut + +package AFS::Load::Action::rmdir; +use strict; +use AFS::Load::Action; +use AFS::ukernel; +our @ISA = ("AFS::Load::Action"); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + + bless($self, $class); + + my $args = $#_ + 1; + if ($args != 1) { + die("wrong number of args ($args) to rmdir (should be 1)"); + } + $self->{DIR} = $_[0]; + + return $self; +} + +sub doact($) { + my $self = shift; + my $code = AFS::ukernel::uafs_rmdir($self->{DIR}); + if ($code) { + return (int($!), ''); + } + return (0,0); +} + +sub str($) { + my $self = shift; + return "rmdir($self->{DIR})"; +} + +=head1 AUTHORS + +Andrew Deason Eadeason@sinenomine.netE, Sine Nomine Associates. + +=head1 COPYRIGHT + +Copyright 2010-2011 Sine Nomine Associates. + +=cut + +1; diff --git a/src/libuafs/afsload/lib/AFS/Load/Config.pm b/src/libuafs/afsload/lib/AFS/Load/Config.pm new file mode 100644 index 0000000..011df1d --- /dev/null +++ b/src/libuafs/afsload/lib/AFS/Load/Config.pm @@ -0,0 +1,438 @@ +package AFS::Load::Config; + +=head1 NAME + +AFS::Load::Config - afsload configuration file format + +=head1 SYNOPSIS + + nodeconfig + node * afsconfig "-fakestat -cachedir /tmp/afsload/cache.$RANK" + node 0-15 logfile "/tmp/afsload/log.$RANK" + node 16-* logfile /dev/null + step + node * chdir /afs/.localcell/afsload + step + node 0 creat foo "foo contents" + step name "read newly created file" + node * read foo "foo contents" + step + node 0 unlink foo + +=head1 DESCRIPTION + +The afsload scripts run certain operations on various OpenAFS userspace +client nodes, according to a test configuration. The general syntax of +this configuration is described here, but the documentation for +individual test actions are documented in AFS::Load::Action. + +In general, keywords are composed of any characters besides whitespace +and quotes. Keywords are separated by whitespace, except when quoted, +and any duplicate whitespace is ignored. No interpolation or +preprocessing is done when reading the configuration file itself, though +individual actions or directives may perform some kind of interpolation +on the given arguments to the directive. + +=head1 RANGES + +Everything in the configuration can be specified to apply to all nodes, +some subset of the nodes, or a specific node. This is specified by +giving a range of node ranks that the configuration directive applies +to. This range can take one of the following forms: + +=over 4 + +=item B + +A single number by itself only applies to a node with that rank. + +=item B + +Two numbers separated by a hyphen applies to any node that has a rank +equal to either of those two numbers, or is between those two numbers. + +=item B<*> + +An asterisk applies to all nodes. + +=item B + +A number followed by a hyphen and an asterisk applies to any node whose +rank is equal to the specified number or higher. You can think of this +as the same as the B case, where the asterisk is treated +as an infinite number. + +=item + +Any combination of the above range specifications can be specified, +separated by commas, and it will apply to any node to which any of the +supplied ranges apply. + +=back + +For example, a range of 0,4-7,10-* will apply to all nodes that have a +rank of 0, 4, 5, 6, 7, 10, and any rank higher than 10. + +=head1 NODECONFIG + +The first directive that should be specified is the 'nodeconfig' +directive, which defines the configuration for the various nodes. To +specify some configuration for some nodes, specify the 'node' directive, +followed by a range of node ranks, followed by the configuration +directive and any arguments: + + node + +Right now only two directives can be given: + +=over 4 + +=item B + +This specifies the arguments to give to the userspace client equivalent +of afsd. Specify this as a single string; so if you want to use multiple +arguments, you must quote the string and separate arguments by spaces. + +The literal string $RANK is replaced with the numeric rank of the node, +anywhere the string $RANK appears in the config. + +For example: + + node * afsconfig "-fakestat -cachedir /tmp/afsload/cache.$RANK" + +will make all nodes turn on fakestat, and will use a cache directory in +/tmp/afsload/cache.$RANK. Note that the afsload scripts do not interpret +the given afsd-like parameters; they are just passed to libuafs. In +particular this means that you must create all of the given cache +directorie before running afsload, as libuafs/afsd does not create it +for you. + +=item B + +This specifies where to direct output for this node. The userspace +client as well as perl itself may print some information or warnings, +etc to stdout or stderr. Since having all nodes print to the same stdout +can be unreadable, this allows you to specify a file for each node that +you can look at later if necessary. + +The literal string $RANK is replaced with the numeric rank of the node, +anywhere the string $RANK appears in the given log file name. If this is +unspecified, it defaults to /dev/null, so all output from the node will +be lost. + +=back + +=head1 STEP + +After the nodeconfig directives are specified, the rest of the +configuration consists of 'step' directives. Each step directive marks a +synchronization point between all running nodes; all nodes must complete +all previous actions before any node will proceed beyond a step +directive. + +Each step is specified by just the directive "step" in the configuration +file. Each step may be given a name to make it easier to identify in the +test run output. To do this, just specify "step name myname" instead of +just "step". + +In each step, you must specify a series of action directives that +dictate what each node does during each step. If you don't specify that +a node should do anything, that node just waits for the other nodes to +complete their actions. + +Each action is specified like so + + node + +Where the action and action arguments are documented in +AFS::Load::Action, for all defined actions. + +All actions on different nodes between step directives are performed in +parallel, with no guarantee on the ordering in which they occur. If you +specify multiple actions for the same node between step directives, +those actions occur sequentially in the order they were specified. For +example: + + step + node 0 creat file1 foo + node 0 read file1 foo + node 1-* read file2 bar + +In this step, node 0 will create file1 and then read it. While that is +ocurring, all other nodes will read file2, which may occur before, +after, or during one of the other actions node 0 is performing. + +=head1 AUTHORS + +Andrew Deason Eadeason@sinenomine.netE, Sine Nomine Associates. + +=head1 COPYRIGHT + +Copyright 2010-2011 Sine Nomine Associates. + +=cut + +use strict; +use Text::ParseWords qw(parse_line); + +use AFS::Load::Action; + +my @saw_nodes = (); +my $in_nodeconfig = 0; + +sub _range_check($$) { + my ($max, $word) = @_; + if ($max == 0) { + return; + } + foreach (split /,/, $word) { + if (m/^(\d+)-(\d+|[*])$/) { + # X-Y range + my ($lo, $hi); + $lo = int($1); + + if ($2 eq "*") { + $hi = $max; + } else { + $hi = int($2); + } + + if ($lo < 0 || $lo > $max || $hi < $lo || $hi > $max) { + die("Invalid range $lo-$hi; you can only specify from 0 to $max, ". + "and the second range element must be greater than the first"); + } + + if (not $in_nodeconfig) { + for (my $i = $lo; $i <= $hi; $i++) { + $saw_nodes[$i] = 1; + } + } + } elsif (m/^(\d+)$/) { + # plain number + my $n = int($1); + if ($n < 0 || $n > $max) { + die("Invalid node id $n; you can only specify from 0 to $max\n"); + } + if (not $in_nodeconfig) { + $saw_nodes[$n] = 1; + } + } elsif ($_ eq "*") { + if (not $in_nodeconfig) { + for (my $i = 0; $i <= $max; $i++) { + $saw_nodes[$i] = 1; + } + } + } else { + die("unparseable range element $_"); + } + } +} + +sub _range_match($$) { + my ($rank, $word) = @_; + + if ($rank < 0) { + $rank *= -1; + $rank--; + _range_check($rank, $word); + return 1; + } + + foreach (split /,/, $word) { + if (m/^(\d+)-(\d+|[*])$/) { + # X-Y range + my ($lo, $hi); + $lo = int($1); + if ($rank < $lo) { + next; + } + if ($2 eq "*") { + return 1; + } + $hi = int($2); + if ($rank <= $hi) { + return 1; + } + } elsif (m/^(\d+)$/) { + # plain number + if (int($1) == $rank) { + return 1; + } + } elsif ($_ eq "*") { + return 1; + } else { + die("unparseable range element $_"); + } + } + return 0; +} + +sub _nextword($$) { + my ($wordref, $iref) = @_; + my $ret = undef; + while (!defined($ret) and $$iref < scalar(@$wordref)) { + $ret = $$wordref[$$iref]; + $$iref++; + } + return $ret; +} + +sub check_conf($$) { + my ($np, $conf_file) = @_; + my $max; + my $rank; + my @steps; + my %nodeconf; + my $counter = 0; + + # subtract 2 from the number of processes, since node ids are 0-indexed, + # and we need one process for the 'director' node + $max = $np - 2; + + $rank = -1 * $max; + $rank--; + + load_conf($rank, $conf_file, \@steps, \%nodeconf) + or die("Error parsing configuration file\n"); + + for (my $i = 0; $i <= $max; $i++) { + if (not defined($saw_nodes[$i]) or !$saw_nodes[$i]) { + $counter++; + if ($counter > 5) { + next; + } + print STDERR "# WARNING: node $i does not appear to have any\n"; + print STDERR "# actions associated with it\n"; + } + } + if ($counter > 5) { + print STDERR "# ... along with ".($counter-5)." other nodes\n"; + } +} + +sub load_conf($$$$) { + my ($rank, $conf_file, $stepsref, $nodeconfref) = @_; + my $conf_h; + my $conf; + + open($conf_h, "<$conf_file") or die("Cannot open $conf_file: $!\n"); + { + local $/; + $conf = <$conf_h>; + } + close($conf_h); + + my @words = parse_line(qr/\s+/, 0, $conf); + push(@words, "step"); + my @actwords = (); + my @acts = (); + my $didRange = 0; + my $ignore = 0; + + my $i = 0; + + while ($i < scalar @words) { + my $word; + $word = _nextword(\@words, \$i); + if (not defined($word)) { + next; + } + if ($word eq "nodeconfig") { + $in_nodeconfig = 1; + + # keep going until we see a "step" + while ($i < scalar @words && $words[$i] ne "step") { + my ($key, $val); + + $word = _nextword(\@words, \$i); + if ($word ne "node") { + die("Expected nodeconfig/node, got nodeconfig/$word"); + } + + $word = _nextword(\@words, \$i); + if (!_range_match($rank, $word)) { + # skip this 'node' directive + while ($i < scalar @words) { + # skip until we see the next 'node' + $word = _nextword(\@words, \$i); + if ($word eq "node" || $word eq "step") { + $i--; + last; + } + } + next; + } + + $key = _nextword(\@words, \$i); + $val = _nextword(\@words, \$i); + + $$nodeconfref{$key} = $val; + } + + $in_nodeconfig = 0; + + } elsif ($word eq "step") { + my @acts = (); + my $nAct = 0; + my $name = undef; + + if (!($i < scalar @words)) { + last; + } + + if (defined($words[$i]) && $words[$i] eq "name") { + $word = _nextword(\@words, \$i); + $name = _nextword(\@words, \$i); + } + + # keep going until we see the next "step" + while ($i < scalar @words && $words[$i] ne "step") { + $word = _nextword(\@words, \$i); + + if ($word ne "node") { + die("Expected step/node, got step/$word"); + } + + $word = _nextword(\@words, \$i); + if (!_range_match($rank, $word)) { + $nAct++; + while ($i < scalar @words) { + # skip until we see the next 'node' + $word = _nextword(\@words, \$i); + if ($word eq "node" || $word eq "step") { + $i--; + last; + } + } + next; + } + + my @actwords = (); + + while ($i < scalar @words) { + $word = _nextword(\@words, \$i); + if ($word eq "node" || $word eq "step") { + $i--; + last; + } + push(@actwords, $word); + } + + my $act = AFS::Load::Action->parse($nAct, @actwords); + push(@acts, \$act); + $nAct++; + } + push(@$stepsref, [$name, @acts]); + } else { + die("Unknown top-level config directive '$word'\n"); + } + } + + foreach my $key (keys %$nodeconfref) { + $$nodeconfref{$key} =~ s/\$RANK/$rank/g; + } + + return 1; +} + +1;