mirror of
				https://github.com/pandorafms/pandorafms.git
				synced 2025-10-31 11:34:51 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			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-2008  Artica Soluciones Tecnologicas S.L.
 | |
| #
 | |
| # tentacle_client.pl	Tentacle Client. See http://www.openideas.info/wiki 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 http://www.openideas.info/wiki 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<< http://openideas.info/wiki/index.php?title=Tentacle >>
 | |
| 
 | |
| =head1 COPYRIGHT
 | |
| 
 | |
| Copyright (c) 2005-2010 Artica Soluciones Tecnologicas S.L
 | |
| 
 | |
| =cut
 | |
| 
 |