Add WebSocket pings to try to work around Slack hangs.

diff --git a/bin/ws.pl b/bin/ws.pl
index dd6a0ae65eb59257171cfd1365671143d3db6352..8dbfd14294916752b10e6ef90e617eb4c59676ea 100644 (file)
--- a/bin/ws.pl
+++ b/bin/ws.pl
@@ -67,6 +67,36 @@ sub ws_cb {
 
        print STDERR "Connected to the Slack WebSocket.\n";
 
+       bless $connection, 'PingableConnection';
+       $connection->{'_pending_ping'} = undef;
+       $connection->{'_ping_sent'} = undef;
+       $connection->{'_stuck_timer'} = AnyEvent->timer(
+               after => 5.0,
+               interval => 5.0,
+               cb => sub {
+                       if (defined($connection->{'_pending_ping'})) {
+                               print STDERR "Timed out while waiting for pong on '$connection->{'_pending_ping'}'; disconnecting.\n";
+                               $connection->close;
+                               return;
+                       }
+                       chomp ($connection->{'_pending_ping'} = ctime(time));
+                       $connection->{'_ping_sent'} = [Time::HiRes::gettimeofday];
+                       $connection->ping($connection->{'_pending_ping'});
+               });
+       $connection->on_pong(sub {
+               my ($conn, $msg) = @_;
+               if (defined($connection->{'_pending_ping'}) && $connection->{'_pending_ping'} eq $msg->{'body'}) {
+                       my $t0 = Time::HiRes::tv_interval($connection->{'_ping_sent'});
+                       print STDERR "Received expected pong: $msg->{'body'} ($t0 seconds RTT)\n";
+                       undef $connection->{'_pending_ping'};
+                       undef $connection->{'_ping_sent'};
+               } else {
+                       print STDERR "Received unexpected pong '$msg->{'body'}' (expected '$connection->{'_pending_ping'}'); disconnecting.\n";
+                       $connection->close;
+               }
+       });
+
+
        $connection->on(each_message => sub {
                my ($conn, $message) = @_;
                my $now = [Time::HiRes::gettimeofday];
@@ -153,3 +183,30 @@ sub handle_event {
                print STDERR "Type is $type (not a reaction added or removed); ignoring.\n";
        }
 }
+
+# Override a little packet processing so that we get to see pong messages.
+
+package PingableConnection;
+use parent 'AnyEvent::WebSocket::Connection';
+
+sub on_pong {
+       my ($self, $cb) = @_;
+       push @{ $self->{'_pong_cb'} }, $cb;
+}
+
+sub ping {
+       my ($self, $message) = @_;
+
+       $self->send(AnyEvent::WebSocket::Message->new({
+               opcode => 9,  # ping
+               body => $message
+       }));
+}
+
+sub _process_message {
+       my ($self, $message) = @_;
+       if ($message->is_pong) {
+               $_->($self, $message) for @{$self->{'_pong_cb'}};
+       }
+       return $self->SUPER::_process_message($message);
+}