aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--README115
-rw-r--r--input29
-rw-r--r--localhost.conf3
-rw-r--r--testplan6
-rw-r--r--xml/auth.expected.xml1
-rw-r--r--xml/auth.xml1
-rw-r--r--xml/bind-reneg.expected.xml9
-rw-r--r--xml/bind-reneg.xml7
-rw-r--r--xml/bind.expected.xml5
-rw-r--r--xml/bind.xml5
-rw-r--r--xml/session.expected.xml1
-rw-r--r--xml/session.xml3
-rw-r--r--xml/signin.expected.xml12
-rw-r--r--xml/signin.xml6
-rw-r--r--xml/signout.expected.xml1
-rw-r--r--xml/signout.xml1
-rwxr-xr-xxmpt279
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
diff --git a/README b/README
new file mode 100644
index 0000000..ed74d01
--- /dev/null
+++ b/README
@@ -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.
diff --git a/input b/input
new file mode 100644
index 0000000..5effb70
--- /dev/null
+++ b/input
@@ -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>
diff --git a/xmpt b/xmpt
new file mode 100755
index 0000000..bae4eee
--- /dev/null
+++ b/xmpt
@@ -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}));
+}