summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/proxy_websockets.t
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-25 04:41:28 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-25 04:41:28 +0000
commit2eeb62e38ae17a3523ad3cd81c3de9f20f9e7742 (patch)
treefe91033d4712f6d836006b998525656b9dd193b8 /debian/perl-framework/t/modules/proxy_websockets.t
parentMerging upstream version 2.4.59. (diff)
downloadapache2-debian.tar.xz
apache2-debian.zip
Adding debian version 2.4.59-1~deb10u1.debian/2.4.59-1_deb10u1debian
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/modules/proxy_websockets.t')
-rw-r--r--debian/perl-framework/t/modules/proxy_websockets.t81
1 files changed, 81 insertions, 0 deletions
diff --git a/debian/perl-framework/t/modules/proxy_websockets.t b/debian/perl-framework/t/modules/proxy_websockets.t
new file mode 100644
index 0000000..f2d6558
--- /dev/null
+++ b/debian/perl-framework/t/modules/proxy_websockets.t
@@ -0,0 +1,81 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+use Apache::TestConfig ();
+
+# not reliable, hangs for some people:
+# my @test_cases = ( "ping0", "ping1" x 10, "ping2" x 100, "ping3" x 1024, "ping4" x 4096, "sendquit");
+my @test_cases = ( "ping0", "ping1" x 10, "ping2" x 100, "ping3" x 1024, "sendquit");
+my $total_tests = 2;
+
+plan tests => $total_tests, need 'AnyEvent::WebSocket::Client',
+ need_module('proxy_http', 'lua'), need_min_apache_version('2.4.47');
+
+require AnyEvent;
+require AnyEvent::WebSocket::Client;
+
+my $config = Apache::Test::config();
+my $hostport = Apache::TestRequest::hostport();
+
+my $client = AnyEvent::WebSocket::Client->new(timeout => 5);
+
+my $quit_program = AnyEvent->condvar;
+
+my $responses = 0;
+my $surprised = 0;
+
+$client->connect("ws://$hostport/proxy/wsoc")->cb(sub {
+ our $connection = eval { shift->recv };
+ t_debug("wsoc connected");
+ if($@) {
+ # handle error...
+ warn $@;
+ $quit_program->send();
+ return;
+ }
+
+
+ # AnyEvent::WebSocket::Connection does not pass the PONG message down to the callback
+ # my $actualpingmsg = AnyEvent::WebSocket::Message->new(opcode => 0x09, body => "xxx");
+ # $connection->send($actualpingmsg);
+
+ foreach (@test_cases){
+ $connection->send($_);
+ }
+
+ $connection->on(finish => sub {
+ t_debug("finish");
+ });
+
+ # recieve message from the websocket...
+ $connection->on(each_message => sub {
+ # $connection is the same connection object
+ # $message isa AnyEvent::WebSocket::Message
+ my($connection, $message) = @_;
+ $responses++;
+ t_debug("wsoc msg received: " . substr($message->body, 0, 5). " opcode " . $message->opcode);
+ if ("sendquit" eq $message->body) {
+ $connection->send('quit');
+ t_debug("closing");
+ $connection->close; # doesn't seem to close TCP.
+ $quit_program->send();
+ }
+ elsif ($message->body =~ /^ping(\d)/) {
+ my $offset = $1;
+ if ($message->body ne $test_cases[$offset]) {
+ $surprised++;
+ }
+ }
+ else {
+ $surprised++;
+ }
+ });
+
+});
+
+$quit_program->recv;
+ok t_cmp($surprised, 0);
+ok t_cmp($responses, scalar(@test_cases) );