updated WebSocket implementation to ietf-06

mojolicious · Mar 22, 2011 · 28f0f98 · 28f0f98
1 parent 8e8cd86
commit 28f0f98
Show file tree

Hide file tree

Showing 9 changed files with 210 additions and 173 deletions.
diff --git a/Changes b/Changes
@@ -1,6 +1,7 @@
 This file documents the revision history for Perl extension Mojolicious.
 
 1.16 2011-03-19 00:00:00
+        - Updated WebSocket implementation to ietf-06.
         - Improved documentation.
         - Fixed small route pattern escaping bug.
 

diff --git a/lib/Mojo/Client.pm b/lib/Mojo/Client.pm
@@ -998,11 +998,8 @@ sub _tx_start {
     }
   }
 
-  # Make sure WebSocket requests have an origin header
-  my $headers = $req->headers;
-  $headers->origin($url) if $headers->upgrade && !$headers->origin;
-
   # We identify ourself
+  my $headers = $req->headers;
   $headers->user_agent($self->user_agent) unless $headers->user_agent;
 
   # Inject cookies

diff --git a/lib/Mojo/Content/Single.pm b/lib/Mojo/Content/Single.pm
@@ -45,15 +45,6 @@ sub parse {
   # Headers
   my $headers = $self->headers;
 
-  # Content-Length
-  my $len = $self->headers->content_length;
-
-  # WebSocket handshakes have a static Content-Length
-  $len ||=
-      $headers->sec_websocket_key1     ? 8
-    : $headers->sec_websocket_location ? 16
-    :                                    undef;
-
   # Content needs to be upgraded to multipart
   if ($self->is_multipart) {
 
@@ -84,7 +75,7 @@ sub parse {
   else {
 
     # Slurp
-    $len ||= $self->headers->content_length || 0;
+    my $len   = $self->headers->content_length || 0;
     my $asset = $self->asset;
     my $need  = $len - $asset->size;
     $asset->add_chunk(substr $self->{_b2}, 0, $need, '') if $need > 0;

diff --git a/lib/Mojo/Headers.pm b/lib/Mojo/Headers.pm
@@ -60,11 +60,9 @@ my @ENTITY_HEADERS = qw/
   Last-Modified
   /;
 my @WEBSOCKET_HEADERS = qw/
-  Origin
-  Sec-WebSocket-Key1
-  Sec-WebSocket-Key2
+  Sec-WebSocket-Accept
+  Sec-WebSocket-Key
   Sec-WebSocket-Origin
-  Sec-WebSocket-Location
   Sec-WebSocket-Protocol
   /;
 my @HEADERS = (
@@ -190,8 +188,6 @@ sub names {
   return \@headers;
 }
 
-sub origin { scalar shift->header(Origin => @_) }
-
 sub parse {
   my ($self, $chunk) = @_;
 
@@ -290,17 +286,17 @@ sub to_string {
   return length $headers ? $headers : undef;
 }
 
-sub trailer            { scalar shift->header(Trailer              => @_) }
-sub transfer_encoding  { scalar shift->header('Transfer-Encoding'  => @_) }
-sub upgrade            { scalar shift->header(Upgrade              => @_) }
-sub user_agent         { scalar shift->header('User-Agent'         => @_) }
-sub sec_websocket_key1 { scalar shift->header('Sec-WebSocket-Key1' => @_) }
-sub sec_websocket_key2 { scalar shift->header('Sec-WebSocket-Key2' => @_) }
+sub trailer           { scalar shift->header(Trailer             => @_) }
+sub transfer_encoding { scalar shift->header('Transfer-Encoding' => @_) }
+sub upgrade           { scalar shift->header(Upgrade             => @_) }
+sub user_agent        { scalar shift->header('User-Agent'        => @_) }
 
-sub sec_websocket_location {
-  scalar shift->header('Sec-WebSocket-Location' => @_);
+sub sec_websocket_accept {
+  scalar shift->header('Sec-WebSocket-Accept' => @_);
 }
 
+sub sec_websocket_key { scalar shift->header('Sec-WebSocket-Key' => @_) }
+
 sub sec_websocket_origin {
   scalar shift->header('Sec-WebSocket-Origin' => @_);
 }
@@ -496,13 +492,6 @@ Shortcut for the C<Location> header.
 
 Generate a list of all currently defined headers.
 
-=head2 C<origin>
-
-  my $origin = $headers->origin;
-  $headers   = $headers->origin('http://example.com');
-
-Shortcut for the C<Origin> header.
-
 =head2 C<parse>
 
   $headers = $headers->parse("Content-Type: text/foo\n\n");
@@ -544,26 +533,19 @@ resulted in C<Referer> becoming an official header.
 
 Remove a header.
 
-=head2 C<sec_websocket_key1>
-
-  my $key1 = $headers->sec_websocket_key1;
-  $headers = $headers->sec_websocket_key1('4 @1  46546xW%0l 1 5');
-
-Shortcut for the C<Sec-WebSocket-Key1> header.
-
-=head2 C<sec_websocket_key2>
+=head2 C<sec_websocket_accept>
 
-  my $key2 = $headers->sec_websocket_key2;
-  $headers = $headers->sec_websocket_key2('12998 5 Y3 1  .P00');
+  my $accept = $headers->sec_websocket_accept;
+  $headers   = $headers->sec_websocket_accept('s3pPLMBiTxaQ9kYGzzhZRbK+xOo=');
 
-Shortcut for the C<Sec-WebSocket-Key2> header.
+Shortcut for the C<Sec-WebSocket-Accept> header.
 
-=head2 C<sec_websocket_location>
+=head2 C<sec_websocket_key>
 
-  my $location = $headers->sec_websocket_location;
-  $headers     = $headers->sec_websocket_location('ws://example.com/demo');
+  my $key  = $headers->sec_websocket_key;
+  $headers = $headers->sec_websocket_key('dGhlIHNhbXBsZSBub25jZQ==');
 
-Shortcut for the C<Sec-WebSocket-Location> header.
+Shortcut for the C<Sec-WebSocket-Key> header.
 
 =head2 C<sec_websocket_origin>
 

diff --git a/lib/Mojo/HelloWorld.pm b/lib/Mojo/HelloWorld.pm
@@ -90,6 +90,7 @@ sub _diag {
 
   # Path
   my $path = $tx->req->url->path->to_abs_string;
+  $path = '/diag/websocket' if $path eq '/chat';
   $path =~ s/^\/diag// or return $self->_hello($tx);
 
   # WebSocket
@@ -267,12 +268,10 @@ sub _websocket {
 
   # WebSocket request
   if ($tx->is_websocket) {
-    $tx->send_message('Congratulations, your Mojo is working!');
     $tx->on_message(
       sub {
         my ($tx, $message) = @_;
-        return unless $message eq 'test 123';
-        $tx->send_message('With WebSocket support!');
+        $tx->send_message($message);
         $tx->resume;
       }
     );

diff --git a/lib/Mojo/Message/Response.pm b/lib/Mojo/Message/Response.pm
@@ -21,7 +21,7 @@ my $START_LINE_RE = qr/
 # Umarked codes are from RFC 2616 (mostly taken from LWP)
 my %MESSAGES = (
   100 => 'Continue',
-  101 => 'WebSocket Protocol Handshake',    # WebSocket
+  101 => 'Switching Protocols',
   102 => 'Processing',                      # RFC 2518 (WebDAV)
   200 => 'OK',
   201 => 'Created',