Adding initial commit, nothing works yet.

The cualsead binary will be the server
it delegates soon in Cualsea::Server::Loop and which
will redirect requests to MessageController.

Forking is not implemented and will be probably out of the
project scope since this is a demo program.

The MessageManager is pretty much inpired in the way
sftp comunicates, but we soon stop sending raw binary
data when we have comunicated the packet size to delegate
in json which is more useful in Perl than handling
fake struct logic.
This commit is contained in:
sergiotarxz 2021-11-09 00:15:47 +01:00
parent 531a6f104e
commit 09d976141b
4 changed files with 148 additions and 0 deletions

View File

@ -0,0 +1,79 @@
package Cualsea::MessageManager;
use v5.30.0;
use strict;
use warnings;
use Encode;
use Types::Standard qw/Object/;
use Params::ValidationCompiler qw/validation_for/;
use JSON;
{
my $validator = validation_for(
params => {
# Ideally this would check the class, but I don't care a lot in this case.
socket => { type => Object },
}
);
sub new {
my $class = shift;
# Having a instance soon in the constructor is often useful if a method needs to be called.
my $self = bless {}, $class;
my %params = $validator->(@_);
# This is magically safe using ValidationCompiler.
$self->{socket} = $params{socket};
return $self;
}
}
sub _socket {
return $self->{socket};
}
sub read_message {
my $self = shift;
my $socket = $self->_socket;
my $len_bytes;
my $len;
my $message_json;
$socket->recv($len_bytes, 4);
$len = unpack ('L', $len_bytes);
$socket->recv($message_json, $len);
eval {
return decode_json($message_json);
};
if ($@) {
warn "Unable to decode the message.";
}
}
{
my $validator = validation_for(
params => {
# I have decided everything should be a HashRef in order to
# have a sane in packet metadata support.
message => { type => HashRef },
}
);
sub write_message {
my $self = shift;
my %params = $validator->(@_);
my $message = $params{message};
my $socket = $self->_socket;
my $message_json = encode_json($message);
# We will want the len to be calculated over the raw bytes.
$message_json = Encode::encode("UTF-8");
my $len = length $message_json;
my $len_str = pack 'L', $len;
$socket->send($len_str);
$socket->send($message_json);
}
}
1

10
cualsea-server/bin/cualsead Executable file
View File

@ -0,0 +1,10 @@
#!/usr/bin/env perl
use v5.30.0;
use strict;
use warnings;
use Cualsea::Server::Loop;
my $loop = Cualsea::Server::Loop->new;
$loop->run while 1;

View File

@ -0,0 +1,44 @@
package Cualsea::Server::Loop;
use v5.30.0;
use strict;
use warnings;
use IO::Socket::UNIX;
# The built-in constants are not that good.
use Const::Fast;
const $SOCKET_PATH => '/run/cualsea.sock';
sub new {
my $class = shift;
# Return is optional but helpful while reading.
return bless {}, $class;
}
sub socket {
my $self = shift;
if ( !defined $self->{socket} ) {
warn 'Overwritting cualsea socket, this may be a bug.'
if -e $SOCKET_PATH;
system 'rm', $SOCKET_PATH;
$self->{socket} = IO::Socket::Unix->new(
Type => SOCK_STREAM(),
Local => $SOCKET_PATH,
Listen => 1,
);
}
return $self->{socket};
}
sub run {
my $self = shift;
my $socket = $self->socket;
my $conn = $socket->accept;
if ($conn) {
}
}
1

View File

@ -0,0 +1,15 @@
package Cualsea::Server::MessageController;
use v5.30.0;
use strict;
use warnings;
sub new {
my $class = shift;
return bless {}, $class;
}
sub dispatch {
}
1