From aac49e84982295f0a7ce3a1142f54bc08f5a8c15 Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Mon, 7 Mar 2016 15:57:27 -0500 Subject: [PATCH] perl websocket client WIP Signed-off-by: Bill Erickson --- src/extras/perl-websocket-client.pl | 50 ++++++++---- .../lib/OpenSRF/Transport/WebSockets/Client.pm | 91 ++++++++++++++++------ .../lib/OpenSRF/Transport/WebSockets/Message.pm | 1 - 3 files changed, 100 insertions(+), 42 deletions(-) diff --git a/src/extras/perl-websocket-client.pl b/src/extras/perl-websocket-client.pl index 2931bf6..8302c17 100755 --- a/src/extras/perl-websocket-client.pl +++ b/src/extras/perl-websocket-client.pl @@ -1,17 +1,26 @@ #!/usr/bin/perl +# ------------------------------------------------------------- +# Copyright (C) 2016, King County Library System +# Bill Erickson +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# ------------------------------------------------------------- +# Sample script using WebSockets transport. +# ------------------------------------------------------------- use strict; use warnings; -use OpenSRF::System; -use OpenSRF::AppSession; use OpenSRF::DomainObject::oilsMethod; use OpenSRF::DomainObject::oilsMessage; use OpenSRF::Transport::WebSockets::Client; -my $osrf_config = '/openils/conf/opensrf_core.xml'; - -# note: for now this still connects to jabber. -OpenSRF::System->bootstrap_client(config_file => $osrf_config); - my $method = OpenSRF::DomainObject::oilsMethod->new( method => 'opensrf.system.echo', params => ['hello, world'] @@ -27,7 +36,7 @@ my $msg = OpenSRF::DomainObject::oilsMessage->new( # connects to localhost by default my $client = OpenSRF::Transport::WebSockets::Client->new( - 'no-op', + 'ignored', host => 'localhost', port => 7682, ssl_no_verify => 1, @@ -35,18 +44,25 @@ my $client = OpenSRF::Transport::WebSockets::Client->new( die "cound not connect\n" unless $client->connect; -$client->send( - to => 'open-ils.auth', - thread => rand(), - msg => [$msg] -); +my $idx = 0; +while ($idx++ < 5) { + + $client->send( + to => 'open-ils.auth', + thread => rand(), + msg => [$msg] + ); -my $response = $client->recv(-1); + my $response = $client->recv(-1); -for my $msg (@{$response->{msg}}) { - print "received: " . - OpenSRF::Utils::JSON->perl2JSON($msg) . "\n\n"; + for my $msg (@{$response->{msg}}) { + print "RECEIVED: " . $msg->type . "\n"; + if ($msg->type eq 'RESULT') { + print "_-=> " . $msg->payload->content . "\n"; + } + } } +$client->disconnect; diff --git a/src/perl/lib/OpenSRF/Transport/WebSockets/Client.pm b/src/perl/lib/OpenSRF/Transport/WebSockets/Client.pm index 587aa98..8af2f36 100644 --- a/src/perl/lib/OpenSRF/Transport/WebSockets/Client.pm +++ b/src/perl/lib/OpenSRF/Transport/WebSockets/Client.pm @@ -13,6 +13,11 @@ package OpenSRF::Transport::WebSockets::Client; # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # ------------------------------------------------------------- +# WebSockets Client. +# Only works in manual/client mode, pending changes to higher- +# level code to support connecting without requiring access +# to the settings server. +# ------------------------------------------------------------- use strict; use warnings; use IO::Socket::SSL; @@ -24,7 +29,8 @@ use OpenSRF::Transport::WebSockets::Message; use Data::Dumper; $Data::Dumper::INDENT=0; - +# Shared connection required by OpenSRF in some contexts. +# Can be bypassed in new(). our $connection; sub retrieve { @@ -38,26 +44,46 @@ sub reset { } +# $app is ignored in client (non-server) mode sub new { my ($class, $app, %args) = @_; return $connection if - $connection && $connection->{socket}->connected; + !$args{force_new} && + $connection && + $connection->{socket}->connected; + + my $host = $args{host}; + my $port = $args{port}; + my $path = $args{path}; + # In client-only mode, there may be no bootstrap config. my $conf = OpenSRF::Utils::Config->current; + if ($conf) { + $host ||= $conf->bootstrap->domain; + $port ||= $conf->bootstrap->port; + $path ||= $conf->bootstrap->path; + } + + # Finally apply defaults + $host ||= 'localhost'; + $port ||= 7682; + $path ||= '/osrf-websocket-translator'; my $self = { service => $app, - host => $args{host} || $conf->bootstrap->domain || 'localhost', - port => $args{port} || $conf->bootstrap->domain || 7682, - path => $args{path} || $conf->bootstrap->path || '/osrf-websocket-translator', + host => $host, + port => $port, + path => $path, connected => 0, responses => [], ssl_params => {} }; - $self->{ssl_params} = {SSL_verify_mode => SSL_VERIFY_NONE} - if ($args{ssl_no_verify} || $conf->bootstrap->ssl_no_verify); + $self->{ssl_params} = {SSL_verify_mode => SSL_VERIFY_NONE} if ( + $args{ssl_no_verify} || + ($conf && $conf->bootstrap->ssl_no_verify) + ); $connection = bless($self, $class); return $connection; @@ -118,16 +144,18 @@ sub connect_socket { }; $logger->debug("WebSocket socket args: " . Dumper($sock_args)); - warn "WebSocket socket args: " . Dumper($sock_args) . "\n"; my $sock = IO::Socket::SSL->new(%$sock_args); - return $self->{socket} = $sock if $sock && $sock->connected; + unless ($sock && $sock->connected) { + + $logger->error("SSL socket connection failed for ". + $self->{host}.":".$self->{port}." => $!"); - warn "SSL socket connection failed to ". - $self->{host}.":".$self->{port}." => $!\n"; + return undef; + } - return undef; + return $self->{socket} = $sock; } @@ -151,10 +179,8 @@ sub app { # true if a connection exists and the TCP port is open. sub tcp_connected { - return - $connection && - $connection->{socket} && - $connection->{socket}->connected; + my $self = shift; + return $self->{socket} && $self->{socket}->connected; } # true if we have completed the websockets handshake w/ the server @@ -163,11 +189,7 @@ sub connected { return $self->tcp_connected && $self->{connected}; } -# returns a message if one is availabe or becomes available -# within the timeout provided. A timeout value of 0 or undef -# means check for messages, but don't wait. A timeout of -1 means -# wait until a message arrives. A timeout of > 0 means to wait -# the many seconds for a message to arrive. +# OpenSRF method; checks for received messages. sub process { my $self = shift; return $self->recv(@_); @@ -268,9 +290,30 @@ sub send { sub disconnect { my $self = shift; $self->{connected} = 0; - return unless $self->{client}; - $self->{client}->disconnect; - delete $self->{client}; + + if ($self->{client}) { + $self->{client}->disconnect; + delete $self->{client}; + } + + if ($self->{socket}) { + $self->{socket}->close; + $self->{socket}->shutdown(2); + delete $self->{socket}; + } +} + +# Read and discard all messages from the socket (without blocking). +# Returns 1 on success, 0 if not connected. +sub flush_socket { + my $self = shift; + return 0 unless $self->connected; + + while ($self->recv(0)) { + $logger->debug("flushing data from socket..."); + } + + return $self->connected; } diff --git a/src/perl/lib/OpenSRF/Transport/WebSockets/Message.pm b/src/perl/lib/OpenSRF/Transport/WebSockets/Message.pm index 1078028..8340452 100644 --- a/src/perl/lib/OpenSRF/Transport/WebSockets/Message.pm +++ b/src/perl/lib/OpenSRF/Transport/WebSockets/Message.pm @@ -19,7 +19,6 @@ use OpenSRF::Utils::JSON; sub new { my $class = shift; - warn "Message: @_\n"; my %args = @_; my $self = bless({}, $class); -- 2.11.0