Menu
▾
▴
tentacled-develop — Development mailing list, also for users
You can subscribe to this list here.
| 2008 |
Jan
|
Feb
|
Mar
(6) |
Apr
|
May
|
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2009 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2010 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
(2) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2011 |
Jan
(1) |
Feb
|
Mar
(1) |
Apr
(2) |
May
|
Jun
|
Jul
|
Aug
|
Sep
(3) |
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
|
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2013 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(2) |
Dec
|
| 2015 |
Jan
|
Feb
(1) |
Mar
(2) |
Apr
(3) |
May
(2) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(2) |
Dec
|
| 2016 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2018 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <ra...@us...> - 2018-07-04 09:51:52
|
Revision: 55
http://sourceforge.net/p/tentacled/code/55
Author: ramonn
Date: 2018-07-04 09:51:47 +0000 (Wed, 04 Jul 2018)
Log Message:
-----------
2018-07-04 Ramon Novoa <rn...@ar...>
* c/src/client/tentacle_client.c: Fix the EOF check.
Modified Paths:
--------------
trunk/c/src/client/tentacle_client.c
Modified: trunk/c/src/client/tentacle_client.c
===================================================================
--- trunk/c/src/client/tentacle_client.c 2016-03-21 14:36:18 UTC (rev 54)
+++ trunk/c/src/client/tentacle_client.c 2018-07-04 09:51:47 UTC (rev 55)
@@ -645,11 +645,9 @@
}
/* Send the file */
- while(0 == feof(fh)) {
+ while((count = fread(buff, 1, BSIZE, fh)) > 0) {
- count = fread(buff, 1, BSIZE, fh);
-
- /* Error */
+ /* Error (fread returned a short item count) */
if (ferror(fh) != 0) {
PrintError("read(): %s", LastErrorMsg());
fclose(fh);
@@ -663,6 +661,13 @@
}
}
+ /* Error (fread returned 0) */
+ if (ferror(fh) != 0) {
+ PrintError("read(): %s", LastErrorMsg());
+ fclose(fh);
+ return -1;
+ }
+
/* Wait for server response */
buff[0] = 0;
if (-1 == RecvCommand(sock, ssl, buff)) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2016-03-21 14:36:24
|
Revision: 54
http://sourceforge.net/p/tentacled/code/54
Author: ramonn
Date: 2016-03-21 14:36:18 +0000 (Mon, 21 Mar 2016)
Log Message:
-----------
SSL_verify_mode must be a number, not a string!
Modified Paths:
--------------
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2015-11-26 11:07:14 UTC (rev 53)
+++ trunk/perl/client/bin/tentacle_client 2016-03-21 14:36:18 UTC (rev 54)
@@ -467,7 +467,7 @@
IO::Socket::SSL->start_SSL (
$t_socket,
# No authentication
- SSL_verify_mode => '0x00',
+ SSL_verify_mode => 0x00,
);
}
elsif ($t_ssl_ca eq '') {
@@ -478,7 +478,7 @@
SSL_passwd_cb => sub {return $t_ssl_pwd},
SSL_use_cert =>'1',
# No authentication
- SSL_verify_mode => '0x00',
+ SSL_verify_mode => 0x00,
);
}
else {
@@ -490,7 +490,7 @@
SSL_passwd_cb => sub {return $t_ssl_pwd},
SSL_use_cert =>'1',
# Verify peer
- SSL_verify_mode => '0x01',
+ SSL_verify_mode => 0x01,
);
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-11-26 11:07:19
|
Revision: 53
http://sourceforge.net/p/tentacled/code/53
Author: ramonn
Date: 2015-11-26 11:07:14 +0000 (Thu, 26 Nov 2015)
Log Message:
-----------
Removed some changes that should not have been commited.
Modified Paths:
--------------
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-11-26 10:01:55 UTC (rev 52)
+++ trunk/perl/server/bin/tentacle_server 2015-11-26 11:07:14 UTC (rev 53)
@@ -64,6 +64,7 @@
use Thread::Semaphore;
use POSIX ":sys_wait_h";
use Time::HiRes qw(usleep);
+use Scalar::Util qw(refaddr);
# Constants for Win32 services.
use constant WIN32_SERVICE_STOPPED => 0x01;
@@ -774,14 +775,21 @@
# Forward data between the client and the server.
eval {
- while (1) {
- if ($t_select->can_read(0)) {
+ my $select = IO::Select->new ();
+ $select->add($t_proxy_socket);
+ $select->add($t_client_socket);
+ while (my @ready = $select->can_read()) {
+ foreach my $socket (@ready) {
+ if (refaddr($socket) == refaddr($t_client_socket)) {
my ($read, $data) = recv_data($t_block_size);
+ return unless defined($data);
send_data_proxy($data);
- }
- if ($t_proxy_select->can_read(0)) {
+ }
+ else {
my ($read, $data) = recv_data_proxy($t_block_size);
+ return unless defined($data);
send_data($data);
+ }
}
}
};
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-11-26 10:02:03
|
Revision: 52
http://sourceforge.net/p/tentacled/code/52
Author: ramonn
Date: 2015-11-26 10:01:55 +0000 (Thu, 26 Nov 2015)
Log Message:
-----------
Deleted tentacle_server_windows_fixed. tentacle_server works on win32.
Modified Paths:
--------------
trunk/perl/server/bin/tentacle_server
Removed Paths:
-------------
trunk/perl/server/bin/tentacle_server_windows_fixed
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-06-15 11:31:30 UTC (rev 51)
+++ trunk/perl/server/bin/tentacle_server 2015-11-26 10:01:55 UTC (rev 52)
@@ -64,7 +64,6 @@
use Thread::Semaphore;
use POSIX ":sys_wait_h";
use Time::HiRes qw(usleep);
-use Scalar::Util qw(refaddr);
# Constants for Win32 services.
use constant WIN32_SERVICE_STOPPED => 0x01;
@@ -685,7 +684,7 @@
my $pid;
my $t_server_socket;
- # Ignore SIGPIPE errors (happens on FreeBSD when SSL is enabled ¿?)
+ # Ignore SIGPIPE
$SIG{PIPE} = 'IGNORE';
# Start server
@@ -775,21 +774,14 @@
# Forward data between the client and the server.
eval {
- my $select = IO::Select->new ();
- $select->add($t_proxy_socket);
- $select->add($t_client_socket);
- while (my @ready = $select->can_read()) {
- foreach my $socket (@ready) {
- if (refaddr($socket) == refaddr($t_client_socket)) {
+ while (1) {
+ if ($t_select->can_read(0)) {
my ($read, $data) = recv_data($t_block_size);
- return unless defined($data);
send_data_proxy($data);
- }
- else {
+ }
+ if ($t_proxy_select->can_read(0)) {
my ($read, $data) = recv_data_proxy($t_block_size);
- return unless defined($data);
send_data($data);
- }
}
}
};
@@ -982,8 +974,10 @@
sub error {
if ($t_quiet == 0) {
- die("[err] $_[0]\n\n");
+ print (STDERR "[err] $_[0]\n");
}
+
+ die("\n");
}
################################################################################
Deleted: trunk/perl/server/bin/tentacle_server_windows_fixed
===================================================================
--- trunk/perl/server/bin/tentacle_server_windows_fixed 2015-06-15 11:31:30 UTC (rev 51)
+++ trunk/perl/server/bin/tentacle_server_windows_fixed 2015-11-26 10:01:55 UTC (rev 52)
@@ -1,1502 +0,0 @@
-#!/usr/bin/perl
-##########################################################################
-# Tentacle Server
-# See http://www.openideas.info/wiki for protocol description.
-# Tentacle have IANA assigned port tpc/41121 as official port.
-##########################################################################
-# Copyright (c) 2007-2008 Ramon Novoa <rn...@ar...>
-# Copyright (c) 2005-2010 Artica Soluciones Tecnologicas S.L
-#
-# tentacle_server.pl Tentacle Server. 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.
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-##########################################################################
-
-package tentacle::server;
-=head1 NAME
-
-tentacle_server - Tentacle Server
-
-=head1 VERSION
-
-Version 0.3.0
-
-=head1 USAGE
-
-tentacle_server B<< -s F<storage_directory> >> [I<options>]
-
-=head1 DESCRIPTION
-
-B<tentacle_server(1)> is a server 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>.
-
-=cut
-
-
-use strict;
-use warnings;
-use Getopt::Std;
-use IO::Select;
-use IO::Socket::INET;
-use threads;
-#use threads::shared;
-
-# Program version
-our $VERSION = '0.3.0';
-
-# Address to listen on
-my $t_address = '0.0.0.0';
-
-# Block size for socket read/write operations in bytes
-my $t_block_size = 1024;
-
-# Run as daemon, 1 true, 0 false
-my $t_daemon = 0;
-
-# Storage directory
-my $t_directory = '';
-
-# Filters
-my @t_filters;
-
-# String containing quoted invalid file name characters
-my $t_invalid_chars = '\?\[\]\/\\\=\+\<\>\:\;\'\,\*\~';
-
-# Log messages, 1 enabled, 0 disabled
-my $t_log = 0;
-
-# Maximum number of simultaneous connections
-my $t_max_conn = 10;
-
-# Maximum file size allowed by the server in bytes
-my $t_max_size = 2000000;
-
-# File overwrite, 1 enabled, 0 disabled
-my $t_overwrite = 0;
-
-# Port to listen on
-my $t_port = 41121;
-
-# Server password
-my $t_pwd = '';
-
-# Do not output error messages, 1 enabled, 0 disabled
-my $t_quiet = 0;
-
-# Number of retries for socket read/write operations
-my $t_retries = 3;
-
-# Select handler
-my $t_select: shared;
-
-# Server socket
-my $t_server_socket: shared;
-
-# Client socket
-my $t_client_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 password
-my $t_ssl_pwd = '';
-
-# Timeout for socket read/write operations in seconds
-my $t_timeout = 1;
-
-#Bridge IP to actuate as a proxy
-my $t_proxy_ip = undef;
-
-# Proxy port by default 41121
-my $t_proxy_port = 41121;
-
-# Proxy socket
-my $t_proxy_socket;
-
-# Proxy selected handler
-my $t_proxy_select;
-
-# Thread array
-my @Threads;
-
-################################################################################
-## SUB print_help
-## Print help screen.
-################################################################################
-sub print_help {
-
- print ("Usage: $0 -s <storage directory> [options]\n\n");
- print ("Tentacle server v$VERSION. See http://www.openideas.info/wiki for protocol description.\n\n");
- print ("Options:\n");
- print ("\t-a ip_address\tAddress to listen on (default $t_address).\n");
- print ("\t-c number\tMaximum number of simultaneous connections (default $t_max_conn).\n");
- print ("\t-d\t\tRun as daemon.\n");
- print ("\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
- print ("\t-f ca_cert\tVerify that the peer certificate is signed by a ca.\n");
- print ("\t-h\t\tShow help.\n");
- print ("\t-i\t\tFilters.\n");
- print ("\t-k key\t\tOpenSSL private key file.\n");
- print ("\t-m size\t\tMaximum file size in bytes (default ${t_max_size}b).\n");
- print ("\t-o\t\tEnable file overwrite.\n");
- print ("\t-p port\t\tPort to listen on (default $t_port).\n");
- print ("\t-q\t\tQuiet. Do now print error messages.\n");
- print ("\t-r number\tNumber of retries for network opertions (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\n");
- print ("\t-b proxy_ip_address\t\tProxied server address.\n\n");
- print ("\t-g proxy_port\t\tPort of proxied server.\n\n");
-}
-
-################################################################################
-## SUB daemonize
-## Turn the current process into a daemon.
-################################################################################
-sub daemonize {
- my $pid;
-
- require POSIX;
-
- chdir ('/') || error ("Cannot chdir to /: $!.");
- umask 0;
-
- open (STDIN, '/dev/null') || error ("Cannot read /dev/null: $!.");
-
- # Do not be verbose when running as a daemon
- open (STDOUT, '>/dev/null') || error ("Cannot write to /dev/null: $!.");
- open (STDERR, '>/dev/null') || error ("Cannot write to /dev/null: $!.");
-
- # Fork
- $pid = fork ();
- if (! defined ($pid)) {
- error ("Cannot fork: $!.");
- }
-
- # Parent
- if ($pid != 0) {
- exit;
- }
-
- # Child
- POSIX::setsid () || error ("Cannot start a new session: $!.");
-}
-
-################################################################################
-## SUB start_win_service
-## Turn the current process into a Windows service.
-################################################################################
-#sub start_win_service {
-# require Win32::Daemon;
-#
-# # Tell the OS to start the service
-# Win32::Daemon::StartService ();
-#
-# # Wait until the service manager is ready
-# while (SERVICE_START_PENDING != Win32::Daemon::State()) {
-# sleep (1);
-# }
-#
-# # Tell the service manager we are running
-# Win32::Daemon::State (SERVICE_RUNNING);
-#
-# # Call Win32::Daemon::StopService() when done
-#}
-
-################################################################################
-## SUB parse_options
-## Parse command line options and initialize global variables.
-################################################################################
-sub parse_options {
- my %opts;
- my $tmp;
-
- # Get options
- if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:', \%opts) == 0 || defined ($opts{'h'})) {
- print_help ();
- exit 1;
- }
-
- # Address
- if (defined ($opts{'a'})) {
- $t_address = $opts{'a'};
- if ($t_address !~ /^[a-zA-Z\.]+$/ && ($t_address !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
- || $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
- error ("Address $t_address is not valid.");
- }
- }
-
- # Maximum simultaneous connections
- if (defined ($opts{'c'})) {
- $t_max_conn = $opts{'c'};
- if ($t_max_conn !~ /^\d+$/ || $t_max_conn < 1) {
- error ("Invalid number of maximum simultaneous connections.");
- }
- }
-
- # Run as daemon
- if (defined ($opts{'d'})) {
- if ($^ eq 'MSWin32') {
- error ("-d flag not available for this OS.");
- }
-
- $t_daemon = 1;
- }
-
- # Enable SSL
- if (defined ($opts{'e'})) {
-
- 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'})) {
- $t_ssl_ca = $opts{'f'};
- if (! -f $t_ssl_ca) {
- error ("File $t_ssl_ca does not exist.");
- }
- }
-
- # Filters (regexp:dir;regexp:dir...)
- if (defined ($opts{'i'})) {
- my @filters = split (';', $opts{'i'});
- foreach my $filter (@filters) {
- my ($regexp, $dir) = split (':', $filter);
- next unless defined ($regexp) && defined ($dir);
-
- # Remove any trailing /
- my $char = chop ($dir);
- $dir .= $char if ($char) ne '/';
-
- push(@t_filters, [$regexp, $dir]);
- }
- }
-
- # SSL private key file
- if (defined ($opts{'k'})) {
- $t_ssl_key = $opts{'k'};
- if (! -f $t_ssl_key) {
- error ("File $t_ssl_key does not exist.");
- }
- }
-
- # Maximum file size
- if (defined ($opts{'m'})) {
- $t_max_size = $opts{'m'};
- if ($t_max_size !~ /^\d+$/ || $t_max_size < 1) {
- error ("Invalid maximum file size.");
- }
- }
-
- # File overwrite
- if (defined ($opts{'o'})) {
- $t_overwrite = 1;
- }
-
- # 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.");
- }
- }
-
- # Storage directory
- if (defined ($opts{'s'})) {
-
- $t_directory = $opts{'s'};
-
- # Check that directory exists
- if (! -d $t_directory) {
- error ("Directory $t_directory does not exist.");
- }
-
- # Check directory permissions
- if (! -w $t_directory) {
- error ("Cannot write to directory $t_directory.");
- }
-
- # Remove the trailing / if present
- $tmp = chop ($t_directory);
- if ($tmp ne '/') {
- $t_directory .= $tmp;
- }
- }
- else {
- if (! defined($opts{'b'})) {
- print_help ();
- exit 1;
- }
- }
-
- # 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'})) {
- $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 IP address
- if (defined ($opts{'b'})) {
- $t_proxy_ip = $opts{'b'};
- if ($t_proxy_ip !~ /^[a-zA-Z\.]+$/ && ($t_proxy_ip !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
- || $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
- error ("Proxy address $t_proxy_ip is not valid.");
- }
- }
-
- # Proxy Port
- if (defined ($opts{'g'})) {
- $t_proxy_port = $opts{'g'};
- if ($t_proxy_port !~ /^\d+$/ || $t_proxy_port < 1 || $t_proxy_port > 65535) {
- error ("Proxy port $t_port is not valid.");
- }
- }
-}
-
-################################################################################
-## SUB start_proxy
-## Open the server socket.
-################################################################################
-sub open_proxy {
-
- # Connect to server
- $t_proxy_socket = IO::Socket::INET->new (
- PeerAddr => $t_proxy_ip,
- PeerPort => $t_proxy_port,
- );
-
- if (! defined ($t_proxy_socket)) {
- error ("Cannot connect to $t_proxy_ip on port $t_proxy_port: $!.");
- }
-
- # Create proxy selector
- $t_proxy_select = IO::Select->new ();
- $t_proxy_select->add ($t_proxy_socket);
-
-}
-
-################################################################################
-## SUB start_server
-## Open the server socket.
-################################################################################
-sub start_server {
-
- $t_server_socket = IO::Socket::INET->new (
- Listen => $t_max_conn,
- LocalAddr => $t_address,
- LocalPort => $t_port,
- Proto => 'tcp',
- ReuseAddr => 1,
- );
-
- if (! defined ($t_server_socket)) {
- error ("Cannot open socket for address $t_address on port $t_port: $!.");
- }
-
- print_log ("Server listening on $t_address port $t_port (press <ctr-c> to stop)");
-
- # Say message if tentacle proxy is enable
- if (defined ($t_proxy_ip)) {
- print_log ("Proxy Mode enable, data will be sent to $t_proxy_ip port $t_proxy_port");
- }
-
-}
-
-################################################################################
-## SUB send_data_proxy
-## Send data to proxy socket.
-################################################################################
-sub send_data_proxy {
- my $data = $_[0];
- my $retries = 0;
- my $size;
- my $total = 0;
- my $written;
-
- $size = length ($data);
-
- while (1) {
-
- # Try to write data to the socket
- if ($t_proxy_select->can_write ($t_timeout)) {
-
- $written = syswrite ($t_proxy_socket, $data, $size - $total, $total);
-
- # Write error
- if (! defined ($written)) {
- error ("Connection error from " . $t_proxy_socket->sockhost () . ": $!.");
- return undef;
- }
-
- # EOF
- if ($written == 0) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " unexpectedly closed.");
- return undef;
- }
-
- $total += $written;
-
- # Check if all data was written
- if ($total == $size) {
- return 1;
- }
- # Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
- return undef;
- }
- }
- }
-}
-
-################################################################################
-## SUB close_proxy
-## Close the proxy socket.
-################################################################################
-sub close_proxy {
- $t_proxy_socket->close ();
- print_log ("Proxy socket closed");
-
-}
-
-################################################################################
-## SUB stop_server
-## Close the server socket.
-################################################################################
-sub stop_server {
-
- $t_server_socket->close ();
- print_log ("Server going down");
-
- exit 0;
-}
-
-################################################################################
-## SUB start_ssl
-## Convert the client socket to an IO::Socket::SSL socket.
-################################################################################
-sub start_ssl {
- my $err;
-
- if ($t_ssl_ca eq '') {
- IO::Socket::SSL->start_SSL (
- $t_client_socket,
- SSL_cert_file => $t_ssl_cert,
- SSL_key_file => $t_ssl_key,
- SSL_passwd_cb => sub {return $t_ssl_pwd},
- SSL_server => 1,
- # Verify peer
- SSL_verify_mode => 0x01,
- );
- }
- else {
- IO::Socket::SSL->start_SSL (
- $t_client_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_server => 1,
- # Fail verification if no peer certificate exists
- SSL_verify_mode => 0x03,
- );
- }
-
- $err = IO::Socket::SSL::errstr ();
- if ($err ne '') {
- error ($err);
- }
-
- print_log ("SSL started for " . $t_client_socket->sockhost ());
-}
-
-################################################################################
-## SUB accept_connection
-## Accept an incoming connection and fork.
-################################################################################
-sub accept_connection {
-
- threads->yield();
- while (1) {
- sleep(1);
- # Accept connection
- $t_client_socket = $t_server_socket->accept ();
-
- if (! defined ($t_client_socket)) {
-
- # EINTR
- if ($! ne '') {
- next;
- }
-
- error ("accept: $!.");
- }
-
-
-
-
- print_log ("Client connected from " . $t_client_socket->sockhost ());
-
- # Add client socket to select queue
- $t_select = IO::Select->new ();
- $t_select->add ($t_client_socket);
-
- # Start SSL
- if ($t_ssl == 1) {
- start_ssl ();
- }
-
- # Authenticate client
- if ($t_pwd ne '') {
- auth_pwd ();
- }
-
- # Check if proxy mode is enable
- if (defined ($t_proxy_ip)) {
-
- serve_proxy_connection ();
-
- } else {
-
- serve_connection ();
- }
-
- $t_client_socket->close ();
-
- }
-
-}
-
-################################################################################
-## SUB serve_proxy_connection
-## Actuate as a proxy between its client and other tentacle server.
-################################################################################
-sub serve_proxy_connection {
- my $read;
- my $data=1;
-
- # Start a connection with the other Tentacle Server
- open_proxy();
-
- my $command;
-
- # Read commands
- while ($command = recv_command ($t_block_size)) {
- # Client wants to send a file
- if ($command =~ /^SEND <(.*)> SIZE (\d+)$/) {
- my $res = recv_file_proxy($command, $2);
-
- if (!defined($res)) {
- last;
- }
- }
- # Client wants to receive a file
- elsif ($command =~ /^RECV <(.*)>$/) {
- my $res = send_file_proxy ($command);
-
- if (!defined($res)) {
- last;
- }
- }
- # Quit
- elsif ($command =~ /^QUIT$/) {
- print_log ("Connection closed from " . $t_client_socket->sockhost ());
-
- # End proxy connection
- send_data_proxy("QUIT\n");
- last;
- }
- # Unknown command
- else {
- print_log ("Unknown command '$command' from " . $t_client_socket->sockhost ());
- last;
- }
- }
-
- # End a connection with the other Tentacle Server
- close_proxy();
-}
-
-################################################################################
-## SUB serve_connection
-## Read and process commands from the client.
-################################################################################
-sub serve_connection {
- my $command;
-
- # Read commands
- while ($command = recv_command ($t_block_size)) {
-
- # Client wants to send a file
- if ($command =~ /^SEND <(.*)> SIZE (\d+)$/) {
- print_log ("Request to send file '$1' size ${2}b from " . $t_client_socket->sockhost ());
- recv_file ($1, $2);
- }
- # Client wants to receive a file
- elsif ($command =~ /^RECV <(.*)>$/) {
- print_log ("Request to receive file '$1' from " . $t_client_socket->sockhost ());
- send_file ($1);
- }
- # Quit
- elsif ($command =~ /^QUIT$/) {
- print_log ("Connection closed from " . $t_client_socket->sockhost ());
- last;
- }
- # Unknown command
- else {
- print_log ("Unknown command '$command' from " . $t_client_socket->sockhost ());
- last;
- }
- }
-}
-
-################################################################################
-## SUB auth_pwd
-## Authenticate client with server password.
-################################################################################
-sub auth_pwd {
- my $client_digest;
- my $command;
- my $pwd_digest;
-
- require Digest::MD5;
-
- # Wait for password
- $command = recv_command ($t_block_size);
- if ($command !~ /^PASS (.*)$/) {
- error ("Client " . $t_client_socket->sockhost () . " did not authenticate.");
- }
-
- $client_digest = $1;
- $pwd_digest = Digest::MD5::md5 ($t_pwd);
- $pwd_digest = Digest::MD5::md5_hex ($pwd_digest);
-
- if ($client_digest ne $pwd_digest) {
- error ("Invalid password from " . $t_client_socket->sockhost () . ".");
- }
-
- print_log ("Client " . $t_client_socket->sockhost () . " authenticated");
- send_data ("PASS OK\n");
-}
-
-################################################################################
-## SUB recv_file_proxy
-## Redirect file from agent to proxy
-################################################################################
-sub recv_file_proxy ($$) {
- my ($command, $size) = @_;
-
- # Send command to proxy
- print_log ("[PROXY] Host: ".$t_client_socket->sockhost()." send ".$command." to ".$t_proxy_socket->sockhost ());
- my $res = send_data_proxy($command."\n");
-
- if (!defined($res)) {
- return undef;
- }
-
- # Proxied server response
- my $rc = dump_data($t_proxy_socket, $t_client_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return undef;
- }
-
- # Client send data to server
- $rc = dump_data($t_client_socket, $t_proxy_socket, $size);
-
- # Check if there was an error
- if ($rc == -1) {
- return undef;
- }
-
- # Server says if data was recieved or not
- $rc = dump_data($t_proxy_socket, $t_client_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return undef;
- }
-
-}
-
-################################################################################
-## SUB recv_file
-## Receive a file of size $_[1] and save it in $t_directory as $_[0].
-################################################################################
-sub recv_file {
- my $base_name = $_[0];
- my $data = '';
- my $file;
- my $size = $_[1];
-
- # Check file name
- if ($base_name =~ /[$t_invalid_chars]/) {
- print_log ("File '$base_name' size ${size}b from " . $t_client_socket->sockhost () . " has an invalid file name");
- send_data ("SEND ERR\n");
- return;
- }
-
- # Check file size, empty files are not allowed
- if ($size < 1 || $size > $t_max_size) {
- print_log ("File '$base_name' size ${size}b from " . $t_client_socket->sockhost () . " is too big");
- send_data ("SEND ERR\n");
- return;
- }
-
- # Apply filters
- $file = "$t_directory/" . apply_filters ($base_name) . $base_name;
-
- # Check if file exists
- if (-f $file && $t_overwrite == 0) {
- print_log ("File '$base_name' size ${size}b from " . $t_client_socket->sockhost () . " already exists");
- send_data ("SEND ERR\n");
- return;
- }
-
- send_data ("SEND 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);
-
- send_data ("SEND OK\n");
- print_log ("Received file '$base_name' size ${size}b from " . $t_client_socket->sockhost ());
-}
-
-################################################################################
-## SUB send_file_proxy
-## Redirect file from agent to proxy
-################################################################################
-sub send_file_proxy ($) {
- my ($command) = @_;
- my $size;
- # Send command to proxy
- print_log ("[PROXY] ".$t_client_socket->sockhost()." send ".$command." to ".$t_proxy_socket->sockhost ());
- my $res = send_data_proxy($command."\n");
-
- if (!defined($res)) {
- return undef;
- }
-
- $command = recv_command_proxy($t_block_size);
-
- if (!defined($command)) {
- return undef;
- }
-
- if ($command =~ /^RECV SIZE (\d+)$/) {
- $size = $1;
- }
-
- print_log ("[PROXY] ".$t_proxy_socket->sockhost()." send ".$command." to ".$t_client_socket->sockhost ());
-
- $res = send_data($command."\n");
-
- if(!defined($res)) {
- return undef;
- }
-
- # Client send OK to server
- my $rc = dump_data($t_client_socket, $t_proxy_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return undef;
- }
-
- # Proxied server send the file to client
- $rc = dump_data($t_proxy_socket, $t_client_socket, $size);
-
- # Check if there was an error
- if ($rc == -1) {
- return undef;
- }
-
-}
-
-################################################################################
-## SUB send_file
-## Send a file to the client
-################################################################################
-sub send_file {
- my $base_name = $_[0];
- my $data = '';
- my $file;
- my $response;
- my $size;
-
- # Check file name
- if ($base_name =~ /[$t_invalid_chars]/) {
- print_log ("Requested file '$base_name' from " . $t_client_socket->sockhost () . " has an invalid file name");
- send_data ("RECV ERR\n");
- return;
- }
-
- # Apply filters
- $file = "$t_directory/" . apply_filters ($base_name) . $base_name;
-
- # Check if file exists
- if (! -f $file) {
- print_log ("Requested file '$file' from " . $t_client_socket->sockhost () . " does not exist");
- send_data ("RECV ERR\n");
- return;
- }
-
- $size = -s $file;
- send_data ("RECV SIZE $size\n");
-
- # Wait for client response
- $response = recv_command ($t_block_size);
- if ($response ne "RECV OK") {
- print_log ("Requested file '$file' from " . $t_client_socket->sockhost () . " not sent");
- return;
- }
-
- # Send the file
- open (FILE, $file) || error ("Cannot open file '$file' for reading.");
- binmode (FILE);
-
- while ($data = <FILE>) {
- send_data ($data);
- }
-
- close (FILE);
-
- print_log ("Requested file '$file' from " . $t_client_socket->sockhost () . " 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");
- }
- if (!defined ($t_proxy_ip)) {
- exit 1;
- } else {
- print_log("ERROR EN EL HILO ".threads->tid());
- return undef;
- }
-}
-
-################################################################################
-## SUB recv_data_proxy
-## Recv data from proxy socket.
-################################################################################
-sub recv_data_proxy {
- my $data;
- my $read;
- my $retries = 0;
- my $size = $_[0];
-
- while (1) {
-
- # Try to read data from the socket
- if ($t_proxy_select->can_read ($t_timeout)) {
-
- # Read at most $size bytes
- $read = sysread ($t_proxy_socket, $data, $size);
-
- # Read error
- if (! defined ($read)) {
- error ("Read error from " . $t_proxy_socket->sockhost () . ": $!.");
- return undef;
- }
-
- # EOF
- if ($read == 0) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " unexpectedly closed.");
- return undef;
- }
-
- return ($read, $data);
- }
-
- # Retry
- $retries++;
-
- # But check for error conditions first
- if ($retries > $t_retries) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
- return undef;
- }
- }
-}
-################################################################################
-## 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_client_socket, $data, $size);
-
- # Read error
- if (! defined ($read)) {
- error ("Read error from " . $t_client_socket->sockhost () . ": $!.");
- return undef;
- }
-
- # EOF
- if ($read == 0) {
- error ("Connection from " . $t_client_socket->sockhost () . " unexpectedly closed.");
- return undef;
- }
-
- return ($read, $data);
- }
-
- # Retry
- $retries++;
-
- # But check for error conditions first
- if ($retries > $t_retries) {
- error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
- return undef;
- }
- }
-}
-
-################################################################################
-## SUB send_data
-## Write data to the client socket.
-################################################################################
-sub send_data {
- my $data = $_[0];
- 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)) {
-
- $written = syswrite ($t_client_socket, $data, $size - $total, $total);
-
- # Write error
- if (! defined ($written)) {
- error ("Connection error from " . $t_client_socket->sockhost () . ": $!.");
- return undef;
- }
-
- # EOF
- if ($written == 0) {
- error ("Connection from " . $t_client_socket->sockhost () . " unexpectedly closed.");
- return undef;
- }
-
- $total += $written;
-
- # Check if all data was written
- if ($total == $size) {
- return 1;
- }
-
- # Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
- return undef;
- }
- }
- }
-}
-
-################################################################################
-## SUB dump_data
-## Dump data from a socket to another one. Following Tentacle Protocol.
-################################################################################
-sub dump_data($$;$) {
- my ($from, $to, $size) = @_;
- my $read;
- my $data;
- my $buffer = "";
- my $written;
- my $total = $size;
- my $t_select_read = undef;
- my $t_select_write = undef;
-
- # Assign the correct selector for each socket
- if ($from == $t_proxy_socket) {
- # We must read from t_proxy_socket
- $t_select_read = $t_proxy_select;
- $t_select_write = $t_select;
- } else {
- # We must read from t_client_socket
- $t_select_read = $t_select;
- $t_select_write = $t_proxy_select;
- }
-
- while (1) {
-
- # Ensure we can read from socket
- if ($t_select_read->can_read()) {
- # Ensure we can write from socket
- if ($t_select_write->can_write()) {
-
- $read = "";
- $read = sysread ($from, $data, $t_block_size);
-
- # Read error
- if (! defined ($read)) {
- error ("Read error from " . $from->sockhost () . ": $!.");
- return -1;
- }
-
- # EOF
- if ($read == 0) {
- error ("Connection from " . $from->sockhost () . " unexpectedly closed.");
- return -1;
- }
-
- $written = syswrite ($to, $data, $read);
-
- if ($written != $read) {
- error ("Connection from " . $to->sockhost () . " unexpectedly closed.");
- return -1;
- }
-
- $buffer .= $data;
-
- if (! defined ($size)) {
- # If no size defined check for \n
- # because a command was sent.
-
- if ($buffer =~ /\n$/) {
-
- # Delete CHAR \n
- chop($buffer);
-
- print_log ("[PROXY] ".$from->sockhost()." send ".$buffer." to ".$to->sockhost ());
-
- # Returns error if proxy returns error to end connection
- if ($buffer =~ /SEND ERR/) {
- return -1;
- } else {
- return 0;
- }
- }
- } else {
- # If size is defined check if all bytes were sent
- $size = $size - $read;
-
- if ($size == 0) {
- print_log ("[PROXY] ".$from->sockhost()." send ".$total."b to ".$to->sockhost());
-
- return 0;
- }
- }
- }
- }
- }
-}
-
-################################################################################
-## SUB recv_command_proxy
-## Read a command from the proxied server, ended by a new line character.
-################################################################################
-sub recv_command_proxy {
- my $buffer;
- my $char;
- my $command = '';
- my $read;
- my $total = 0;
-
- while (1) {
-
- ($read, $buffer) = recv_data_proxy ($t_block_size);
-
- if (!defined($read)) {
- return undef;
- }
-
- $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_proxy_socket->sockhost () . ".");
- return undef;
- }
- }
-}
-
-################################################################################
-## 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);
-
- if (!defined($read)) {
- return undef;
- }
-
- $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_client_socket->sockhost () . ".");
- return undef;
- }
- }
-}
-
-################################################################################
-## 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) {
- print ("Error: passwords do not match.\n");
- exit 1;
- }
-
- # Remove the trailing new line character
- chop $pwd1;
-
- return $pwd1;
-}
-
-################################################################################
-## SUB apply_filters
-## Applies filters to the given file.
-################################################################################
-sub apply_filters ($) {
- my ($file_name) = @_;
-
- foreach my $filter (@t_filters) {
- my ($regexp, $dir) = @{$filter};
- if ($file_name =~ /$regexp/) {
- print_log ("File '$file_name' matches filter '$regexp' (changing to directory '$dir')");
- return $dir . '/';
- }
- }
-
- return '';
-}
-
-################################################################################
-# Main
-################################################################################
-
-# Never run as root
-if ($> == 0 && $^O ne 'MSWin32') {
- print ("Error: for safety reasons $0 cannot be run with root privileges.\n");
- exit 1;
-}
-
-# Parse command line options
-parse_options ();
-
-# Check command line arguments
-if ($#ARGV != -1) {
- print_help ();
- exit 1;
-}
-
-# Run as daemon?
-if ($t_daemon == 1 && $^O ne 'MSWin32') {
- daemonize ();
-}
-
-# Handle ctr-c
-if ($^O eq 'MSWin32') {
- $SIG{INT2} = \&stop_server;
-}
-else {
- $SIG{INT} = \&stop_server;
-}
-
-# Handle SIGCHLD
-#$SIG{CHLD} = \&sigchld_handler;
-
-start_server ();
-
-# Accept connections
-for(my $i=0; $i<$t_max_conn; $i++) {
- $Threads[$i] = threads->create('accept_connection');
-}
-
-while (1) {
- sleep(5);
-
- for(my $i=0; $i<$t_max_conn; $i++) {
-
- if (defined($Threads[$i])) {
- if (! $Threads[$i]->is_running) {
- print_log ("Waiting for thread: $i");
- $Threads[$i]->join();
- }
- }
- }
-}
-
-__END__
-
-=head1 REQUIRED ARGUMENTES
-
-=over
-
-=item B<< -s F<storage_directory> >> Root directory to store the files received by the server
-
-=back
-
-=head1 OPTIONS
-
-=over
-
-=item I<-a ip_address> Address to B<listen> on (default I<0.0.0.0>).
-
-=item I<-c number> B<Maximum> number of simultaneous B<connections> (default I<10>).
-
-=item I<-d> Run as B<daemon>.
-
-=item I<-e cert> B<OpenSSL certificate> file. Enables SSL.
-
-=item I<-f ca_cert> Verify that the peer certificate is signed by a B<CA>.
-
-=item I<-h> Show B<help>.
-
-=item I<-i> B<Filters>.
-
-=item I<-k key> B<OpenSSL private key> file.
-
-=item I<-m size> B<Maximum file size> in bytes (default I<2000000b>).
-
-=item I<-o> Enable file B<overwrite>.
-
-=item I<-p port> B<Port to listen> on (default I<41121>).
-
-=item I<-q> B<Quiet>. Do now print error messages.
-
-=item I<-r number> B<Number of retries> for network opertions (default I<3>).
-
-=item I<-t time> B<Time-out> for network operations in B<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>.
-
-=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<Thread::Semaphore>, L<POSIX>
-
-
-=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<Thread::Semaphore>, L<POSIX>
-
-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
-
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-06-15 11:31:35
|
Revision: 51
http://sourceforge.net/p/tentacled/code/51
Author: ramonn
Date: 2015-06-15 11:31:30 +0000 (Mon, 15 Jun 2015)
Log Message:
-----------
Improvements to the proxy server's loop.
Modified Paths:
--------------
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-05-28 14:53:14 UTC (rev 50)
+++ trunk/perl/server/bin/tentacle_server 2015-06-15 11:31:30 UTC (rev 51)
@@ -64,6 +64,7 @@
use Thread::Semaphore;
use POSIX ":sys_wait_h";
use Time::HiRes qw(usleep);
+use Scalar::Util qw(refaddr);
# Constants for Win32 services.
use constant WIN32_SERVICE_STOPPED => 0x01;
@@ -774,14 +775,21 @@
# Forward data between the client and the server.
eval {
- while (1) {
- if ($t_select->can_read(0)) {
+ my $select = IO::Select->new ();
+ $select->add($t_proxy_socket);
+ $select->add($t_client_socket);
+ while (my @ready = $select->can_read()) {
+ foreach my $socket (@ready) {
+ if (refaddr($socket) == refaddr($t_client_socket)) {
my ($read, $data) = recv_data($t_block_size);
+ return unless defined($data);
send_data_proxy($data);
- }
- if ($t_proxy_select->can_read(0)) {
+ }
+ else {
my ($read, $data) = recv_data_proxy($t_block_size);
+ return unless defined($data);
send_data($data);
+ }
}
}
};
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-05-28 14:53:20
|
Revision: 50
http://sourceforge.net/p/tentacled/code/50
Author: ramonn
Date: 2015-05-28 14:53:14 +0000 (Thu, 28 May 2015)
Log Message:
-----------
2015-05-28 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Rewrote the Tentacle proxy to simply forward
data between the client and the server.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2015-05-26 12:01:36 UTC (rev 49)
+++ trunk/perl/ChangeLog 2015-05-28 14:53:14 UTC (rev 50)
@@ -1,3 +1,8 @@
+2015-05-28 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Rewrote the Tentacle proxy to simply forward
+ data between the client and the server.
+
2015-04-09 Akihiro Uchida <au...@rw...>
* client/bin/tentacle_client: Added '-b' option to specify
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-05-26 12:01:36 UTC (rev 49)
+++ trunk/perl/server/bin/tentacle_server 2015-05-28 14:53:14 UTC (rev 50)
@@ -30,7 +30,7 @@
=head1 VERSION
-Version 0.4.0
+Version 0.5.0
=head1 USAGE
@@ -90,7 +90,7 @@
my $SERVICE_PARAMS=join(' ', @ARGV);
# Program version
-our $VERSION = '0.4.0';
+our $VERSION = '0.5.0';
# IPv4 address to listen on
my @t_addresses = ('0', '0.0.0.0');
@@ -142,8 +142,10 @@
# Server socket
my @t_server_sockets;
-my $select;
+# Server select handler
+my $t_server_select;
+
# Use SSL, 1 true, 0 false
my $t_ssl = 0;
@@ -162,10 +164,10 @@
# Timeout for socket read/write operations in seconds
my $t_timeout = 1;
-#Bridge IP to actuate as a proxy
+# Address to proxy client requests to
my $t_proxy_ip = undef;
-# Proxy port by default 41121
+# Port to proxy client requests to
my $t_proxy_port = 41121;
# Proxy socket
@@ -192,7 +194,7 @@
print ("Tentacle server v$VERSION. See http://www.openideas.info/wiki for protocol description.\n\n");
print ("Options:\n");
print ("\t-a ip_addresses\tIP addresses to listen on (default @t_addresses).\n");
- print ("\t\t(Multiple addresses separated by comma can be defined.)\n");
+ print ("\t \t(Multiple addresses separated by comma can be defined.)\n");
print ("\t-c number\tMaximum number of simultaneous connections (default $t_max_conn).\n");
print ("\t-d\t\tRun as daemon.\n");
print ("\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
@@ -209,11 +211,11 @@
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\n");
- print ("\t-b proxy_ip_address\t\tProxied server address.\n\n");
- print ("\t-g proxy_port\t\tPort of proxied server.\n\n");
+ print ("\t-x pwd\t\tServer password.\n");
+ print ("\t-b ip_address\tProxy requests to the given address.\n");
+ print ("\t-g port\t\tProxy requests to the given port.\n");
print ("\t-T\t\tEnable tcpwrappers support.\n");
- print ("\t\t(To use this option, 'Authen::Libwrap' should be installed.)\n\n");
+ print ("\t \t\t(To use this option, 'Authen::Libwrap' should be installed.)\n\n");
}
################################################################################
@@ -499,9 +501,9 @@
################################################################################
## SUB start_proxy
-## Open the server socket.
+## Open the proxy server socket.
################################################################################
-sub open_proxy {
+sub start_proxy {
# Connect to server
$t_proxy_socket = $SOCKET_MODULE->new (
@@ -514,8 +516,8 @@
}
# Create proxy selector
- $t_proxy_select = IO::Select->new ();
- $t_proxy_select->add ($t_proxy_socket);
+ $t_proxy_select = IO::Select->new ();
+ $t_proxy_select->add ($t_proxy_socket);
}
@@ -554,11 +556,11 @@
if (!@t_server_sockets) {
error ("Cannot open socket for all addresses on port $t_port: $!.");
- }
+ }
- $select = IO::Select->new();
+ $t_server_select = IO::Select->new();
foreach my $t_server_socket (@t_server_sockets){
- $select->add($t_server_socket);
+ $t_server_select->add($t_server_socket);
}
}
@@ -618,8 +620,6 @@
sub close_proxy {
$t_proxy_socket->shutdown (2);
$t_proxy_socket->close ();
- print_log ("Proxy socket closed");
-
}
################################################################################
@@ -694,7 +694,7 @@
$t_sem = Thread::Semaphore->new ($t_max_conn);
while (1) {
- my @ready = $select->can_read;
+ my @ready = $t_server_select->can_read;
foreach $t_server_socket (@ready) {
# Accept connection
@@ -768,40 +768,25 @@
## Actuate as a proxy between its client and other tentacle server.
################################################################################
sub serve_proxy_connection {
- my $read;
- my $data=1;
- # Start a connection with the other Tentacle Server
- open_proxy();
-
- my $command;
+ # We are a proxy! Start a connection to the Tentacle Server.
+ start_proxy();
- # Read commands
- while ($command = recv_command ($t_block_size)) {
- # Client wants to send a file
- if ($command =~ /^SEND <(.*)> SIZE (\d+)$/) {
- recv_file_proxy($command, $2);
+ # Forward data between the client and the server.
+ eval {
+ while (1) {
+ if ($t_select->can_read(0)) {
+ my ($read, $data) = recv_data($t_block_size);
+ send_data_proxy($data);
+ }
+ if ($t_proxy_select->can_read(0)) {
+ my ($read, $data) = recv_data_proxy($t_block_size);
+ send_data($data);
+ }
}
- # Client wants to receive a file
- elsif ($command =~ /^RECV <(.*)>$/) {
- send_file_proxy ($command);
- }
- # Quit
- elsif ($command =~ /^QUIT$/) {
- print_log ("Connection closed from " . $t_client_socket->sockhost ());
-
- # End proxy connection
- send_data_proxy("QUIT\n");
- last;
- }
- # Unknown command
- else {
- print_log ("Unknown command '$command' from " . $t_client_socket->sockhost ());
- last;
- }
- }
+ };
- # End a connection with the other Tentacle Server
+ # Close the connection to the Tentacle Server.
close_proxy();
}
@@ -868,43 +853,6 @@
}
################################################################################
-## SUB recv_file_proxy
-## Redirect file from agent to proxy
-################################################################################
-sub recv_file_proxy ($$) {
- my ($command, $size) = @_;
-
- # Send command to proxy
- print_log ("[PROXY] Host: ".$t_client_socket->sockhost()." send ".$command." to ".$t_proxy_socket->sockhost ());
- send_data_proxy($command."\n");
-
- # Proxied server response
- my $rc = dump_data($t_proxy_socket, $t_client_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return;
- }
-
- # Client send data to server
- $rc = dump_data($t_client_socket, $t_proxy_socket, $size);
-
- # Check if there was an error
- if ($rc == -1) {
- return;
- }
-
- # Server says if data was recieved or not
- $rc = dump_data($t_proxy_socket, $t_client_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return;
- }
-
-}
-
-################################################################################
## SUB recv_file
## Receive a file of size $_[1] and save it in $t_directory as $_[0].
################################################################################
@@ -954,45 +902,6 @@
}
################################################################################
-## SUB send_file_proxy
-## Redirect file from agent to proxy
-################################################################################
-sub send_file_proxy ($) {
- my ($command) = @_;
- my $size;
- # Send command to proxy
- print_log ("[PROXY] ".$t_client_socket->sockhost()." send ".$command." to ".$t_proxy_socket->sockhost ());
- send_data_proxy($command."\n");
-
- $command = recv_command_proxy($t_block_size);
-
- if ($command =~ /^RECV SIZE (\d+)$/) {
- $size = $1;
- }
-
- print_log ("[PROXY] ".$t_proxy_socket->sockhost()." send ".$command." to ".$t_client_socket->sockhost ());
-
- send_data($command."\n");
-
- # Client send OK to server
- my $rc = dump_data($t_client_socket, $t_proxy_socket);
-
- # Check if there was an error
- if ($rc == -1) {
- return;
- }
-
- # Proxied server send the file to client
- $rc = dump_data($t_proxy_socket, $t_client_socket, $size);
-
- # Check if there was an error
- if ($rc == -1) {
- return;
- }
-
-}
-
-################################################################################
## SUB send_file
## Send a file to the client
################################################################################
@@ -1201,127 +1110,6 @@
}
################################################################################
-## SUB dump_data
-## Dump data from a socket to another one. Following Tentacle Protocol.
-################################################################################
-sub dump_data($$;$) {
- my ($from, $to, $size) = @_;
- my $read;
- my $data;
- my $buffer = "";
- my $written;
- my $total = $size;
- my $t_select_read = undef;
- my $t_select_write = undef;
-
- # Assign the correct selector for each socket
- if ($from == $t_proxy_socket) {
- # We must read from t_proxy_socket
- $t_select_read = $t_proxy_select;
- $t_select_write = $t_select;
- } else {
- # We must read from t_client_socket
- $t_select_read = $t_select;
- $t_select_write = $t_proxy_select;
- }
-
- while (1) {
-
- # Ensure we can read from socket
- if ($t_select_read->can_read()) {
- # Ensure we can write from socket
- if ($t_select_write->can_write()) {
-
- $read = "";
- $read = sysread ($from, $data, $t_block_size);
-
- # Read error
- if (! defined ($read)) {
- error ("Read error from " . $from->sockhost () . ": $!.");
- return -1;
- }
-
- # EOF
- if ($read == 0) {
- error ("Connection from " . $from->sockhost () . " unexpectedly closed.");
- return -1;
- }
-
- $written = syswrite ($to, $data, $read);
-
- if ($written != $read) {
- error ("Connection from " . $to->sockhost () . " unexpectedly closed.");
- return -1;
- }
-
- $buffer .= $data;
-
- if (! defined ($size)) {
- # If no size defined check for \n
- # because a command was sent.
-
- if ($buffer =~ /\n$/) {
-
- # Delete CHAR \n
- chop($buffer);
-
- print_log ("[PROXY] ".$from->sockhost()." send ".$buffer." to ".$to->sockhost ());
-
- # Returns error if proxy returns error to end connection
- if ($buffer =~ /SEND ERR/) {
- return -1;
- } else {
- return 0;
- }
- }
- } else {
- # If size is defined check if all bytes were sent
- $size = $size - $read;
-
- if ($size == 0) {
- print_log ("[PROXY] ".$from->sockhost()." send ".$total."b to ".$to->sockhost());
-
- return 0;
- }
- }
- }
- }
- }
-}
-
-################################################################################
-## SUB recv_command_proxy
-## Read a command from the proxied server, ended by a new line character.
-################################################################################
-sub recv_command_proxy {
- my $buffer;
- my $char;
- my $command = '';
- my $read;
- my $total = 0;
-
- while (1) {
-
- ($read, $buffer) = recv_data_proxy ($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_proxy_socket->sockhost () . ".");
- }
- }
-}
-
-################################################################################
## SUB recv_command
## Read a command from the client, ended by a new line character.
################################################################################
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-05-26 12:01:41
|
Revision: 49
http://sourceforge.net/p/tentacled/code/49
Author: ramonn
Date: 2015-05-26 12:01:36 +0000 (Tue, 26 May 2015)
Log Message:
-----------
Install the Win32 service without checking other parameters (prevents problems with quotes).
Modified Paths:
--------------
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-04-09 07:28:15 UTC (rev 48)
+++ trunk/perl/server/bin/tentacle_server 2015-05-26 12:01:36 UTC (rev 49)
@@ -264,6 +264,23 @@
exit 1;
}
+ # The Win32 service must be installed/uninstalled without checking other parameters.
+ if (defined ($opts{'S'})) {
+ my $service_action = $opts{'S'};
+ if ($^O ne 'MSWin32') {
+ error ("Windows services are only available on Win32.");
+ } else {
+ eval "use Win32::Daemon";
+ die($@) if ($@);
+
+ if ($service_action eq 'install') {
+ install_service();
+ } elsif ($service_action eq 'uninstall') {
+ uninstall_service();
+ }
+ }
+ }
+
# Address
if (defined ($opts{'a'})) {
@t_addresses = ();
@@ -465,11 +482,7 @@
eval "use Win32::Daemon";
die($@) if ($@);
- if ($service_action eq 'install') {
- install_service();
- } elsif ($service_action eq 'uninstall') {
- uninstall_service();
- } elsif ($service_action eq 'run') {
+ if ($service_action eq 'run') {
Win32::Daemon::RegisterCallbacks({
start => \&callback_start,
running => \&callback_running,
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <au...@us...> - 2015-04-09 07:28:27
|
Revision: 48
http://sourceforge.net/p/tentacled/code/48
Author: auchida
Date: 2015-04-09 07:28:15 +0000 (Thu, 09 Apr 2015)
Log Message:
-----------
2015-04-09 Akihiro Uchida <au...@rw...>
* client/bin/tentacle_client: Added '-b' option to specify
a local ip address to bind, contributed by Hiroki Shimizu.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2015-04-09 07:04:58 UTC (rev 47)
+++ trunk/perl/ChangeLog 2015-04-09 07:28:15 UTC (rev 48)
@@ -1,3 +1,8 @@
+2015-04-09 Akihiro Uchida <au...@rw...>
+
+ * client/bin/tentacle_client: Added '-b' option to specify
+ a local ip address to bind, contributed by Hiroki Shimizu.
+
2015-04-07 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Fixed command line options for the Windows
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2015-04-09 07:04:58 UTC (rev 47)
+++ trunk/perl/client/bin/tentacle_client 2015-04-09 07:28:15 UTC (rev 48)
@@ -131,6 +131,9 @@
# Timeout for socket read/write operations in seconds
my $t_timeout = 1;
+# bind ipaddr
+my $t_bind_address = undef;
+
################################################################################
## SUB print_help
## Print help screen.
@@ -141,6 +144,7 @@
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");
@@ -166,7 +170,7 @@
my $tmp;
# Get options
- if (getopts ('a:ce:f:ghk:p:qr:t:vwx:y:', \%opts) == 0 || defined ($opts{'h'})) {
+ if (getopts ('a:b:ce:f:ghk:p:qr:t:vwx:y:', \%opts) == 0 || defined ($opts{'h'})) {
print_help ();
exit 1;
}
@@ -183,6 +187,18 @@
}
+ # 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;
@@ -309,20 +325,42 @@
# Connect to server
if ($SOCKET_MODULE ne 'IO::Socket::INET') {
- $t_socket = $SOCKET_MODULE->new (
- Domain => AF_INET6,
- PeerAddr => $t_address,
- PeerPort => $t_port,
- Type => SOCK_STREAM
- );
+ 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)) {
- $t_socket = $SOCKET_MODULE->new (
- Domain => AF_INET,
- PeerAddr => $t_address,
- PeerPort => $t_port,
- Type => SOCK_STREAM
- );
+ 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)) {
@@ -344,18 +382,38 @@
# Connect to proxy
if ($SOCKET_MODULE ne 'IO::Socket::INET') {
- $t_socket = $SOCKET_MODULE->new (
- Domain => AF_INET6,
- PeerAddr => $t_proxy_address,
- PeerPort => $t_proxy_port,
- );
+ 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)) {
- $t_socket = $SOCKET_MODULE->new (
- Domain => AF_INET,
- PeerAddr => $t_proxy_address,
- PeerPort => $t_proxy_port,
- );
+ 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)) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <au...@us...> - 2015-04-09 07:05:04
|
Revision: 47
http://sourceforge.net/p/tentacled/code/47
Author: auchida
Date: 2015-04-09 07:04:58 +0000 (Thu, 09 Apr 2015)
Log Message:
-----------
2015-04-09 Akihiro Uchida <au...@rw...>
* src/client/tentacle_client.h src/client/tentacle_client.c
lib/tentacle_lib.c lib/tentacle_lib.h: Added '-b' option to specify
a local ip address to bind, contributed by Hiroki Shimizu.
Modified Paths:
--------------
trunk/c/ChangeLog
trunk/c/lib/tentacle_lib.c
trunk/c/lib/tentacle_lib.h
trunk/c/src/client/tentacle_client.c
trunk/c/src/client/tentacle_client.h
Modified: trunk/c/ChangeLog
===================================================================
--- trunk/c/ChangeLog 2015-04-07 14:13:23 UTC (rev 46)
+++ trunk/c/ChangeLog 2015-04-09 07:04:58 UTC (rev 47)
@@ -1,3 +1,9 @@
+2015-04-09 Akihiro Uchida <au...@rw...>
+
+ * src/client/tentacle_client.h src/client/tentacle_client.c
+ lib/tentacle_lib.c lib/tentacle_lib.h: Added '-b' option to specify
+ a local ip address to bind, contributed by Hiroki Shimizu.
+
2010-11-02 Ramon Novoa <rn...@ar...>
* lib/tentacle_lib.c, lib/tentacle_lib.h: Moved the base64 translation
Modified: trunk/c/lib/tentacle_lib.c
===================================================================
--- trunk/c/lib/tentacle_lib.c 2015-04-07 14:13:23 UTC (rev 46)
+++ trunk/c/lib/tentacle_lib.c 2015-04-09 07:04:58 UTC (rev 47)
@@ -119,9 +119,10 @@
* \return The connected socket on success, -1 on error.
* \note Blocking sockets will be used, polling before read and write operations.
*/
-int ConnectTo(char *addr, unsigned short int port) {
+int ConnectTo(char *addr, unsigned short int port, char *bindaddr) {
int sock;
struct sockaddr_in server;
+ struct sockaddr_in client;
struct hostent *host = NULL;
if (NULL == addr) {
@@ -151,6 +152,27 @@
memcpy(&server.sin_addr, host->h_addr_list[0], host->h_length);
}
+ /* Bind IPAddress */
+ if (NULL != bindaddr) {
+ memset(&client, 0, sizeof(client));
+ client.sin_family = AF_INET;
+ client.sin_port = htons(0);
+ client.sin_addr.s_addr = inet_addr(bindaddr);
+ if (-1 == server.sin_addr.s_addr) {
+ host = gethostbyname(bindaddr);
+ if (NULL == host) {
+ PrintError("Could not resolve bindaddress for %s", bindaddr);
+ return -1;
+ }
+ memcpy(&client.sin_addr, host->h_addr_list[0], host->h_length);
+ }
+ if (SOCKET_ERROR == bind(sock, (struct sockaddr *) &client, sizeof(client))) {
+ PrintError("bind(): %s", LastErrorMsg());
+ return -1;
+ }
+ }
+
+
/* Connect to the server */
if (SOCKET_ERROR == connect(sock, (struct sockaddr *) &server, sizeof(server))) {
PrintError ("connect(): %s", LastErrorMsg());
Modified: trunk/c/lib/tentacle_lib.h
===================================================================
--- trunk/c/lib/tentacle_lib.h 2015-04-07 14:13:23 UTC (rev 46)
+++ trunk/c/lib/tentacle_lib.h 2015-04-09 07:04:58 UTC (rev 47)
@@ -63,7 +63,7 @@
char *LastErrorMsg();
void PrintError(char *format, ...);
void PrintLog(char *format, ...);
-int ConnectTo(char *addr, unsigned short int port);
+int ConnectTo(char *addr, unsigned short int port, char *bindaddr);
int DisconnectFrom(int socket);
int RecvCommand(int sock, int ssl, char *buff);
int RecvDataPlain(int sock, int ssl, char *data, size_t max);
Modified: trunk/c/src/client/tentacle_client.c
===================================================================
--- trunk/c/src/client/tentacle_client.c 2015-04-07 14:13:23 UTC (rev 46)
+++ trunk/c/src/client/tentacle_client.c 2015-04-09 07:04:58 UTC (rev 47)
@@ -76,7 +76,7 @@
if (config.proxy_addr[0] != '\0') {
/* Connect to proxy */
- sock = ConnectTo(config.proxy_addr, config.proxy_port);
+ sock = ConnectTo(config.proxy_addr, config.proxy_port, config.bindaddr);
if(-1 == sock) {
goto err;
}
@@ -93,7 +93,7 @@
} else {
/* Connect to server */
- sock = ConnectTo(config.addr, config.port);
+ sock = ConnectTo(config.addr, config.port, config.bindaddr);
if(-1 == sock) {
goto err;
}
@@ -359,6 +359,7 @@
/* Load default values */
config->addr = DEF_ADDR;
+ config->bindaddr = NULL;
config->ca_cert = NULL;
config->cert = NULL;
config->get = 0;
@@ -377,7 +378,7 @@
Verbose = DEF_VERB;
/* Parse command line options */
- while (-1 != (opt = getopt(argc, argv, "a:ce:f:ghk:p:qr:t:vwx:y:"))){
+ while (-1 != (opt = getopt(argc, argv, "a:b:ce:f:ghk:p:qr:t:vwx:y:"))){
switch (opt){
@@ -385,6 +386,11 @@
case 'a':
config->addr = optarg;
break;
+
+ /* Bind address */
+ case 'b':
+ config->bindaddr = optarg;
+ break;
/* SSL without client certificate */
case 'c':
@@ -530,6 +536,7 @@
fprintf(stdout, "Tentacle client v%s. See %s for protocol description.\n\n", PACKAGE_VERSION, TENT_URL);
fprintf(stdout, "Options:\n");
fprintf(stdout, "\t-a address\tServer address (default %s).\n", DEF_ADDR);
+ fprintf(stdout, "\t-b address\tBind address.\n", DEF_ADDR);
fprintf(stdout, "\t-c\t\tEnable SSL without a client certificate.\n");
fprintf(stdout, "\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
fprintf(stdout, "\t-f ca\t\tVerify that the peer certificate is signed by a ca.\n");
Modified: trunk/c/src/client/tentacle_client.h
===================================================================
--- trunk/c/src/client/tentacle_client.h 2015-04-07 14:13:23 UTC (rev 46)
+++ trunk/c/src/client/tentacle_client.h 2015-04-09 07:04:58 UTC (rev 47)
@@ -28,6 +28,7 @@
typedef struct {
char *addr; /* Server address */
+ char *bindaddr; /* Bind address */
char *ca_cert; /* SSL CA certificate file */
char *cert; /* SSL certificate file */
unsigned char get; /* Get mode enabled/disabled */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-04-07 14:13:28
|
Revision: 46
http://sourceforge.net/p/tentacled/code/46
Author: ramonn
Date: 2015-04-07 14:13:23 +0000 (Tue, 07 Apr 2015)
Log Message:
-----------
2015-04-07 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Fixed command line options for the Windows
service. Fixed a SIGPIPE error on FreeBSD when SSL is enabled.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2015-03-28 05:27:42 UTC (rev 45)
+++ trunk/perl/ChangeLog 2015-04-07 14:13:23 UTC (rev 46)
@@ -1,3 +1,8 @@
+2015-04-07 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Fixed command line options for the Windows
+ service. Fixed a SIGPIPE error on FreeBSD when SSL is enabled.
+
2015-03-28 Junichi Satoh <ju...@rw...>
* clint/bin/tentacle_client: To avoid the default SSL verification
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-03-28 05:27:42 UTC (rev 45)
+++ trunk/perl/server/bin/tentacle_server 2015-04-07 14:13:23 UTC (rev 46)
@@ -86,6 +86,9 @@
# Service name for Win32.
my $SERVICE_NAME="Tentacle Server";
+# Service parameters.
+my $SERVICE_PARAMS=join(' ', @ARGV);
+
# Program version
our $VERSION = '0.4.0';
@@ -668,6 +671,9 @@
my $pid;
my $t_server_socket;
+ # Ignore SIGPIPE errors (happens on FreeBSD when SSL is enabled ¿?)
+ $SIG{PIPE} = 'IGNORE';
+
# Start server
start_server ();
@@ -740,6 +746,7 @@
};
$t_client_socket->shutdown (2);
+ $t_client_socket->close ();
$t_sem->up();
}
@@ -1418,8 +1425,11 @@
sub install_service() {
my $service_path = $0;
- my $service_params = "-s \"$t_directory\" -S run";
+ my $service_params = $SERVICE_PARAMS;
+ # Change the service parameter from 'install' to 'run'.
+ $service_params =~ s/\-S\s+\S+/\-S run/;
+
my %service_hash = (
machine => '',
name => 'TENTACLESRV',
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2015-03-28 05:27:47
|
Revision: 45
http://sourceforge.net/p/tentacled/code/45
Author: junichi-satoh
Date: 2015-03-28 05:27:42 +0000 (Sat, 28 Mar 2015)
Log Message:
-----------
2015-03-28 Junichi Satoh <ju...@rw...>
* clint/bin/tentacle_client: To avoid the default SSL verification
mode is changed by new version of IO::Socket::SSL, set SSL_verify_mode
to 0 for no client certificate mode.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2015-03-28 05:04:38 UTC (rev 44)
+++ trunk/perl/ChangeLog 2015-03-28 05:27:42 UTC (rev 45)
@@ -1,5 +1,11 @@
2015-03-28 Junichi Satoh <ju...@rw...>
+ * clint/bin/tentacle_client: To avoid the default SSL verification
+ mode is changed by new version of IO::Socket::SSL, set SSL_verify_mode
+ to 0 for no client certificate mode.
+
+2015-03-28 Junichi Satoh <ju...@rw...>
+
* server/bin/tentacle_server: Fixed tentacle_server crash when ssl
is enabled.
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2015-03-28 05:04:38 UTC (rev 44)
+++ trunk/perl/client/bin/tentacle_client 2015-03-28 05:27:42 UTC (rev 45)
@@ -408,6 +408,8 @@
if ($t_ssl_cert eq ''){
IO::Socket::SSL->start_SSL (
$t_socket,
+ # No authentication
+ SSL_verify_mode => '0x00',
);
}
elsif ($t_ssl_ca eq '') {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2015-03-28 05:04:44
|
Revision: 44
http://sourceforge.net/p/tentacled/code/44
Author: junichi-satoh
Date: 2015-03-28 05:04:38 +0000 (Sat, 28 Mar 2015)
Log Message:
-----------
2015-03-28 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Fixed tentacle_server crash when ssl
is enabled.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2015-02-11 11:12:10 UTC (rev 43)
+++ trunk/perl/ChangeLog 2015-03-28 05:04:38 UTC (rev 44)
@@ -1,3 +1,8 @@
+2015-03-28 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Fixed tentacle_server crash when ssl
+ is enabled.
+
2015-02-11 Ramon Novoa <rn...@ar...>
* clint/bin/tentacle_client: Properly close all sockets and explicitly
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2015-02-11 11:12:10 UTC (rev 43)
+++ trunk/perl/server/bin/tentacle_server 2015-03-28 05:04:38 UTC (rev 44)
@@ -740,7 +740,6 @@
};
$t_client_socket->shutdown (2);
- $t_client_socket->close ();
$t_sem->up();
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2015-02-11 11:12:49
|
Revision: 43
http://sourceforge.net/p/tentacled/code/43
Author: ramonn
Date: 2015-02-11 11:12:10 +0000 (Wed, 11 Feb 2015)
Log Message:
-----------
2015-02-11 Ramon Novoa <rn...@ar...>
* clint/bin/tentacle_client: Properly close all sockets and explicitly
shutdown connections.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2014-11-27 14:34:33 UTC (rev 42)
+++ trunk/perl/ChangeLog 2015-02-11 11:12:10 UTC (rev 43)
@@ -1,3 +1,8 @@
+2015-02-11 Ramon Novoa <rn...@ar...>
+
+ * clint/bin/tentacle_client: Properly close all sockets and explicitly
+ shutdown connections.
+
2014-11-27 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Properly close all sockets and explicitly
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2014-11-27 14:34:33 UTC (rev 42)
+++ trunk/perl/client/bin/tentacle_client 2015-02-11 11:12:10 UTC (rev 43)
@@ -394,6 +394,7 @@
################################################################################
sub stop_client {
+ $t_socket->shutdown(2);
$t_socket->close ();
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2014-11-27 14:34:39
|
Revision: 42
http://sourceforge.net/p/tentacled/code/42
Author: ramonn
Date: 2014-11-27 14:34:33 +0000 (Thu, 27 Nov 2014)
Log Message:
-----------
2014-11-27 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Properly close all sockets and explicitly
shutdown connections.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2014-11-24 12:25:35 UTC (rev 41)
+++ trunk/perl/ChangeLog 2014-11-27 14:34:33 UTC (rev 42)
@@ -1,3 +1,8 @@
+2014-11-27 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Properly close all sockets and explicitly
+ shutdown connections.
+
2014-11-24 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Fixed that tcp connection is not closed
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2014-11-24 12:25:35 UTC (rev 41)
+++ trunk/perl/server/bin/tentacle_server 2014-11-27 14:34:33 UTC (rev 42)
@@ -600,6 +600,7 @@
## Close the proxy socket.
################################################################################
sub close_proxy {
+ $t_proxy_socket->shutdown (2);
$t_proxy_socket->close ();
print_log ("Proxy socket closed");
@@ -612,6 +613,7 @@
sub stop_server {
foreach my $t_server_socket (@t_server_sockets) {
+ $t_server_socket->shutdown (2);
$t_server_socket->close ();
}
print_log ("Server going down");
@@ -688,6 +690,7 @@
if ($t_use_libwrap && (! hosts_ctl($t_program_name, $t_client_socket))) {
print_log ("Connection from " . $t_client_socket->peerhost() . " is closed by tcpwrappers.");
+ $t_client_socket->shutdown (2);
$t_client_socket->close();
}
else {
@@ -736,6 +739,8 @@
}
};
+ $t_client_socket->shutdown (2);
+ $t_client_socket->close ();
$t_sem->up();
}
@@ -1485,6 +1490,7 @@
sub callback_stop {
foreach my $t_server_socket (@t_server_sockets) {
+ $t_server_socket->shutdown (2);
$t_server_socket->close ();
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2014-11-24 12:25:51
|
Revision: 41
http://sourceforge.net/p/tentacled/code/41
Author: junichi-satoh
Date: 2014-11-24 12:25:35 +0000 (Mon, 24 Nov 2014)
Log Message:
-----------
2014-11-24 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Fixed that tcp connection is not closed
when timed out or connection refused by libwrap.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2014-05-27 12:30:23 UTC (rev 40)
+++ trunk/perl/ChangeLog 2014-11-24 12:25:35 UTC (rev 41)
@@ -1,3 +1,8 @@
+2014-11-24 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Fixed that tcp connection is not closed
+ when timed out or connection refused by libwrap.
+
2014-05-27 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Sleep between socket polls.
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2014-05-27 12:30:23 UTC (rev 40)
+++ trunk/perl/server/bin/tentacle_server 2014-11-24 12:25:35 UTC (rev 41)
@@ -684,15 +684,23 @@
error ("accept: $!.");
}
- print_log ("Client connected from " . $t_client_socket->sockhost ());
+ print_log ("Client connected from " . $t_client_socket->peerhost ());
- # Create a new thread and serve the client
- $t_sem->down();
- my $thr = threads->create(\&serve_client);
- if (! defined ($thr)) {
- error ("Error creating thread: $!.");
+ if ($t_use_libwrap && (! hosts_ctl($t_program_name, $t_client_socket))) {
+ print_log ("Connection from " . $t_client_socket->peerhost() . " is closed by tcpwrappers.");
+ $t_client_socket->close();
}
- $thr->detach();
+ else {
+
+ # Create a new thread and serve the client
+ $t_sem->down();
+ my $thr = threads->create(\&serve_client);
+ if (! defined ($thr)) {
+ error ("Error creating thread: $!.");
+ }
+ $thr->detach();
+ $t_client_socket->close ();
+ }
}
usleep (1000);
@@ -705,15 +713,6 @@
################################################################################
sub serve_client() {
- if ($t_use_libwrap) {
- if (! hosts_ctl($t_program_name, $t_client_socket)) {
- print_log ("Connection from " . $t_client_socket->sockhost() . " is closed by tcpwrappers.");
- $t_client_socket->close ();
- $t_sem->up();
- return;
- }
- }
-
eval {
# Add client socket to select queue
$t_select = IO::Select->new ();
@@ -737,7 +736,6 @@
}
};
- $t_client_socket->close ();
$t_sem->up();
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2014-05-27 12:30:29
|
Revision: 40
http://sourceforge.net/p/tentacled/code/40
Author: ramonn
Date: 2014-05-27 12:30:23 +0000 (Tue, 27 May 2014)
Log Message:
-----------
2014-05-27 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Sleep between socket polls.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2014-05-12 11:11:11 UTC (rev 39)
+++ trunk/perl/ChangeLog 2014-05-27 12:30:23 UTC (rev 40)
@@ -1,3 +1,7 @@
+2014-05-27 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Sleep between socket polls.
+
2014-05-12 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Redefined service constants only available on
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2014-05-12 11:11:11 UTC (rev 39)
+++ trunk/perl/server/bin/tentacle_server 2014-05-27 12:30:23 UTC (rev 40)
@@ -63,6 +63,7 @@
use threads;
use Thread::Semaphore;
use POSIX ":sys_wait_h";
+use Time::HiRes qw(usleep);
# Constants for Win32 services.
use constant WIN32_SERVICE_STOPPED => 0x01;
@@ -693,6 +694,8 @@
}
$thr->detach();
}
+
+ usleep (1000);
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2014-05-12 11:11:17
|
Revision: 39
http://sourceforge.net/p/tentacled/code/39
Author: ramonn
Date: 2014-05-12 11:11:11 +0000 (Mon, 12 May 2014)
Log Message:
-----------
2014-05-12 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Redefined service constants only available on
win32.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2014-05-09 15:08:43 UTC (rev 38)
+++ trunk/perl/ChangeLog 2014-05-12 11:11:11 UTC (rev 39)
@@ -1,3 +1,8 @@
+2014-05-12 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Redefined service constants only available on
+ win32.
+
2014-05-09 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Ported to win32.
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2014-05-09 15:08:43 UTC (rev 38)
+++ trunk/perl/server/bin/tentacle_server 2014-05-12 11:11:11 UTC (rev 39)
@@ -64,6 +64,10 @@
use Thread::Semaphore;
use POSIX ":sys_wait_h";
+# Constants for Win32 services.
+use constant WIN32_SERVICE_STOPPED => 0x01;
+use constant WIN32_SERVICE_RUNNING => 0x04;
+
my $t_libwrap_installed = eval { require Authen::Libwrap } ? 1 : 0;
if ($t_libwrap_installed) {
@@ -454,9 +458,7 @@
if ($^O ne 'MSWin32') {
error ("Windows services are only available on Win32.");
} else {
- eval {
- use Win32::Daemon;
- };
+ eval "use Win32::Daemon";
die($@) if ($@);
if ($service_action eq 'install') {
@@ -1452,11 +1454,9 @@
## Windows service callback function for the running event.
################################################################################
sub callback_running {
- no strict;
- if (Win32::Daemon::State() == SERVICE_RUNNING) {
+ if (Win32::Daemon::State() == WIN32_SERVICE_RUNNING) {
}
- use strict;
}
################################################################################
@@ -1464,19 +1464,17 @@
## Windows service callback function for the start event.
################################################################################
sub callback_start {
- no strict;
# Accept_connections ();
my $thr = threads->create(\&accept_connections);
if (!defined($thr)) {
- Win32::Daemon::State(SERVICE_STOPPED);
+ Win32::Daemon::State(WIN32_SERVICE_STOPPED);
Win32::Daemon::StopService();
return;
}
$thr->detach();
- Win32::Daemon::State(SERVICE_RUNNING);
- use strict;
+ Win32::Daemon::State(WIN32_SERVICE_RUNNING);
}
################################################################################
@@ -1484,15 +1482,13 @@
## Windows service callback function for the stop event.
################################################################################
sub callback_stop {
- no strict;
foreach my $t_server_socket (@t_server_sockets) {
$t_server_socket->close ();
}
- Win32::Daemon::State(SERVICE_STOPPED);
+ Win32::Daemon::State(WIN32_SERVICE_STOPPED);
Win32::Daemon::StopService();
- use strict;
}
################################################################################
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ra...@us...> - 2014-05-09 15:08:48
|
Revision: 38
http://sourceforge.net/p/tentacled/code/38
Author: ramonn
Date: 2014-05-09 15:08:43 +0000 (Fri, 09 May 2014)
Log Message:
-----------
2014-05-09 Ramon Novoa <rn...@ar...>
* server/bin/tentacle_server: Ported to win32.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-09-22 14:53:42 UTC (rev 37)
+++ trunk/perl/ChangeLog 2014-05-09 15:08:43 UTC (rev 38)
@@ -1,3 +1,7 @@
+2014-05-09 Ramon Novoa <rn...@ar...>
+
+ * server/bin/tentacle_server: Ported to win32.
+
2013-09-22 Junichi Satoh <ju...@rw...>
* client/bin/tentacle_client: Added fallback to IPv4 when IPv6
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2013-09-22 14:53:42 UTC (rev 37)
+++ trunk/perl/server/bin/tentacle_server 2014-05-09 15:08:43 UTC (rev 38)
@@ -60,6 +60,7 @@
use warnings;
use Getopt::Std;
use IO::Select;
+use threads;
use Thread::Semaphore;
use POSIX ":sys_wait_h";
@@ -77,9 +78,8 @@
: 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.");
-}
+# Service name for Win32.
+my $SERVICE_NAME="Tentacle Server";
# Program version
our $VERSION = '0.4.0';
@@ -130,7 +130,7 @@
my $t_select;
# Semaphore
-my $t_sem;
+my $t_sem :shared;
# Server socket
my @t_server_sockets;
@@ -197,6 +197,7 @@
print ("\t-p port\t\tPort to listen on (default $t_port).\n");
print ("\t-q\t\tQuiet. Do now print error messages.\n");
print ("\t-r number\tNumber of retries for network opertions (default $t_retries).\n");
+ print ("\t-S (install|uninstall|run) Manage the win32 service.\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");
@@ -241,27 +242,6 @@
}
################################################################################
-## SUB start_win_service
-## Turn the current process into a Windows service.
-################################################################################
-#sub start_win_service {
-# require Win32::Daemon;
-#
-# # Tell the OS to start the service
-# Win32::Daemon::StartService ();
-#
-# # Wait until the service manager is ready
-# while (SERVICE_START_PENDING != Win32::Daemon::State()) {
-# sleep (1);
-# }
-#
-# # Tell the service manager we are running
-# Win32::Daemon::State (SERVICE_RUNNING);
-#
-# # Call Win32::Daemon::StopService() when done
-#}
-
-################################################################################
## SUB parse_options
## Parse command line options and initialize global variables.
################################################################################
@@ -271,7 +251,7 @@
my @t_addresses_tmp;
# Get options
- if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:T', \%opts) == 0 || defined ($opts{'h'})) {
+ if (getopts ('a:b:c:de:f:g:hi:k:m:op:qr:s:S:t:Tvwx:', \%opts) == 0 || defined ($opts{'h'})) {
print_help ();
exit 1;
}
@@ -467,19 +447,35 @@
error ("Authen::Libwrap is not installed.");
}
}
-}
-################################################################################
-## SUB sigchld_handler
-## Handle child process termination.
-################################################################################
-sub sigchld_handler {
+ # Win32 service management
+ if (defined ($opts{'S'})) {
+ my $service_action = $opts{'S'};
+ if ($^O ne 'MSWin32') {
+ error ("Windows services are only available on Win32.");
+ } else {
+ eval {
+ use Win32::Daemon;
+ };
+ die($@) if ($@);
- while (waitpid(-1, &WNOHANG) > 0) {
- $t_sem->up ();
+ if ($service_action eq 'install') {
+ install_service();
+ } elsif ($service_action eq 'uninstall') {
+ uninstall_service();
+ } elsif ($service_action eq 'run') {
+ Win32::Daemon::RegisterCallbacks({
+ start => \&callback_start,
+ running => \&callback_running,
+ stop => \&callback_stop,
+ });
+ Win32::Daemon::StartService();
+ exit 0;
+ } else {
+ error("Unknown action: $service_action");
+ }
+ }
}
-
- $SIG{CHLD} = \&sigchld_handler;
}
################################################################################
@@ -660,87 +656,84 @@
}
################################################################################
-## SUB accept_connection
-## Accept an incoming connection and fork.
+## SUB accept_connections
+## Manage incoming connections.
################################################################################
-sub accept_connection {
+sub accept_connections {
my $pid;
my $t_server_socket;
- my @ready = $select->can_read;
+ # Start server
+ start_server ();
- foreach $t_server_socket (@ready) {
+ # Initialize semaphore
+ $t_sem = Thread::Semaphore->new ($t_max_conn);
- # Accept connection
- $t_client_socket = $t_server_socket->accept ();
+ while (1) {
+ my @ready = $select->can_read;
+ foreach $t_server_socket (@ready) {
- if (! defined ($t_client_socket)) {
+ # Accept connection
+ $t_client_socket = $t_server_socket->accept ();
- # EINTR
- if ($! ne '') {
- next;
+ if (! defined ($t_client_socket)) {
+ next if ($! ne ''); # EINTR
+ error ("accept: $!.");
}
- error ("accept: $!.");
+ print_log ("Client connected from " . $t_client_socket->sockhost ());
+
+ # Create a new thread and serve the client
+ $t_sem->down();
+ my $thr = threads->create(\&serve_client);
+ if (! defined ($thr)) {
+ error ("Error creating thread: $!.");
+ }
+ $thr->detach();
}
+ }
+}
- print_log ("Client connected from " . $t_client_socket->sockhost ());
+################################################################################
+## SUB serve_client
+## Serve a connected client.
+################################################################################
+sub serve_client() {
- # Fork and serve the client
- $pid = fork ();
- if (! defined ($pid)) {
- error ("Cannot fork: $!.");
+ if ($t_use_libwrap) {
+ if (! hosts_ctl($t_program_name, $t_client_socket)) {
+ print_log ("Connection from " . $t_client_socket->sockhost() . " is closed by tcpwrappers.");
+ $t_client_socket->close ();
+ $t_sem->up();
+ return;
}
-
- # Child
- if ($pid == 0) {
-
- # We do not need the server socket
- $t_server_socket->close ();
+ }
- if ($t_use_libwrap) {
- if (! hosts_ctl($t_program_name, $t_client_socket)) {
- print_log ("Connection from " . $t_client_socket->sockhost() . " is closed by tcpwrappers.");
- $t_client_socket->close ();
-
- exit;
- }
- }
-
- # Add client socket to select queue
- $t_select = IO::Select->new ();
- $t_select->add ($t_client_socket);
-
- # Start SSL
- if ($t_ssl == 1) {
- start_ssl ();
- }
-
- # Authenticate client
- if ($t_pwd ne '') {
- auth_pwd ();
- }
-
- # Check if proxy mode is enable
- if (defined ($t_proxy_ip)) {
-
- serve_proxy_connection ();
+ eval {
+ # Add client socket to select queue
+ $t_select = IO::Select->new ();
+ $t_select->add ($t_client_socket);
- } else {
-
- serve_connection ();
- }
-
- $t_client_socket->close ();
-
- # Must exit now
- exit;
+ # Start SSL
+ if ($t_ssl == 1) {
+ start_ssl ();
}
+
+ # Authenticate client
+ if ($t_pwd ne '') {
+ auth_pwd ();
+ }
+
+ # Check if proxy mode is enable
+ if (defined ($t_proxy_ip)) {
+ serve_proxy_connection ();
+ } else {
+ serve_connection ();
+ }
+ };
- # Parent
- $t_client_socket->close ();
-
- }
+ $t_client_socket->close ();
+ $t_sem->up();
}
################################################################################
@@ -1045,10 +1038,8 @@
sub error {
if ($t_quiet == 0) {
- print (STDERR "[err] $_[0]\n");
+ die("[err] $_[0]\n\n");
}
-
- exit 1;
}
################################################################################
@@ -1414,6 +1405,97 @@
}
################################################################################
+## SUB install_service
+## Install the Windows service.
+################################################################################
+sub install_service() {
+
+ my $service_path = $0;
+ my $service_params = "-s \"$t_directory\" -S run";
+
+ my %service_hash = (
+ machine => '',
+ name => 'TENTACLESRV',
+ display => $SERVICE_NAME,
+ path => $service_path,
+ user => '',
+ pwd => '',
+ description => 'Tentacle Server http://sourceforge.net/projects/tentacled/',
+ parameters => $service_params
+ );
+
+ if (Win32::Daemon::CreateService(\%service_hash)) {
+ print "Successfully added.\n";
+ exit 0;
+ } else {
+ print "Failed to add service: " . Win32::FormatMessage(Win32::Daemon::GetLastError()) . "\n";
+ exit 1;
+ }
+}
+
+################################################################################
+## SUB uninstall_service
+## Install the Windows service.
+################################################################################
+sub uninstall_service() {
+ if (Win32::Daemon::DeleteService('', 'TENTACLESRV')) {
+ print "Successfully deleted.\n";
+ exit 0;
+ } else {
+ print "Failed to delete service: " . Win32::FormatMessage(Win32::Daemon::GetLastError()) . "\n";
+ exit 1;
+ }
+}
+
+################################################################################
+## SUB callback_running
+## Windows service callback function for the running event.
+################################################################################
+sub callback_running {
+ no strict;
+
+ if (Win32::Daemon::State() == SERVICE_RUNNING) {
+ }
+ use strict;
+}
+
+################################################################################
+## SUB callback_start
+## Windows service callback function for the start event.
+################################################################################
+sub callback_start {
+ no strict;
+
+ # Accept_connections ();
+ my $thr = threads->create(\&accept_connections);
+ if (!defined($thr)) {
+ Win32::Daemon::State(SERVICE_STOPPED);
+ Win32::Daemon::StopService();
+ return;
+ }
+ $thr->detach();
+
+ Win32::Daemon::State(SERVICE_RUNNING);
+ use strict;
+}
+
+################################################################################
+## SUB callback_stop
+## Windows service callback function for the stop event.
+################################################################################
+sub callback_stop {
+ no strict;
+
+ foreach my $t_server_socket (@t_server_sockets) {
+ $t_server_socket->close ();
+ }
+
+ Win32::Daemon::State(SERVICE_STOPPED);
+ Win32::Daemon::StopService();
+ use strict;
+}
+
+################################################################################
# Main
################################################################################
@@ -1444,25 +1526,16 @@
# Handle ctr-c
if ($^O eq 'MSWin32') {
+ no warnings;
$SIG{INT2} = \&stop_server;
+ use warnings;
}
else {
$SIG{INT} = \&stop_server;
}
-# Handle SIGCHLD
-$SIG{CHLD} = \&sigchld_handler;
-
-start_server ();
-
-# Initialize semaphore
-$t_sem = Thread::Semaphore->new ($t_max_conn);
-
# Accept connections
-while (1) {
- $t_sem->down ();
- accept_connection ();
-}
+accept_connections();
__END__
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-09-22 14:53:48
|
Revision: 37
http://sourceforge.net/p/tentacled/code/37
Author: junichi-satoh
Date: 2013-09-22 14:53:42 +0000 (Sun, 22 Sep 2013)
Log Message:
-----------
2013-09-22 Junichi Satoh <ju...@rw...>
* client/bin/tentacle_client: Added fallback to IPv4 when IPv6
connection is failure.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-09-22 14:34:19 UTC (rev 36)
+++ trunk/perl/ChangeLog 2013-09-22 14:53:42 UTC (rev 37)
@@ -1,5 +1,10 @@
2013-09-22 Junichi Satoh <ju...@rw...>
+ * client/bin/tentacle_client: Added fallback to IPv4 when IPv6
+ connection is failure.
+
+2013-09-22 Junichi Satoh <ju...@rw...>
+
* server/bin/tentacle_server: Added support for 'TCP Wrappers'.
When the 'Authen::Libwrap' is installed and -T option is specified,
this feature can be used.
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2013-09-22 14:34:19 UTC (rev 36)
+++ trunk/perl/client/bin/tentacle_client 2013-09-22 14:53:42 UTC (rev 37)
@@ -58,7 +58,7 @@
use File::Basename;
use Getopt::Std;
use IO::Select;
-use Socket (qw(SOCK_STREAM));
+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'
@@ -308,11 +308,22 @@
sub start_client {
# Connect to server
- $t_socket = $SOCKET_MODULE->new (
- PeerAddr => $t_address,
- PeerPort => $t_port,
- Type => SOCK_STREAM
- );
+ if ($SOCKET_MODULE ne 'IO::Socket::INET') {
+ $t_socket = $SOCKET_MODULE->new (
+ Domain => AF_INET6,
+ PeerAddr => $t_address,
+ PeerPort => $t_port,
+ Type => SOCK_STREAM
+ );
+ }
+ if (! defined ($t_socket)) {
+ $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: $!.");
@@ -332,10 +343,20 @@
sub start_client_proxy {
# Connect to proxy
- $t_socket = $SOCKET_MODULE->new (
- PeerAddr => $t_proxy_address,
- PeerPort => $t_proxy_port,
- );
+ if ($SOCKET_MODULE ne 'IO::Socket::INET') {
+ $t_socket = $SOCKET_MODULE->new (
+ Domain => AF_INET6,
+ PeerAddr => $t_proxy_address,
+ PeerPort => $t_proxy_port,
+ );
+ }
+ if (! defined ($t_socket)) {
+ $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: $!.");
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-09-22 14:34:25
|
Revision: 36
http://sourceforge.net/p/tentacled/code/36
Author: junichi-satoh
Date: 2013-09-22 14:34:19 +0000 (Sun, 22 Sep 2013)
Log Message:
-----------
2013-09-22 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Added support for 'TCP Wrappers'.
When the 'Authen::Libwrap' is installed and -T option is specified,
this feature can be used.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-06-04 00:54:22 UTC (rev 35)
+++ trunk/perl/ChangeLog 2013-09-22 14:34:19 UTC (rev 36)
@@ -1,3 +1,9 @@
+2013-09-22 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Added support for 'TCP Wrappers'.
+ When the 'Authen::Libwrap' is installed and -T option is specified,
+ this feature can be used.
+
2013-06-04 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Added support for IPv6 and improved
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2013-06-04 00:54:22 UTC (rev 35)
+++ trunk/perl/server/bin/tentacle_server 2013-09-22 14:34:19 UTC (rev 36)
@@ -63,6 +63,15 @@
use Thread::Semaphore;
use POSIX ":sys_wait_h";
+my $t_libwrap_installed = eval { require Authen::Libwrap } ? 1 : 0;
+
+if ($t_libwrap_installed) {
+ Authen::Libwrap->import( qw( hosts_ctl STRING_UNKNOWN ) );
+}
+
+# Log messages, 1 enabled, 0 disabled
+my $t_log = 0;
+
my $SOCKET_MODULE =
eval { require IO::Socket::INET6 } ? 'IO::Socket::INET6'
: eval { require IO::Socket::INET } ? 'IO::Socket::INET'
@@ -96,9 +105,6 @@
# String containing quoted invalid file name characters
my $t_invalid_chars = '\?\[\]\/\\\=\+\<\>\:\;\'\,\*\~';
-# Log messages, 1 enabled, 0 disabled
-my $t_log = 0;
-
# Maximum number of simultaneous connections
my $t_max_conn = 10;
@@ -160,6 +166,13 @@
# Proxy selected handler
my $t_proxy_select;
+# Use libwrap, 1 true, 0 false
+my $t_use_libwrap = 0;
+
+# Program name for libwrap
+my $t_program_name = $0;
+$t_program_name =~ s/.*\///g;
+
################################################################################
## SUB print_help
## Print help screen.
@@ -190,6 +203,8 @@
print ("\t-x pwd\t\tServer password.\n\n");
print ("\t-b proxy_ip_address\t\tProxied server address.\n\n");
print ("\t-g proxy_port\t\tPort of proxied server.\n\n");
+ print ("\t-T\t\tEnable tcpwrappers support.\n");
+ print ("\t\t(To use this option, 'Authen::Libwrap' should be installed.)\n\n");
}
################################################################################
@@ -256,7 +271,7 @@
my @t_addresses_tmp;
# Get options
- if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:', \%opts) == 0 || defined ($opts{'h'})) {
+ if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:T', \%opts) == 0 || defined ($opts{'h'})) {
print_help ();
exit 1;
}
@@ -443,6 +458,15 @@
error ("Proxy port $t_port is not valid.");
}
}
+
+ # TCP wrappers support
+ if (defined ($opts{'T'})) {
+ if ($t_libwrap_installed) {
+ $t_use_libwrap = 1;
+ } else {
+ error ("Authen::Libwrap is not installed.");
+ }
+ }
}
################################################################################
@@ -673,6 +697,15 @@
# We do not need the server socket
$t_server_socket->close ();
+
+ if ($t_use_libwrap) {
+ if (! hosts_ctl($t_program_name, $t_client_socket)) {
+ print_log ("Connection from " . $t_client_socket->sockhost() . " is closed by tcpwrappers.");
+ $t_client_socket->close ();
+
+ exit;
+ }
+ }
# Add client socket to select queue
$t_select = IO::Select->new ();
@@ -697,7 +730,7 @@
serve_connection ();
}
-
+
$t_client_socket->close ();
# Must exit now
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-06-04 00:54:32
|
Revision: 35
http://sourceforge.net/p/tentacled/code/35
Author: junichi-satoh
Date: 2013-06-04 00:54:22 +0000 (Tue, 04 Jun 2013)
Log Message:
-----------
2013-06-04 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Added support for IPv6 and improved
to be able to bind multiple interfaces and/or IP addresses.
Updated version.
* client/bin/tentacle_client: Added IPv6 support and updated version.
Merged from old repository, I commited by mistake.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2012-08-03 11:55:53 UTC (rev 34)
+++ trunk/perl/ChangeLog 2013-06-04 00:54:22 UTC (rev 35)
@@ -1,3 +1,13 @@
+2013-06-04 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Added support for IPv6 and improved
+ to be able to bind multiple interfaces and/or IP addresses.
+ Updated version.
+
+ * client/bin/tentacle_client: Added IPv6 support and updated version.
+
+ Merged from old repository, I commited by mistake.
+
2012-08-03 Ramon Novoa <rn...@ar...>
* client/bin/tentacle_client: Specify the socket type. On some OSs (like certain
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2012-08-03 11:55:53 UTC (rev 34)
+++ trunk/perl/client/bin/tentacle_client 2013-06-04 00:54:22 UTC (rev 35)
@@ -26,7 +26,7 @@
=head1 VERSION
-Version 0.3.0
+Version 0.4.0
=head1 USAGE
@@ -50,16 +50,26 @@
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;
-use IO::Socket::INET;
+use Socket (qw(SOCK_STREAM));
+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.3.0';
+our $VERSION = '0.4.0';
# Server address
my $t_address = '127.0.0.1';
@@ -164,9 +174,10 @@
# 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+)$/
+ 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)) {
+ || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) &&
+ ($t_address !~ /^[0-9a-f:]+$/o)) {
error ("Address $t_address is not valid.");
}
@@ -297,7 +308,7 @@
sub start_client {
# Connect to server
- $t_socket = IO::Socket::INET->new (
+ $t_socket = $SOCKET_MODULE->new (
PeerAddr => $t_address,
PeerPort => $t_port,
Type => SOCK_STREAM
@@ -321,7 +332,7 @@
sub start_client_proxy {
# Connect to proxy
- $t_socket = IO::Socket::INET->new (
+ $t_socket = $SOCKET_MODULE->new (
PeerAddr => $t_proxy_address,
PeerPort => $t_proxy_port,
);
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2012-08-03 11:55:53 UTC (rev 34)
+++ trunk/perl/server/bin/tentacle_server 2013-06-04 00:54:22 UTC (rev 35)
@@ -30,7 +30,7 @@
=head1 VERSION
-Version 0.3.0
+Version 0.4.0
=head1 USAGE
@@ -56,20 +56,27 @@
=cut
-
use strict;
use warnings;
use Getopt::Std;
use IO::Select;
-use IO::Socket::INET;
use Thread::Semaphore;
use POSIX ":sys_wait_h";
+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.3.0';
+our $VERSION = '0.4.0';
-# Address to listen on
-my $t_address = '0.0.0.0';
+# IPv4 address to listen on
+my @t_addresses = ('0', '0.0.0.0');
# Block size for socket read/write operations in bytes
my $t_block_size = 1024;
@@ -120,7 +127,8 @@
my $t_sem;
# Server socket
-my $t_server_socket;
+my @t_server_sockets;
+my $select;
# Use SSL, 1 true, 0 false
my $t_ssl = 0;
@@ -157,11 +165,13 @@
## Print help screen.
################################################################################
sub print_help {
+ $" = ',';
print ("Usage: $0 -s <storage directory> [options]\n\n");
print ("Tentacle server v$VERSION. See http://www.openideas.info/wiki for protocol description.\n\n");
print ("Options:\n");
- print ("\t-a ip_address\tAddress to listen on (default $t_address).\n");
+ print ("\t-a ip_addresses\tIP addresses to listen on (default @t_addresses).\n");
+ print ("\t\t(Multiple addresses separated by comma can be defined.)\n");
print ("\t-c number\tMaximum number of simultaneous connections (default $t_max_conn).\n");
print ("\t-d\t\tRun as daemon.\n");
print ("\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
@@ -243,6 +253,7 @@
sub parse_options {
my %opts;
my $tmp;
+ my @t_addresses_tmp;
# Get options
if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:', \%opts) == 0 || defined ($opts{'h'})) {
@@ -252,11 +263,19 @@
# Address
if (defined ($opts{'a'})) {
- $t_address = $opts{'a'};
- if ($t_address !~ /^[a-zA-Z\.]+$/ && ($t_address !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
- || $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
- error ("Address $t_address is not valid.");
+ @t_addresses = ();
+ @t_addresses_tmp = split(/,/, $opts{'a'});
+
+ foreach my $t_address (@t_addresses_tmp) {
+ $t_address =~ s/^ *(.*?) *$/$1/;
+ if (($t_address ne '0') &&
+ ($t_address !~ /^[a-zA-Z\.]+$/ && ($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.");
+ }
+ push @t_addresses, $t_address;
}
}
@@ -411,7 +430,8 @@
$t_proxy_ip = $opts{'b'};
if ($t_proxy_ip !~ /^[a-zA-Z\.]+$/ && ($t_proxy_ip !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
|| $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
+ || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255) &&
+ $t_proxy_ip !~ /^[0-9a-f:]+$/o) {
error ("Proxy address $t_proxy_ip is not valid.");
}
}
@@ -445,7 +465,7 @@
sub open_proxy {
# Connect to server
- $t_proxy_socket = IO::Socket::INET->new (
+ $t_proxy_socket = $SOCKET_MODULE->new (
PeerAddr => $t_proxy_ip,
PeerPort => $t_proxy_port,
);
@@ -466,25 +486,41 @@
################################################################################
sub start_server {
- $t_server_socket = IO::Socket::INET->new (
- Listen => $t_max_conn,
- LocalAddr => $t_address,
- LocalPort => $t_port,
- Proto => 'tcp',
- ReuseAddr => 1,
- );
+ my $t_server_socket;
- if (! defined ($t_server_socket)) {
- error ("Cannot open socket for address $t_address on port $t_port: $!.");
- }
+ foreach my $t_address (@t_addresses) {
- print_log ("Server listening on $t_address port $t_port (press <ctr-c> to stop)");
+ $t_server_socket = $SOCKET_MODULE->new (
+ Listen => $t_max_conn,
+ LocalAddr => $t_address,
+ LocalPort => $t_port,
+ Proto => 'tcp',
+ ReuseAddr => 1,
+ );
+
+ if (! defined ($t_server_socket)) {
+ print_log ("Cannot open socket for address $t_address on port $t_port: $!.");
+ next;
+ }
+
+ print_log ("Server listening on $t_address port $t_port (press <ctr-c> to stop)");
- # Say message if tentacle proxy is enable
- if (defined ($t_proxy_ip)) {
- print_log ("Proxy Mode enable, data will be sent to $t_proxy_ip port $t_proxy_port");
+ # Say message if tentacle proxy is enable
+ if (defined ($t_proxy_ip)) {
+ print_log ("Proxy Mode enable, data will be sent to $t_proxy_ip port $t_proxy_port");
+ }
+
+ push @t_server_sockets, $t_server_socket;
}
+ if (!@t_server_sockets) {
+ error ("Cannot open socket for all addresses on port $t_port: $!.");
+ }
+
+ $select = IO::Select->new();
+ foreach my $t_server_socket (@t_server_sockets){
+ $select->add($t_server_socket);
+ }
}
################################################################################
@@ -516,19 +552,22 @@
if ($written == 0) {
error ("Connection from " . $t_proxy_socket->sockhost () . " unexpectedly closed.");
}
+
+ }
- $total += $written;
+ $total += $written;
- # Check if all data was written
- if ($total == $size) {
- return;
- }
+ # Check if all data was written
+ if ($total == $size) {
+ return;
+ }
+
# Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
- }
+ $retries++;
+
+ # But check for error conditions first
+ if ($retries > $t_retries) {
+ error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
}
}
}
@@ -548,8 +587,10 @@
## Close the server socket.
################################################################################
sub stop_server {
-
- $t_server_socket->close ();
+
+ foreach my $t_server_socket (@t_server_sockets) {
+ $t_server_socket->close ();
+ }
print_log ("Server going down");
exit 0;
@@ -600,9 +641,12 @@
################################################################################
sub accept_connection {
my $pid;
+ my $t_server_socket;
- while (1) {
+ my @ready = $select->can_read;
+ foreach $t_server_socket (@ready) {
+
# Accept connection
$t_client_socket = $t_server_socket->accept ();
@@ -616,55 +660,54 @@
error ("accept: $!.");
}
- last;
- }
+ print_log ("Client connected from " . $t_client_socket->sockhost ());
- print_log ("Client connected from " . $t_client_socket->sockhost ());
-
- # Fork and serve the client
- $pid = fork ();
- if (! defined ($pid)) {
- error ("Cannot fork: $!.");
- }
+ # Fork and serve the client
+ $pid = fork ();
+ if (! defined ($pid)) {
+ error ("Cannot fork: $!.");
+ }
- # Child
- if ($pid == 0) {
+ # Child
+ if ($pid == 0) {
- # We do not need the server socket
- $t_server_socket->close ();
+ # We do not need the server socket
+ $t_server_socket->close ();
- # Add client socket to select queue
- $t_select = IO::Select->new ();
- $t_select->add ($t_client_socket);
+ # Add client socket to select queue
+ $t_select = IO::Select->new ();
+ $t_select->add ($t_client_socket);
- # Start SSL
- if ($t_ssl == 1) {
- start_ssl ();
- }
+ # Start SSL
+ if ($t_ssl == 1) {
+ start_ssl ();
+ }
- # Authenticate client
- if ($t_pwd ne '') {
- auth_pwd ();
- }
+ # Authenticate client
+ if ($t_pwd ne '') {
+ auth_pwd ();
+ }
- # Check if proxy mode is enable
- if (defined ($t_proxy_ip)) {
+ # Check if proxy mode is enable
+ if (defined ($t_proxy_ip)) {
- serve_proxy_connection ();
+ serve_proxy_connection ();
- } else {
+ } else {
- serve_connection ();
+ serve_connection ();
+ }
+
+ $t_client_socket->close ();
+
+ # Must exit now
+ exit;
}
-
+
+ # Parent
$t_client_socket->close ();
- # Must exit now
- exit;
}
-
- # Parent
- $t_client_socket->close ();
}
################################################################################
@@ -1086,20 +1129,22 @@
if ($written == 0) {
error ("Connection from " . $t_client_socket->sockhost () . " unexpectedly closed.");
}
+
+ }
- $total += $written;
+ $total += $written;
- # Check if all data was written
- if ($total == $size) {
- return;
- }
-
+ # Check if all data was written
+ if ($total == $size) {
+ return;
+ }
+
# Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
- }
+ $retries++;
+
+ # But check for error conditions first
+ if ($retries > $t_retries) {
+ error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
}
}
}
@@ -1354,6 +1399,11 @@
exit 1;
}
+# Show IPv6 status
+if ($SOCKET_MODULE eq 'IO::Socket::INET') {
+ print_log ("IO::Socket::INET6 is not found. IPv6 is disabled.");
+}
+
# Run as daemon?
if ($t_daemon == 1 && $^O ne 'MSWin32') {
daemonize ();
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-03-21 13:21:27
|
Revision: 38
http://tentacled.svn.sourceforge.net/tentacled/?rev=38&view=rev
Author: junichi-satoh
Date: 2013-03-21 13:21:20 +0000 (Thu, 21 Mar 2013)
Log Message:
-----------
2013-03-21 Junichi Satoh <ju...@rw...>
* client/bin/tentacle_client: Improved to fallback to IPv4 connection,
when tentacle_server has both IPv6 and IPv4 addresses and listens
IPv4 only.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-02-07 05:49:28 UTC (rev 37)
+++ trunk/perl/ChangeLog 2013-03-21 13:21:20 UTC (rev 38)
@@ -1,3 +1,9 @@
+2013-03-21 Junichi Satoh <ju...@rw...>
+
+ * client/bin/tentacle_client: Improved to fallback to IPv4 connection,
+ when tentacle_server has both IPv6 and IPv4 addresses and listens
+ IPv4 only.
+
2013-02-07 Junichi Satoh <ju...@rw...>
* client/bin/tentacle_client: Added IPv6 support and updated version.
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2013-02-07 05:49:28 UTC (rev 37)
+++ trunk/perl/client/bin/tentacle_client 2013-03-21 13:21:20 UTC (rev 38)
@@ -58,7 +58,7 @@
use File::Basename;
use Getopt::Std;
use IO::Select;
-use Socket (qw(SOCK_STREAM));
+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'
@@ -308,11 +308,22 @@
sub start_client {
# Connect to server
- $t_socket = $SOCKET_MODULE->new (
- PeerAddr => $t_address,
- PeerPort => $t_port,
- Type => SOCK_STREAM
- );
+ if ($SOCKET_MODULE ne 'IO::Socket::INET') {
+ $t_socket = $SOCKET_MODULE->new (
+ Domain => AF_INET6,
+ PeerAddr => $t_address,
+ PeerPort => $t_port,
+ Type => SOCK_STREAM
+ );
+ }
+ if (! defined ($t_socket)) {
+ $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: $!.");
@@ -332,10 +343,20 @@
sub start_client_proxy {
# Connect to proxy
- $t_socket = $SOCKET_MODULE->new (
- PeerAddr => $t_proxy_address,
- PeerPort => $t_proxy_port,
- );
+ if ($SOCKET_MODULE ne 'IO::Socket::INET') {
+ $t_socket = $SOCKET_MODULE->new (
+ Domain => AF_INET6,
+ PeerAddr => $t_proxy_address,
+ PeerPort => $t_proxy_port,
+ );
+ }
+ if (! defined ($t_socket)) {
+ $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: $!.");
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-02-07 05:49:47
|
Revision: 37
http://tentacled.svn.sourceforge.net/tentacled/?rev=37&view=rev
Author: junichi-satoh
Date: 2013-02-07 05:49:28 +0000 (Thu, 07 Feb 2013)
Log Message:
-----------
2013-02-07 Junichi Satoh <ju...@rw...>
* client/bin/tentacle_client: Added IPv6 support and updated version.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/client/bin/tentacle_client
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-01-28 07:32:47 UTC (rev 36)
+++ trunk/perl/ChangeLog 2013-02-07 05:49:28 UTC (rev 37)
@@ -1,3 +1,7 @@
+2013-02-07 Junichi Satoh <ju...@rw...>
+
+ * client/bin/tentacle_client: Added IPv6 support and updated version.
+
2013-01-28 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Updated version.
Modified: trunk/perl/client/bin/tentacle_client
===================================================================
--- trunk/perl/client/bin/tentacle_client 2013-01-28 07:32:47 UTC (rev 36)
+++ trunk/perl/client/bin/tentacle_client 2013-02-07 05:49:28 UTC (rev 37)
@@ -26,7 +26,7 @@
=head1 VERSION
-Version 0.3.0
+Version 0.4.0
=head1 USAGE
@@ -50,16 +50,26 @@
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;
-use IO::Socket::INET;
+use Socket (qw(SOCK_STREAM));
+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.3.0';
+our $VERSION = '0.4.0';
# Server address
my $t_address = '127.0.0.1';
@@ -164,9 +174,10 @@
# 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+)$/
+ 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)) {
+ || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) &&
+ ($t_address !~ /^[0-9a-f:]+$/o)) {
error ("Address $t_address is not valid.");
}
@@ -297,7 +308,7 @@
sub start_client {
# Connect to server
- $t_socket = IO::Socket::INET->new (
+ $t_socket = $SOCKET_MODULE->new (
PeerAddr => $t_address,
PeerPort => $t_port,
Type => SOCK_STREAM
@@ -321,7 +332,7 @@
sub start_client_proxy {
# Connect to proxy
- $t_socket = IO::Socket::INET->new (
+ $t_socket = $SOCKET_MODULE->new (
PeerAddr => $t_proxy_address,
PeerPort => $t_proxy_port,
);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-01-28 07:32:55
|
Revision: 36
http://tentacled.svn.sourceforge.net/tentacled/?rev=36&view=rev
Author: junichi-satoh
Date: 2013-01-28 07:32:47 +0000 (Mon, 28 Jan 2013)
Log Message:
-----------
2013-01-28 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Updated version.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2013-01-25 05:29:50 UTC (rev 35)
+++ trunk/perl/ChangeLog 2013-01-28 07:32:47 UTC (rev 36)
@@ -1,3 +1,7 @@
+2013-01-28 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Updated version.
+
2013-01-25 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Added support for IPv6 and improved
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2013-01-25 05:29:50 UTC (rev 35)
+++ trunk/perl/server/bin/tentacle_server 2013-01-28 07:32:47 UTC (rev 36)
@@ -30,7 +30,7 @@
=head1 VERSION
-Version 0.3.0
+Version 0.4.0
=head1 USAGE
@@ -73,7 +73,7 @@
}
# Program version
-our $VERSION = '0.3.0';
+our $VERSION = '0.4.0';
# IPv4 address to listen on
my @t_addresses = ('0', '0.0.0.0');
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jun...@us...> - 2013-01-25 05:30:00
|
Revision: 35
http://tentacled.svn.sourceforge.net/tentacled/?rev=35&view=rev
Author: junichi-satoh
Date: 2013-01-25 05:29:50 +0000 (Fri, 25 Jan 2013)
Log Message:
-----------
2013-01-25 Junichi Satoh <ju...@rw...>
* server/bin/tentacle_server: Added support for IPv6 and improved
to be able to bind multiple interfaces and/or IP addresses.
Modified Paths:
--------------
trunk/perl/ChangeLog
trunk/perl/server/bin/tentacle_server
Modified: trunk/perl/ChangeLog
===================================================================
--- trunk/perl/ChangeLog 2012-08-03 11:55:53 UTC (rev 34)
+++ trunk/perl/ChangeLog 2013-01-25 05:29:50 UTC (rev 35)
@@ -1,3 +1,8 @@
+2013-01-25 Junichi Satoh <ju...@rw...>
+
+ * server/bin/tentacle_server: Added support for IPv6 and improved
+ to be able to bind multiple interfaces and/or IP addresses.
+
2012-08-03 Ramon Novoa <rn...@ar...>
* client/bin/tentacle_client: Specify the socket type. On some OSs (like certain
Modified: trunk/perl/server/bin/tentacle_server
===================================================================
--- trunk/perl/server/bin/tentacle_server 2012-08-03 11:55:53 UTC (rev 34)
+++ trunk/perl/server/bin/tentacle_server 2013-01-25 05:29:50 UTC (rev 35)
@@ -56,20 +56,27 @@
=cut
-
use strict;
use warnings;
use Getopt::Std;
use IO::Select;
-use IO::Socket::INET;
use Thread::Semaphore;
use POSIX ":sys_wait_h";
+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.3.0';
-# Address to listen on
-my $t_address = '0.0.0.0';
+# IPv4 address to listen on
+my @t_addresses = ('0', '0.0.0.0');
# Block size for socket read/write operations in bytes
my $t_block_size = 1024;
@@ -120,7 +127,8 @@
my $t_sem;
# Server socket
-my $t_server_socket;
+my @t_server_sockets;
+my $select;
# Use SSL, 1 true, 0 false
my $t_ssl = 0;
@@ -157,11 +165,13 @@
## Print help screen.
################################################################################
sub print_help {
+ $" = ',';
print ("Usage: $0 -s <storage directory> [options]\n\n");
print ("Tentacle server v$VERSION. See http://www.openideas.info/wiki for protocol description.\n\n");
print ("Options:\n");
- print ("\t-a ip_address\tAddress to listen on (default $t_address).\n");
+ print ("\t-a ip_addresses\tIP addresses to listen on (default @t_addresses).\n");
+ print ("\t\t(Multiple addresses separated by comma can be defined.)\n");
print ("\t-c number\tMaximum number of simultaneous connections (default $t_max_conn).\n");
print ("\t-d\t\tRun as daemon.\n");
print ("\t-e cert\t\tOpenSSL certificate file. Enables SSL.\n");
@@ -243,6 +253,7 @@
sub parse_options {
my %opts;
my $tmp;
+ my @t_addresses_tmp;
# Get options
if (getopts ('a:c:de:f:hi:k:m:op:qr:s:t:vwx:b:g:', \%opts) == 0 || defined ($opts{'h'})) {
@@ -252,11 +263,19 @@
# Address
if (defined ($opts{'a'})) {
- $t_address = $opts{'a'};
- if ($t_address !~ /^[a-zA-Z\.]+$/ && ($t_address !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
- || $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
- error ("Address $t_address is not valid.");
+ @t_addresses = ();
+ @t_addresses_tmp = split(/,/, $opts{'a'});
+
+ foreach my $t_address (@t_addresses_tmp) {
+ $t_address =~ s/^ *(.*?) *$/$1/;
+ if (($t_address ne '0') &&
+ ($t_address !~ /^[a-zA-Z\.]+$/ && ($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.");
+ }
+ push @t_addresses, $t_address;
}
}
@@ -411,7 +430,8 @@
$t_proxy_ip = $opts{'b'};
if ($t_proxy_ip !~ /^[a-zA-Z\.]+$/ && ($t_proxy_ip !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/
|| $1 < 0 || $1 > 255 || $2 < 0 || $2 > 255
- || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255)) {
+ || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255) &&
+ $t_proxy_ip !~ /^[0-9a-f:]+$/o) {
error ("Proxy address $t_proxy_ip is not valid.");
}
}
@@ -445,7 +465,7 @@
sub open_proxy {
# Connect to server
- $t_proxy_socket = IO::Socket::INET->new (
+ $t_proxy_socket = $SOCKET_MODULE->new (
PeerAddr => $t_proxy_ip,
PeerPort => $t_proxy_port,
);
@@ -466,25 +486,41 @@
################################################################################
sub start_server {
- $t_server_socket = IO::Socket::INET->new (
- Listen => $t_max_conn,
- LocalAddr => $t_address,
- LocalPort => $t_port,
- Proto => 'tcp',
- ReuseAddr => 1,
- );
+ my $t_server_socket;
- if (! defined ($t_server_socket)) {
- error ("Cannot open socket for address $t_address on port $t_port: $!.");
- }
+ foreach my $t_address (@t_addresses) {
- print_log ("Server listening on $t_address port $t_port (press <ctr-c> to stop)");
+ $t_server_socket = $SOCKET_MODULE->new (
+ Listen => $t_max_conn,
+ LocalAddr => $t_address,
+ LocalPort => $t_port,
+ Proto => 'tcp',
+ ReuseAddr => 1,
+ );
+
+ if (! defined ($t_server_socket)) {
+ print_log ("Cannot open socket for address $t_address on port $t_port: $!.");
+ next;
+ }
+
+ print_log ("Server listening on $t_address port $t_port (press <ctr-c> to stop)");
- # Say message if tentacle proxy is enable
- if (defined ($t_proxy_ip)) {
- print_log ("Proxy Mode enable, data will be sent to $t_proxy_ip port $t_proxy_port");
+ # Say message if tentacle proxy is enable
+ if (defined ($t_proxy_ip)) {
+ print_log ("Proxy Mode enable, data will be sent to $t_proxy_ip port $t_proxy_port");
+ }
+
+ push @t_server_sockets, $t_server_socket;
}
+ if (!@t_server_sockets) {
+ error ("Cannot open socket for all addresses on port $t_port: $!.");
+ }
+
+ $select = IO::Select->new();
+ foreach my $t_server_socket (@t_server_sockets){
+ $select->add($t_server_socket);
+ }
}
################################################################################
@@ -516,19 +552,22 @@
if ($written == 0) {
error ("Connection from " . $t_proxy_socket->sockhost () . " unexpectedly closed.");
}
+
+ }
- $total += $written;
+ $total += $written;
- # Check if all data was written
- if ($total == $size) {
- return;
- }
+ # Check if all data was written
+ if ($total == $size) {
+ return;
+ }
+
# Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
- }
+ $retries++;
+
+ # But check for error conditions first
+ if ($retries > $t_retries) {
+ error ("Connection from " . $t_proxy_socket->sockhost () . " timed out.");
}
}
}
@@ -548,8 +587,10 @@
## Close the server socket.
################################################################################
sub stop_server {
-
- $t_server_socket->close ();
+
+ foreach my $t_server_socket (@t_server_sockets) {
+ $t_server_socket->close ();
+ }
print_log ("Server going down");
exit 0;
@@ -600,9 +641,12 @@
################################################################################
sub accept_connection {
my $pid;
+ my $t_server_socket;
- while (1) {
+ my @ready = $select->can_read;
+ foreach $t_server_socket (@ready) {
+
# Accept connection
$t_client_socket = $t_server_socket->accept ();
@@ -616,55 +660,54 @@
error ("accept: $!.");
}
- last;
- }
+ print_log ("Client connected from " . $t_client_socket->sockhost ());
- print_log ("Client connected from " . $t_client_socket->sockhost ());
-
- # Fork and serve the client
- $pid = fork ();
- if (! defined ($pid)) {
- error ("Cannot fork: $!.");
- }
+ # Fork and serve the client
+ $pid = fork ();
+ if (! defined ($pid)) {
+ error ("Cannot fork: $!.");
+ }
- # Child
- if ($pid == 0) {
+ # Child
+ if ($pid == 0) {
- # We do not need the server socket
- $t_server_socket->close ();
+ # We do not need the server socket
+ $t_server_socket->close ();
- # Add client socket to select queue
- $t_select = IO::Select->new ();
- $t_select->add ($t_client_socket);
+ # Add client socket to select queue
+ $t_select = IO::Select->new ();
+ $t_select->add ($t_client_socket);
- # Start SSL
- if ($t_ssl == 1) {
- start_ssl ();
- }
+ # Start SSL
+ if ($t_ssl == 1) {
+ start_ssl ();
+ }
- # Authenticate client
- if ($t_pwd ne '') {
- auth_pwd ();
- }
+ # Authenticate client
+ if ($t_pwd ne '') {
+ auth_pwd ();
+ }
- # Check if proxy mode is enable
- if (defined ($t_proxy_ip)) {
+ # Check if proxy mode is enable
+ if (defined ($t_proxy_ip)) {
- serve_proxy_connection ();
+ serve_proxy_connection ();
- } else {
+ } else {
- serve_connection ();
+ serve_connection ();
+ }
+
+ $t_client_socket->close ();
+
+ # Must exit now
+ exit;
}
-
+
+ # Parent
$t_client_socket->close ();
- # Must exit now
- exit;
}
-
- # Parent
- $t_client_socket->close ();
}
################################################################################
@@ -1086,20 +1129,22 @@
if ($written == 0) {
error ("Connection from " . $t_client_socket->sockhost () . " unexpectedly closed.");
}
+
+ }
- $total += $written;
+ $total += $written;
- # Check if all data was written
- if ($total == $size) {
- return;
- }
-
+ # Check if all data was written
+ if ($total == $size) {
+ return;
+ }
+
# Retry
- } else {
- $retries++;
- if ($retries > $t_retries) {
- error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
- }
+ $retries++;
+
+ # But check for error conditions first
+ if ($retries > $t_retries) {
+ error ("Connection from " . $t_client_socket->sockhost () . " timed out.");
}
}
}
@@ -1354,6 +1399,11 @@
exit 1;
}
+# Show IPv6 status
+if ($SOCKET_MODULE eq 'IO::Socket::INET') {
+ print_log ("IO::Socket::INET6 is not found. IPv6 is disabled.");
+}
+
# Run as daemon?
if ($t_daemon == 1 && $^O ne 'MSWin32') {
daemonize ();
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
