83 lines
2.1 KiB
Perl
83 lines
2.1 KiB
Perl
package MSGBA::Web::Controller::WS;
|
|
|
|
use v5.34.1;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Mojo::Base 'Mojolicious::Controller', -signatures;
|
|
use Mojo::IOLoop;
|
|
|
|
sub proxy {
|
|
my $self = shift;
|
|
$self->tx->max_websocket_size(100000000);
|
|
|
|
handle($self);
|
|
}
|
|
|
|
sub _handle_on_connect {
|
|
my $stream = shift;
|
|
my $ws = shift;
|
|
$ws->on('binary', sub {
|
|
my ($ws, $bytes) = @_;
|
|
if (!$bytes) {
|
|
warn "Received empty message";
|
|
return;
|
|
}
|
|
$stream->write($bytes);
|
|
});
|
|
}
|
|
|
|
sub handle {
|
|
my $ws = shift;
|
|
_build_msgba_connection($ws);
|
|
}
|
|
|
|
my $tx_buffer = {};
|
|
sub _build_msgba_connection {
|
|
my $ws = shift;
|
|
my $config = $ws->config;
|
|
Mojo::IOLoop->client(path => $config->{domain_socket}, sub ($loop, $err, $stream) {
|
|
_handle_on_connect($stream, $ws);
|
|
$tx_buffer->{$ws->tx} .= '';
|
|
$stream->on(read => sub ($stream, $bytes) {
|
|
if (!defined $ws->tx) {
|
|
$stream->close();
|
|
return;
|
|
}
|
|
$tx_buffer->{$ws->tx} //= '';
|
|
$tx_buffer->{$ws->tx} .= $bytes;
|
|
while (1) {
|
|
open my $fh, '<', \$tx_buffer->{$ws->tx};
|
|
if (length $tx_buffer->{$ws->tx} < 16) {
|
|
return;
|
|
}
|
|
read $fh, my $id, 8;
|
|
read $fh, my $size, 8;
|
|
my $size_num = unpack 'Q>', $size;
|
|
if (length $tx_buffer->{$ws->tx} < 16 + $size_num) {
|
|
return;
|
|
}
|
|
read $fh, my ($raw_data), $size_num;
|
|
$tx_buffer->{$ws->tx} = substr $tx_buffer->{$ws->tx}, 16 + $size_num, length $tx_buffer->{$ws->tx};
|
|
handle_packet($ws, {
|
|
id => $id,
|
|
size => $size,
|
|
raw_data => $raw_data,
|
|
});
|
|
|
|
close $fh;
|
|
}
|
|
|
|
});
|
|
});
|
|
}
|
|
|
|
sub handle_packet {
|
|
my $ws = shift;
|
|
my $packet = shift;
|
|
my ($id, $size, $raw_data) = $packet->@{qw/id size raw_data/};
|
|
$ws->send({binary => "${id}${size}${raw_data}"});
|
|
}
|
|
1;
|