1102 lines
26 KiB
Perl
Executable File
1102 lines
26 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
################################################################################
|
|
#
|
|
# Copyright (c) 2007-2008 Ramon Novoa <rnovoa@artica.es>
|
|
# Copyright (c) 2007-2023 Pandora FMS.
|
|
#
|
|
# tentacle_client.pl Tentacle Client. See https://pandorafms.com/docs/ for
|
|
# protocol description.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; version 2 of the License.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
################################################################################
|
|
|
|
package tentacle::client;
|
|
|
|
=head1 NAME
|
|
|
|
tentacle_client - Tentacle Client
|
|
|
|
=head1 VERSION
|
|
|
|
Version 0.4.0
|
|
|
|
=head1 USAGE
|
|
|
|
tentacle_client [options] [file] [file] ...
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
B<tentacle_client(1)> is a client for B<tentacle>, a B<client/server> file transfer protocol that aims to be:
|
|
|
|
=over
|
|
|
|
=item * Secure by design.
|
|
|
|
=item * Easy to use.
|
|
|
|
=item * Versatile and cross-platform.
|
|
|
|
=back
|
|
|
|
Tentacle was created to replace more complex tools like SCP and FTP for simple file transfer/retrieval, and switch from authentication mechanisms like .netrc, interactive logins and SSH keys to X.509 certificates. Simple password authentication over a SSL secured connection is supported too.
|
|
|
|
The client and server (B<TCP port 41121>) are designed to be run from the command line or called from a shell script, and B<no configuration files are needed>.
|
|
|
|
If IO::Socket::INET6 is installed, the tentacle client supports IPv6.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use File::Basename;
|
|
use Getopt::Std;
|
|
use IO::Select;
|
|
my $zlib_available = 1;
|
|
|
|
eval {
|
|
eval "use IO::Compress::Zip qw(zip);1" or die($@);
|
|
eval "use IO::Uncompress::Unzip qw(unzip);1" or die($@);
|
|
};
|
|
if ($@) {
|
|
print_log ("Zip transfer not available, required libraries not found (IO::Compress::Zip, IO::Uncompress::Unzip).");
|
|
$zlib_available = 0;
|
|
}
|
|
|
|
use Socket (qw(SOCK_STREAM AF_INET AF_INET6));
|
|
my $SOCKET_MODULE =
|
|
eval { require IO::Socket::INET6 } ? 'IO::Socket::INET6'
|
|
: eval { require IO::Socket::INET } ? 'IO::Socket::INET'
|
|
: die $@;
|
|
|
|
if ($SOCKET_MODULE eq 'IO::Socket::INET') {
|
|
print_log ("IO::Socket::INET6 is not found. IPv6 is disabled.");
|
|
}
|
|
|
|
# Program version
|
|
our $VERSION = '0.4.0';
|
|
|
|
# Server address
|
|
my $t_address = '127.0.0.1';
|
|
|
|
# Block size for socket read/write operations in bytes
|
|
my $t_block_size = 1024;
|
|
|
|
# Log messages, 1 enabled, 0 disabled
|
|
my $t_log = 0;
|
|
|
|
# Server port
|
|
my $t_port = 41121;
|
|
|
|
# Do not output error messages, 1 enabled, 0 disabled
|
|
my $t_quiet = 0;
|
|
|
|
# Proxy address
|
|
my $t_proxy_address = '';
|
|
|
|
# Proxy user
|
|
my $t_proxy_user = '';
|
|
|
|
# Proxy password
|
|
my $t_proxy_pass = '';
|
|
|
|
# Proxy port
|
|
my $t_proxy_port = 0;
|
|
|
|
# Server password
|
|
my $t_pwd = '';
|
|
|
|
# Receive mode, 1 enabled, 0 disabled
|
|
my $t_recv = 0;
|
|
|
|
# Retries for socket read/write operations
|
|
my $t_retries = 3;
|
|
|
|
# Select handler
|
|
my $t_select;
|
|
|
|
# Server socket
|
|
my $t_socket;
|
|
|
|
# Use SSL, 1 true, 0 false
|
|
my $t_ssl = 0;
|
|
|
|
# SSL ca certificate file
|
|
my $t_ssl_ca = '';
|
|
|
|
# SSL certificate file
|
|
my $t_ssl_cert = '';
|
|
|
|
# SSL private key file
|
|
my $t_ssl_key = '';
|
|
|
|
# SSL private key file password
|
|
my $t_ssl_pwd = '';
|
|
|
|
# Timeout for socket read/write operations in seconds
|
|
my $t_timeout = 1;
|
|
|
|
# bind ipaddr
|
|
my $t_bind_address = undef;
|
|
|
|
# Compress data before sending it through the socket.
|
|
my $t_zip = 0;
|
|
|
|
################################################################################
|
|
## SUB print_help
|
|
## Print help screen.
|
|
################################################################################
|
|
sub print_help {
|
|
|
|
print ("Usage: $0 [options] [file] [file] ...\n\n");
|
|
print ("Tentacle client v$VERSION. See https://pandorafms.com/docs/ for protocol description.\n\n");
|
|
print ("Options:\n");
|
|
print ("\t-a address\tServer address (default $t_address).\n");
|
|
print ("\t-b localaddress\tLocal address to bind.\n");
|
|
print ("\t-c\t\tEnable SSL without a client certificate.\n");
|
|
print ("\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
|
|
print ("\t-f ca\t\tVerify that the peer certificate is signed by a ca.\n");
|
|
print ("\t-g\t\tGet files from the server.\n");
|
|
print ("\t-h\t\tShow help.\n");
|
|
print ("\t-k key\t\tOpenSSL private key file.\n");
|
|
print ("\t-p port\t\tServer port (default $t_port).\n");
|
|
print ("\t-q\t\tQuiet. Do now print error messages.\n");
|
|
print ("\t-r number\tNumber of retries for network operations (default $t_retries).\n");
|
|
print ("\t-t time\t\tTime-out for network operations in seconds (default ${t_timeout}s).\n");
|
|
print ("\t-v\t\tBe verbose.\n");
|
|
print ("\t-w\t\tPrompt for OpenSSL private key password.\n");
|
|
print ("\t-x pwd\t\tServer password.\n");
|
|
print ("\t-y proxy\tProxy server string (user:password\@address:port).\n");
|
|
print ("\t-z Compress data.\n\n");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB parse_options
|
|
## Parse command line options and initialize global variables.
|
|
################################################################################
|
|
sub parse_options {
|
|
my %opts;
|
|
my $tmp;
|
|
|
|
# Get options
|
|
if (getopts ('a:b:ce:f:ghk:p:qr:t:vwx:y:z', \%opts) == 0 || defined ($opts{'h'})) {
|
|
print_help ();
|
|
exit 1;
|
|
}
|
|
|
|
# Address
|
|
if (defined ($opts{'a'})) {
|
|
$t_address = $opts{'a'};
|
|
if (($t_address !~ /^[a-zA-Z\.][a-zA-Z0-9\.\-]+$/ && ($t_address !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
|
|
|| $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
|
|
|| $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) &&
|
|
($t_address !~ /^[0-9a-f:]+$/o)) {
|
|
error ("Address $t_address is not valid.");
|
|
}
|
|
|
|
}
|
|
|
|
# Bind local address
|
|
if (defined ($opts{'b'})) {
|
|
$t_bind_address = $opts{'b'};
|
|
if (($t_bind_address !~ /^[a-zA-Z\.][a-zA-Z0-9\.\-]+$/ && ($t_bind_address !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
|
|
|| $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
|
|
|| $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) &&
|
|
($t_address !~ /^[0-9a-f:]+$/o)) {
|
|
error ("Local address $t_bind_address is not valid.");
|
|
}
|
|
|
|
}
|
|
|
|
# Enable SSL without a client certificate
|
|
if (defined ($opts{'c'})) {
|
|
require IO::Socket::SSL;
|
|
$t_ssl = 1;
|
|
}
|
|
|
|
# Enable SSL
|
|
if (defined ($opts{'e'})) {
|
|
|
|
if (defined ($opts{'c'})) {
|
|
error ("Flags -c and -e can not be used at the same time.");
|
|
}
|
|
|
|
require IO::Socket::SSL;
|
|
|
|
$t_ssl_cert = $opts{'e'};
|
|
if (! -f $t_ssl_cert) {
|
|
error ("File $t_ssl_cert does not exist.");
|
|
}
|
|
|
|
$t_ssl = 1;
|
|
}
|
|
|
|
# Verify peer certificate
|
|
if (defined ($opts{'f'})) {
|
|
|
|
if (! defined ($opts{'e'})) {
|
|
error ("Flag -e must be set to enable peer certificate verify.");
|
|
}
|
|
|
|
$t_ssl_ca = $opts{'f'};
|
|
if (! -f $t_ssl_ca) {
|
|
error ("File $t_ssl_ca does not exist.");
|
|
}
|
|
}
|
|
|
|
# Get files
|
|
if (defined ($opts{'g'})) {
|
|
$t_recv = 1;
|
|
}
|
|
|
|
# SSL private key file
|
|
if (defined ($opts{'k'})) {
|
|
|
|
if (! defined ($opts{'e'})) {
|
|
error ("Flag -e must be set to use a private key file.");
|
|
}
|
|
|
|
$t_ssl_key = $opts{'k'};
|
|
if (! -f $t_ssl_key) {
|
|
error ("File $t_ssl_key does not exist.");
|
|
}
|
|
}
|
|
|
|
# Port
|
|
if (defined ($opts{'p'})) {
|
|
$t_port = $opts{'p'};
|
|
if ($t_port !~ /^\d+$/ || $t_port < 1 || $t_port > 65535) {
|
|
error ("Port $t_port is not valid.");
|
|
}
|
|
}
|
|
|
|
# Quiet mode
|
|
if (defined ($opts{'q'})) {
|
|
$t_quiet = 1;
|
|
}
|
|
|
|
# Retries
|
|
if (defined ($opts{'r'})) {
|
|
$t_retries = $opts{'r'};
|
|
if ($t_retries !~ /^\d+$/ || $t_retries < 1) {
|
|
error ("Invalid number of retries for network operations.");
|
|
}
|
|
}
|
|
|
|
# Timeout
|
|
if (defined ($opts{'t'})) {
|
|
$t_timeout = $opts{'t'};
|
|
if ($t_timeout !~ /^\d+$/ || $t_timeout < 1) {
|
|
error ("Invalid timeout for network operations.");
|
|
}
|
|
}
|
|
|
|
# Be verbose
|
|
if (defined ($opts{'v'})) {
|
|
$t_log = 1;
|
|
}
|
|
|
|
# SSL private key password
|
|
if (defined ($opts{'w'})) {
|
|
|
|
if (! defined ($opts{'e'})) {
|
|
error ("Flag -k must be set to provide a private key password.");
|
|
}
|
|
|
|
$t_ssl_pwd = ask_passwd ("Enter private key file password: ", "Enter private key file password again for confirmation: ");
|
|
}
|
|
|
|
# Server password
|
|
if (defined ($opts{'x'})) {
|
|
$t_pwd = $opts{'x'};
|
|
}
|
|
|
|
# Proxy server
|
|
if (defined ($opts{'y'})) {
|
|
if ($opts{'y'} !~ /^((.*):(.*)@){0,1}(\S+):(\d+)$/) {
|
|
error ("Invalid proxy string: " . $opts{'y'});
|
|
}
|
|
|
|
($t_proxy_user, $t_proxy_pass, $t_proxy_address, $t_proxy_port) = ($2, $3, $4, $5);
|
|
$t_proxy_user = '' unless defined ($t_proxy_user);
|
|
$t_proxy_pass = '' unless defined ($t_proxy_pass);
|
|
if ($t_proxy_port < 1 || $t_proxy_port > 65535) {
|
|
error ("Proxy port $t_proxy_port is not valid.");
|
|
}
|
|
}
|
|
|
|
# Compress data
|
|
if (defined ($opts{'z'})) {
|
|
if ($zlib_available == 1) {
|
|
$t_zip = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB start_client
|
|
## Open the server socket.
|
|
################################################################################
|
|
sub start_client {
|
|
|
|
# Connect to server
|
|
if ($SOCKET_MODULE ne 'IO::Socket::INET') {
|
|
if (defined ($t_bind_address)) {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET6,
|
|
PeerAddr => $t_address,
|
|
PeerPort => $t_port,
|
|
LocalAddr => $t_bind_address,
|
|
Type => SOCK_STREAM
|
|
);
|
|
}
|
|
else {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET6,
|
|
PeerAddr => $t_address,
|
|
PeerPort => $t_port,
|
|
Type => SOCK_STREAM
|
|
);
|
|
}
|
|
}
|
|
if (! defined ($t_socket)) {
|
|
if (defined ($t_bind_address)) {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET,
|
|
PeerAddr => $t_address,
|
|
PeerPort => $t_port,
|
|
LocalAddr => $t_bind_address,
|
|
Type => SOCK_STREAM
|
|
);
|
|
}
|
|
else {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET,
|
|
PeerAddr => $t_address,
|
|
PeerPort => $t_port,
|
|
Type => SOCK_STREAM
|
|
);
|
|
}
|
|
}
|
|
|
|
if (! defined ($t_socket)) {
|
|
error ("Cannot connect to $t_address on port $t_port: $!.");
|
|
}
|
|
|
|
# Add server socket to select queue
|
|
$t_select = IO::Select->new ();
|
|
$t_select->add ($t_socket);
|
|
|
|
print_log ("Connected to $t_address port $t_port");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB start_client_proxy
|
|
## Open the server socket. Connects to the Tentacle server through an HTTP proxy.
|
|
################################################################################
|
|
sub start_client_proxy {
|
|
|
|
# Connect to proxy
|
|
if ($SOCKET_MODULE ne 'IO::Socket::INET') {
|
|
if (defined ($t_bind_address)) {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET6,
|
|
PeerAddr => $t_proxy_address,
|
|
PeerPort => $t_proxy_port,
|
|
LocalAddr => $t_bind_address,
|
|
);
|
|
}
|
|
else {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET6,
|
|
PeerAddr => $t_proxy_address,
|
|
PeerPort => $t_proxy_port,
|
|
);
|
|
}
|
|
}
|
|
if (! defined ($t_socket)) {
|
|
if (defined ($t_bind_address)) {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET,
|
|
PeerAddr => $t_proxy_address,
|
|
PeerPort => $t_proxy_port,
|
|
LocalAddr => $t_bind_address,
|
|
);
|
|
}
|
|
else {
|
|
$t_socket = $SOCKET_MODULE->new (
|
|
Domain => AF_INET,
|
|
PeerAddr => $t_proxy_address,
|
|
PeerPort => $t_proxy_port,
|
|
);
|
|
}
|
|
}
|
|
|
|
if (! defined ($t_socket)) {
|
|
error ("Cannot connect to proxy server $t_proxy_address on port $t_proxy_port: $!.");
|
|
}
|
|
|
|
# Add server socket to select queue
|
|
$t_select = IO::Select->new ();
|
|
$t_select->add ($t_socket);
|
|
|
|
print_log ("Connected to proxy server $t_proxy_address port $t_proxy_port");
|
|
|
|
# Try to CONNECT to the Tentacle server
|
|
send_data ("CONNECT " . $t_address . ":" . $t_port . " HTTP/1.0\r\n");
|
|
|
|
# Authenticate to the proxy
|
|
if ($t_proxy_user ne '') {
|
|
send_data ("Proxy-Authorization: Basic " . base64 ($t_proxy_user . ":" . $t_proxy_pass) . "\r\n");
|
|
}
|
|
|
|
send_data ("\r\n");
|
|
|
|
# Check for an HTTP 200 response
|
|
my $response = recv_data ($t_block_size);
|
|
if ($response !~ m/HTTP.* 200 /) {
|
|
my $error = (split (/\r\n/, $response))[0];
|
|
error ("CONNECT error: $error");
|
|
}
|
|
|
|
print_log ("Connected to $t_address port $t_port");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB stop_client
|
|
## Close the server socket.
|
|
################################################################################
|
|
sub stop_client {
|
|
|
|
$t_socket->shutdown(2);
|
|
$t_socket->close ();
|
|
}
|
|
|
|
################################################################################
|
|
## SUB start_ssl
|
|
## Convert the server socket to an IO::Socket::SSL socket.
|
|
################################################################################
|
|
sub start_ssl {
|
|
my $err;
|
|
|
|
if ($t_ssl_cert eq ''){
|
|
IO::Socket::SSL->start_SSL (
|
|
$t_socket,
|
|
# No authentication
|
|
SSL_verify_mode => 0x00,
|
|
);
|
|
}
|
|
elsif ($t_ssl_ca eq '') {
|
|
IO::Socket::SSL->start_SSL (
|
|
$t_socket,
|
|
SSL_cert_file => $t_ssl_cert,
|
|
SSL_key_file => $t_ssl_key,
|
|
SSL_passwd_cb => sub {return $t_ssl_pwd},
|
|
SSL_use_cert =>'1',
|
|
# No authentication
|
|
SSL_verify_mode => 0x00,
|
|
);
|
|
}
|
|
else {
|
|
IO::Socket::SSL->start_SSL (
|
|
$t_socket,
|
|
SSL_ca_file => $t_ssl_ca,
|
|
SSL_cert_file => $t_ssl_cert,
|
|
SSL_key_file => $t_ssl_key,
|
|
SSL_passwd_cb => sub {return $t_ssl_pwd},
|
|
SSL_use_cert =>'1',
|
|
# Verify peer
|
|
SSL_verify_mode => 0x01,
|
|
);
|
|
}
|
|
|
|
$err = IO::Socket::SSL::errstr ();
|
|
if ($err ne '') {
|
|
error ($err);
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB auth_pwd
|
|
## Authenticate client with server password.
|
|
################################################################################
|
|
sub auth_pwd {
|
|
my $command;
|
|
my $pwd_digest;
|
|
|
|
require Digest::MD5;
|
|
|
|
$pwd_digest = Digest::MD5::md5 ($t_pwd);
|
|
$pwd_digest = Digest::MD5::md5_hex ($pwd_digest);
|
|
|
|
send_data ("PASS $pwd_digest\n");
|
|
|
|
$command = recv_command ($t_block_size);
|
|
if ($command !~ /^PASS OK$/) {
|
|
error ("Authentication failed.");
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB base64
|
|
## Returns the base 64 encoding of a string.
|
|
################################################################################
|
|
my @alphabet = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
|
|
'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
|
|
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
|
|
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
|
|
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/');
|
|
sub base64 {
|
|
my $str = shift;
|
|
my $str64;
|
|
|
|
# Pre-processing
|
|
my $msg = unpack ("B*", pack ("A*", $str));
|
|
my $bit_len = length ($msg);
|
|
|
|
# Process the message in successive 24-bit chunks
|
|
for (my $i = 0; $i < $bit_len; $i += 24) {
|
|
my $chunk_len = length (substr ($msg, $i, 24));
|
|
$str64 .= $alphabet[ord (pack ("B8", "00" . substr ($msg, $i, 6)))];
|
|
$str64 .= $alphabet[ord (pack ("B8", "00" . substr ($msg, $i+6, 6)))];
|
|
$str64 .= ($chunk_len <= 12) ? "=" : $alphabet[ord (pack ("B8", "00" . substr ($msg, $i+12, 6)))];
|
|
$str64 .= ($chunk_len <= 18) ? "=" : $alphabet[ord (pack ("B8", "00" . substr ($msg, $i+18, 6)))];
|
|
}
|
|
|
|
return $str64;
|
|
}
|
|
|
|
|
|
################################################################################
|
|
## SUB recv_file
|
|
## Receive a file from the server
|
|
################################################################################
|
|
sub recv_file {
|
|
my $data = '';
|
|
my $file = $_[0];
|
|
my $response;
|
|
my $size;
|
|
|
|
# Request file
|
|
send_data ("RECV <$file>\n");
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
if ($response !~ /^RECV SIZE (\d+)$/) {
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
$size = $1;
|
|
send_data ("RECV OK\n");
|
|
|
|
# Receive file
|
|
$data = recv_data_block ($size);
|
|
|
|
# Write it to disk
|
|
open (FILE, "> $file") || error ("Cannot open file '$file' for writing.");
|
|
binmode (FILE);
|
|
print (FILE $data);
|
|
close (FILE);
|
|
|
|
print_log ("Received file '$file'");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB zrecv_file
|
|
## Receive a compressed file from the server
|
|
################################################################################
|
|
sub zrecv_file {
|
|
my $data = '';
|
|
my $file = $_[0];
|
|
my $response;
|
|
my $size;
|
|
my $zdata = '';
|
|
|
|
# Request file
|
|
send_data ("ZRECV <$file>\n");
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
if ($response !~ /^ZRECV SIZE (\d+)$/) {
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
$size = $1;
|
|
send_data ("ZRECV OK\n");
|
|
|
|
# Receive file
|
|
$zdata = recv_data_block ($size);
|
|
if (!unzip(\$zdata => \$data)) {
|
|
print_log ("Uncompress error: $IO::Uncompress::Unzip::UnzipError");
|
|
send_data ("ZRECV ERR\n");
|
|
return;
|
|
}
|
|
|
|
# Write it to disk
|
|
open (FILE, "> $file") || error ("Cannot open file '$file' for writing.");
|
|
binmode (FILE);
|
|
print (FILE $data);
|
|
close (FILE);
|
|
|
|
print_log ("Received compressed file '$file'");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB send_file
|
|
## Send a file to the server
|
|
################################################################################
|
|
sub send_file {
|
|
my $base_name;
|
|
my $data = '';
|
|
my $response = '';
|
|
my $retries;
|
|
my $file = $_[0];
|
|
my $size;
|
|
my $written;
|
|
|
|
$base_name = basename ($file);
|
|
$size = -s $file;
|
|
|
|
# Request to send file
|
|
send_data ("SEND <$base_name> SIZE $size\n");
|
|
|
|
print_log ("Request to send file '$base_name' size ${size}b");
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
|
|
# Server rejected the file
|
|
if ($response ne "SEND OK") {
|
|
send_data ("QUIT\n");
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
print_log ("Server responded SEND OK");
|
|
|
|
# Send the file
|
|
open (FILE, $file) || error ("Cannot open file '$file' for reading.");
|
|
binmode (FILE);
|
|
{
|
|
local $/ = undef;
|
|
$data = <FILE>;
|
|
}
|
|
send_data ($data);
|
|
|
|
close (FILE);
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
if ($response ne "SEND OK") {
|
|
send_data ("QUIT\n");
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
print_log ("File sent");
|
|
}
|
|
|
|
################################################################################
|
|
## SUB zsend_file
|
|
## Send a file to the server (compressed)
|
|
################################################################################
|
|
sub zsend_file {
|
|
my $base_name;
|
|
my $data = '';
|
|
my $response = '';
|
|
my $retries;
|
|
my $file = $_[0];
|
|
my $size;
|
|
my $written;
|
|
|
|
# Read the file and compress its contents
|
|
if (! zip($file => \$data)) {
|
|
send_data ("QUIT\n");
|
|
error ("Compression error: $IO::Compress::Zip::ZipError");
|
|
return;
|
|
}
|
|
|
|
$size = length($data);
|
|
$base_name = basename ($file);
|
|
|
|
# Request to send file
|
|
send_data ("ZSEND <$base_name> SIZE $size\n");
|
|
print_log ("Request to send file '$base_name' size ${size}b (compressed)");
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
|
|
# Server rejected the file
|
|
if ($response ne "ZSEND OK") {
|
|
send_data ("QUIT\n");
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
print_log ("Server responded ZSEND OK");
|
|
send_data ($data);
|
|
|
|
# Wait for server response
|
|
$response = recv_command ();
|
|
if ($response ne "ZSEND OK") {
|
|
send_data ("QUIT\n");
|
|
error ("Server responded $response.");
|
|
}
|
|
|
|
print_log ("File sent");
|
|
}
|
|
|
|
################################################################################
|
|
# Common functions
|
|
################################################################################
|
|
|
|
################################################################################
|
|
## SUB print_log
|
|
## Print log messages.
|
|
################################################################################
|
|
sub print_log {
|
|
|
|
if ($t_log == 1) {
|
|
print (STDOUT "[log] $_[0]\n");
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB error
|
|
## Print an error and exit the program.
|
|
################################################################################
|
|
sub error {
|
|
|
|
if ($t_quiet == 0) {
|
|
print (STDERR "[err] $_[0]\n");
|
|
}
|
|
|
|
exit 1;
|
|
}
|
|
|
|
################################################################################
|
|
## SUB recv_data
|
|
## Read data from the client socket. Returns the number of bytes read and the
|
|
## string of bytes as a two element array.
|
|
################################################################################
|
|
sub recv_data {
|
|
my $data;
|
|
my $read;
|
|
my $retries = 0;
|
|
my $size = $_[0];
|
|
|
|
while (1) {
|
|
|
|
# Try to read data from the socket
|
|
if ($t_select->can_read ($t_timeout)) {
|
|
|
|
# Read at most $size bytes
|
|
$read = sysread ($t_socket, $data, $size);
|
|
|
|
# Read error
|
|
if (! defined ($read)) {
|
|
error ("Read error from " . $t_socket->sockhost () . ": $!.");
|
|
}
|
|
|
|
# EOF
|
|
if ($read == 0) {
|
|
error ("Connection from " . $t_socket->sockhost () . " unexpectedly closed.");
|
|
}
|
|
|
|
return ($read, $data);
|
|
}
|
|
|
|
# Retry
|
|
$retries++;
|
|
|
|
# But check for error conditions first
|
|
if ($retries > $t_retries) {
|
|
error ("Connection from " . $t_socket->sockhost () . " timed out.");
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB send_data
|
|
## Write data to the client socket.
|
|
################################################################################
|
|
sub send_data {
|
|
my $data = $_[0];
|
|
my $block_size;
|
|
my $retries = 0;
|
|
my $size;
|
|
my $total = 0;
|
|
my $written;
|
|
|
|
$size = length ($data);
|
|
|
|
while (1) {
|
|
|
|
# Try to write data to the socket
|
|
if ($t_select->can_write ($t_timeout)) {
|
|
|
|
$block_size = ($size - $total) > $t_block_size ? $t_block_size : ($size - $total);
|
|
$written = syswrite ($t_socket, $data, $block_size, $total);
|
|
|
|
# Read error
|
|
if (! defined ($written)) {
|
|
error ("Connection error from " . $t_socket->sockhost () . ": $!.");
|
|
}
|
|
|
|
# EOF
|
|
if ($written == 0) {
|
|
error ("Connection from " . $t_socket->sockhost () . " unexpectedly closed.");
|
|
}
|
|
|
|
$total += $written;
|
|
|
|
# All data was written
|
|
if ($total == $size) {
|
|
return;
|
|
}
|
|
# Retry
|
|
} else {
|
|
$retries++;
|
|
if ($retries > $t_retries) {
|
|
error ("Connection from " . $t_socket->sockhost () . " timed out.");
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB recv_command
|
|
## Read a command from the client, ended by a new line character.
|
|
################################################################################
|
|
sub recv_command {
|
|
my $buffer;
|
|
my $char;
|
|
my $command = '';
|
|
my $read;
|
|
my $total = 0;
|
|
|
|
while (1) {
|
|
|
|
($read, $buffer) = recv_data ($t_block_size);
|
|
$command .= $buffer;
|
|
$total += $read;
|
|
|
|
# Check if the command is complete
|
|
$char = chop ($command);
|
|
if ($char eq "\n") {
|
|
return $command;
|
|
}
|
|
|
|
$command .= $char;
|
|
|
|
# Avoid overflow
|
|
if ($total > $t_block_size) {
|
|
error ("Received too much data from " . $t_socket->sockhost ());
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB recv_data_block
|
|
## Read $_[0] bytes of data from the client.
|
|
################################################################################
|
|
sub recv_data_block {
|
|
my $buffer = '';
|
|
my $data = '';
|
|
my $read;
|
|
my $size = $_[0];
|
|
my $total = 0;
|
|
|
|
while (1) {
|
|
|
|
($read, $buffer) = recv_data ($size - $total);
|
|
$data .= $buffer;
|
|
$total += $read;
|
|
|
|
# Check if all data has been read
|
|
if ($total == $size) {
|
|
return $data;
|
|
}
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
## SUB ask_passwd
|
|
## Asks the user for a password.
|
|
################################################################################
|
|
sub ask_passwd {
|
|
my $msg1 = $_[0];
|
|
my $msg2 = $_[1];
|
|
my $pwd1;
|
|
my $pwd2;
|
|
|
|
require Term::ReadKey;
|
|
|
|
# Disable keyboard echo
|
|
Term::ReadKey::ReadMode('noecho');
|
|
|
|
# Promt for password
|
|
print ($msg1);
|
|
$pwd1 = Term::ReadKey::ReadLine(0);
|
|
print ("\n$msg2");
|
|
$pwd2 = Term::ReadKey::ReadLine(0);
|
|
print ("\n");
|
|
|
|
# Restore original settings
|
|
Term::ReadKey::ReadMode('restore');
|
|
|
|
if ($pwd1 ne $pwd2) {
|
|
# Call print to bypass quiet mode.
|
|
print ("[err] Passwords do not match.\n");
|
|
exit 1;
|
|
}
|
|
|
|
# Remove the trailing new line character
|
|
chop $pwd1;
|
|
|
|
return $pwd1;
|
|
}
|
|
|
|
################################################################################
|
|
# Main
|
|
################################################################################
|
|
|
|
my $file;
|
|
|
|
# Parse command line options
|
|
parse_options ();
|
|
|
|
# Check command line arguments
|
|
if ($t_recv == 0 && $#ARGV == -1) {
|
|
error ("No files to send.");
|
|
}
|
|
|
|
# Connect to the server
|
|
if ($t_proxy_address eq '') {
|
|
start_client ();
|
|
} else {
|
|
start_client_proxy ();
|
|
}
|
|
|
|
# Start SSL
|
|
if ($t_ssl == 1) {
|
|
start_ssl ();
|
|
}
|
|
|
|
# Authenticate with server
|
|
if ($t_pwd ne '') {
|
|
auth_pwd ();
|
|
}
|
|
|
|
if ($t_recv == 0) {
|
|
# Check that all files exist before trying to send them
|
|
foreach $file (@ARGV) {
|
|
if (! -f $file) {
|
|
error ("File '$file' does not exist.");
|
|
}
|
|
}
|
|
|
|
# Send the files
|
|
foreach $file (@ARGV) {
|
|
if ($t_zip == 1) {
|
|
zsend_file($file);
|
|
} else {
|
|
send_file ($file);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
# Receive the files
|
|
foreach $file (@ARGV) {
|
|
if ($t_zip == 1) {
|
|
zrecv_file ($file);
|
|
} else {
|
|
recv_file ($file);
|
|
}
|
|
}
|
|
}
|
|
|
|
# Tell the server that we are finished
|
|
send_data ("QUIT\n");
|
|
|
|
stop_client ();
|
|
|
|
exit 0;
|
|
|
|
|
|
__END__
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over
|
|
|
|
=item I<-a address> B<Server address> (default 127.0.0.1).
|
|
|
|
=item I<-c> Enable B<SSL> without a client certificate.
|
|
|
|
=item I<-e cert> B<OpenSSL certificate> file. Enables SSL.
|
|
|
|
=item I<-f ca> Verify that the peer certificate is signed by a B<CA> (Certificate Authority).
|
|
|
|
=item I<-g> B<Get> files from the server.
|
|
|
|
=item I<-h> Show B<help>.
|
|
|
|
=item I<-k key> B<OpenSSL private key> file.
|
|
|
|
=item I<-p port> B<Server port> (default I<41121>).
|
|
|
|
=item I<-q> B<Quiet>. Do now print error messages.
|
|
|
|
=item I<-r number> B<Number of retries> for network operations (default I<3>).
|
|
|
|
=item I<-t time> B<Time-out> for network operations in seconds (default I<1s>).
|
|
|
|
=item I<-v> Be B<verbose>.
|
|
|
|
=item I<-w> Prompt for B<OpenSSL private key password>.
|
|
|
|
=item I<-x pwd> B<Server password>.
|
|
|
|
=item I<-z> Compress data.
|
|
|
|
=back
|
|
|
|
=head1 EXIT STATUS
|
|
|
|
=over
|
|
|
|
=item 0 on Success
|
|
|
|
=item 1 on Error
|
|
|
|
=back
|
|
|
|
=head1 CONFIGURATION
|
|
|
|
Tentacle doesn't use any configurationf files, all the configuration is done by the options passed when it's started.
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
L<Getopt::Std>, L<IO::Select>, L<IO::Socket::INET>, L<File::Basename>
|
|
|
|
=head1 LICENSE
|
|
|
|
This is released under the GNU Lesser General Public License.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Getopt::Std>, L<IO::Select>, L<IO::Socket::INET>, L<File::Basename>
|
|
|
|
Protocol description and more info at: L<< https://pandorafms.com/docs/index.php?title=Pandora:Documentation_en:Tentacle >>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2005-2023 Pandora FMS
|
|
|
|
=cut
|
|
|