Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
add Mojo::WebSocket for low-level protocol functions
  • Loading branch information
kraih committed Jan 9, 2016
1 parent c7cd1af commit 4b74d88
Show file tree
Hide file tree
Showing 5 changed files with 61 additions and 70 deletions.
4 changes: 2 additions & 2 deletions lib/Mojo/Server/Daemon.pm
Expand Up @@ -8,6 +8,7 @@ use Mojo::IOLoop;
use Mojo::Transaction::WebSocket;
use Mojo::URL;
use Mojo::Util 'term_escape';
use Mojo::WebSocket 'server_handshake';
use Scalar::Util 'weaken';

use constant DEBUG => $ENV{MOJO_DAEMON_DEBUG} || 0;
Expand Down Expand Up @@ -87,8 +88,7 @@ sub _build_tx {
# WebSocket
if ($tx->req->is_handshake) {
my $ws = Mojo::Transaction::WebSocket->new(handshake => $tx);
$ws->server_handshake;
$self->emit(request => $ws);
$self->emit(request => server_handshake $ws);
$tx->next($ws->handshake(undef));
}

Expand Down
63 changes: 2 additions & 61 deletions lib/Mojo/Transaction/WebSocket.pm
Expand Up @@ -6,17 +6,14 @@ use Config;
use List::Util 'first';
use Mojo::JSON qw(encode_json j);
use Mojo::Transaction::HTTP;
use Mojo::Util qw(b64_encode decode dumper encode sha1_bytes trim xor_encode);
use Mojo::Util qw(decode dumper encode trim xor_encode);

use constant DEBUG => $ENV{MOJO_WEBSOCKET_DEBUG} || 0;

# Perl with support for quads
use constant MODERN =>
(($Config{use64bitint} // '') eq 'define' || $Config{longsize} >= 8);

# Unique value from RFC 6455
use constant GUID => '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';

# Opcodes
use constant {
CONTINUATION => 0x0,
Expand Down Expand Up @@ -98,31 +95,6 @@ sub build_message {
return $self->build_frame(@$frame);
}

sub client_challenge {
my $self = shift;

# "permessage-deflate" extension
my $headers = $self->res->headers;
$self->compressed(1)
if ($headers->sec_websocket_extensions // '') =~ /permessage-deflate/;

return _challenge($self->req->headers->sec_websocket_key) eq
$headers->sec_websocket_accept && ++$self->{open};
}

sub client_handshake {
my $self = shift;

my $headers = $self->req->headers;
$headers->upgrade('websocket') unless $headers->upgrade;
$headers->connection('Upgrade') unless $headers->connection;
$headers->sec_websocket_version(13) unless $headers->sec_websocket_version;

# Generate 16 byte WebSocket challenge
my $challenge = b64_encode sprintf('%16u', int(rand 9 x 16)), '';
$headers->sec_websocket_key($challenge) unless $headers->sec_websocket_key;
}

sub client_write { shift->server_write(@_) }

sub connection { shift->handshake->connection }
Expand All @@ -139,7 +111,7 @@ sub finish {
return $self;
}

sub is_established { !!shift->{open} }
sub is_established { !!$_[0]{open} || !!$_[0]{masked} }

sub is_websocket {1}

Expand Down Expand Up @@ -235,14 +207,6 @@ sub server_close {
return $self->emit(finish => $self->{close} ? (@{$self->{close}}) : 1006);
}

sub server_handshake {
my $self = shift;
my $res_headers = $self->res->headers;
$res_headers->upgrade('websocket')->connection('Upgrade');
$res_headers->sec_websocket_accept(
_challenge($self->req->headers->sec_websocket_key));
}

sub server_open { shift->{open}++ }

sub server_write {
Expand Down Expand Up @@ -277,8 +241,6 @@ sub with_protocols {
return $proto;
}

sub _challenge { b64_encode(sha1_bytes(($_[0] || '') . GUID), '') }

sub _message {
my ($self, $frame) = @_;

Expand Down Expand Up @@ -536,20 +498,6 @@ Build WebSocket frame.
Build WebSocket message.
=head2 client_challenge
my $bool = $ws->client_challenge;
Check WebSocket handshake challenge client-side, used to implement user agents
such as L<Mojo::UserAgent>.
=head2 client_handshake
$ws->client_handshake;
Perform WebSocket handshake client-side, used to implement user agents such as
L<Mojo::UserAgent>.
=head2 client_write
my $bytes = $ws->client_write;
Expand Down Expand Up @@ -684,13 +632,6 @@ will be invoked once all data has been written.
Transaction closed server-side, used to implement web servers such as
L<Mojo::Server::Daemon>.
=head2 server_handshake
$ws->server_handshake;
Perform WebSocket handshake server-side, used to implement web servers such as
L<Mojo::Server::Daemon>.
=head2 server_open
$ws->server_open;
Expand Down
7 changes: 3 additions & 4 deletions lib/Mojo/UserAgent/Transactor.pm
Expand Up @@ -12,6 +12,7 @@ use Mojo::Transaction::HTTP;
use Mojo::Transaction::WebSocket;
use Mojo::URL;
use Mojo::Util qw(encode url_escape);
use Mojo::WebSocket qw(challenge client_handshake);

has generators => sub { {form => \&_form, json => \&_json} };
has name => 'Mojolicious (Perl)';
Expand Down Expand Up @@ -128,7 +129,7 @@ sub upgrade {
my $code = $tx->res->code // 0;
return undef unless $tx->req->is_handshake && $code == 101;
my $ws = Mojo::Transaction::WebSocket->new(handshake => $tx, masked => 1);
return $ws->client_challenge ? $ws : undef;
return challenge($ws) ? $ws : undef;
}

sub websocket {
Expand All @@ -144,9 +145,7 @@ sub websocket {
$url->scheme($proto eq 'wss' ? 'https' : 'http') if $proto;

# Handshake
Mojo::Transaction::WebSocket->new(handshake => $tx)->client_handshake;

return $tx;
return client_handshake $tx;
}

sub _form {
Expand Down
52 changes: 52 additions & 0 deletions lib/Mojo/WebSocket.pm
@@ -0,0 +1,52 @@
package Mojo::WebSocket;
use Mojo::Base -strict;

use Exporter 'import';
use Mojo::Util qw(b64_encode sha1_bytes);

our @EXPORT_OK = qw(challenge client_handshake server_handshake);

# Unique value from RFC 6455
use constant GUID => '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';

sub challenge {
my $tx = shift;

# "permessage-deflate" extension
my $headers = $tx->res->headers;
$tx->compressed(1)
if ($headers->sec_websocket_extensions // '') =~ /permessage-deflate/;

return _challenge($tx->req->headers->sec_websocket_key) eq
$headers->sec_websocket_accept;
}

sub client_handshake {
my $tx = shift;

my $headers = $tx->req->headers;
$headers->upgrade('websocket') unless $headers->upgrade;
$headers->connection('Upgrade') unless $headers->connection;
$headers->sec_websocket_version(13) unless $headers->sec_websocket_version;

# Generate 16 byte WebSocket challenge
my $challenge = b64_encode sprintf('%16u', int(rand 9 x 16)), '';
$headers->sec_websocket_key($challenge) unless $headers->sec_websocket_key;

return $tx;
}

sub server_handshake {
my $tx = shift;

my $res_headers = $tx->res->headers;
$res_headers->upgrade('websocket')->connection('Upgrade');
$res_headers->sec_websocket_accept(
_challenge($tx->req->headers->sec_websocket_key));

return $tx;
}

sub _challenge { b64_encode(sha1_bytes(($_[0] || '') . GUID), '') }

1;
5 changes: 2 additions & 3 deletions t/mojo/transactor.t
Expand Up @@ -3,10 +3,10 @@ use Mojo::Base -strict;
use Test::More;
use Mojo::Asset::File;
use Mojo::Asset::Memory;
use Mojo::Transaction::WebSocket;
use Mojo::URL;
use Mojo::UserAgent::Transactor;
use Mojo::Util qw(b64_decode encode);
use Mojo::WebSocket 'server_handshake';

# Custom content generator
my $t = Mojo::UserAgent::Transactor->new;
Expand Down Expand Up @@ -502,8 +502,7 @@ ok $tx->req->headers->sec_websocket_version,
'has "Sec-WebSocket-Version" value';
is $tx->req->headers->upgrade, 'websocket', 'right "Upgrade" value';
is $t->upgrade($tx), undef, 'not upgraded';
Mojo::Transaction::WebSocket->new(handshake => $tx)->server_handshake;
$tx->res->code(101);
server_handshake($tx)->res->code(101);
$tx = $t->upgrade($tx);
ok $tx->is_websocket, 'is a WebSocket';

Expand Down

0 comments on commit 4b74d88

Please sign in to comment.