src/websocket-stdio/test-stateful.pl

   1 #!/usr/bin/perl
   2 # --------------------------------------------------------------------------
   3 # Copyright (C) 2018 King County Library Service
   4 # Bill Erickson <berickxx@gmail.com>
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License
   8 # as published by the Free Software Foundation; either version 2
   9 # of the License, or (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 # --------------------------------------------------------------------------
  16 #
  17 # Synopsis:
  18 #
  19 # $ sudo cpan Net::Async::WebSocket::Client;
  20 # $ sudo cpan IO::Async::SSL;
  21 # $ time perl test-stateful.pl wss://localhost:443/osrf-websocket-translator
  22 #
  23 # --------------------------------------------------------------------------
  24 use strict;
  25 use warnings;
  26 use IO::Async::Loop;
  27 use Net::Async::WebSocket::Client;
  28 use OpenSRF::Utils::JSON;
  29
  30 my $fork_count = 5;
  31 my $batch_size = 1000;
  32
  33 # allow the script to run easily on test VMs.
  34 use IO::Socket::SSL;
  35 IO::Socket::SSL::set_ctx_defaults(SSL_verify_mode => 0);
  36
  37 package StatefulBatch;
  38
  39 sub new {
  40     my $class = shift;
  41     my $self = {
  42         client => undef,
  43         loop => undef,
  44         thread => undef,
  45         sent_count => 0,
  46         in_connect => 0
  47     };
  48
  49     return bless($self, $class);
  50 }
  51
  52 sub send_connect {
  53     my $self = shift;
  54     $self->{in_connect} = 1;
  55
  56     my $thread = $self->{thread} = rand(); # reset on connect
  57     my $msg = <<MSG;
  58     {"service":"open-ils.auth","thread":"$thread","osrf_msg":[{"__c":"osrfMessage","__p":{"threadTrace":"0","locale":"en-US","tz":"America/New_York","type":"CONNECT"}}]}
  59 MSG
  60
  61     $self->{client}->send_text_frame($msg);
  62 }
  63
  64 sub send_request {
  65     my $self = shift;
  66     $self->{in_connect} = 0;
  67
  68     my $thread = $self->{thread};
  69     my $msg = <<MSG;
  70 {"service":"open-ils.auth","thread":"$thread","osrf_msg":[{"__c":"osrfMessage","__p":{"threadTrace":1,"type":"REQUEST","payload":{"__c":"osrfMethod","__p":{"method":"opensrf.system.echo","params":["EC asldi asldif asldfia sdflias dflasdif alsdif asldfias dlfiasd flasidf alsdif alsdif asldfia sldfias dlfias dflaisd flasidf lasidf alsdif asldif asldif asldif asldif asldif asldfia sldfia sdlfias dlfias dfliasd flasidf lasidf alsdif asldif alsdif asldif asldif aslidf alsdif alsidf alsdif asldif asldif asldif asldif asldif asldif alsdif alsdif alsidf alsidf alsdif asldif asldif asldfi asldfi asldif asldif asldfi asldfias ldfaisdf lasidf alsdif asldif asldfi asdlfias dHO ME"]}},"locale":"en-US","tz":"America/New_York","api_level":1}}]}
  71 MSG
  72
  73     $self->{client}->send_text_frame($msg);
  74 }
  75
  76 sub send_disconnect {
  77     my $self = shift;
  78
  79     my $thread = $self->{thread};
  80     my $msg = <<MSG;
  81     {"service":"open-ils.auth","thread":"$thread","osrf_msg":[{"__c":"osrfMessage","__p":{"threadTrace":"2","locale":"en-US","tz":"America/New_York","type":"DISCONNECT"}}]}
  82 MSG
  83     $self->{client}->send_text_frame($msg);
  84 }
  85
  86
  87 sub on_message {
  88     my ($self, $frame) = @_;
  89
  90     my $msg = OpenSRF::Utils::JSON->JSON2perl($frame);
  91     my $type = $msg->{osrf_msg}->[0]->{type};
  92
  93     if ($self->{in_connect}) {
  94         my $msg = OpenSRF::Utils::JSON->JSON2perl($frame);
  95         if ($type ne 'STATUS') {
  96             die "Received unexpected message type: $type : $frame\n";
  97         }
  98         $self->send_request;
  99
 100     } else {
 101
 102         if ($type ne 'RESULT') {
 103             die "Received unexpected message type: $type : $frame\n";
 104         }
 105
 106         # disconnect messages do not return replies
 107         $self->send_disconnect;
 108
 109         print "[$$] completed ".$self->{sent_count} . " of $batch_size\n";
 110
 111         if ($self->{sent_count}++ >= $batch_size) {
 112             $self->{loop}->stop;
 113             return;
 114         }
 115
 116         $self->send_connect;
 117     }
 118 }
 119
 120 package main;
 121
 122 my $url = $ARGV[0] or die "WS URL REQUIRED\n";
 123
 124
 125 for (1..$fork_count) {
 126
 127     if (fork() == 0) {
 128         my $tester = StatefulBatch->new;
 129
 130         $tester->{client} = Net::Async::WebSocket::Client->new(
 131             on_text_frame => sub {
 132                 my ($client, $frame) = @_;
 133                 $tester->on_message($frame);
 134             }
 135         );
 136
 137         $tester->{loop} = IO::Async::Loop->new;
 138         $tester->{loop}->add($tester->{client});
 139         $tester->{client}->connect(
 140             url => $url, on_connected => sub {$tester->send_connect});
 141         $tester->{loop}->run;
 142         exit(0);
 143     }
 144 }
 145
 146 # exit after all children have exited
 147 while (wait() > -1) {}
 148