diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | README | 115 | ||||
| -rw-r--r-- | input | 29 | ||||
| -rw-r--r-- | localhost.conf | 3 | ||||
| -rw-r--r-- | testplan | 6 | ||||
| -rw-r--r-- | xml/auth.expected.xml | 1 | ||||
| -rw-r--r-- | xml/auth.xml | 1 | ||||
| -rw-r--r-- | xml/bind-reneg.expected.xml | 9 | ||||
| -rw-r--r-- | xml/bind-reneg.xml | 7 | ||||
| -rw-r--r-- | xml/bind.expected.xml | 5 | ||||
| -rw-r--r-- | xml/bind.xml | 5 | ||||
| -rw-r--r-- | xml/session.expected.xml | 1 | ||||
| -rw-r--r-- | xml/session.xml | 3 | ||||
| -rw-r--r-- | xml/signin.expected.xml | 12 | ||||
| -rw-r--r-- | xml/signin.xml | 6 | ||||
| -rw-r--r-- | xml/signout.expected.xml | 1 | ||||
| -rw-r--r-- | xml/signout.xml | 1 | ||||
| -rwxr-xr-x | xmpt | 279 |
18 files changed, 485 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0595a33 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +reuasmb.conf
\ No newline at end of file @@ -0,0 +1,115 @@ +# -*- mode: org -*- + +* Overview +A test consists of a config file, which specifies variables available +during the execution of the test, a test plan file, which dictates the +order of the test, and a series of templates, referenced by the test +plan, which contain the data to be read and optionally matched. See +the Testing section for an example of how to use it. + +This is intended to be used for request-response style interactions, +where we send a request and wait for a matching response. However, not +all requests stimulate a response, so response matching is optional. + +By default this program reads from standard input and writes to +standard output, but if a command line is supplied as the final +arguments, that will be used instead. This is useful with netcat for +network server testing. + +* Config File +The format of the config file is a list of arbitrary '$key=$value' +pairs. Comments start with '#' and continue until the end of the line. + +Config keys are auto-interned as nullary functions for use in +templates. + +* Test Plan +The test plan file is a list of files to run within the templates +directory (which defaults to 'xml'), suffixed by '.xml' for sending +data, and, if it exists, suffixed by '.expected.xml' for matching +responses. Thus a test plan line which consists of 'foo' would send +data according to the template in 'xml/foo.xml' and would then wait +for data matching the template in 'xml/foo.expected.xml' if that file +exists. + +The XML stuff is not ideal, since this program doesn't care about the +format of the data being read or written, but since it was developed +for XMPP testing, that's what it got. This may change in the future. + +* Templates +Templates are fundamentally a big regexp with thunks of Perl code +contained within '{}' interpolated at run-time. While templates are +used for both sending data and matching received data, the use of +thunks changes depending on context. + +** Send context +In send context (e.g., 'foo.xml'), the code called may return a string +which will replace the thunk in the template. Assuming you have a +function defined called bar: +#+BEGIN +sub bar() { "text" }; +#+END + +and a template: +#+BEGIN +Here is some {bar}! +#+END + +The output would be: +#+BEGIN +Here is some text! +#+END + +The code is arbitrary Perl 5, and doesn't have to return a string, but +if it returns anything it should be something that can be converted to +a string automatically, or you're likely to get an error. + +** Match context +During matching, the template is processed as a regexp, where thunks +are treated as captured wildcards (i.e., the pattern '(.*)'). After a +successful match, the value of the capture is made available to the +thunk in the $arg variable. This is so that the value can be compared +with an expected value, or that more complex computation can be done +(such as for challenge-response authentication). + +It is assumed that there will be cases where data that you're not +interested in can be interleaved in data that you are interested in +(e.g., keepalives) and match templates will ignore them. + +** Evaluation package +Templates are evaluated in their own package, outside of main, to +better isolate their side-effects. Some package-level globals are made +available: + * $in - The filehandle we're reading match data from. + * $out - The filehandle we're sending data to. + * %env - The key-value pairs from the loaded config file. + * $arg - The value of the capture group for this thunk (in match + context) + +This package is never reinitialized during the test plan execution, +allowing one template to modify data for subsequent templates. + +** XML +In order to make XML processing easier, any type of quote, throughout +the text is turned into the pattern ['"] during match +context. Similarly, whitespace is condensed and replaced with the \s* +pattern. + +Do note that while this program is intended to be used primarily with +XML, it's almost totally ignorant of XML as a format besides the above +substitutions. That means that things like attribute order within a +tag matter, and we cannot normalize '<foo></foo>' to '<foo/>' (at +least unless you write a big tangle of regexp in the template itself). + +* Testing +The file 'testplan' contains a sample plan for a basic XMPP session +given 'localhost.conf', using the files in the 'xml' directory. The +corresponding server data is in 'input'. So to run a quick-and-dirty +test, execute: + +#+BEGIN +% xmpt -c localhost.conf -p testplan < input +#+END + +At some point, these things should be moved into a 't' directory and +used with Test::Harness. @@ -0,0 +1,29 @@ +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + version='1.0' + from='localhost' + id='somestreamid' + xmlns='jabber:client'> + <stream:features> + <mechanisms xmlns='urn:ietf:params:xml:ns:xmpp-sasl'> + <mechanism>SCRAM-SHA-1</mechanism> + <mechanism>PLAIN</mechanism> + </mechanisms> + <auth xmlns='http://jabber.org/features/iq-auth'/> + </stream:features> +<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'></success> +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + version='1.0' + from='localhost' + id='somestreamid' + xmlns='jabber:client'> + <stream:features> + <bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'/> + <session xmlns='urn:ietf:params:xml:ns:xmpp-session'/> + </stream:features> +<iq from='test0@localhost' to='test0@localhost/xmpt' id='bind' type='result'> + <bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'> + <jid>test0@localhost/xmpt</jid> + </bind> +</iq> +<iq from='test0@localhost' to='test0@localhost/xmpt' id='session' type='result'/> +</stream> diff --git a/localhost.conf b/localhost.conf new file mode 100644 index 0000000..bc462d7 --- /dev/null +++ b/localhost.conf @@ -0,0 +1,3 @@ +# Domain and bare JID are calculated from full. +full_jid=test0@localhost/xmpt +password=test diff --git a/testplan b/testplan new file mode 100644 index 0000000..ba7fcaa --- /dev/null +++ b/testplan @@ -0,0 +1,6 @@ +signin +auth +bind-reneg +bind +session +signout diff --git a/xml/auth.expected.xml b/xml/auth.expected.xml new file mode 100644 index 0000000..2c1c582 --- /dev/null +++ b/xml/auth.expected.xml @@ -0,0 +1 @@ +<success xmlns='urn:ietf:params:xml:ns:xmpp-sasl'></success> diff --git a/xml/auth.xml b/xml/auth.xml new file mode 100644 index 0000000..25c8e1d --- /dev/null +++ b/xml/auth.xml @@ -0,0 +1 @@ +<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='PLAIN'>{plain_auth}</auth> diff --git a/xml/bind-reneg.expected.xml b/xml/bind-reneg.expected.xml new file mode 100644 index 0000000..23774eb --- /dev/null +++ b/xml/bind-reneg.expected.xml @@ -0,0 +1,9 @@ +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + version='1.0' + from='{domainpart}' + id='.*' + xmlns='jabber:client'> + <stream:features> + <bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'/> + <session xmlns='urn:ietf:params:xml:ns:xmpp-session'/> + </stream:features> diff --git a/xml/bind-reneg.xml b/xml/bind-reneg.xml new file mode 100644 index 0000000..cf456c0 --- /dev/null +++ b/xml/bind-reneg.xml @@ -0,0 +1,7 @@ +<?xml version='1.0'?> +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + xmlns:xml='http://www.w3.org/XML/1998/namespace' + xmlns='jabber:client' + xml:lang='en' + version='1.0' + to='{domainpart}'> diff --git a/xml/bind.expected.xml b/xml/bind.expected.xml new file mode 100644 index 0000000..9cfa434 --- /dev/null +++ b/xml/bind.expected.xml @@ -0,0 +1,5 @@ +<iq from='{bare_jid}' to='{full_jid}' id='bind' type='result'> + <bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'> + <jid>{full_jid}</jid> + </bind> +</iq> diff --git a/xml/bind.xml b/xml/bind.xml new file mode 100644 index 0000000..82a2d09 --- /dev/null +++ b/xml/bind.xml @@ -0,0 +1,5 @@ +<iq type='set' id='bind'> + <bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'> + <resource>{resourcepart}</resource> + </bind> +</iq> diff --git a/xml/session.expected.xml b/xml/session.expected.xml new file mode 100644 index 0000000..f1bcab2 --- /dev/null +++ b/xml/session.expected.xml @@ -0,0 +1 @@ +<iq from='{bare_jid}' to='{full_jid}' id='session' type='result'/> diff --git a/xml/session.xml b/xml/session.xml new file mode 100644 index 0000000..6f830bf --- /dev/null +++ b/xml/session.xml @@ -0,0 +1,3 @@ +<iq type='set' id='session'> + <session xmlns='urn:ietf:params:xml:ns:xmpp-session'/> +</iq> diff --git a/xml/signin.expected.xml b/xml/signin.expected.xml new file mode 100644 index 0000000..4774bbb --- /dev/null +++ b/xml/signin.expected.xml @@ -0,0 +1,12 @@ +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + version='1.0' + from='{domainpart}' + id='.*' + xmlns='jabber:client'> + <stream:features> + <mechanisms xmlns='urn:ietf:params:xml:ns:xmpp-sasl'> + <mechanism>SCRAM-SHA-1</mechanism> + <mechanism>PLAIN</mechanism> + </mechanisms> + <auth xmlns='http://jabber.org/features/iq-auth'/> + </stream:features> diff --git a/xml/signin.xml b/xml/signin.xml new file mode 100644 index 0000000..7b9438f --- /dev/null +++ b/xml/signin.xml @@ -0,0 +1,6 @@ +<stream:stream xmlns:stream='http://etherx.jabber.org/streams' + xmlns:xml='http://www.w3.org/XML/1998/namespace' + xmlns='jabber:client' + xml:lang='en' + version='1.0' + to='{domainpart}'> diff --git a/xml/signout.expected.xml b/xml/signout.expected.xml new file mode 100644 index 0000000..522b4a3 --- /dev/null +++ b/xml/signout.expected.xml @@ -0,0 +1 @@ +</stream> diff --git a/xml/signout.xml b/xml/signout.xml new file mode 100644 index 0000000..522b4a3 --- /dev/null +++ b/xml/signout.xml @@ -0,0 +1 @@ +</stream> @@ -0,0 +1,279 @@ +#!/usr/bin/env perl + +use Data::Dumper; +use Getopt::Long; +use IO::File; +use IPC::Open2; +use v5.10; + +use strict; +use warnings; + +my $configpath = 'localhost.conf'; +my $testplanpath = 'testplan'; +my $templatepath = 'xml'; +my $timeout = 5; +my $verbose; +my $help; + +GetOptions('config|c=s' => \$configpath, + 'testplan|p=s' => \$testplanpath, + 'templates|d=s' => \$templatepath, + 'timeout|t=i' => \$timeout, + 'verbose|v' => \$verbose, + 'help|h' => \$help) || usage(1); +usage(0) if $help; + +my %conf = read_conf($configpath); +my @plans = load_plans($testplanpath, $templatepath); + +my $curstep; +local $SIG{CHLD} = sub { + my $suffix = "before test plan started."; + $suffix = "in $curstep step." if $curstep; + die "Command '@ARGV' terminated $suffix\n" +}; + +my ($inh, $outh) = (\*STDIN, \*STDOUT); +my $pid; +if (@ARGV) { + $inh = $outh = undef; + $pid = open2($inh, $outh, join(' ', @ARGV)); +} +binmode($inh, ':utf8'); +binmode($outh, ':utf8'); +autoflush $outh 1; +eval_in($inh, $outh, \%conf, @plans); +waitpid($pid, 0) if $pid; + +# TODO: swap over to Pod::Usage. +sub usage { + print STDERR "Usage: $0 [-v] [-c config] [-p testplan] [-d templatedir] [-t seconds] [command]\n"; + exit shift; +} + +sub read_conf { + my ($filen) = @_; + + my $fh = new IO::File("<$filen") || + die "Couldn't open $filen for reading: $!\n"; + map { + chomp; + s/\#.*$//; + map { s/^\s*([^\s]+)\s*$/$1/; $_ } split(/=/, $_, 2); + } <$fh>; +} + +our $testplan; +our $line; +sub load_plans { + local $testplan = shift; + my $dir = shift; + + my $planfh = new IO::File($testplan) || + die "Couldn't open $testplan for reading: $!.\n"; + local $line = 0; + map { + $line++; + chomp; + + my %rc = (name => $_); + $rc{send} = parse_template("$dir/$_.xml"); + if (-f "$dir/$_.expected.xml") { + $rc{expect} = parse_template("$dir/$_.expected.xml"); + } + \%rc; + } <$planfh> +} + +sub parse_template { + my ($fn) = @_; + + my $fh = new IO::File($fn) || + die "Couldn't open $fn for reading at line $line in $testplan: $!.\n"; + binmode($fh, ':utf8'); + + my @parts = split /([{}]|\n)/, do { local $/; <$fh> }; + my $intext = 1; + my $curthunk; + my $line = 1; + my $thunkstart; + my @rc; + while (@parts) { + my $tok = shift @parts; + + $line++ if $tok =~ /\n/; + + if ($intext) { + if ($tok =~ /{/) { + $thunkstart = $line; + $intext = 0; + } else { + push @rc, text($tok); + } + } else { + if ($tok =~ /}/) { + $intext = 1; + push @rc, thunk($curthunk, $fn, $thunkstart); + $curthunk = ''; + } else { + $curthunk .= $tok; + } + } + } + + die "Error in $fn: template ended inside thunk started at line $thunkstart.\n" . + "\tDid you forget a '}'?\n" unless $intext; + \@rc; +} + +sub nothing { ["text", sub { "" }] } + +sub text { + my $t = shift; + ['text', sub { $t }]; +} + +sub thunk { + my ($b, $fn, $line) = @_; + ['thunk', + sub { + package evalpkg; + local $evalpkg::arg = shift; + my $rc = eval $b; + $@ && + die "Error in $fn:$line: $@\ttestplan: $testplanpath\n\tconfig: $configpath\n"; + $rc; + }] +} + +sub eval_in { + local ($evalpkg::in, $evalpkg::out) = (shift, shift); + local %evalpkg::env = %{shift @_}; + my @plans = @_; + + foreach my $k (keys %evalpkg::env) { + # TODO: put $k in the symbol table directly, rather than calling + # string eval. + eval "package evalpkg; sub $k() { env('$k') };"; + } + + eval { + foreach my $plan (@plans) { + $curstep = $plan->{name}; + print STDERR "=> Executing $curstep step.\n" if $verbose; + do_send($plan->{name}, @{$plan->{send}}); + do_recv($plan->{name}, @{$plan->{expect}}) if $plan->{expect}; + } + }; + $@ && die $@; +} + +sub do_send { + my $name = shift; + my $s = join('', (map { $_->[1]->() } @_)); + if ($verbose) { + my $l = $s; + chomp $l; + print STDERR "SEND: $l\n" unless $l =~ /^\s*$/; + } + print $evalpkg::out $s; +} + +sub do_recv { + my $name = shift; + my (@reparts, @thunks); + foreach my $plan (@_) { + # Text is matched explicitly, thunks are treated as wildcards, + # with the match sent as an argument. + if ($plan->[0] eq 'text') { + my $t = $plan->[1]->(); + push @reparts, $t; + } else { + push @reparts, "(.*)"; + push @thunks, $plan->[1]; + } + } + my $re = join '', @reparts; + # TODO: add CLI options for whitespace/quote substitution. + $re =~ s/\s+/\\s\*/g; + $re =~ s/'|"/\['"\]/g; + + # Need a persistent buffer for reading, because we may get more data + # than needed when matching for expected output, so stash it here + # for subsequent reads after the current matcher is done. + state $readbuf = ''; + local $SIG{ALRM} = sub { + my $b = $readbuf; + chomp $b; + die "Timed out waiting for match in $name step. Current read buffer:\n$b\n"; + }; + alarm $timeout; + my @matches; + while (1) { + @matches = ($readbuf =~ /$re/); + if (@matches >= @thunks) { + $readbuf = $'; + last; + } + my $r; + my $n = sysread $evalpkg::in, $r, 2048; + die "Error reading data while waiting for match in $name step: $!.\n" if $n == -1; + die "End of file while waiting for match in $name step.\n" unless $n; + if ($verbose) { + my $l = $r; + chomp $l; + print STDERR "RECV: $l\n" + } + $readbuf .= $r; + } + alarm 0; + + for (my $i = 0; $i < @thunks; $i++) { + $thunks[$i]->($matches[$i]); + } +} + +sub assert_arg { + my ($name, $want) = @_; + if ($evalpkg::arg) { + my $got = $evalpkg::arg; + die "Bad $name (got '$got', want: '$want').\n" if $got ne $want; + } + $want; +} + +# Stick actual execution in its own package so you don't accidentally +# clobber stuff in main while running templates. +package evalpkg; + +use MIME::Base64; + +our ($in, $out); +our %env; +our $arg; + +sub env { + my $k = shift; + main::assert_arg($k, $env{$k}); +} + +sub bare_jid() { + main::assert_arg('bare_jid', (split /\//, $env{full_jid}, 2)[0]); +} + +sub localpart() { + main::assert_arg('localpart', (split /\@/, $env{full_jid}, 2)[0]); +} + +sub domainpart() { + main::assert_arg('domainpart', (split /\//, (split /\@/, $env{full_jid}, 2)[1])[0]); +} + +sub resourcepart() { + main::assert_arg('resourcepart', (split /\//, $env{full_jid}, 2)[1]); +} + +sub plain_auth() { + MIME::Base64::encode(join("\0", "", bare_jid(), $env{password})); +} |