=head1 NAME

Net::WebSocket::EVx - Perl wrapper around Wslay websocket library

=head1 DESCRIPTION

Net::WebSocket::EVx is a websocket module based on L<EV> and L<Alien::Wslay>.
It is a fork of L<Net::WebSocket::EV>, which looks abandoned; the main
differences are the use of Alien::Wslay and RSV bit support (for compressed
transfers, for example).

The module does not perform the HTTP handshake. Complete the upgrade yourself,
then hand the socket to C<new()>.

=head1 SYNOPSIS

    use EV;
    use Net::WebSocket::EVx;

    # $fh is a non-blocking socket whose websocket handshake is already done
    my $ws; $ws = Net::WebSocket::EVx->new({
        fh          => $fh,
        rsv         => WS_RSV_NONE,   # no extension negotiated
        on_msg_recv => sub {
            my ($rsv, $opcode, $msg, $status_code) = @_;
            $ws->queue_msg($msg);     # echo it back
        },
        on_close    => sub { my ($code) = @_; undef $ws; close $fh },
    });

    EV::run;

=head2 A complete PSGI echo server with compression

    use strict; use experimental 'signatures';
    use Net::WebSocket::EVx;
    use Compress::Raw::Zlib qw'Z_SYNC_FLUSH Z_OK MAX_WBITS';
    use Digest::SHA1 'sha1_base64';

    use constant {
        ws_max_size => (1<<31)-1,
        ws_guid => '258EAFA5-E914-47DA-95CA-C5AB0DC85B11',
        ws_inflate_tail => pack(C4 => 0, 0, 255, 255),
        crlf => "\015\012"
    };

    sub ($env) {
        return [200, ['access-control-allow-origin', $env->{uc'http_origin'} // '*'], []] unless
            ($env->{uc'http_connection'}//'') eq 'upgrade' && ($env->{uc'http_upgrade'}//'') eq 'websocket';
        return [400, [], ['expecting ws v13 handshake']] unless
            ($env->{uc'http_sec_websocket_version'}//'') eq '13' && $env->{uc'http_sec_websocket_key'};
        return [500, [], []] unless exists $env->{'psgix.io'};
        my ($deflate, $inflate);
        if (($env->{uc'http_sec_websocket_extensions'} // '') =~ /permessage-deflate/) {
            $deflate = Compress::Raw::Zlib::Deflate->new(WindowBits => -MAX_WBITS);
            $inflate = Compress::Raw::Zlib::Inflate->new(WindowBits => -MAX_WBITS, Bufsize => ws_max_size, LimitOutput => 1);
        }
        sub {
            my $io = $env->{'psgix.io'};
            my $key = sha1_base64($env->{uc'http_sec_websocket_key'}.ws_guid);
            my $handshake = join crlf,
                'HTTP/1.1 101 Switching Protocols', 'connection: upgrade', 'upgrade: websocket',
                $deflate ? 'sec-websocket-extensions: permessage-deflate' : (),
                "sec-websocket-accept: $key=", crlf;
            my $got = syswrite $io, $handshake;
            die "failed to write ws handshake in one go: $!" unless $got and $got == length $handshake;
            open(my $fh, '+<&', $io) or die $!;
            my $srv; $srv = Net::WebSocket::EVx->new({
                fh => $fh, max_recv_size => ws_max_size,
                rsv => $deflate ? WS_RSV1_BIT : WS_RSV_NONE,
                on_msg_recv => sub ($rsv, $opcode, $msg, $status_code) {
                    $srv->queue_msg($msg), return unless $rsv && $inflate; # plain echo
                    return unless $inflate->inflate(($msg .= ws_inflate_tail), my $out) == Z_OK;
                    return unless $deflate->deflate($out, $msg) == Z_OK && $deflate->flush($msg, Z_SYNC_FLUSH) == Z_OK;
                    substr $msg, -4, 4, ''; # cut deflated tail
                    $srv->queue_msg_ex($msg);
                },
                on_close => sub ($code) { undef $_ for $io, $fh, $srv, $inflate, $deflate } });
            return
        }
    }

Run it via Twiggy or Feersum, which support C<psgix.io>:

    plackup -l $(realpath app.sock) -s Feersum app.psgi

Put nginx in front:

    http {
      upstream app { server unix:app.sock; }
      map $http_upgrade $connection_upgrade { default upgrade; '' ''; }
      server {
        listen 127.0.0.1:5000;
        location / {
          proxy_pass http://app;
          proxy_ignore_client_abort on;
          proxy_set_header Host $http_host;
          proxy_set_header X-Forwarded-For $http_x_forwarded_for;
          proxy_set_header X-Forwarded-Proto $http_x_forwarded_proto;
          proxy_set_header Upgrade $http_upgrade;
          proxy_set_header Connection $connection_upgrade;
        }
      }
    }

Run it:

    /usr/sbin/nginx -p . -e nginx.err -c nginx.conf

=head1 EXPORTS

C<WS_FRAGMENTED_DATA>, C<WS_FRAGMENTED_EOF>, C<WS_FRAGMENTED_ERROR>,
C<WS_RSV_NONE> and C<WS_RSV1_BIT> are exported by default.

=head1 METHODS

=head2 new( \%params )

Returns a new websocket. The parameter hash becomes the object itself, so the
callback keys stay live: replacing C<< $ws->{on_msg_recv} >> later takes effect
on the next message.

=over

=item fh or fd

Filehandle or numeric file descriptor of the socket to use. The socket must be
in non-blocking mode, and its websocket handshake must already be complete.

The descriptor is duplicated with C<dup(2)>, so the module owns and closes only
its own copy. Ownership of what you pass in stays with you: keep the handle
alive for as long as the websocket is in use, and close it yourself afterwards.

Croaks unless a defined, non-negative descriptor can be resolved - a missing,
undefined or already closed C<fh> is an error rather than a silent fallback.

=item type

Either C<client> or C<server>.

Default: C<server>

=item buffering

If set to 0, disables buffering: C<on_msg_recv> is then always called with an
empty C<$msg> and you use the C<on_frame_recv_*> callbacks instead. Useful for
handling large binary data without buffering it in memory.

Default: 1

=item max_recv_size

Maximum message or frame size. See
L<wslay_event_config_set_max_recv_msg_length|https://tatsuhiro-t.github.io/wslay/man/wslay_event_config_set_max_recv_msg_length.html>.

=item rsv

Reserved bits used by C<queue_msg_ex()> and C<queue_fragmented_ex()> when the
caller omits their C<rsv> argument. A per-call argument always wins.

Default: C<WS_RSV1_BIT>

RFC 6455 section 5.2 requires the RSV bits to be 0 unless an extension that
defines them has been negotiated, so a connection without permessage-deflate
should be created with C<< rsv => WS_RSV_NONE >>. The default is kept for
backwards compatibility.

=item allowed_rsv

Bitmask of reserved bits accepted on incoming frames; a frame carrying any other
RSV bit fails the connection. Only C<WS_RSV_NONE> and C<WS_RSV1_BIT> are
meaningful to wslay.

Default: C<WS_RSV1_BIT>

=item on_msg_recv

Called when a complete message has been received. Close messages are not
reported here - use C<on_close>. When C<buffering> is disabled, C<$msg> is
always empty.

    my ($rsv, $opcode, $msg, $status_code) = @_;

=item on_close

Called when the connection is closed.

    my ($close_code) = @_;

=item genmask

Client mode only. Must return a scalar of exactly C<$len> bytes to mask the
message with; any other length is an error and aborts the connection.

If not specified, a C<rand()> based generator seeded from perl's entropy source
is used. That is adequate for the RFC's "unpredictable to intermediaries"
requirement, but it is not cryptographically strong - supply your own callback
if you need that.

    my ($len) = @_;

=item on_frame_recv_start

Called when a frame header has been received.

    my ($fin, $rsv, $opcode, $payload_length) = @_;

=item on_frame_recv_chunk

Called for each portion of frame data received.

    my ($data) = @_;

=item on_frame_recv_end

Called at the end of a frame. No arguments.

=back

=head2 queue_msg( message, opcode )

Queues a message. C<opcode> is optional, default 1 (text). Returns 0 on success
or a negative wslay error code on failure.

Control frames go through the same call: C<< $ws->queue_msg($payload, 0x9) >>
sends a ping, and wslay answers incoming pings with a pong by itself.

=head2 queue_msg_ex( message, opcode, rsv )

As C<queue_msg()>, but with explicit reserved bits. C<rsv> is optional and
defaults to the connection's C<rsv> setting (see C<new()>).

=head2 queue_fragmented( callback, opcode )

Queues a fragmented message whose data comes from a callback. C<opcode> is
optional, default 2 (binary).

    my ($len) = @_;

The callback must return one or two elements: C<($data)> or C<($data, $status)>.
With a single scalar, the status defaults to C<WS_FRAGMENTED_DATA>. Status can
be:

=over

=item C<WS_FRAGMENTED_DATA>

A data chunk. Wslay re-invokes the callback continuously while it returns this.
Other events still run, but you will see 100% CPU if the callback keeps
returning an empty scalar while waiting for data. To avoid that, call
C<stop_write()> when you have nothing more to send and C<start_write()> when the
next portion is ready.

=item C<WS_FRAGMENTED_EOF>

End of message.

=item C<WS_FRAGMENTED_ERROR>

Error; the callback is not called again and the connection is aborted.

=back

=head2 queue_fragmented_ex( callback, opcode, rsv )

As C<queue_fragmented()>, but with explicit reserved bits. C<rsv> is optional
and defaults to the connection's C<rsv> setting (see C<new()>).

=head2 wait( cb )

Registers a callback to be run when the send queue becomes empty. Setting a new
one replaces any callback not yet fired.

=head2 queued_count()

Returns the number of messages in the send queue.

=head2 start() and stop()

Resume or suspend all websocket IO.

=head2 start_write() and stop_write()

Resume or suspend the write side only. Use this for flow control while sending a
fragmented message, as described under C<queue_fragmented()>.

=head2 start_read() and stop_read()

Resume or suspend the read side only. Data already in the socket buffer is
delivered once reading is resumed.

=head2 shutdown_read() and shutdown_write()

Permanently disable reading or writing at the wslay protocol level. Unlike
C<stop_*>/C<start_*>, which only pause the event watcher, a shutdown is
irreversible for the lifetime of the connection.

=head2 close( status_code, reason_data )

Queues a close frame. Both arguments are optional. C<reason_data> must not
exceed 123 bytes; anything longer is rejected by wslay and croaks. (Wslay's own
header says "less than 123 bytes", but the implementation accepts 123.)

Possible attack vector: a client can hold the connection open after receiving
the close frame, and open many such connections. To close for certain, call
C<close()>, C<wait()> until the close frame has been sent, then close
C<< $ws->{fh} >> yourself.

That handshake cannot complete while writing is suspended: call C<start_write()>
first if you have used C<stop_write()>, otherwise the close frame is never sent
and C<wait()> never fires.

=head1 ERRORS AND EXCEPTIONS

The queueing methods return a negative wslay error code for conditions you are
expected to handle - in practice only C<WSLAY_ERR_NO_MORE_MSG> (-302), returned
when queueing after a close frame has been queued.

Programming errors croak instead: an invalid argument (an over-long close
reason, for instance), C<WSLAY_ERR_NOMEM>, and calling any method on a
connection that is already closed or on an object that has been destroyed. Wrap
sends in C<eval> if you cannot rule those out.

A callback that dies does not unwind through wslay and libev. The exception is
held until the C state is consistent, then rethrown from whichever call entered
the module - an C<EV::run>, or the C<queue_*>/C<start_*>/C<stop_*> method you
called. While an exception is pending, the remaining callbacks for that event
are skipped.

Whether the connection survives depends on which callback died. C<on_msg_recv>,
C<on_frame_recv_*>, C<on_close> and the C<wait()> callback are advisory, so the
connection is left intact and you can carry on using it. C<genmask> and the
C<queue_fragmented> source callback produce bytes that wslay is in the middle of
framing, so a failure there - dying, or returning the wrong length - aborts the
connection.

The object must not outlive the event loop it was created on. Watchers are
disarmed automatically if the default loop is destroyed first, but any websocket
still open at that point stops doing IO.

Unix only. The WIN32 guards in the XS are incomplete: socket errors are read
from C<errno> rather than C<WSAGetLastError()>, and descriptors are closed with
C<close()> rather than C<closesocket()>.

=head1 SEE ALSO

L<EV>, L<Alien::Wslay>, L<Net::WebSocket::EV>,
L<RFC 6455|https://datatracker.ietf.org/doc/html/rfc6455>,
L<RFC 7692|https://datatracker.ietf.org/doc/html/rfc7692> (permessage-deflate)

=head1 AUTHOR

Yegor Korablev <egor@cpan.org>

=head1 LICENSE

This is free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut
