--- /dev/null
+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.
--- /dev/null
+#!/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 <nprocs> -t <test.conf>" >&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"
--- /dev/null
+=head1 NAME
+
+afsload - AFS client load simulator
+
+=head1 SYNOPSYS
+
+B<afsload> [B<-q>] B<-p> <I<processes>> B<-t> <I<test.conf>>
+
+=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<AFS::Load::Config> 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> <I<processes>>
+
+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> <I<test.conf>>
+
+This specifies the test configuration to use. See the documentation for
+L<AFS::Load::Config> and L<AFS::Load::Action> 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<AFS::Load::Action>), but errno is always just the errno value
+immediately after the action failed.
+
+=head1 ENVIRONMENT
+
+B<afsload> makes use of these environment variables:
+
+=over 4
+
+=item MPIRUN
+
+Name or location of the B<mpirun> 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<mpirun> if not specified.
+
+=item LIBMPI
+
+Location of the C<libmpi.so> 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<afsload>.
+
+Defaults to C</usr/lib/libmpi.so> if not specified.
+
+=back
+
+=head1 AUTHORS
+
+Andrew Deason E<lt>adeason@sinenomine.netE<gt>, Sine Nomine Associates.
+
+=head1 COPYRIGHT
+
+Copyright 2010-2011 Sine Nomine Associates.
+
+=cut
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use AFS::Load::Config;
+
+sub usage() {
+ print STDERR "Usage: $0 -p <NP> <testconfig.conf>";
+ 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";
--- /dev/null
+#!/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 <testconfig.conf>\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();
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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::<name>,
+where <name> 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<chdir> 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<access_r> action on file1, and
+succeeds if the C<access_r> 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 E<lt>adeason@sinenomine.netE<gt>, Sine Nomine Associates.
+
+=head1 COPYRIGHT
+
+Copyright 2010-2011 Sine Nomine Associates.
+
+=cut
+
+1;
--- /dev/null
+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<number>
+
+A single number by itself only applies to a node with that rank.
+
+=item B<number-number>
+
+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<number-*>
+
+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<number-number> case, where the asterisk is treated
+as an infinite number.
+
+=item <range,range>
+
+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 <range> <directive> <arguments>
+
+Right now only two directives can be given:
+
+=over 4
+
+=item B<afsconfig>
+
+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<logfile>
+
+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 <range> <action> <action arguments>
+
+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 E<lt>adeason@sinenomine.netE<gt>, 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;
projects / packages / o / openafs.git / commitdiff