111 lines
2.5 KiB
Perl
111 lines
2.5 KiB
Perl
package MSGBA::Web::Controller::WS;
|
|
|
|
use v5.34.1;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Mojo::Base 'Mojolicious::Controller', -signatures;
|
|
|
|
sub proxy {
|
|
my $self = shift;
|
|
my $conn = MSGBA::Web::Controller::WS::Connection->new(ws => $self, config => $self->config);
|
|
return $conn->handle();
|
|
}
|
|
|
|
package MSGBA::Web::Controller::WS::Connection {
|
|
use v5.34.1;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Moo;
|
|
use IO::Socket::UNIX;
|
|
|
|
|
|
has config => (
|
|
is => 'ro',
|
|
required => 1,
|
|
);
|
|
|
|
has ws => (
|
|
is => 'ro',
|
|
required => 1,
|
|
);
|
|
|
|
has msgba_connection => (
|
|
is => 'rw',
|
|
required => 0,
|
|
);
|
|
|
|
sub handle {
|
|
my $self = shift;
|
|
my $ws = $self->ws;
|
|
$self->_build_msgba_connection;
|
|
$ws->on('message', sub {
|
|
my ($ws, $bytes) = @_;
|
|
if (!$bytes) {
|
|
warn "Received empty message";
|
|
return;
|
|
}
|
|
say "Received message";
|
|
say unpack 'H*', $bytes;
|
|
open my $fh, '<', \$bytes;
|
|
read $fh, my $id, 8;
|
|
read $fh, my $size, 8;
|
|
$size = unpack 'Q>', $size;
|
|
close $fh;
|
|
$self->msgba_connection->print($bytes);
|
|
});
|
|
return;
|
|
#while (my $packet = $self->read_packet) {
|
|
# $self->handle_packet($packet);
|
|
#}
|
|
#close $self->msgba_connection;
|
|
#$ws->closed;
|
|
}
|
|
|
|
sub handle_packet {
|
|
my $self = shift;
|
|
my $packet = shift;
|
|
my $ws = $self->ws;
|
|
my ($id, $size, $raw_data) = $packet->@{qw/id size raw_data/};
|
|
$ws->send({binary => "${id}${size}${raw_data}"});
|
|
}
|
|
|
|
sub read_packet {
|
|
my $self = shift;
|
|
my $fh = $self->msgba_connection;
|
|
my $ws = $self->ws;
|
|
my ($id, $size, $raw_data);
|
|
if ((read $fh, $id, 8) != 8) {
|
|
return;
|
|
}
|
|
if ((read $fh, $size, 8) != 8) {
|
|
return;
|
|
}
|
|
my $size_num = unpack 'Q>', $size;
|
|
if ((read $fh, $raw_data, $size_num) != $size_num) {
|
|
return;
|
|
}
|
|
return {
|
|
id => $id,
|
|
size => $size,
|
|
raw_data => $raw_data,
|
|
};
|
|
}
|
|
|
|
sub _build_msgba_connection {
|
|
my $self = shift;
|
|
my $config = $self->config;
|
|
my $msgba_connection = IO::Socket::UNIX->new(
|
|
Type => SOCK_STREAM(),
|
|
Peer => $config->{domain_socket},
|
|
) or die "@{[$config->{domain_socket}]}: $!";
|
|
$self->msgba_connection($msgba_connection);
|
|
}
|
|
|
|
};
|
|
|
|
1;
|