From 38b342e36f7a8df359154f741d1e1b0b7091bd47 Mon Sep 17 00:00:00 2001
From: Badlop
Date: Tue, 16 Jun 2009 17:48:31 +0000
Subject: [PATCH] Add unit test script for http-bind service (thanks to Stefan
Strigler)
SVN Revision: 2259
---
tools/jhbtest.pl | 451 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 451 insertions(+)
create mode 100755 tools/jhbtest.pl
diff --git a/tools/jhbtest.pl b/tools/jhbtest.pl
new file mode 100755
index 000000000..854e09ee7
--- /dev/null
+++ b/tools/jhbtest.pl
@@ -0,0 +1,451 @@
+#!/usr/bin/perl -w
+
+use strict; # har har
+
+use constant ERR => 0;
+use constant WARN => 1;
+use constant INFO => 2;
+use constant DEBUG => 3;
+
+use constant RID => 31974;
+
+### ### ### conf ### ### ###
+
+my $BASE_ADDRESS = "http://localhost:5280/http-bind/";
+my $JABBER_SERVER = "localhost";
+
+my $RID = RID;
+
+my $WAIT = 60;
+
+my $USER = "tester";
+my $UPW = "mysecret";
+
+my $DEBUG = INFO;
+
+### ### ### END conf ### ### ###
+
+# create an agent we can use for our requests
+use LWP::UserAgent;
+my $ua = new LWP::UserAgent();
+
+# create a tree parser to parse response content
+use XML::Parser;
+my $p = new XML::Parser(Style => 'Tree');
+
+
+### ### ### subs ### ### ###
+sub doSend() {
+ my $content = shift;
+
+ # create a request
+ my $req = new HTTP::Request(POST => $BASE_ADDRESS);
+ $req->content_type('text/xml; charset=utf-8');
+ $req->content($content);
+
+ debug(DEBUG,"<< Request\n".$req->as_string."<< END Request");
+
+ # send request
+ my $res = $ua->request($req);
+
+ debug(DEBUG,">> Response\n" . $res->as_string .">> END Response");
+ return $res;
+}
+
+# getChildEls
+# used to strip enclosing body element
+# PARAMS: @tree - tree style array from XML::Parser
+# RETURN: @children - child elements of top level element
+sub getChildEls
+{
+ my $t = $_[0];
+
+ shift @{$t->[1]};
+ return @{$t->[1]};
+}
+
+sub debug
+{
+ my $lvl = shift;
+ my $msg = shift;
+
+ return if ($DEBUG < $lvl);
+
+ my $prefix = "[";
+ $prefix .= "ERROR" if ($lvl == ERR);
+ $prefix .= "WARNING" if ($lvl == WARN);
+ $prefix .= "INFO" if ($lvl == INFO);
+ $prefix .= "DEBUG" if ($lvl == DEBUG);
+ $prefix .= "] ";
+
+ $msg =~ s/\n/\n$prefix/g;
+ print STDERR $prefix . $msg . "\n";
+}
+### ### ### main ### ### ###
+
+$| = 1; # set streaming output
+
+# no body
+print "Sending some 'foo': ";
+my $res = &doSend("foo");
+if ($res->code == 400) {
+ print "OK.\n";
+} else {
+ print "Failed!\n";
+ print $res->as_string, "\n";
+}
+# no body
+print "Sending some '': ";
+$res = &doSend("");
+if ($res->code == 400) {
+ print "OK.\n";
+} else {
+ print "Failed!\n";
+ print $res->as_string, "\n";
+}
+
+# empty body
+print "Sending empty body: ";
+$res = &doSend("");
+if ($res->code == 400) {
+ print "OK.\n";
+} else {
+ print "Failed!\n";
+ print $res->as_string, "\n";
+}
+
+# fake a sid
+print "Sending wrong sid: ";
+$res = &doSend("
content =~/as_string, "\n";
+}
+
+# sending empty 'to' attribute
+print "Empty 'to' attribute at session creation request: ";
+$res = &doSend("content =~/as_string, "\n";
+}
+
+# forget to send a rid
+print "Missing 'rid' attribute at session creation request: ";
+$res = &doSend("content =~/as_string, "\n";
+}
+
+# trying to connect to non-existent jabber server
+print "Connecting to non-existent jabber server: ";
+$res = &doSend("content =~/content =~/as_string, "\n";
+}
+
+# connection to foreign server
+#print "Connecting to foreign jabber server: ";
+#$res = &doSend("content =~/as_string, "\n";
+#}
+
+my %sess;
+sub getSess
+{
+ $sess{rid} = RID; # a rid to start
+ $res = &doSend("$USER");
+ my @els = (&getChildEls($p->parse($res->content)));
+ unless ($els[0] eq 'iq' && $els[1]->[0]->{'type'} eq 'result') {
+ debug(ERR, $res->content);
+ return 0;
+ }
+
+# send auth
+ $sess{rid}++;
+ $res = &doSend("$USERtest$UPW");
+ @els = (&getChildEls($p->parse($res->content)));
+ unless ($els[0] eq 'iq' && $els[1]->[0]->{'type'} eq 'result') {
+ debug(ERR, $res->content);
+ return 0;
+ }
+
+ return 1;
+}
+
+print "Authenticating: ";
+if (&doAuth()) {
+ print "OK.\n";
+} else {
+ print "FAILED!\n";
+ debug(ERR, "Aborting.");
+ exit(1);
+}
+
+
+sub doPoll
+{
+ $sess{rid}++;
+ return &doSend("");
+debug(INFO, $res->content);
+
+# send presence
+print "sending presence\n";
+$sess{rid}++;
+$res = &doSend("");
+debug(INFO, $res->content);
+
+# sending bullshit
+print "sending bullshit\n";
+$sess{rid}++;
+$res = &doSend("sending bullshit");
+debug(INFO, $res->content);
+
+# send presence
+print "sending xa presence\n";
+$sess{rid}++;
+$res = &doSend("xa");
+debug(INFO, $res->content);
+
+# disconnect
+sleep 3;
+print "logout\n";
+$sess{rid}++;
+$res = &doSend("");
+debug(INFO, $res->content);
+
+
+print "Checking if session terminated: ";
+$res = &doPoll();
+if ($res->code != 404) {
+ print "FAILED!\n";
+ debug(ERR, "Aborting.");
+ exit(1);
+}
+print "OK.\n";