EV-Websockets
view release on metacpan or search on metacpan
eg/adopt_server.pl
eg/backpressure.pl
eg/binary_test.pl
eg/chat_server.pl
eg/echo_test.pl
eg/feersum_native.pl
eg/feersum_psgi.pl
eg/graceful_shutdown.pl
eg/headers_and_cookies.pl
eg/json_protocol.pl
eg/keepalive.pl
eg/multi_conn.pl
eg/proxy.pl
eg/reconnect.pl
eg/router.pl
eg/self_signed.pl
eg/state_monitor.pl
eg/tls_server.pl
lib/EV/Websockets.pm
Makefile.PL
MANIFEST This list of files
Queue a binary frame. Croaks if the connection is not open.
send_ping([$payload])
Queue a Ping frame. $payload is optional; if supplied it is silently
truncated to 125 bytes per RFC 6455 §5.5. Croaks if the connection is
not open.
send_pong([$payload])
Queue a Pong frame. Same payload rules as "send_ping". Most peers send
Pong automatically in response to Ping; you only need this to send an
unsolicited Pong (e.g. as a one-way keepalive).
send_fragment($data, $is_binary = 0, $is_final = 1)
Send one fragment of a streaming message. The first call starts a new
fragmented message (text or binary per $is_binary); subsequent calls
send continuation frames. Set $is_final true on the last fragment.
$conn->send_fragment("part1", 0, 0); # text, not final
$conn->send_fragment("part2", 0, 0); # continuation, not final
$conn->send_fragment("part3", 0, 1); # continuation, final
is_connecting
Returns true while "state" is "connecting". Returns false once the
connection is established, closing, closed, or destroyed.
state
Returns the current state as one of:
"connecting" - TCP/TLS handshake or HTTP upgrade in progress
"connected" - open and ready to send/receive
"closing" - close() has been called; pending sends still draining
"closed" - the underlying wsi is gone but the Perl object is still alive
"destroyed" - the C struct has been freed (further method calls will
croak)
DEBUGGING
EV::Websockets::_set_debug(1);
Enables verbose debug output from both the module and libwebsockets. In
tests, gate on $ENV{EV_WS_DEBUG}:
EV::Websockets::_set_debug(1) if $ENV{EV_WS_DEBUG};
Websockets.xs view on Meta::CPAN
struct ev_ws_send_s* next;
size_t len;
enum lws_write_protocol write_mode;
char data[1]; /* C89-compatible flexible array; LWS_PRE + payload */
} ev_ws_send_t;
/* Context structure - manages lws_context and connections */
struct ev_ws_ctx_s {
unsigned int magic;
int refcnt; /* lifecycle refcount: Perl + each in-flight lws_service */
int* alive_flag; /* points to caller's stack variable during lws_service */
struct ev_loop* loop;
struct lws_context* lws_ctx;
ev_ws_conn_t* connections;
ev_ws_conn_t* flush_head; /* conns with a buffered, fully-received message
awaiting delivery once the service call drains */
ev_ws_conn_t* flush_tail; /* append point, so delivery across connections
follows queue order; reset with flush_head */
ev_ws_fd_t** fd_table;
int fd_table_size;
ev_timer timer;
Websockets.xs view on Meta::CPAN
if (*s < '0' || *s > '9') return -1;
v = v * 10 + (*s - '0');
if (v > 65535) return -1;
}
return v >= 1 ? (int)v : -1;
}
/* Bridges userdata into ws_callback() before lws_adopt returns. */
static ev_ws_conn_t* pending_adoption = NULL;
static HV* handshake_headers_map = NULL; /* wsi-ptr → per-conn response headers HV */
static struct lws_context* ssl_keepalive_ctx = NULL; /* see ensure_ssl_keepalive() */
/* Copy an lws header token into a fresh SV, or return NULL if absent/empty */
static SV* hdr_to_sv(struct lws *wsi, enum lws_token_indexes tok) {
int total = lws_hdr_total_length(wsi, tok);
if (total > 0) {
char *buf;
int n;
Newx(buf, total + 1, char);
n = lws_hdr_copy(wsi, buf, total + 1, tok);
if (n > 0) {
Websockets.xs view on Meta::CPAN
ev_timer_stop(ctx->loop, &ctx->timer);
ev_timer_set(&ctx->timer, delay_s, 0.);
ev_timer_start(ctx->loop, &ctx->timer);
}
static void flush_recv_messages(ev_ws_ctx_t* ctx);
static void do_lws_service(ev_ws_ctx_t* ctx) {
if (ctx && ctx->magic == EV_WS_CTX_MAGIC && ctx->lws_ctx) {
int alive = 1;
int* prev_flag = ctx->alive_flag;
ctx->alive_flag = &alive;
ctx_ref(ctx);
/* "Forced service": drive connections that need servicing with no
pending socket event -- rx already read into lws's buflist, plus any
due lws_sul timeouts. Counterintuitively a timeout_ms of 0 is NOT
non-blocking here: lws maps it to its maximum internal poll wait, so
the old lws_service(ctx, 0) blocked for seconds on an idle connection
and starved every other EV watcher. A negative timeout_ms clamps the
wait to 0, servicing only ready + forced-service work and returning at
once (see the lws_service_adjust_timeout docs). lws_service_fd(ctx,
NULL) is invalid since lws 3.2 and never drains buflists. Per-fd I/O
is driven by io_cb via lws_service_fd(&pollfd). */
lws_service_tsi(ctx->lws_ctx, -1, 0);
if (alive)
flush_recv_messages(ctx); /* deliver messages reassembled above */
if (alive) {
ctx->alive_flag = prev_flag;
schedule_timeout(ctx);
} else if (prev_flag) {
*prev_flag = 0; /* propagate destruction up the alive_flag chain */
}
ctx_unref(ctx);
}
}
static void timer_cb(EV_P_ ev_timer* w, int revents) {
(void)loop; (void)revents;
do_lws_service((ev_ws_ctx_t*)w->data);
}
Websockets.xs view on Meta::CPAN
XPUSHs(sv_2mortal(newSViv(is_binary)));
XPUSHs(sv_2mortal(newSViv(is_final)));
EMIT_END(conn, "message handler");
}
/* Deliver buffered, fully-received messages once an lws service call has
drained all currently-available input. The receive path reassembles a
message across callbacks (necessary because permessage-deflate inflates one
frame into several callbacks, each reporting lws_is_final_fragment() == 1)
and queues the connection here; we emit only complete messages. The ref taken
when queuing keeps each conn alive across its callback, so it is safe to
touch conn after emit_message returns. */
static void flush_recv_messages(ev_ws_ctx_t* ctx) {
ev_ws_conn_t* conn = ctx->flush_head;
ctx->flush_head = NULL;
ctx->flush_tail = NULL; /* must clear with the head: a stale tail would be
appended to (use-after-free) on the next queue */
while (conn) {
ev_ws_conn_t* next = conn->flush_next;
conn->flush_next = NULL;
conn->on_flush = 0;
Websockets.xs view on Meta::CPAN
pollfd.fd = fdw->fd;
pollfd.events = fdw->poll_events;
pollfd.revents = 0;
if (revents & EV_READ) pollfd.revents |= POLLIN;
if (revents & EV_WRITE) pollfd.revents |= POLLOUT;
if (revents & EV_ERROR) pollfd.revents |= POLLERR | POLLHUP;
{
int alive = 1;
int* prev_flag = ctx->alive_flag;
ctx->alive_flag = &alive;
ctx_ref(ctx);
lws_service_fd(ctx->lws_ctx, &pollfd);
if (alive)
flush_recv_messages(ctx); /* deliver messages reassembled above */
if (alive) {
ctx->alive_flag = prev_flag;
schedule_timeout(ctx);
} else if (prev_flag) {
*prev_flag = 0; /* propagate destruction up the alive_flag chain */
}
ctx_unref(ctx);
}
}
#define FD_TABLE_INIT_SIZE 64
static void fd_table_grow(ev_ws_ctx_t* ctx, int needed) {
int new_size = ctx->fd_table_size ? ctx->fd_table_size : FD_TABLE_INIT_SIZE;
while (new_size <= needed) new_size *= 2;
Websockets.xs view on Meta::CPAN
memcpy(conn->recv_buf + conn->recv_len, in, len);
conn->recv_len += len;
conn->recv_complete = is_final;
/* Queue the connection so its completed message is delivered
once the current lws service call drains all available input
(see flush_recv_messages). is_final alone is unreliable under
permessage-deflate, so we defer delivery: a fully-received
message (recv_complete) is emitted either in the first-fragment
branch above when the next message starts, or at flush time.
The flush-list ref keeps conn alive until then. */
if (!conn->on_flush) {
ev_ws_ctx_t* fctx = conn->ctx;
conn_ref(conn);
conn->flush_next = NULL;
if (fctx->flush_tail)
fctx->flush_tail->flush_next = conn;
else
fctx->flush_head = conn;
fctx->flush_tail = conn;
conn->on_flush = 1;
Websockets.xs view on Meta::CPAN
conn_unref(conn); /* drop wsi ref */
}
break;
case LWS_CALLBACK_PROTOCOL_DESTROY: {
struct lws_vhost *vh = wsi ? lws_get_vhost(wsi) : NULL;
if (vh) {
ev_ws_server_t *srv = (ev_ws_server_t *)lws_get_vhost_user(vh);
if (srv && (srv->magic == EV_WS_SRV_MAGIC || srv->magic == EV_WS_SRV_FREED)) {
/* SRV_FREED means a failed listen() already dropped the SV
refs but deliberately left protocol_name alive (the vhost
still pointed at it); free it here, once, at teardown. */
if (srv->magic == EV_WS_SRV_MAGIC)
free_server_svs(srv);
if (srv->protocol_name) Safefree(srv->protocol_name);
Safefree(srv);
}
}
break;
}
Websockets.xs view on Meta::CPAN
lws refcounts the global OpenSSL init across contexts created with
LWS_SERVER_OPTION_DO_SSL_GLOBAL_INIT. When that refcount falls to zero (the
last such context is destroyed) lws runs OPENSSL_cleanup(), which OpenSSL
1.1+/3.x cannot undo: creating another TLS context then fails, and lws's own
error reporting dereferences torn-down state and crashes. So a program that
destroys its TLS context and makes a new one (reconnect-with-fresh-ctx,
worker recycling, test suites) would break.
A TLS-using context still needs its own GLOBAL_INIT flag for its TLS to work
(the flag is per-context: "initialize the SSL library at all"); we keep that.
This keepalive is a single extra flagged context, created on first TLS use
and never destroyed or serviced, that holds the refcount floor at >= 1 so no
user context's teardown can trigger the cleanup. Returns 1 if held.
Idempotent; single-threaded use only (like the rest of this module). */
static int ensure_ssl_keepalive(void) {
struct lws_context_creation_info info;
if (ssl_keepalive_ctx)
return 1;
memset(&info, 0, sizeof(info));
info.port = CONTEXT_PORT_NO_LISTEN;
info.protocols = protocols;
info.gid = -1;
info.uid = -1;
info.options = LWS_SERVER_OPTION_DO_SSL_GLOBAL_INIT;
ssl_keepalive_ctx = lws_create_context(&info);
return ssl_keepalive_ctx != NULL;
}
MODULE = EV::Websockets PACKAGE = EV::Websockets
BOOT:
{
I_EV_API("EV::Websockets");
lws_set_log_level(LLL_ERR | LLL_WARN, NULL);
}
Websockets.xs view on Meta::CPAN
info.port = CONTEXT_PORT_NO_LISTEN;
info.protocols = protocols;
#ifdef LWS_HAS_EXTENSIONS
info.extensions = extensions;
#endif
info.gid = -1;
info.uid = -1;
/* ssl_init: -1 = manage OpenSSL init (default); 1 = force; 0 = coexist
(leave it to another TLS library). When we manage it, flag this context
so its own TLS works, and also pin the global init in a process-lifetime
keepalive so destroying this context can't drop lws's TLS refcount to
zero (which would run OPENSSL_cleanup() and break later TLS use). */
info.options = 0;
if (ssl_init != 0) {
info.options = LWS_SERVER_OPTION_DO_SSL_GLOBAL_INIT;
ensure_ssl_keepalive();
}
info.user = RETVAL;
info.foreign_loops = foreign_loops;
info.vhost_name = "default";
if (proxy && strlen(proxy) > 0) {
DEBUG_LOG("Context using proxy: %s:%d", proxy, proxy_port);
info.http_proxy_address = proxy;
info.http_proxy_port = proxy_port;
}
Websockets.xs view on Meta::CPAN
conn_unref(conn); /* drop wsi ref — may free conn */
}
self->connections = NULL;
if (self->lws_ctx) {
lws_context_destroy(self->lws_ctx);
self->lws_ctx = NULL;
}
self->loop = NULL;
if (self->alive_flag) *self->alive_flag = 0;
ctx_unref(self); /* drops Perl ref; Safefree happens when refcnt==0 */
}
EV::Websockets::Connection
connect(EV::Websockets::Context self, ...);
PREINIT:
struct lws_client_connect_info ccinfo;
const char* url = NULL;
const char* protocol = NULL;
char* host = NULL;
Websockets.xs view on Meta::CPAN
info.vhost_name = name;
info.user = srv;
info.options = 0;
if (ssl_cert && *ssl_cert && ssl_key && *ssl_key) {
info.ssl_cert_filepath = ssl_cert;
info.ssl_private_key_filepath = ssl_key;
if (ssl_ca && *ssl_ca)
info.ssl_ca_filepath = ssl_ca;
info.options |= LWS_SERVER_OPTION_DO_SSL_GLOBAL_INIT;
ensure_ssl_keepalive(); /* pin global init so vhost/context teardown won't OPENSSL_cleanup */
}
vh = lws_create_vhost(self->lws_ctx, &info);
if (vh == NULL) {
free_server_svs(srv);
if (srv->protocol_name) Safefree(srv->protocol_name);
Safefree(srv);
croak("Failed to create vhost for listening");
}
RETVAL = lws_get_vhost_listen_port(vh);
if (RETVAL <= 0) {
/* Vhost created but port bind failed. Release the SV refs now, but
leave protocol_name alive — the live vhost still points at it via
vhost_protocols[0].name, so freeing it here would dangle. Do NOT
Safefree(srv): the vhost retains the pointer. PROTOCOL_DESTROY frees
protocol_name and srv at context teardown; the SRV_FREED sentinel
tells it to skip the (already-released) SV refs. */
free_server_svs(srv);
srv->magic = EV_WS_SRV_FREED;
croak("listen: failed to bind port");
}
DEBUG_LOG("Server listening on port %d", RETVAL);
}
Websockets.xs view on Meta::CPAN
RETVAL->on_message = on_message;
RETVAL->on_close = on_close;
RETVAL->on_error = on_error;
RETVAL->on_pong = on_pong;
RETVAL->on_drain = on_drain;
RETVAL->max_message_size = max_message_size;
RETVAL->loop = self->loop;
/* Hold a reference to the underlying glob/IO to prevent Perl
* from closing the fd while lws owns it. For blessed glob refs
* (IO::Socket etc.) we ref the glob itself so framework DESTROY
* methods see it as still alive. */
RETVAL->adopted_fh = SvROK(fh_sv) ? newRV_inc(SvRV(fh_sv))
: SvREFCNT_inc(fh_sv);
link_conn(self, RETVAL);
{
struct lws_vhost *vh = lws_get_vhost_by_name(self->lws_ctx, "server");
if (!vh) {
/* Auto-create a server vhost for adoption (no listener needed) */
struct lws_context_creation_info vinfo;
Websockets.xs view on Meta::CPAN
conn_unref(RETVAL); /* drop sentinel */
/* Kick lws to process the adopted socket's readbuf (needed for lws 4.5+).
* Use the same non-blocking forced-service call as do_lws_service: the
* readbuf is pending work, so lws_service_tsi(ctx, -1, 0) drains it without
* blocking. A plain lws_service(ctx, 0) would block the EV loop here when a
* socket is adopted with no immediately-pending data.
* Guard with extra refs: the service call may synchronously fire
* error/destroy callbacks that would free RETVAL or ctx. */
{
int rejected, alive = 1;
int* prev_flag = self->alive_flag;
conn_ref(RETVAL);
ctx_ref(self);
self->alive_flag = &alive;
lws_service_tsi(self->lws_ctx, -1, 0);
if (alive)
flush_recv_messages(self); /* deliver any reassembled message */
if (alive) {
self->alive_flag = prev_flag;
schedule_timeout(self);
} else if (prev_flag) {
/* Context destroyed during inner lws_service.
Propagate destruction up the alive_flag chain. */
*prev_flag = 0;
}
rejected = (RETVAL->wsi == NULL);
conn_unref(RETVAL);
ctx_unref(self);
if (rejected)
croak("Failed to adopt socket");
}
}
OUTPUT:
eg/graceful_shutdown.pl view on Meta::CPAN
my $bound = $ctx->listen(
port => $port,
on_connect => sub { warn "client connected\n" },
on_message => sub { my ($c, $d) = @_; $c->send("echo: $d") },
on_close => sub { warn "client closed\n" },
);
warn "listening on port $bound; Ctrl-C to shut down\n";
my $shutting_down = 0;
# Keep the watchers alive for the life of the process.
my $sigint = EV::signal('INT', \&graceful_shutdown);
my $sigterm = EV::signal('TERM', \&graceful_shutdown);
sub graceful_shutdown {
return if $shutting_down++;
my @conns = $ctx->connections;
warn "shutting down; closing " . scalar(@conns) . " connection(s)\n";
$_->close(1001, "server going away") for @conns;
# Let the Close frames flush, then leave the loop.
my $t; $t = EV::timer(1, 0, sub { undef $t; EV::break });
eg/keepalive.pl view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use if -d 'blib', lib => 'blib/lib', 'blib/arch';
use EV;
use EV::Websockets;
# Keep a connection alive with periodic pings and detect a dead peer when a
# pong does not come back in time.
#
# Usage: perl eg/keepalive.pl [ws://host:port/path] [ping_interval] [pong_timeout]
my $url = shift // 'ws://127.0.0.1:8080/';
my $interval = shift // 15; # seconds between pings
my $timeout = shift // 10; # seconds to wait for each pong
my $ctx = EV::Websockets::Context->new;
my ($ping_timer, $pong_deadline);
my $conn = $ctx->connect(
url => $url,
on_connect => sub {
my ($c) = @_;
warn "connected; pinging every ${interval}s\n";
$ping_timer = EV::timer($interval, $interval, sub {
return unless $c->is_connected;
$c->send_ping("keepalive");
# Expect a pong within $timeout, else treat the peer as dead.
$pong_deadline = EV::timer($timeout, 0, sub {
warn "no pong within ${timeout}s; closing dead connection\n";
$c->close(1000);
});
});
},
on_pong => sub {
$pong_deadline = undef; # peer is alive; cancel the deadline
},
on_message => sub {
my ($c, $data) = @_;
warn "message: $data\n";
},
on_close => sub {
warn "closed\n";
$ping_timer = $pong_deadline = undef;
EV::break;
},
lib/EV/Websockets.pm view on Meta::CPAN
=head3 send_ping([$payload])
Queue a Ping frame. C<$payload> is optional; if supplied it is silently
truncated to 125 bytes per RFC 6455 §5.5. Croaks if the connection is not
open.
=head3 send_pong([$payload])
Queue a Pong frame. Same payload rules as C<send_ping>. Most peers send Pong
automatically in response to Ping; you only need this to send an unsolicited
Pong (e.g. as a one-way keepalive).
=head3 send_fragment($data, $is_binary = 0, $is_final = 1)
Send one fragment of a streaming message. The first call starts a new
fragmented message (text or binary per C<$is_binary>); subsequent calls send
continuation frames. Set C<$is_final> true on the last fragment.
$conn->send_fragment("part1", 0, 0); # text, not final
$conn->send_fragment("part2", 0, 0); # continuation, not final
$conn->send_fragment("part3", 0, 1); # continuation, final
lib/EV/Websockets.pm view on Meta::CPAN
Returns the current state as one of:
=over 4
=item C<"connecting"> - TCP/TLS handshake or HTTP upgrade in progress
=item C<"connected"> - open and ready to send/receive
=item C<"closing"> - C<close()> has been called; pending sends still draining
=item C<"closed"> - the underlying wsi is gone but the Perl object is still alive
=item C<"destroyed"> - the C struct has been freed (further method calls will croak)
=back
=head1 DEBUGGING
EV::Websockets::_set_debug(1);
Enables verbose debug output from both the module and libwebsockets.
t/07-end-to-end.t view on Meta::CPAN
EV::Websockets::_set_debug(1) if $ENV{EV_WS_DEBUG};
my $ctx = EV::Websockets::Context->new();
my %results = (
server_received => '',
client_received => '',
done => 0,
);
my %keep_alive;
# 1. Native Listener (port 0 = OS-assigned)
my $port = $ctx->listen(
port => 0,
on_connect => sub {
my ($c) = @_;
diag "Server: WebSocket established";
$keep_alive{server_conn} = $c;
},
on_message => sub {
my ($c, $data) = @_;
$results{server_received} = $data;
diag "Server: Received '$data', echoing...";
$c->send("Echo: $data");
},
on_close => sub {
diag "Server: Connection closed";
delete $keep_alive{server_conn};
}
);
diag "Server: listening on port $port";
# 2. Native Client
my $timer = EV::timer(0.1, 0, sub {
diag "Client: initiating connection...";
$keep_alive{client_conn} = $ctx->connect(
url => "ws://127.0.0.1:$port",
on_connect => sub {
my ($c) = @_;
diag "Client: connected, sending greeting";
$c->send("Hello Native");
},
on_message => sub {
my ($c, $data) = @_;
$results{client_received} = $data;
diag "Client: received '$data'";
$results{done} = 1;
$c->close(1000, "Done");
},
on_close => sub {
diag "Client: closed";
delete $keep_alive{client_conn};
EV::break;
},
on_error => sub {
diag "Client Error: $_[1]";
delete $keep_alive{client_conn};
EV::break;
}
);
diag "Client: Stored conn=" . $keep_alive{client_conn};
});
# 3. Execution
my $timeout = EV::timer(10, 0, sub { diag "Test timed out"; EV::break; });
diag "Entering loop";
EV::run;
is($results{server_received}, "Hello Native", "Server received client message");
is($results{client_received}, "Echo: Hello Native", "Client received server response");
t/16-edge-cases.t view on Meta::CPAN
my $to = EV::timer(10, 0, sub { EV::break });
EV::run;
ok(!defined $closed_peer, "peer_address returns undef on closed connection");
ok(!defined $closed_proto, "get_protocol returns undef on closed connection");
}
# Drop the shared context before test 6
undef $ctx;
# 6. Context destroy from inside on_message (alive_flag test)
{
my $ctx2 = EV::Websockets::Context->new();
my ($msg_received, $destroyed_ok);
my %keep;
my $port = $ctx2->listen(
port => 0,
on_connect => sub { $keep{s} = $_[0] },
on_message => sub { $_[0]->send("ack") },
on_close => sub { delete $keep{s} },
t/18-new-features.t view on Meta::CPAN
my $srv_msg_count = 0;
my $port = $ctx->listen(
port => 0,
on_connect => sub { $keep{srv} = $_[0] },
on_message => sub {
my ($c, $data) = @_;
$srv_msg_count++;
$c->send("echo:$data");
if ($srv_msg_count == 1) {
# Send retry immediately — the client's die in on_message
# is caught by G_EVAL, so the connection stays alive
$c->send("retry");
}
},
on_close => sub { delete $keep{srv} },
);
my $phase = 0;
$keep{cli} = $ctx->connect(
url => "ws://127.0.0.1:$port",
on_connect => sub { $_[0]->send("first") },
t/24-callback-and-accessor-coverage.t view on Meta::CPAN
on_error => sub { delete $keep{cli}; EV::break },
);
my $to = EV::timer(5, 0, sub { diag "timeout"; EV::break });
EV::run;
undef $ctx;
# $conn_after is still a Perl-side EV::Websockets::Connection object;
# the wsi is gone but stash() should still work on it (state="closed").
# The destroyed-magic croak fires only after the C struct is freed,
# which happens when the last Perl ref drops. We can verify the
# already-closed-but-not-destroyed branch:
ok(eval { $conn_after->stash; 1 }, "stash on closed-but-alive conn returns hashref");
is(ref $conn_after->stash, "HASH", "stash hashref persists across close");
}
done_testing;
t/27-review-coverage.t view on Meta::CPAN
ok(!$ok, "listen(name => 'default') croaked");
like($@, qr/reserved/i, "croak says the name is reserved");
}
# NOTE: the listen() bind-failure (RETVAL <= 0) path isn't driven here:
# colliding on an explicit port is unreliable under SO_REUSEPORT (the bind
# succeeds, and a 2-vhost-same-port context tickles an lws-internal teardown
# read). The vhost-creation-failure path (free_server_svs) is exercised by an
# unreadable-TLS-cert listen in t/28 (fork-contained) -- that path once
# SIGSEGV'd via OpenSSL's ERR path after a context had been destroyed, but the
# SSL keepalive fix resolved it. free_server_svs also runs on every successful
# listen() teardown via PROTOCOL_DESTROY.
# 7. Saving $conn inside on_error then dropping it must not crash.
# Exercises the connect() failure path where perl_self is set during a
# (possibly synchronous) connection error.
{
my $ctx = EV::Websockets::Context->new();
my $saved;
my $err = 0;
t/28-tls-context-recycle.t view on Meta::CPAN
EV::Websockets::_set_debug(1) if $ENV{EV_WS_DEBUG};
# Regression for the OpenSSL global-deinit crash.
#
# libwebsockets refcounts the global TLS-library init across contexts created
# with DO_SSL_GLOBAL_INIT and runs OPENSSL_cleanup() when the last such context
# is destroyed — and OpenSSL 1.1+/3.x cannot re-init after that. So destroying a
# TLS-capable context and then using TLS again (reconnect-with-fresh-context,
# worker recycling, ...) used to SIGSEGV inside OpenSSL's error path or fail to
# create the next context. The module now pins the init in a process-lifetime
# keepalive context so user contexts can be recycled freely.
#
# The crash-prone sequence is run in a forked child so that, if a regression
# (or an lws/OpenSSL combination the keepalive doesn't cover) reintroduces the
# crash, it is contained and reported rather than taking down the whole suite.
sub child_status {
my ($code) = @_;
my $pid = fork;
return undef unless defined $pid;
unless ($pid) { $code->(); POSIX::_exit(0); }
waitpid($pid, 0);
return $?;
}
# 1. create + destroy a context, then a fresh context performs a TLS operation
{
my $st = child_status(sub {
{ my $c = EV::Websockets::Context->new(); } # create + destroy
my $ctx = EV::Websockets::Context->new();
# Unreadable cert: exercises lws's OpenSSL error path — exactly what
# crashed before the keepalive. Should croak cleanly, not crash.
eval {
$ctx->listen(
port => 0,
name => 'recycle1',
ssl_cert => '/nonexistent/cert.pem',
ssl_key => '/nonexistent/key.pem',
on_message => sub { },
);
};
});
t/28-tls-context-recycle.t view on Meta::CPAN
);
};
});
SKIP: {
skip "fork unavailable: $!", 1 unless defined $st;
is($st & 127, 0, "no crash after multiple context recycles + TLS");
}
}
# 3. (in-process, no crash path) a TLS-capable context is creatable after a
# prior TLS context was destroyed. Without the keepalive, lws would have run
# OPENSSL_cleanup() on the first context's teardown and this second
# create would fail (cleanly) — so this both proves the fix and is safe to
# run in-process.
{
{ EV::Websockets::Context->new(ssl_init => 1); } # flagged, destroyed
my $ctx = eval { EV::Websockets::Context->new(ssl_init => 1) };
ok($ctx, "TLS-capable context creatable after destroying a prior TLS context")
or diag "context creation failed: $@";
}
xt/author/spelling.t view on Meta::CPAN
PSGI
psgix
endjinn
vhost
vhosts
subprotocol
hashref
filehandle
fd
backpressure
keepalive
reassembled
unsent
mid
runtime
lifecycle
RFC
UTF
IPv
IPv4
IPv6
( run in 3.243 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )