diff --git a/lib/Protocol/WebSocket/Request.pm b/lib/Protocol/WebSocket/Request.pm index b5d192b..747e849 100644 --- a/lib/Protocol/WebSocket/Request.pm +++ b/lib/Protocol/WebSocket/Request.pm @@ -18,6 +18,8 @@ sub new_from_psgi { my $version = ''; + my $cookies; + my $fields = { upgrade => $env->{HTTP_UPGRADE}, connection => $env->{HTTP_CONNECTION}, @@ -60,9 +62,14 @@ sub new_from_psgi { $fields->{origin} = $env->{HTTP_ORIGIN}; } + if ($env->{HTTP_COOKIE}) { + $cookies = Protocol::WebSocket::Cookie->new->parse($env->{HTTP_COOKIE}); + } + my $self = $class->new( version => $version, fields => $fields, + cookies => $cookies, resource_name => "$env->{SCRIPT_NAME}$env->{PATH_INFO}" . ($env->{QUERY_STRING} ? "?$env->{QUERY_STRING}" : "") ); @@ -77,7 +84,18 @@ sub new_from_psgi { return $self; } -sub cookies { shift->{cookies} } +sub cookies { + if(@_ > 1) { + my $cookie = Protocol::WebSocket::Cookie->new; + return unless $_[1]; + + if (my $cookies = $cookie->parse($_[1])) { + $_[0]->{cookies} = $cookies; + } + } else { + return $_[0]->{cookies}; + } +} sub resource_name { @_ > 1 ? $_[0]->{resource_name} = $_[1] : $_[0]->{resource_name} || '/'; @@ -110,6 +128,12 @@ sub to_string { Carp::croak(qq/Host is required/) unless defined $self->host; $string .= "Host: " . $self->host . "\x0d\x0a"; + if (ref $self->{cookies} eq 'Protocol::WebSocket::Cookie') { + my $cookie_string = $self->{cookies}->to_string; + $string .= 'Cookie: ' . $cookie_string . "\x0d\x0a" + if $cookie_string; + } + my $origin = $self->origin ? $self->origin : 'http://' . $self->host; $origin =~ s{^http:}{https:} if $self->secure; $string .= ( @@ -162,8 +186,6 @@ sub to_string { Carp::croak('Version ' . $self->version . ' is not supported'); } - # TODO cookies - $string .= "\x0d\x0a"; $string .= $self->challenge if $version eq 'draft-ietf-hybi-00'; @@ -384,11 +406,7 @@ sub _finalize { || $self->field('WebSocket-Protocol'); $self->subprotocol($subprotocol) if $subprotocol; - my $cookie = $self->_build_cookie; - if (my $cookies = $cookie->parse($self->field('Cookie'))) { - $self->{cookies} = $cookies; - } - + $self->cookies($self->field('Cookie')); return $self; } diff --git a/t/draft-hixie-75/request.t b/t/draft-hixie-75/request.t index 0d381b9..e9477b3 100644 --- a/t/draft-hixie-75/request.t +++ b/t/draft-hixie-75/request.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 104; +use Test::More tests => 110; use IO::Handle; @@ -25,15 +25,18 @@ ok $req->parse("Connection: Upgrade\x0d\x0a"); is $req->state => 'fields'; ok $req->parse("Host: example.com\x0d\x0a"); is $req->state => 'fields'; +ok $req->parse("Cookie: foo=bar;alice=bob\x0d\x0a"); +is $req->state => 'fields'; ok $req->parse("Origin: http://example.com\x0d\x0a"); is $req->state => 'fields'; ok $req->parse("\x0d\x0a"); is $req->state => 'done'; -is $req->version => 'draft-hixie-75'; -is $req->resource_name => '/demo'; -is $req->host => 'example.com'; -is $req->origin => 'http://example.com'; +is $req->version => 'draft-hixie-75'; +is $req->resource_name => '/demo'; +is $req->host => 'example.com'; +is $req->cookies->to_string => 'foo=bar; alice=bob'; +is $req->origin => 'http://example.com'; $req = Protocol::WebSocket::Request->new; ok $req->parse("GET /demo HTTP/1.1\x0d\x0a"); @@ -91,9 +94,12 @@ ok $req->parse("Cookie: \$Version=1; foo=bar; \$Path=/\x0d\x0a"); ok $req->parse("\x0d\x0a"); ok $req->is_done; -is $req->cookies->[0]->version => 1; -is $req->cookies->[0]->name => 'foo'; -is $req->cookies->[0]->value => 'bar'; +is $req->cookies->pairs->[0][0] => '$Version'; +is $req->cookies->pairs->[0][1] => '1'; +is $req->cookies->pairs->[1][0] => 'foo'; +is $req->cookies->pairs->[1][1] => 'bar'; +is $req->cookies->pairs->[2][0] => '$Path'; +is $req->cookies->pairs->[2][1] => '/'; $req = Protocol::WebSocket::Request->new; $req->parse("GET /demo HTTP/1.1\x0d\x0a"); @@ -119,12 +125,14 @@ ok $req->secure; $req = Protocol::WebSocket::Request->new( version => 'draft-hixie-75', host => 'example.com', + cookies => Protocol::WebSocket::Cookie->new->parse('foo=bar; alice=bob'), resource_name => '/demo' ); is $req->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: http://example.com\x0d\x0a" . "\x0d\x0a"; diff --git a/t/draft-ietf-hybi-00/client-ssl.t b/t/draft-ietf-hybi-00/client-ssl.t index 988ec30..ce3f142 100644 --- a/t/draft-ietf-hybi-00/client-ssl.t +++ b/t/draft-ietf-hybi-00/client-ssl.t @@ -16,11 +16,13 @@ $h->url('wss://example.com/demo'); $h->req->key1("18x 6]8vM;54 *(5: { U1]8 z [ 8"); $h->req->key2("1_ tx7X d < nw 334J702) 7]o}` 0"); $h->req->challenge("Tm[K T2u"); +$h->req->cookies('foo=bar; alice=bob'); is $h->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: https://example.com\x0d\x0a" . "Sec-WebSocket-Key1: 18x 6]8vM;54 *(5: { U1]8 z [ 8\x0d\x0a" . "Sec-WebSocket-Key2: 1_ tx7X d < nw 334J702) 7]o}` 0\x0d\x0a" diff --git a/t/draft-ietf-hybi-00/client.t b/t/draft-ietf-hybi-00/client.t index c162497..624f497 100644 --- a/t/draft-ietf-hybi-00/client.t +++ b/t/draft-ietf-hybi-00/client.t @@ -16,11 +16,13 @@ $h->url('ws://example.com/demo'); $h->req->key1("18x 6]8vM;54 *(5: { U1]8 z [ 8"); $h->req->key2("1_ tx7X d < nw 334J702) 7]o}` 0"); $h->req->challenge("Tm[K T2u"); +$h->req->cookies('foo=bar; alice=bob'); is $h->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Key1: 18x 6]8vM;54 *(5: { U1]8 z [ 8\x0d\x0a" . "Sec-WebSocket-Key2: 1_ tx7X d < nw 334J702) 7]o}` 0\x0d\x0a" diff --git a/t/draft-ietf-hybi-00/request.t b/t/draft-ietf-hybi-00/request.t index ce3a19d..9cf3665 100644 --- a/t/draft-ietf-hybi-00/request.t +++ b/t/draft-ietf-hybi-00/request.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 60; +use Test::More tests => 64; use IO::Handle; @@ -24,6 +24,8 @@ ok $req->parse("Connection: Upgrade\x0d\x0a"); is $req->state => 'fields'; ok $req->parse("Host: example.com\x0d\x0a"); is $req->state => 'fields'; +ok $req->parse("Cookie: foo=bar;alice=bob\x0d\x0a"); +is $req->state => 'fields'; ok $req->parse("Origin: http://example.com\x0d\x0a"); is $req->state => 'fields'; ok $req->parse( @@ -37,11 +39,12 @@ is $req->number1 => '155712099'; is $req->number2 => '173347027'; is $req->challenge => 'Tm[K T2u'; -is $req->version => 'draft-ietf-hybi-00'; -is $req->resource_name => '/demo'; -is $req->host => 'example.com'; -is $req->origin => 'http://example.com'; -is $req->checksum => 'fQJ,fN/4F4!~K~MH'; +is $req->version => 'draft-ietf-hybi-00'; +is $req->resource_name => '/demo'; +is $req->host => 'example.com'; +is $req->origin => 'http://example.com'; +is $req->checksum => 'fQJ,fN/4F4!~K~MH'; +is $req->cookies->to_string => 'foo=bar; alice=bob'; $req = Protocol::WebSocket::Request->new; $req->parse("GET /demo HTTP/1.1\x0d\x0a"); @@ -75,6 +78,7 @@ is $req->subprotocol => 'sample'; $req = Protocol::WebSocket::Request->new( version => 'draft-ietf-hybi-00', host => 'example.com', + cookies => Protocol::WebSocket::Cookie->new->parse('foo=bar; alice=bob'), resource_name => '/demo', key1 => '18x 6]8vM;54 *(5: { U1]8 z [ 8', key2 => '1_ tx7X d < nw 334J702) 7]o}` 0', @@ -84,6 +88,7 @@ is $req->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Key1: 18x 6]8vM;54 *(5: { U1]8 z [ 8\x0d\x0a" . "Sec-WebSocket-Key2: 1_ tx7X d < nw 334J702) 7]o}` 0\x0d\x0a" @@ -148,6 +153,7 @@ $req = Protocol::WebSocket::Request->new_from_psgi( HTTP_UPGRADE => 'WebSocket', HTTP_CONNECTION => 'Upgrade', HTTP_HOST => 'example.com', + HTTP_COOKIE => 'foo=bar', HTTP_ORIGIN => 'http://example.com', HTTP_SEC_WEBSOCKET_PROTOCOL => 'sample', HTTP_SEC_WEBSOCKET_KEY1 => '18x 6]8vM;54 *(5: { U1]8 z [ 8', @@ -156,13 +162,14 @@ $req = Protocol::WebSocket::Request->new_from_psgi( } ); $req->parse($io); -is $req->resource_name => '/demo?foo=bar'; -is $req->subprotocol => 'sample'; -is $req->upgrade => 'WebSocket'; -is $req->connection => 'Upgrade'; -is $req->host => 'example.com'; -is $req->origin => 'http://example.com'; -is $req->key1 => '18x 6]8vM;54 *(5: { U1]8 z [ 8'; -is $req->key2 => '1_ tx7X d < nw 334J702) 7]o}` 0'; +is $req->resource_name => '/demo?foo=bar'; +is $req->subprotocol => 'sample'; +is $req->upgrade => 'WebSocket'; +is $req->connection => 'Upgrade'; +is $req->host => 'example.com'; +is $req->cookies->to_string => 'foo=bar'; +is $req->origin => 'http://example.com'; +is $req->key1 => '18x 6]8vM;54 *(5: { U1]8 z [ 8'; +is $req->key2 => '1_ tx7X d < nw 334J702) 7]o}` 0'; ok $req->is_done; is $req->version => 'draft-ietf-hybi-00'; diff --git a/t/draft-ietf-hybi-10/client.t b/t/draft-ietf-hybi-10/client.t index 9013164..ab76d44 100644 --- a/t/draft-ietf-hybi-10/client.t +++ b/t/draft-ietf-hybi-10/client.t @@ -12,11 +12,13 @@ $h->url('ws://example.com/demo'); # Mocking $h->req->key("dGhlIHNhbXBsZSBub25jZQ=="); +$h->req->cookies('foo=bar; alice=bob'); is $h->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Sec-WebSocket-Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a" . "Sec-WebSocket-Version: 8\x0d\x0a" diff --git a/t/draft-ietf-hybi-10/request.t b/t/draft-ietf-hybi-10/request.t index ad0961a..73633da 100644 --- a/t/draft-ietf-hybi-10/request.t +++ b/t/draft-ietf-hybi-10/request.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 48; +use Test::More tests => 52; use IO::Handle; @@ -26,6 +26,8 @@ ok $req->parse("Upgrade: websocket\x0d\x0a"); is $req->state => 'fields'; ok $req->parse("Connection: Upgrade\x0d\x0a"); is $req->state => 'fields'; +ok $req->parse("Cookie: foo=bar; alice=bob\x0d\x0a"); +is $req->state => 'fields'; ok $req->parse("Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a"); ok $req->parse("Sec-WebSocket-Origin: http://example.com\x0d\x0a"); ok $req->parse("Sec-WebSocket-Protocol: chat, superchat\x0d\x0a"); @@ -33,11 +35,12 @@ ok $req->parse("Sec-WebSocket-Version: 8\x0d\x0a\x0d\x0a"); is $req->state => 'done'; is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; -is $req->version => 'draft-ietf-hybi-10'; -is $req->subprotocol => 'chat, superchat'; -is $req->resource_name => '/chat'; -is $req->host => 'server.example.com'; -is $req->origin => 'http://example.com'; +is $req->version => 'draft-ietf-hybi-10'; +is $req->subprotocol => 'chat, superchat'; +is $req->resource_name => '/chat'; +is $req->host => 'server.example.com'; +is $req->origin => 'http://example.com'; +is $req->cookies->to_string => 'foo=bar; alice=bob'; $req = Protocol::WebSocket::Request->new; @@ -61,6 +64,7 @@ $req = Protocol::WebSocket::Request->new( version => 'draft-ietf-hybi-10', host => 'server.example.com', origin => 'http://example.com', + cookies => Protocol::WebSocket::Cookie->new->parse('foo=bar; alice=bob'), subprotocol => 'chat, superchat', resource_name => '/chat', key => 'dGhlIHNhbXBsZSBub25jZQ==' @@ -69,6 +73,7 @@ is $req->to_string => "GET /chat HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: server.example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Sec-WebSocket-Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Protocol: chat, superchat\x0d\x0a" . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a" @@ -85,6 +90,7 @@ $req = Protocol::WebSocket::Request->new_from_psgi( HTTP_UPGRADE => 'websocket', HTTP_CONNECTION => 'Upgrade', HTTP_HOST => 'server.example.com', + HTTP_COOKIE => 'foo=bar', HTTP_SEC_WEBSOCKET_ORIGIN => 'http://example.com', HTTP_SEC_WEBSOCKET_PROTOCOL => 'chat, superchat', HTTP_SEC_WEBSOCKET_KEY => 'dGhlIHNhbXBsZSBub25jZQ==', @@ -92,12 +98,13 @@ $req = Protocol::WebSocket::Request->new_from_psgi( } ); $req->parse($io); -is $req->resource_name => '/chat?foo=bar'; -is $req->subprotocol => 'chat, superchat'; -is $req->upgrade => 'websocket'; -is $req->connection => 'Upgrade'; -is $req->host => 'server.example.com'; -is $req->origin => 'http://example.com'; -is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; +is $req->resource_name => '/chat?foo=bar'; +is $req->subprotocol => 'chat, superchat'; +is $req->upgrade => 'websocket'; +is $req->connection => 'Upgrade'; +is $req->host => 'server.example.com'; +is $req->cookies->to_string => 'foo=bar'; +is $req->origin => 'http://example.com'; +is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; ok $req->is_done; is $req->version => 'draft-ietf-hybi-10'; diff --git a/t/draft-ietf-hybi-17/client.t b/t/draft-ietf-hybi-17/client.t index 83e99dd..aaa3705 100644 --- a/t/draft-ietf-hybi-17/client.t +++ b/t/draft-ietf-hybi-17/client.t @@ -12,11 +12,13 @@ $h->url('ws://example.com/demo'); # Mocking $h->req->key("dGhlIHNhbXBsZSBub25jZQ=="); +$h->req->cookies('foo=bar; alice=bob'); is $h->to_string => "GET /demo HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a" . "Sec-WebSocket-Version: 13\x0d\x0a" diff --git a/t/draft-ietf-hybi-17/request.t b/t/draft-ietf-hybi-17/request.t index 583de0c..e0b4f41 100644 --- a/t/draft-ietf-hybi-17/request.t +++ b/t/draft-ietf-hybi-17/request.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 54; +use Test::More tests => 57; use_ok 'Protocol::WebSocket::Request'; @@ -19,6 +19,8 @@ is $req->state => 'fields'; ok $req->parse("Host: server.example.com\x0d\x0a"); is $req->state => 'fields'; +ok $req->parse("Cookie: foo=bar;alice=bob\x0d\x0a"); +is $req->state => 'fields'; ok $req->parse("Upgrade: websocket\x0d\x0a"); is $req->state => 'fields'; ok $req->parse("Connection: Upgrade\x0d\x0a"); @@ -30,11 +32,12 @@ ok $req->parse("Sec-WebSocket-Version: 13\x0d\x0a\x0d\x0a"); is $req->state => 'done'; is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; -is $req->version => 'draft-ietf-hybi-17'; -is $req->subprotocol => 'chat, superchat'; -is $req->resource_name => '/chat'; -is $req->host => 'server.example.com'; -is $req->origin => 'http://example.com'; +is $req->version => 'draft-ietf-hybi-17'; +is $req->subprotocol => 'chat, superchat'; +is $req->resource_name => '/chat'; +is $req->host => 'server.example.com'; +is $req->origin => 'http://example.com'; +is $req->cookies->to_string => 'foo=bar; alice=bob'; $req = Protocol::WebSocket::Request->new; @@ -75,6 +78,7 @@ is $req->origin => 'http://example.com'; $req = Protocol::WebSocket::Request->new( host => 'server.example.com', origin => 'http://example.com', + cookies => Protocol::WebSocket::Cookie->new->parse('foo=bar; alice=bob'), subprotocol => 'chat, superchat', resource_name => '/chat', key => 'dGhlIHNhbXBsZSBub25jZQ==' @@ -83,6 +87,7 @@ is $req->to_string => "GET /chat HTTP/1.1\x0d\x0a" . "Upgrade: WebSocket\x0d\x0a" . "Connection: Upgrade\x0d\x0a" . "Host: server.example.com\x0d\x0a" + . "Cookie: foo=bar; alice=bob\x0d\x0a" . "Origin: http://example.com\x0d\x0a" . "Sec-WebSocket-Protocol: chat, superchat\x0d\x0a" . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a" diff --git a/t/draft-ietf-hybi-17/request_psgi.t b/t/draft-ietf-hybi-17/request_psgi.t index 6b9d532..2c24b19 100644 --- a/t/draft-ietf-hybi-17/request_psgi.t +++ b/t/draft-ietf-hybi-17/request_psgi.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 11; use IO::Handle; @@ -23,6 +23,7 @@ $req = Protocol::WebSocket::Request->new_from_psgi( HTTP_UPGRADE => 'websocket', HTTP_CONNECTION => 'Upgrade', HTTP_HOST => 'server.example.com', + HTTP_COOKIE => 'foo=bar', HTTP_SEC_WEBSOCKET_ORIGIN => 'http://example.com', HTTP_SEC_WEBSOCKET_PROTOCOL => 'chat, superchat', HTTP_SEC_WEBSOCKET_KEY => 'dGhlIHNhbXBsZSBub25jZQ==', @@ -30,12 +31,13 @@ $req = Protocol::WebSocket::Request->new_from_psgi( } ); $req->parse($io); -is $req->resource_name => '/chat?foo=bar'; -is $req->subprotocol => 'chat, superchat'; -is $req->upgrade => 'websocket'; -is $req->connection => 'Upgrade'; -is $req->host => 'server.example.com'; -is $req->origin => 'http://example.com'; -is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; +is $req->resource_name => '/chat?foo=bar'; +is $req->subprotocol => 'chat, superchat'; +is $req->upgrade => 'websocket'; +is $req->connection => 'Upgrade'; +is $req->host => 'server.example.com'; +is $req->cookies->to_string => 'foo=bar'; +is $req->origin => 'http://example.com'; +is $req->key => 'dGhlIHNhbXBsZSBub25jZQ=='; ok $req->is_done; is $req->version => 'draft-ietf-hybi-17';