view release on metacpan or  search on metacpan

lib/AnyEvent/WebSocket/Client.pm  view on Meta::CPAN

package AnyEvent::WebSocket::Client;

use strict;
use warnings;
use Moo;
use AE;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket ();
use Protocol::WebSocket::Request;
use Protocol::WebSocket::Handshake::Client;
use AnyEvent::WebSocket::Connection;
use PerlX::Maybe qw( maybe provided );

# ABSTRACT: WebSocket client for AnyEvent
our $VERSION = '0.55'; # VERSION


has timeout => (
  is      => 'ro',
  default => sub { 30 },
);


has ssl_no_verify => (
  is => 'ro',
);


has ssl_ca_file => (
  is => 'ro',
);


has protocol_version => (
  is => 'ro',
);


has subprotocol => (
  is     => 'ro',
  coerce => sub { ref $_[0] ? $_[0] : [$_[0]] },
);


has http_headers => (
  is => 'ro',
  coerce => sub {
    ref $_[0] eq 'ARRAY' ? $_[0] : do {
      my $h = shift;
      [
        map {
          my($k,$v) = ($_, $h->{$_});
          $v = [$v] unless ref $v;
          map { $k => $_ } @$v;
          # sorted to make testing easier.
          # may be removed in the future
          # so do not depend on it.
        } sort keys %$h
      ],
    };
  },
);


has max_payload_size => (
  is => 'ro',
);


has max_fragments => (
  is => 'ro',
);


has env_proxy => (
  is => 'ro',
  default => sub { 0 },
);



sub connect
{
  my($self, $uri, $host, $port) = @_;
  unless(ref $uri)
  {
    require URI;
    $uri = URI->new($uri);
  }

  my $done = AE::cv;

  # TODO: should we also accept http and https URLs?
  # probably.
  if($uri->scheme ne 'ws' && $uri->scheme ne 'wss')
  {
    $done->croak("URI is not a websocket");
    return $done;
  }

  $host = $uri->host unless defined $host;
  $port = $uri->port unless defined $port;

  $self->_make_tcp_connection($uri->scheme, $host, $port, sub {
    my $fh = shift;
    unless($fh)
    {
      $done->croak("unable to connect");
      return;
    }
    my $req = Protocol::WebSocket::Request->new( maybe headers => $self->http_headers );
    my $handshake = Protocol::WebSocket::Handshake::Client->new(
            url     => $uri->as_string,
      maybe version => $self->protocol_version,
            req     => $req,
    );

    my %subprotocol;
    if($self->subprotocol)
    {
      %subprotocol = map { $_ => 1 } @{ $self->subprotocol };
      $handshake->req->subprotocol(join(',', @{ $self->subprotocol }));
    }

    my $hdl = AnyEvent::Handle->new(
                                                      fh       => $fh,
      provided $uri->secure,                          tls      => 'connect',
      provided $uri->secure && !$self->ssl_no_verify, peername => $uri->host,
      provided $uri->secure && !$self->ssl_no_verify, tls_ctx  => {
                                                              verify => 1,
                                                              verify_peername => "https",
                                                        maybe ca_file => $self->ssl_ca_file,
                                                      },
                                                      on_error => sub {
                                                        my ($hdl, $fatal, $msg) = @_;
                                                        if($fatal)
                                                        { $done->croak("connect error: " . $msg) }
                                                        else
                                                        { warn $msg }
                                                      },
    );

    $hdl->push_write($handshake->to_string);
    $hdl->on_read(sub {
      $handshake->parse($_[0]{rbuf});
      if($handshake->error)
      {
        $done->croak("handshake error: " . $handshake->error);
        undef $hdl;
        undef $handshake;
        undef $done;
      }
      elsif($handshake->is_done)
      {
        my $sb;
        if($self->subprotocol)
        {
          $sb = $handshake->res->subprotocol;
          if(defined $sb)
          {
            unless($subprotocol{$sb})
            {
              $done->croak("subprotocol mismatch, requested: @{[ join ', ', @{ $self->subprotocol } ]}, got: $sb");
            }
          }
          else
          {
            $done->croak("no subprotocol in response");
          }
        }
        undef $handshake;
        $done->send(
          AnyEvent::WebSocket::Connection->new(
                  handle               => $hdl,
                  masked               => 1,
            maybe subprotocol          => $sb,
            maybe max_payload_size     => $self->max_payload_size,
            maybe max_fragments        => $self->max_fragments,
          )
        );
        undef $hdl;
        undef $done;
      }
    });
  }, sub { $self->timeout });
  $done;
}

sub _make_tcp_connection
{
  my $self = shift;

lib/AnyEvent/WebSocket/Client.pm  view on Meta::CPAN

   # make $connection an our variable rather than
   # my so that it will stick around.  Once the
   # connection falls out of scope any callbacks
   # tied to it will be destroyed.
   our $connection = eval { shift->recv };
   if($@) {
     # handle error...
     warn $@;
     return;
   }
 
   # send a message through the websocket...
   $connection->send('a message');
 
   # recieve message from the websocket...
   $connection->on(each_message => sub {
     # $connection is the same connection object
     # $message isa AnyEvent::WebSocket::Message
     my($connection, $message) = @_;
     ...
   });
 
   # handle a closed connection...
   $connection->on(finish => sub {
     # $connection is the same connection object
     my($connection) = @_;
     ...
   });
 
   # close the connection (either inside or
   # outside another callback)
   $connection->close;
 
 });
 
 ## uncomment to enter the event loop before exiting.
 ## Note that calling recv on a condition variable before
 ## it has been triggered does not work on all event loops
 #AnyEvent->condvar->recv;

=head1 DESCRIPTION

This class provides an interface to interact with a web server that provides
services via the WebSocket protocol in an L<AnyEvent> context.  It uses
L<Protocol::WebSocket> rather than reinventing the wheel.  You could use
L<AnyEvent> and L<Protocol::WebSocket> directly if you wanted finer grain
control, but if that is not necessary then this class may save you some time.

The recommended API was added to the L<AnyEvent::WebSocket::Connection>
class with version 0.12, so it is recommended that you include that version
when using this module.  The older version of the API has since been
deprecated and removed.

=head1 ATTRIBUTES

=head2 timeout

Timeout for the initial connection to the web server.  The default
is 30.

=head2 ssl_no_verify

If set to true, then secure WebSockets (those that use SSL/TLS) will
not be verified.  The default is false.

=head2 ssl_ca_file

Provide your own CA certificates file instead of using the system default for
SSL/TLS verification.

=head2 protocol_version

The protocol version.  See L<Protocol::WebSocket> for the list of supported
WebSocket protocol versions.

=head2 subprotocol

List of subprotocols to request from the server.  This class will throw an
exception if none of the protocols are supported by the server.

=head2 http_headers

Extra headers to include in the initial request.  May be either specified
as a hash reference, or an array reference.  For example:

 AnyEvent::WebSocket::Client->new(
   http_headers => {
     'X-Foo' => 'bar',
     'X-Baz' => [ 'abc', 'def' ],
   },
 );
 
 AnyEvent::WebSocket::Client->new(
   http_headers => [
     'X-Foo' => 'bar',
     'X-Baz' => 'abc',
     'X-Baz' => 'def',
   ],
 );

Will generate:

 X-Foo: bar
 X-Baz: abc
 X-Baz: def

Although, the order cannot be guaranteed when using the hash style.

=head2 max_payload_size

The maximum payload size for received frames.  Currently defaults to whatever
L<Protocol::WebSocket> defaults to.

=head2 max_fragments

The maximum number of fragments for received frames.  Currently defaults to whatever
L<Protocol::WebSocket> defaults to.

=head2 env_proxy

If you set true to this boolean attribute, it loads proxy settings