Combine headers with duplicate keys

.gitignore

@@ -9,6 +9,7 @@ TestApp
 t/sessions/
 tags
 MYMETA.yml
+MYMETA.json
 
 
 # From: https://github.com/github/gitignore/blob/master/Global/Linux.gitignore
@@ -44,10 +45,7 @@ Makefile
 Makefile.old
 MANIFEST.bak
 META.yml
+META.json
 MYMETA.yml
 nytprof.out
 pm_to_blib
-
-Build.PL
-META.json
-README.md

Build.PL

@@ -0,0 +1,12 @@
+# =========================================================================
+# THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA.
+# DO NOT EDIT DIRECTLY.
+# =========================================================================
+
+use 5.008_001;
+use strict;
+
+use Module::Build::Tiny 0.035;
+
+Build_PL();
+

Changes

@@ -2,6 +2,17 @@ Revision history for perl module Protocol::WebSocket
 
 {{$NEXT}}
 
+0.20 2016-11-04T18:21:37Z
+
+ - RSV bit (Anton Petrusevich)
+ - do not modify passed headers structure (Graham Ollis)
+ - bypass max payload size (Graham Ollis)
+
+0.19 2015-09-28T16:55:01Z
+
+ - custom headers in request
+ - fix wrong UTF-8 related documentation (#GH-13)
+
 0.18 2014-09-01T14:45:16Z
 
  - Digest::SHA1 -> Digest::SHA (Michal Špaček)

README.md

@@ -0,0 +1,135 @@
+# NAME
+
+Protocol::WebSocket - WebSocket protocol
+
+# SYNOPSIS
+
+    # Server side
+    my $hs = Protocol::WebSocket::Handshake::Server->new;
+
+    $hs->parse('some data from the client');
+
+    $hs->is_done; # tells us when handshake is done
+
+    my $frame = $hs->build_frame;
+
+    $frame->append('some data from the client');
+
+    while (defined(my $message = $frame->next)) {
+        if ($frame->is_close) {
+
+            # Send close frame back
+            send(
+                $hs->build_frame(
+                    type    => 'close',
+                    version => $version
+                )->to_bytes
+            );
+
+            return;
+        }
+
+        # We got a message!
+    }
+
+# DESCRIPTION
+
+Client/server WebSocket message and frame parser/constructor. This module does
+not provide a WebSocket server or client, but is made for using in http servers
+or clients to provide WebSocket support.
+
+[Protocol::WebSocket](https://metacpan.org/pod/Protocol::WebSocket) supports the following WebSocket protocol versions:
+
+    draft-ietf-hybi-17 (latest)
+    draft-ietf-hybi-10
+    draft-ietf-hybi-00 (with HAProxy support)
+    draft-hixie-75
+
+By default the latest version is used. The WebSocket version is detected
+automatically on the server side. On the client side you have set a `version`
+attribute to an appropriate value.
+
+[Protocol::WebSocket](https://metacpan.org/pod/Protocol::WebSocket) itself does not contain any code and cannot be used
+directly. Instead the following modules should be used:
+
+## High-level modules
+
+### [Protocol::WebSocket::Server](https://metacpan.org/pod/Protocol::WebSocket::Server)
+
+Server helper class.
+
+### [Protocol::WebSocket::Client](https://metacpan.org/pod/Protocol::WebSocket::Client)
+
+Client helper class.
+
+## Low-level modules
+
+### [Protocol::WebSocket::Handshake::Server](https://metacpan.org/pod/Protocol::WebSocket::Handshake::Server)
+
+Server handshake parser and constructor.
+
+### [Protocol::WebSocket::Handshake::Client](https://metacpan.org/pod/Protocol::WebSocket::Handshake::Client)
+
+Client handshake parser and constructor.
+
+### [Protocol::WebSocket::Frame](https://metacpan.org/pod/Protocol::WebSocket::Frame)
+
+WebSocket frame parser and constructor.
+
+### [Protocol::WebSocket::Request](https://metacpan.org/pod/Protocol::WebSocket::Request)
+
+Low level WebSocket request parser and constructor.
+
+### [Protocol::WebSocket::Response](https://metacpan.org/pod/Protocol::WebSocket::Response)
+
+Low level WebSocket response parser and constructor.
+
+### [Protocol::WebSocket::URL](https://metacpan.org/pod/Protocol::WebSocket::URL)
+
+Low level WebSocket url parser and constructor.
+
+# EXAMPLES
+
+For examples on how to use [Protocol::WebSocket](https://metacpan.org/pod/Protocol::WebSocket) with various event loops see
+`examples/` directory in the distribution.
+
+# CREDITS
+
+In order of appearance:
+
+Paul "LeoNerd" Evans
+
+Jon Gentle
+
+Lee Aylward
+
+Chia-liang Kao
+
+Atomer Ju
+
+Chuck Bredestege
+
+Matthew Lien (BlueT)
+
+Joao Orui
+
+Toshio Ito (debug-ito)
+
+Neil Bowers
+
+Michal Špaček
+
+Graham Ollis
+
+Anton Petrusevich
+
+# AUTHOR
+
+Viacheslav Tykhanovskyi, `vti@cpan.org`.
+
+# COPYRIGHT
+
+Copyright (C) 2010-2014, Viacheslav Tykhanovskyi.
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl 5.10.

lib/Protocol/WebSocket.pm

@@ -3,7 +3,7 @@ package Protocol::WebSocket;
 use strict;
 use warnings;
 
-our $VERSION = '0.18';
+our $VERSION = '0.20';
 
 use Protocol::WebSocket::Frame;
 use Protocol::WebSocket::Handshake::Client;
@@ -138,6 +138,8 @@ Michal Špaček
 
 Graham Ollis
 
+Anton Petrusevich
+
 =head1 AUTHOR
 
 Viacheslav Tykhanovskyi, C<vti@cpan.org>.

lib/Protocol/WebSocket/Client.pm

@@ -30,7 +30,13 @@ sub new {
 
     $self->{hs} =
       Protocol::WebSocket::Handshake::Client->new(url => $self->{url});
-    $self->{frame_buffer} = $self->_build_frame;
+
+    my %frame_buffer_params = (
+        max_fragments_amount => $params{max_fragments_amount}
+    );
+    $frame_buffer_params{max_payload_size} = $params{max_payload_size} if exists $params{max_payload_size};
+
+    $self->{frame_buffer} = $self->_build_frame(%frame_buffer_params);
 
     return $self;
 }

lib/Protocol/WebSocket/Frame.pm

@@ -53,7 +53,7 @@ sub new {
     $self->{fragments} = [];
 
     $self->{max_fragments_amount} ||= 128;
-    $self->{max_payload_size}     ||= 65536;
+    $self->{max_payload_size}     ||= 65536 unless exists $self->{max_payload_size};
 
     return $self;
 }
@@ -174,7 +174,7 @@ sub next_bytes {
             $offset += 8;
         }
 
-        if ($payload_len > $self->{max_payload_size}) {
+        if ($self->{max_payload_size} && $payload_len > $self->{max_payload_size}) {
             $self->{buffer} = '';
             die "Payload is too big. "
               . "Deny big message ($payload_len) "
@@ -246,16 +246,22 @@ sub to_bytes {
         return "\x00" . $self->{buffer} . "\xff";
     }
 
-    if (length $self->{buffer} > $self->{max_payload_size}) {
+    if ($self->{max_payload_size} && length $self->{buffer} > $self->{max_payload_size}) {
         die "Payload is too big. "
           . "Send shorter messages or increase max_payload_size";
     }
 
-    my $string = '';
 
+    my $rsv_set = 0;
+    if($self->{rsv} && ref($self->{rsv}) eq 'ARRAY') {
+    	for my $i (0..@{$self->{rsv}}-1) { 
+    		$rsv_set += $self->{rsv}->[$i] * (1 << (6 - $i));
+    	}
+    }
+
+    my $string = '';
     my $opcode = $self->opcode;
-
-    $string .= pack 'C', ($opcode + ($self->fin ? 128 : 0));
+    $string .= pack 'C', ($opcode | $rsv_set | ($self->fin ? 128 : 0));
 
     my $payload_len = length($self->{buffer});
     if ($payload_len <= 125) {
@@ -312,6 +318,12 @@ sub _mask {
     return $payload;
 }
 
+sub max_payload_size {
+    my $self = shift;
+
+    return $self->{max_payload_size};
+}
+
 1;
 __END__
 
@@ -444,4 +456,9 @@ Return the next message as is.
 
 Construct a WebSocket message.
 
+=head2 C<max_payload_size>
+
+The maximum size of the payload. You may set this to C<0> or C<undef> to disable
+checking the payload size.
+
 =cut

lib/Protocol/WebSocket/Message.pm

@@ -40,7 +40,11 @@ sub field {
 
     return $self->fields->{$name} unless @_;
 
-    $self->fields->{$name} = $_[0];
+    if(defined $self->fields->{$name}) {
+        $self->fields->{$name} .= ',' . $_[0];
+    } else {
+        $self->fields->{$name} = $_[0];
+    }
 
     return $self;
 }

lib/Protocol/WebSocket/Request.pm

@@ -194,8 +194,8 @@ sub to_string {
     else {
         Carp::croak('Version ' . $self->version . ' is not supported');
     }
-
-    while (my ($key, $value) = splice @{$self->{headers}}, 0, 2) {
+    my @headers = @{$self->{headers}};
+    while (my ($key, $value) = splice @headers, 0, 2) {
         $key =~ s{[\x0d\x0a]}{}gsm;
         $value =~ s{[\x0d\x0a]}{}gsm;
 

t/client.t

@@ -81,6 +81,15 @@ subtest 'call on_write on write' => sub {
     isnt $written, '';
 };
 
+subtest 'max_payload_size passed to frame buffer' => sub {
+
+    is(Protocol::WebSocket::Client->new(url => 'ws://localhost:8080')->{frame_buffer}->max_payload_size, 65536, "default");
+    is(Protocol::WebSocket::Client->new(url => 'ws://localhost:8080', max_payload_size => 22)->{frame_buffer}->max_payload_size, 22, "set to 22");
+    is(Protocol::WebSocket::Client->new(url => 'ws://localhost:8080', max_payload_size => 0)->{frame_buffer}->max_payload_size, 0, "set to 0");
+    is(Protocol::WebSocket::Client->new(url => 'ws://localhost:8080', max_payload_size => undef)->{frame_buffer}->max_payload_size, undef, "set to undef");
+
+};
+
 sub _recv_server_handshake {
     my ($client) = @_;
 

t/draft-ietf-hybi-17/request.t

@@ -111,6 +111,16 @@ subtest 'add custom headers' => sub {
       . "Sec-WebSocket-Version: 13\x0d\x0a"
       . "X-Foo: bar\x0d\x0a"
       . "\x0d\x0a";
+
+    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"
+      . "Origin: http://example.com\x0d\x0a"
+      . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\x0d\x0a"
+      . "Sec-WebSocket-Version: 13\x0d\x0a"
+      . "X-Foo: bar\x0d\x0a"
+      . "\x0d\x0a";
 };
 
 done_testing;