Net-Clacks
view release on metacpan or search on metacpan
"runtime" : {
"requires" : {
"Array::Contains" : "2.7",
"Carp" : "0",
"DBI" : "0",
"English" : "0",
"Errno" : "0",
"File::Copy" : "0",
"IO::Select" : "0",
"IO::Socket::IP" : "0",
"IO::Socket::SSL" : "0",
"Readonly" : "0",
"Scalar::Util" : "0",
"Sys::Hostname" : "0",
"Time::HiRes" : "0",
"XML::Simple" : "0",
"YAML::Syck" : "0",
"perl" : "5.036000"
}
}
},
- inc
requires:
Array::Contains: '2.7'
Carp: '0'
DBI: '0'
English: '0'
Errno: '0'
File::Copy: '0'
IO::Select: '0'
IO::Socket::IP: '0'
IO::Socket::SSL: '0'
Readonly: '0'
Scalar::Util: '0'
Sys::Hostname: '0'
Time::HiRes: '0'
XML::Simple: '0'
YAML::Syck: '0'
perl: '5.036000'
version: 36
x_serialization_backend: 'CPAN::Meta::YAML version 0.020'
Makefile.PL view on Meta::CPAN
WriteMakefile(
NAME => 'Net::Clacks',
VERSION_FROM => 'lib/Net/Clacks.pm', # finds $VERSION
MIN_PERL_VERSION => '5.36.0',
PREREQ_PM => {
"Array::Contains" => 2.7,
"DBI" => 0,
"XML::Simple" => 0,
"IO::Select" => 0,
"IO::Socket::IP" => 0,
"IO::Socket::SSL" => 0,
"Time::HiRes" => 0,
"Carp" => 0,
"English" => 0,
"Errno" => 0,
"Readonly" => 0,
"Sys::Hostname" => 0,
"Time::HiRes" => 0,
"YAML::Syck" => 0,
"File::Copy" => 0,
"Scalar::Util" => 0,
example/rawclient.pl view on Meta::CPAN
use utf8;
use Encode qw(is_utf8 encode_utf8 decode_utf8);
use Data::Dumper;
use builtin qw[true false is_bool];
no warnings qw(experimental::builtin); ## no critic (TestingAndDebugging::ProhibitNoWarnings)
#---AUTOPRAGMAEND---
use Term::ReadKey;
use Time::HiRes qw(sleep);
use IO::Socket::IP;
use IO::Socket::SSL;
use MIME::Base64;
my $peer = shift @ARGV;
if(!defined($peer) || $peer !~ /\:/) {
die("Usage: rawclient.pl host:port");
}
my ($host, $port) = split/\:/, $peer;
my $username = 'exampleuser';
my $password = 'unsafepassword';
example/rawclient.pl view on Meta::CPAN
my $socket = IO::Socket::IP->new(
PeerHost => $host,
PeerPort => $port,
Type => SOCK_STREAM,
) or croak("Failed to connect to Clacks message service: $ERRNO");
binmode($socket, ':bytes');
$socket->blocking(0);
IO::Socket::SSL->start_SSL($socket,
SSL_verify_mode => SSL_VERIFY_NONE,
) or croak("Can't use SSL: " . $SSL_ERROR);
# Auth
foreach my $initcmd (@initcommands) {
print '>', $initcmd, "\n";
syswrite($socket, $initcmd . "\r\n");
}
my $keepRunning = 1;
lib/Net/Clacks/ClacksCache.pm view on Meta::CPAN
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
$self->{clacks}->disconnect();
};
return;
}
sub DESTROY($self) {
# During Perl's global destruction phase, package symbol tables are torn
# down in arbitrary order. By the time DESTROY runs here the inner
# Net::Clacks::Client (and IO::Socket::SSL, IO::Select, etc.) may already
# be unavailable. Skip cleanup entirely in that phase — the kernel closes
# any leftover FD on process exit and the server detects EOF.
return if(${^GLOBAL_PHASE} eq 'DESTRUCT');
# Outside global destruction, do a *fast* close (no flush, no QUIT, no
# sleeps). DESTROY can run at moments where the graceful path is
# inappropriate (worker child unwinding after fork, exception
# propagation, local-block exit). Callers who want a graceful protocol-
# level close should call $cache->disconnect() explicitly first.
if(defined($self->{clacks})) {
lib/Net/Clacks/Client.pm view on Meta::CPAN
use Data::Dumper;
use builtin qw[true false is_bool];
no warnings qw(experimental::builtin); ## no critic (TestingAndDebugging::ProhibitNoWarnings)
#---AUTOPRAGMAEND---
use IO::Socket::IP;
#use IO::Socket::UNIX;
use Time::HiRes qw[sleep usleep time];
use Sys::Hostname;
use IO::Select;
use IO::Socket::SSL;
use MIME::Base64;
sub new($class, $server, $port, $username, $password, $clientname, $iscaching = 0) {
my $self = bless {}, $class;
if(!defined($server) || !length($server)) {
croak("server not defined!");
}
if(!defined($port) || !length($port)) {
croak("port not defined!");
lib/Net/Clacks/Client.pm view on Meta::CPAN
$self->{nextremembrance} = time + $self->{remembranceinterval};
$self->reconnect();
return;
}
sub _safeCloseSocket($self, $socket) {
return if(!defined($socket));
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
if(ref($socket) =~ /^IO::Socket::SSL/) {
$socket->close(SSL_no_shutdown => 1, SSL_fast_shutdown => 1);
} else {
$socket->close;
}
};
return;
}
# Perform a TLS handshake with our own deadline, without using SIGALRM.
# Strategy: put the socket into non-blocking mode up front, defer the handshake
# at start_SSL (SSL_startHandshake => 0), then drive connect_SSL() ourselves and
# poll with IO::Select::can_read / can_write between attempts. This is safe in
# applications that already use signals or have their own event loop.
#
# Returns the wrapped socket on success, or undef on timeout / handshake error.
# On failure, the caller is responsible for closing the original $socket.
sub _sslHandshakeWithTimeout($self, $socket, $timeout) {
$socket->blocking(0);
my $wrapped = IO::Socket::SSL->start_SSL($socket,
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_startHandshake => 0,
);
if(!$wrapped) {
return;
}
my $deadline = time + $timeout;
my $select = IO::Select->new($wrapped);
while(1) {
lib/Net/Clacks/Client.pm view on Meta::CPAN
delete $self->{socket};
}
$self->{needreconnect} = 1;
return;
}
sub DESTROY($self) {
# During Perl's global destruction phase, package symbol tables are torn
# down in arbitrary order. By the time DESTROY runs here, methods on
# IO::Socket::SSL, IO::Select, or even IO::Socket may already be
# unavailable. Skip cleanup entirely in that phase — the kernel closes
# any leftover FD when the process exits, and the server detects that
# as EOF and removes us cleanly. Trying to be "polite" here can stall
# exit (flush() waits up to requesttimeout seconds) or call methods on
# half-destroyed package state.
return if(${^GLOBAL_PHASE} eq 'DESTRUCT');
# Outside global destruction we do a *fast* close (no flush(), no QUIT,
# no sleeps). DESTROY can run at moments where the graceful path is
# inappropriate — e.g. a worker child unwinding after fork, an exception
lib/Net/Clacks/Server.pm view on Meta::CPAN
use builtin qw[true false is_bool];
no warnings qw(experimental::builtin); ## no critic (TestingAndDebugging::ProhibitNoWarnings)
#---AUTOPRAGMAEND---
use XML::Simple;
use Time::HiRes qw(sleep usleep time);
use Sys::Hostname;
use Errno;
use IO::Socket::IP;
use IO::Select;
use IO::Socket::SSL;
use YAML::Syck;
use MIME::Base64;
use File::Copy;
use Scalar::Util qw(looks_like_number weaken);
# For turning off SSL session cache
use Readonly;
Readonly my $SSL_SESS_CACHE_OFF => 0x0000;
my %overheadflags = (
lib/Net/Clacks/Server.pm view on Meta::CPAN
S => "shutdown_service", # value: positive number (number in seconds before shutdown). If interclacks clients are present, should be high
# enough to flush all buffers to them
T => 'timestamp', # Used before KEYSYNC to compensate for time drift between different systems
U => "return_to_sender",
Z => "no_flags", # Only sent when no other flags are set
);
BEGIN {
{
# We need to add some extra function to IO::Socket::SSL so we can track the client ID
# on both TCP and Unix Domain Sockets
no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
*{"IO::Socket::SSL::_setClientID"} = sub {
my ($self, $cid) = @_;
${*$self}{'__client_id'} = $cid; ## no critic (References::ProhibitDoubleSigils)
return;
};
*{"IO::Socket::SSL::_getClientID"} = sub {
my ($self) = @_;
return ${*$self}{'__client_id'} || ''; ## no critic (References::ProhibitDoubleSigils)
};
}
}
sub new($class, $isDebugging, $configfile) {
lib/Net/Clacks/Server.pm view on Meta::CPAN
$self->_savePersistanceFile();
sleep(0.5);
foreach my $cid (keys %{$self->{clients}}) {
print "Removing client $cid\n";
# Try to notify the client (may or may not work);
$self->_evalsyswrite($self->{clients}->{$cid}->{socket}, "\r\nQUIT\r\n");
# Remove from the selector AND explicitly close — relying on Perl GC was
# leaving handles (and thus OS file descriptors) alive whenever IO::Select
# still held a reference, particularly for IO::Socket::SSL handles.
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
$self->{selector}->remove($self->{clients}->{$cid}->{socket});
};
$self->_safeCloseSocket($self->{clients}->{$cid}->{socket});
delete $self->{clients}->{$cid};
}
print "All clients removed\n";
# Close the listening sockets too so the next process can re-bind without
# waiting for the kernel to release the port / unix-socket inode.
lib/Net/Clacks/Server.pm view on Meta::CPAN
sub _nextClientSerial($self) {
$self->{clientSerial}++;
return $self->{clientSerial};
}
# Best-effort socket close that never throws. SSL sockets get SSL_no_shutdown so
# we don't block trying to send a TLS close_notify to a peer that's already gone.
sub _safeCloseSocket($self, $socket) {
return if(!defined($socket));
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
if(ref($socket) =~ /^IO::Socket::SSL/) {
$socket->close(SSL_no_shutdown => 1, SSL_fast_shutdown => 1);
} else {
$socket->close;
}
};
return;
}
sub _slurpBinFile($self, $fname) {
# Read in file in binary mode, slurping it into a single scalar.
lib/Net/Clacks/Server.pm view on Meta::CPAN
);
}
if(!defined($msocket)) {
print STDERR "Can't connect to MASTER via interclacks!\n";
} else {
print "connected to master\n";
if(ref $msocket ne 'IO::Socket::UNIX') {
# ONLY USE SSL WHEN RUNNING OVER THE NETWORK
# There is simply no point in running it over a local socket.
my $encrypted = IO::Socket::SSL->start_SSL($msocket,
SSL_verify_mode => SSL_VERIFY_NONE,
);
if(!$encrypted) {
# Bare `next` was a bug here — there is no enclosing loop. Without an
# explicit close the failed-handshake $msocket leaks a file descriptor.
# Return cleanly; the next reconnect attempt will be scheduled by
# nextinterclackscheck below.
print STDERR "startSSL failed (interclacks master): ", $SSL_ERROR, "\n";
$self->_safeCloseSocket($msocket);
return;
lib/Net/Clacks/Server.pm view on Meta::CPAN
print "Got a new client $cid!\n";
foreach my $debugcid (keys %{$self->{clients}}) {
if($self->{clients}->{$debugcid}->{mirror}) {
$self->{clients}->{$debugcid}->{outbuffer} .= "DEBUG CONNECTED=" . $cid . "\r\n";
}
}
if(ref $clientsocket ne 'IO::Socket::UNIX') {
# ONLY USE SSL WHEN RUNNING OVER THE NETWORK
# There is simply no point in running it over a local socket.
my $encrypted = IO::Socket::SSL->start_SSL($clientsocket,
SSL_server => 1,
SSL_cert_file => $self->{config}->{ssl}->{cert},
SSL_key_file => $self->{config}->{ssl}->{key},
SSL_cipher_list => 'ALL:!ADH:!RC4:+HIGH:+MEDIUM:!LOW:!SSLv2:!SSLv3!EXPORT',
SSL_create_ctx_callback => sub {
my $ctx = shift;
# Enable workarounds for broken clients
Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL); ## no critic (Subroutines::ProhibitAmpersandSigils)
( run in 1.743 second using v1.01-cache-2.11-cpan-99c4e6809bf )