view release on metacpan or  search on metacpan

demo/wscat_the_hard_way.pl  view on Meta::CPAN

#!/usr/bin/env perl

#----------------------------------------------------------------------
# You probably should use an event loop rather than futzing with
# multiplexing manually. But if you feel you must, here is an example
# of how Net::WebSocket can work in that context.
#
# Still, please look at wscat.pl for an illustration how much of the
# “mess” an event loop can take on for you.
#----------------------------------------------------------------------

use strict;
use warnings;
use autodie;

use Try::Tiny;

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

use IO::Framed ();
use IO::SigGuard ();

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

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 constant MAX_CHUNK_SIZE => 64000;

use constant CRLF => "\x0d\x0a";

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

run( @ARGV ) if !caller;

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

    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 $buf_sr = _handshake_as_client( $inet, $uri );

    _mux_after_handshake( \*STDIN, \*STDOUT, $inet, $$buf_sr );

    exit 0;
}

sub _handshake_as_client {
    my ($inet, $uri) = @_;

    my $handshake = Net::WebSocket::Handshake::Client->new(
        uri => $uri,
    );

    my $hdr = $handshake->to_string();

    #Write out the client handshake.
    IO::SigGuard::syswrite( $inet, $hdr );

    my $handshake_ok;

    my $buf = q<>;

    #Read the server handshake.
    my $idx;
    while ( IO::SigGuard::sysread($inet, $buf, MAX_CHUNK_SIZE, length $buf ) ) {
        $idx = index($buf, CRLF . CRLF);
        last if -1 != $idx;
    }

    my $hdrs_txt = substr( $buf, 0, $idx + 2 * length(CRLF), q<> );

    my $req = HTTP::Response->parse($hdrs_txt);

    my $code = $req->code();