Achieved server-client local communication.
This commit is contained in:
parent
09d976141b
commit
366c5ad081
|
@ -0,0 +1,10 @@
|
||||||
|
use ExtUtils::MakeMaker;
|
||||||
|
|
||||||
|
WriteMakefile(
|
||||||
|
NAME => 'Cualsea::Cli',
|
||||||
|
VERSION => '0.1',
|
||||||
|
INST_SCRIPT => './bin',
|
||||||
|
INST_BIN => './bin',
|
||||||
|
test => { TESTS => 't/*.t' },
|
||||||
|
test => { TESTS => 't/*/*.t' },
|
||||||
|
);
|
|
@ -0,0 +1,22 @@
|
||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use v5.30.0;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
use IO::Socket::UNIX;
|
||||||
|
|
||||||
|
use Cualsea::FileSocket;
|
||||||
|
use Cualsea::MessageManager;
|
||||||
|
|
||||||
|
my $socket = IO::Socket::UNIX->new(
|
||||||
|
Type => SOCK_STREAM(),
|
||||||
|
Peer => $Cualsea::FileSocket::SOCKET_PATH,
|
||||||
|
) or die "Daemon not started";
|
||||||
|
my $message_manager = Cualsea::MessageManager->new(socket => $socket);
|
||||||
|
|
||||||
|
$message_manager->write_message( message => {hola => 'mundo'} );
|
||||||
|
|
||||||
|
print Data::Dumper::Dumper $message_manager->read_message;
|
|
@ -0,0 +1,15 @@
|
||||||
|
use ExtUtils::MakeMaker;
|
||||||
|
|
||||||
|
WriteMakefile(
|
||||||
|
NAME => 'Cualsea',
|
||||||
|
VERSION => '0.1',
|
||||||
|
test => { TESTS => 't/*.t' },
|
||||||
|
test => { TESTS => 't/*/*.t' },
|
||||||
|
PREREQ_PM => {
|
||||||
|
'Const::Fast' => 0,
|
||||||
|
'Types::Standard' => 0,
|
||||||
|
'Params::ValidationCompiler' => 0,
|
||||||
|
'JSON' => 0,
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
|
@ -0,0 +1,11 @@
|
||||||
|
package Cualsea::FileSocket;
|
||||||
|
|
||||||
|
use v5.30.0;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Const::Fast;
|
||||||
|
|
||||||
|
const our $SOCKET_PATH => '/run/cualsea/cualsea.sock';
|
||||||
|
1;
|
|
@ -7,7 +7,7 @@ use warnings;
|
||||||
|
|
||||||
use Encode;
|
use Encode;
|
||||||
|
|
||||||
use Types::Standard qw/Object/;
|
use Types::Standard qw/Object HashRef/;
|
||||||
use Params::ValidationCompiler qw/validation_for/;
|
use Params::ValidationCompiler qw/validation_for/;
|
||||||
use JSON;
|
use JSON;
|
||||||
|
|
||||||
|
@ -34,6 +34,7 @@ use JSON;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _socket {
|
sub _socket {
|
||||||
|
my $self = shift;
|
||||||
return $self->{socket};
|
return $self->{socket};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -45,13 +46,12 @@ sub read_message {
|
||||||
my $message_json;
|
my $message_json;
|
||||||
$socket->recv($len_bytes, 4);
|
$socket->recv($len_bytes, 4);
|
||||||
$len = unpack ('L', $len_bytes);
|
$len = unpack ('L', $len_bytes);
|
||||||
|
say "Received len $len";
|
||||||
$socket->recv($message_json, $len);
|
$socket->recv($message_json, $len);
|
||||||
eval {
|
say "Received message $message_json";
|
||||||
return decode_json($message_json);
|
my $message = decode_json($message_json);
|
||||||
};
|
print Data::Dumper::Dumper $message;
|
||||||
if ($@) {
|
return $message;
|
||||||
warn "Unable to decode the message.";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
{
|
{
|
||||||
|
@ -69,11 +69,13 @@ sub read_message {
|
||||||
my $socket = $self->_socket;
|
my $socket = $self->_socket;
|
||||||
my $message_json = encode_json($message);
|
my $message_json = encode_json($message);
|
||||||
# We will want the len to be calculated over the raw bytes.
|
# We will want the len to be calculated over the raw bytes.
|
||||||
$message_json = Encode::encode("UTF-8");
|
$message_json = Encode::encode("UTF-8", $message_json);
|
||||||
my $len = length $message_json;
|
my $len = length $message_json;
|
||||||
my $len_str = pack 'L', $len;
|
my $len_str = pack 'L', $len;
|
||||||
$socket->send($len_str);
|
$socket->send($len_str);
|
||||||
|
say "Sended len $len";
|
||||||
$socket->send($message_json);
|
$socket->send($message_json);
|
||||||
|
say "Sended message $message_json";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
1
|
1
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
use ExtUtils::MakeMaker;
|
||||||
|
|
||||||
|
WriteMakefile(
|
||||||
|
NAME => 'Cualsea::Server',
|
||||||
|
VERSION => '0.1',
|
||||||
|
INST_SCRIPT => './bin',
|
||||||
|
INST_BIN => './bin',
|
||||||
|
test => { TESTS => 't/*.t' },
|
||||||
|
test => { TESTS => 't/*/*.t' },
|
||||||
|
);
|
|
@ -6,12 +6,12 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
use IO::Socket::UNIX;
|
use IO::Socket::UNIX;
|
||||||
|
use Cualsea::FileSocket;
|
||||||
|
use Cualsea::Server::MessageController;
|
||||||
|
|
||||||
# The built-in constants are not that good.
|
# The built-in constants are not that good.
|
||||||
use Const::Fast;
|
use Const::Fast;
|
||||||
|
|
||||||
const $SOCKET_PATH => '/run/cualsea.sock';
|
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
|
|
||||||
|
@ -19,26 +19,38 @@ sub new {
|
||||||
return bless {}, $class;
|
return bless {}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub socket {
|
sub _socket {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
if ( !defined $self->{socket} ) {
|
if ( !defined $self->{socket} ) {
|
||||||
warn 'Overwritting cualsea socket, this may be a bug.'
|
if (-e $Cualsea::FileSocket::SOCKET_PATH) {
|
||||||
if -e $SOCKET_PATH;
|
warn 'Overwritting cualsea socket, this may be a bug.';
|
||||||
system 'rm', $SOCKET_PATH;
|
system 'rm', $Cualsea::FileSocket::SOCKET_PATH;
|
||||||
$self->{socket} = IO::Socket::Unix->new(
|
}
|
||||||
|
$self->{socket} = IO::Socket::UNIX->new(
|
||||||
Type => SOCK_STREAM(),
|
Type => SOCK_STREAM(),
|
||||||
Local => $SOCKET_PATH,
|
Local => $Cualsea::FileSocket::SOCKET_PATH,
|
||||||
Listen => 1,
|
Listen => 1,
|
||||||
);
|
);
|
||||||
|
chmod 0777, $Cualsea::FileSocket::SOCKET_PATH;
|
||||||
}
|
}
|
||||||
return $self->{socket};
|
return $self->{socket};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub _message_controller {
|
||||||
|
my $self = shift;
|
||||||
|
if (!defined $self->{message_controller}) {
|
||||||
|
$self->{message_controller} = Cualsea::Server::MessageController->new;
|
||||||
|
}
|
||||||
|
return $self->{message_controller};
|
||||||
|
}
|
||||||
|
|
||||||
sub run {
|
sub run {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $socket = $self->socket;
|
my $socket = $self->_socket;
|
||||||
my $conn = $socket->accept;
|
my $conn = $socket->accept;
|
||||||
|
my $message_controller = $self->_message_controller;
|
||||||
if ($conn) {
|
if ($conn) {
|
||||||
|
$message_controller->dispatch ( socket => $conn );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
1
|
1
|
||||||
|
|
|
@ -5,11 +5,66 @@ use v5.30.0;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
use Params::ValidationCompiler qw/validation_for/;
|
||||||
|
use Types::Standard qw/Object HashRef/;
|
||||||
|
|
||||||
|
use Cualsea::MessageManager;
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
return bless {}, $class;
|
return bless {}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub dispatch {
|
{
|
||||||
|
my $validator = validation_for(
|
||||||
|
params => {
|
||||||
|
socket => { type => Object },
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
sub dispatch {
|
||||||
|
my $self = shift;
|
||||||
|
my %params = $validator->(@_);
|
||||||
|
my $socket = $params{socket};
|
||||||
|
my $message_manager = Cualsea::MessageManager->new( socket => $socket );
|
||||||
|
my $message = $message_manager->read_message;
|
||||||
|
if ( !$self->check_is_command( message => $message ) ) {
|
||||||
|
$self->write_malformed(
|
||||||
|
message_manager => $message_manager );
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
$message_manager->write_message( message => $message );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
my $validator = validation_for(
|
||||||
|
params => {
|
||||||
|
message_manager => { type => Object }
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
sub write_malformed {
|
||||||
|
my $self = shift;
|
||||||
|
my %params = $validator->(@_);
|
||||||
|
my $message_manager = $params{message_manager};
|
||||||
|
$message_manager->write_message(
|
||||||
|
message => { is_error => 1, status => 400 } );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
{
|
||||||
|
my $validator = validation_for(
|
||||||
|
params => {
|
||||||
|
message => { type => HashRef },
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
sub check_is_command {
|
||||||
|
my $self = shift;
|
||||||
|
my %params = $validator->(@_);
|
||||||
|
my $message = $params{message};
|
||||||
|
return 1 if exists $message->{command};
|
||||||
|
}
|
||||||
}
|
}
|
||||||
1
|
1
|
||||||
|
|
|
@ -0,0 +1,14 @@
|
||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
if ! getent passwd cualsea &> /dev/null; then
|
||||||
|
sudo useradd -m cualsea -d /var/lib/cualsea -s /bin/bash &&
|
||||||
|
sudo mkdir /run/cualsea &&
|
||||||
|
sudo chown cualsea:cualsea /run/cualsea/
|
||||||
|
fi
|
||||||
|
current_dir=$(dirname $(realpath $0));
|
||||||
|
cd $current_dir/cualsea-lib &&
|
||||||
|
sudo cpan . &&
|
||||||
|
cd $current_dir/cualsea-cli &&
|
||||||
|
sudo cpan . &&
|
||||||
|
cd $current_dir/cualsea-server &&
|
||||||
|
sudo cpan .
|
Loading…
Reference in New Issue