view release on metacpan or  search on metacpan

demo/wscat.pl  view on Meta::CPAN

use warnings;
use autodie;

use Try::Tiny;

use IO::Events ();

use HTTP::Response;
use IO::Socket::INET ();
use Socket ();
use URI::Split ();

use FindBin;
use lib "$FindBin::Bin/../lib";

use lib "$FindBin::Bin/lib";
use MockReader ();

use Net::WebSocket::Endpoint::Client ();
use Net::WebSocket::Frame::binary ();
use Net::WebSocket::Frame::close  ();
use Net::WebSocket::Handshake::Client ();
use Net::WebSocket::Parser ();

use Net::WebSocket::PMCE::deflate::Client ();

use Net::WebSocket::HTTP_R ();

use constant {
    MAX_CHUNK_SIZE => 64000,
    CRLF => "\x0d\x0a",
    DEBUG => 0,

    SEND_FRAME_CLASS => 'Net::WebSocket::Frame::binary',
};

#No PIPE
use constant ERROR_SIGS => qw( INT HUP QUIT ABRT USR1 USR2 SEGV ALRM TERM );

run( @ARGV ) if !caller;

sub run {
    my ($uri) = @_;

    local $SIG{'PIPE'} = 'IGNORE';

    -t \*STDIN or die "STDIN must be a TTY for this demo.\n";

    my ($uri_scheme, $uri_authority) = URI::Split::uri_split($uri);

    if (!$uri_scheme) {
        die "Need a URI!\n";
    }

    if ($uri_scheme !~ m<\Awss?\z>) {
        die sprintf "Invalid schema: “%s” ($uri)\n", $uri_scheme;
    }

    my $inet;

    my ($host, $port) = split m<:>, $uri_authority;

    if ($uri_scheme eq 'ws') {
        my $iaddr = Socket::inet_aton($host);

        $port ||= 80;
        my $paddr = Socket::pack_sockaddr_in( $port, $iaddr );

        socket( $inet, Socket::PF_INET(), Socket::SOCK_STREAM(), 0 );
        connect( $inet, $paddr );
    }
    elsif ($uri_scheme eq 'wss') {
        require IO::Socket::SSL;

        $inet = IO::Socket::SSL->new(
            PeerHost => $host,
            PeerPort => $port || 443,
            SSL_hostname => $host,
        );

        die "IO::Socket::SSL: [$!][$@]\n" if !$inet;
    }
    else {
        die "Unknown scheme ($uri_scheme) in URI: “$uri”";
    }

    my $loop = IO::Events::Loop->new();

    my ($handle, $ept);

    my $timeout = IO::Events::Timer->new(
        owner => $loop,
        timeout => 5,
        repetitive => 1,
        on_tick => sub {
            die "Handshake timeout!\n" if !$ept;

            $ept->check_heartbeat();

            #Handle any control frames we might need to write out,
            #esp. pings.
            #TODO
        },
    );

    my @to_write;

    my $sent_handshake;
    my $got_handshake;

    my $read_obj = MockReader->new();

    my $handshake;

    my $deflate = Net::WebSocket::PMCE::deflate::Client->new();
    my $deflate_hsk = $deflate->get_handshake_object();
    my $deflate_data;

    $handle = IO::Events::Handle->new(
        owner => $loop,
        handle => $inet,