#!/usr/bin/perl ################################################################################ # # Copyright (c) 2007-2008 Ramon Novoa # 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 is a client for B, a B 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) are designed to be run from the command line or called from a shell script, and B. 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 = ; } 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 (default 127.0.0.1). =item I<-c> Enable B without a client certificate. =item I<-e cert> B file. Enables SSL. =item I<-f ca> Verify that the peer certificate is signed by a B (Certificate Authority). =item I<-g> B files from the server. =item I<-h> Show B. =item I<-k key> B file. =item I<-p port> B (default I<41121>). =item I<-q> B. Do now print error messages. =item I<-r number> B for network operations (default I<3>). =item I<-t time> B for network operations in seconds (default I<1s>). =item I<-v> Be B. =item I<-w> Prompt for B. =item I<-x pwd> B. =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, L, L, L =head1 LICENSE This is released under the GNU Lesser General Public License. =head1 SEE ALSO L, L, L, L Protocol description and more info at: L<< https://pandorafms.com/manual/en/documentation/08_technical_reference/09_tentacle >> =head1 COPYRIGHT Copyright (c) 2005-2010 Artica Soluciones Tecnologicas S.L =cut