From 1c6a40b64483804dc78e59e82762a8c7ff5a9842 Mon Sep 17 00:00:00 2001 From: Bill Erickson Date: Mon, 7 Mar 2016 15:57:52 -0500 Subject: [PATCH] perl websocket client WIP Signed-off-by: Bill Erickson --- src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm | 193 ------------------------- 1 file changed, 193 deletions(-) delete mode 100644 src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm diff --git a/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm b/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm deleted file mode 100644 index da4be56..0000000 --- a/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm +++ /dev/null @@ -1,193 +0,0 @@ -package OpenSRF::Utils::WebSocketsClient; -# ------------------------------------------------------------- -# 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. -# ------------------------------------------------------------- -# -# WebSocketsClient library. -# -# SSL only for now. -# -# ------------------------------------------------------------- -use strict; -use warnings; -use IO::Socket::SSL; -use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); -use Protocol::WebSocket::Client; -use OpenSRF::Utils::JSON; - -sub new { - my ($class, %args) = @_; - - my $self = { - host => $args{host} || 'localhost', - port => $args{port} || 7682, - path => $args{path} || '/osrf-websocket-translator', - ssl_params => $args{ssl_params} || {}, - connected => 0, - responses => [] - }; - - return bless($self, $class); -} - -sub connect { - my $self = shift; - - $self->connect_socket or return undef; - - my $url = sprintf("wss://%s:%d", $self->{host}, $self->{port}); - $url .= '/' . $self->{path} if $self->{path}; - - my $client = Protocol::WebSocket::Client->new( - url => $url, - on_write => sub { - my ($client, $data) = @_; - $self->{socket}->print($data); - }, - on_connect => sub { - my $client = shift; - $self->{connected} = 1; - }, - on_error => sub { - my ($client, $error) = @_; - warn "ERROR: $error\n"; - $self->disconnect; - } - ); - - $client->on( - # add resposnes to the response queue - read => sub { - my ($client, $data) = @_; - push(@{$self->{responses}}, - OpenSRF::Utils::JSON->JSON2perl($data)); - } - ); - - $self->{client} = $client; # needed in connect/recv callback - - $client->connect; - - while (!$self->{connected}) { $self->recv(-1) } - - return 1; -} - -sub connect_socket { - my $self = shift; - - my $sock = IO::Socket::SSL->new( - PeerHost => $self->{host}, - PeerPort => int($self->{port}), - Proto => 'tcp', - %{$self->{ssl_params}} - ); - - return $self->{socket} = $sock if $sock && $sock->connected; - - warn "SSL socket connection failed to ". - $self->{host}.":".$self->{port}." => $!\n"; - - return undef; -} - -sub send { - my ($self, $msg) = @_; - my $json = OpenSRF::Utils::JSON->perl2JSON($msg); - $self->{client}->write($json); -} - -sub next_msg { - my $self = shift; - return shift @{$self->{responses}}; -} - -sub peek_msg { - my $self = shift; - return (@{$self->{responses}} > 0); -} - -sub recv { - my ($self, $timeout) = @_; - return $self->next_msg if $self->peek_msg; - - $timeout ||= 0; - $timeout = undef if $timeout < 0; - my $socket = $self->{socket}; - - set_block($socket); - - # build the select readset - my $infile = ''; - vec($infile, $socket->fileno, 1) = 1; - - my $nfound = select($infile, undef, undef, $timeout); - return undef if !$nfound or $nfound == -1; - - # now slurp the data off the socket - my $buf; - my $read_size = 1024; - my $nonblock = 0; - my $nbytes; - my $first_read = 1; - - while($nbytes = sysread($socket, $buf, $read_size)) { - $self->{client}->read($buf); - if($nbytes < $read_size or $self->peek_msg) { - set_block($socket) if $nonblock; - last; - } - set_nonblock($socket) unless $nonblock; - $nonblock = 1; - $first_read = 0; - } - - if ($first_read and defined $nbytes and $nbytes == 0) { - # if the first read on an active socket is 0 bytes, - # the socket has been disconnected from the remote end. - die "Disconnected from Jabber server\n"; - } - - return $self->next_msg; -} - -sub disconnect { - my $self = shift; - $self->{connected} = 0; - return unless $self->{client}; - $self->{client}->disconnect; - delete $self->{client}; -} - -# ----------------------------------------------------------- -# Puts a file handle into blocking mode -# ----------------------------------------------------------- -sub set_block { - my $fh = shift; - my $flags = fcntl($fh, F_GETFL, 0); - $flags &= ~O_NONBLOCK; - fcntl($fh, F_SETFL, $flags); -} - -# ----------------------------------------------------------- -# Puts a file handle into non-blocking mode -# ----------------------------------------------------------- -sub set_nonblock { - my $fh = shift; - my $flags = fcntl($fh, F_GETFL, 0); - fcntl($fh, F_SETFL, $flags | O_NONBLOCK); -} - -1; - -- 2.11.0