You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by ro...@apache.org on 2015/07/30 14:20:24 UTC
thrift git commit: THRIFT-3053: Added perl SSL Socket support,
split SSLSocket and SSLServerSocket out from their base classes,
fixed THRIFT-3191 generated perl compiler exception handling code,
added perl to make cross, fixed THRIFT-3189 allowing perl t
Repository: thrift
Updated Branches:
refs/heads/master 4a1e8867a -> f5f1b35a7
THRIFT-3053: Added perl SSL Socket support, split SSLSocket and SSLServerSocket out from their base classes, fixed THRIFT-3191 generated perl compiler exception handling code, added perl to make cross, fixed THRIFT-3189 allowing perl to listen on a specific interface through construction arguments. Did not add support in the perl client SSLSocket to verify server certificate authenticity at this time.
Project: http://git-wip-us.apache.org/repos/asf/thrift/repo
Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/f5f1b35a
Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/f5f1b35a
Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/f5f1b35a
Branch: refs/heads/master
Commit: f5f1b35a7d1ce819bdfdc966741399605b051c92
Parents: 4a1e886
Author: Jim King <ji...@simplivity.com>
Authored: Wed Jun 24 13:47:24 2015 -0400
Committer: Roger Meier <ro...@apache.org>
Committed: Thu Jul 30 14:19:49 2015 +0200
----------------------------------------------------------------------
build/travis/installDependencies.sh | 2 +-
compiler/cpp/src/generate/t_perl_generator.cc | 36 +-
lib/perl/README.md | 18 +-
lib/perl/lib/Thrift.pm | 2 +-
lib/perl/lib/Thrift/FramedTransport.pm | 27 ++
lib/perl/lib/Thrift/SSLServerSocket.pm | 68 ++++
lib/perl/lib/Thrift/SSLSocket.pm | 89 +++++
lib/perl/lib/Thrift/Server.pm | 4 +-
lib/perl/lib/Thrift/ServerSocket.pm | 117 +++++++
lib/perl/lib/Thrift/Socket.pm | 175 +++++-----
test/known_failures_Linux.json | 4 +
test/perl/TestClient.pl | 85 ++++-
test/perl/TestServer.pl | 380 +++++++++++++++++++++
test/tests.json | 33 +-
14 files changed, 900 insertions(+), 140 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/build/travis/installDependencies.sh
----------------------------------------------------------------------
diff --git a/build/travis/installDependencies.sh b/build/travis/installDependencies.sh
index dd92568..5b74140 100755
--- a/build/travis/installDependencies.sh
+++ b/build/travis/installDependencies.sh
@@ -37,7 +37,7 @@ sudo apt-get install -qq ruby ruby-dev
sudo gem install bundler rake
# Perl dependencies
-sudo apt-get install -qq libbit-vector-perl libclass-accessor-class-perl
+sudo apt-get install -qq libbit-vector-perl libclass-accessor-class-perl libio-socket-ssl-perl libnet-ssleay-perl libcrypt-ssleay-perl
# Php dependencies
sudo apt-get install -qq php5 php5-dev php5-cli php-pear re2c
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/compiler/cpp/src/generate/t_perl_generator.cc
----------------------------------------------------------------------
diff --git a/compiler/cpp/src/generate/t_perl_generator.cc b/compiler/cpp/src/generate/t_perl_generator.cc
index 6c823c0..5f52c24 100644
--- a/compiler/cpp/src/generate/t_perl_generator.cc
+++ b/compiler/cpp/src/generate/t_perl_generator.cc
@@ -805,14 +805,27 @@ void t_perl_generator::generate_process_function(t_service* tservice, t_function
<< perl_namespace((*x_iter)->get_type()->get_program())
<< (*x_iter)->get_type()->get_name() << "') ){ " << endl;
- if (!tfunction->is_oneway()) {
- indent_up();
- f_service_ << indent() << "$result->{" << (*x_iter)->get_name() << "} = $@;" << endl;
- indent_down();
- f_service_ << indent();
- }
+ indent_up();
+ f_service_ << indent() << "$result->{" << (*x_iter)->get_name() << "} = $@;" << endl;
+ f_service_ << indent() << "$@ = undef;" << endl;
+ indent_down();
+ f_service_ << indent();
}
f_service_ << "}" << endl;
+
+ // catch-all for unexpected exceptions (THRIFT-3191)
+ f_service_ << indent() << "if ($@) {" << endl;
+ indent_up();
+ f_service_ << indent() << "$@ =~ s/^\\s+|\\s+$//g;" << endl
+ << indent() << "my $err = new TApplicationException(\"Unexpected Exception: \" . $@, TApplicationException::INTERNAL_ERROR);" << endl
+ << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', TMessageType::EXCEPTION, $seqid);" << endl
+ << indent() << "$err->write($output);" << endl
+ << indent() << "$output->writeMessageEnd();" << endl
+ << indent() << "$output->getTransport()->flush();" << endl
+ << indent() << "$@ = undef;" << endl
+ << indent() << "return;" << endl;
+ indent_down();
+ f_service_ << indent() << "}" << endl;
}
// Shortcut out here for oneway functions
@@ -822,11 +835,12 @@ void t_perl_generator::generate_process_function(t_service* tservice, t_function
f_service_ << "}" << endl;
return;
}
- // Serialize the request header
- f_service_ << indent() << "$output->writeMessageBegin('" << tfunction->get_name()
- << "', TMessageType::REPLY, $seqid);" << endl << indent() << "$result->write($output);"
- << endl << indent() << "$output->writeMessageEnd();" << endl << indent()
- << "$output->getTransport()->flush();" << endl;
+
+ // Serialize the reply
+ f_service_ << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', TMessageType::REPLY, $seqid);" << endl
+ << indent() << "$result->write($output);" << endl
+ << indent() << "$output->writeMessageEnd();" << endl
+ << indent() << "$output->getTransport()->flush();" << endl;
// Close function
indent_down();
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/README.md
----------------------------------------------------------------------
diff --git a/lib/perl/README.md b/lib/perl/README.md
index c48ce25..51247e0 100644
--- a/lib/perl/README.md
+++ b/lib/perl/README.md
@@ -25,17 +25,21 @@ Using Thrift with Perl
Thrift requires Perl >= 5.6.0
-Exceptions are thrown with die so be sure to wrap eval{} statments
-around any code that contains exceptions.
+Unexpected exceptions in a service handler are converted to
+TApplicationException with type INTERNAL ERROR and the string
+of the exception is delivered as the message.
-The 64bit Integers work only up to 2^42 on my machine :-?
-Math::BigInt is probably needed.
+On the client side, exceptions are thrown with die, so be sure
+to wrap eval{} statments around any code that contains exceptions.
-Please see tutoral and test dirs for examples...
+Please see tutoral and test dirs for examples.
Dependencies
============
-Bit::Vector - comes with modern perl installations.
+Bit::Vector - comes with modern perl installations.
Class::Accessor
-
+IO::Socket::INET - comes with modern perl installations.
+IO::Socket::SSL - required if using SSL/TLS.
+NET::SSLeay
+Crypt::SSLeay - for make cross
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift.pm b/lib/perl/lib/Thrift.pm
index 67186f2..06e110b 100644
--- a/lib/perl/lib/Thrift.pm
+++ b/lib/perl/lib/Thrift.pm
@@ -84,7 +84,7 @@ use constant UNSUPPORTED_CLIENT_TYPE => 10;
sub new {
my $classname = shift;
- my $self = $classname->SUPER::new();
+ my $self = $classname->SUPER::new(@_);
return bless($self,$classname);
}
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/FramedTransport.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/FramedTransport.pm b/lib/perl/lib/Thrift/FramedTransport.pm
index e8e85dc..6f2d2cf 100644
--- a/lib/perl/lib/Thrift/FramedTransport.pm
+++ b/lib/perl/lib/Thrift/FramedTransport.pm
@@ -163,4 +163,31 @@ sub flush
}
+#
+# FramedTransport factory creates framed transport objects from transports
+#
+package Thrift::FramedTransportFactory;
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ return bless($self, $classname);
+}
+
+#
+# Build a framed transport from the base transport
+#
+# @return Thrift::FramedTransport transport
+#
+sub getTransport
+{
+ my $self = shift;
+ my $trans = shift;
+
+ my $buffered = Thrift::FramedTransport->new($trans);
+ return $buffered;
+}
+
+
1;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/SSLServerSocket.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/SSLServerSocket.pm b/lib/perl/lib/Thrift/SSLServerSocket.pm
new file mode 100644
index 0000000..2efdfff
--- /dev/null
+++ b/lib/perl/lib/Thrift/SSLServerSocket.pm
@@ -0,0 +1,68 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::SSLSocket;
+
+use IO::Socket::SSL;
+use IO::Select;
+
+package Thrift::SSLServerSocket;
+
+use base qw( Thrift::ServerSocket );
+
+#
+# Constructor.
+# Takes a hash:
+# See Thirft::Socket for base class parameters.
+# @param[in] ca certificate authority filename - not required
+# @param[in] cert certificate filename; may contain key in which case key is not required
+# @param[in] key private key filename for the certificate if it is not inside the cert file
+#
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new(@_);
+ return bless($self, $classname);
+}
+
+sub __client
+{
+ return new Thrift::SSLSocket();
+}
+
+sub __listen
+{
+ my $self = shift;
+ return IO::Socket::SSL->new(LocalAddr => $self->{host},
+ LocalPort => $self->{port},
+ Proto => 'tcp',
+ Listen => $self->{queue},
+ ReuseAddr => 1,
+ SSL_cert_file => $self->{cert},
+ SSL_key_file => $self->{key},
+ SSL_ca_file => $self->{ca});
+}
+
+
+1;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/SSLSocket.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/SSLSocket.pm b/lib/perl/lib/Thrift/SSLSocket.pm
new file mode 100644
index 0000000..b70d46f
--- /dev/null
+++ b/lib/perl/lib/Thrift/SSLSocket.pm
@@ -0,0 +1,89 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Transport;
+
+use IO::Socket::SSL;
+use IO::Select;
+
+package Thrift::SSLSocket;
+
+# TODO: Does not provide cipher selection or authentication hooks yet.
+
+use base qw( Thrift::Socket );
+
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new(@_);
+
+ return bless($self, $classname);
+}
+
+sub __open
+{
+ my $self = shift;
+ return IO::Socket::SSL->new(PeerAddr => $self->{host},
+ PeerPort => $self->{port},
+ Proto => 'tcp',
+ Timeout => $self->{sendTimeout} / 1000);
+}
+
+sub __close
+{
+ my $self = shift;
+ my $sock = ($self->{handle}->handles())[0];
+ $sock->close(SSL_no_shutdown => 1);
+}
+
+sub __recv
+{
+ my $self = shift;
+ my $sock = shift;
+ my $len = shift;
+ my $buf = undef;
+ sysread($sock, $buf, $len);
+ return $buf;
+}
+
+sub __send
+{
+ my $self = shift;
+ my $sock = shift;
+ my $buf = shift;
+ return syswrite($sock, $buf);
+}
+
+sub __wait
+{
+ my $self = shift;
+ my $sock = ($self->{handle}->handles())[0];
+ if ($sock->pending() eq 0) {
+ return $self->SUPER::__wait();
+ }
+ return $sock;
+}
+
+
+1;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/Server.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/Server.pm b/lib/perl/lib/Thrift/Server.pm
index 960fbd1..97e6620 100644
--- a/lib/perl/lib/Thrift/Server.pm
+++ b/lib/perl/lib/Thrift/Server.pm
@@ -115,8 +115,8 @@ sub _handleException
my $out = $code . ':' . $message;
$message =~ m/TTransportException/ and die $out;
- if ($message =~ m/TSocket/) {
- # suppress TSocket messages
+ if ($message =~ m/Socket/) {
+ # suppress Socket messages
} else {
warn $out;
}
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/ServerSocket.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/ServerSocket.pm b/lib/perl/lib/Thrift/ServerSocket.pm
new file mode 100644
index 0000000..a41b319
--- /dev/null
+++ b/lib/perl/lib/Thrift/ServerSocket.pm
@@ -0,0 +1,117 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use IO::Select;
+use Thrift;
+use Thrift::Socket;
+
+package Thrift::ServerSocket;
+
+use base qw( Thrift::ServerTransport );
+
+#
+# Constructor.
+# Legacy construction takes one argument, port number.
+# New construction takes a hash:
+# @param[in] host host interface to listen on (undef = all interfaces)
+# @param[in] port port number to listen on (required)
+# @param[in] queue the listen queue size (default if not specified is 128)
+# @example my $serversock = new Thrift::ServerSocket(host => undef, port => port)
+#
+sub new
+{
+ my $classname = shift;
+ my $args = shift;
+ my $self;
+
+ # Support both old-style "port number" construction and newer...
+ if (ref($args) eq 'HASH') {
+ $self = $args;
+ } else {
+ $self = { port => $args };
+ }
+
+ if (not defined $self->{port}) {
+ die("port number not specified");
+ }
+ if (not defined $self->{queue}) {
+ $self->{queue} = 128;
+ }
+
+ return bless($self, $classname);
+}
+
+sub listen
+{
+ my $self = shift;
+
+ my $sock = $self->__listen() || do {
+ my $error = ref($self) . ': Could not bind to ' . '*:' . $self->{port} . ' (' . $! . ')';
+
+ if ($self->{debug}) {
+ $self->{debugHandler}->($error);
+ }
+
+ die new Thrift::TException($error);
+ };
+
+ $self->{handle} = $sock;
+}
+
+sub accept
+{
+ my $self = shift;
+
+ if ( exists $self->{handle} and defined $self->{handle} )
+ {
+ my $client = $self->{handle}->accept();
+ my $result = $self->__client();
+ $result->{handle} = new IO::Select($client);
+ return $result;
+ }
+
+ return 0;
+}
+
+###
+### Overridable methods
+###
+
+sub __client
+{
+ return new Thrift::Socket();
+}
+
+sub __listen
+{
+ my $self = shift;
+ return IO::Socket::INET->new(LocalAddr => $self->{host},
+ LocalPort => $self->{port},
+ Proto => 'tcp',
+ Listen => $self->{queue},
+ ReuseAddr => 1);
+}
+
+
+1;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/lib/perl/lib/Thrift/Socket.pm
----------------------------------------------------------------------
diff --git a/lib/perl/lib/Thrift/Socket.pm b/lib/perl/lib/Thrift/Socket.pm
index 7ebea35..eaf8b9e 100644
--- a/lib/perl/lib/Thrift/Socket.pm
+++ b/lib/perl/lib/Thrift/Socket.pm
@@ -29,7 +29,7 @@ use IO::Select;
package Thrift::Socket;
-use base('Thrift::Transport');
+use base qw( Thrift::Transport );
sub new
{
@@ -105,21 +105,15 @@ sub open
{
my $self = shift;
- my $sock = IO::Socket::INET->new(PeerAddr => $self->{host},
- PeerPort => $self->{port},
- Proto => 'tcp',
- Timeout => $self->{sendTimeout}/1000)
- || do {
- my $error = 'TSocket: Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')';
+ my $sock = $self->__open() || do {
+ my $error = ref($self).': Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')';
- if ($self->{debug}) {
- $self->{debugHandler}->($error);
- }
-
- die new Thrift::TException($error);
-
- };
+ if ($self->{debug}) {
+ $self->{debugHandler}->($error);
+ }
+ die new Thrift::TException($error);
+ };
$self->{handle} = new IO::Select( $sock );
}
@@ -130,9 +124,8 @@ sub open
sub close
{
my $self = shift;
-
- if( defined $self->{handle} ){
- CORE::close( ($self->{handle}->handles())[0] );
+ if( defined $self->{handle} ) {
+ $self->__close();
}
}
@@ -153,25 +146,15 @@ sub readAll
my $pre = "";
while (1) {
- #check for timeout
- my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
-
- if(@sockets == 0){
- die new Thrift::TException('TSocket: timed out reading '.$len.' bytes from '.
- $self->{host}.':'.$self->{port});
- }
-
- my $sock = $sockets[0];
-
- my ($buf,$sz);
- $sock->recv($buf, $len);
+ my $sock = $self->__wait();
+ my $buf = $self->__recv($sock, $len);
if (!defined $buf || $buf eq '') {
- die new Thrift::TException('TSocket: Could not read '.$len.' bytes from '.
+ die new Thrift::TException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port});
- } elsif (($sz = length($buf)) < $len) {
+ } elsif ((my $sz = length($buf)) < $len) {
$pre .= $buf;
$len -= $sz;
@@ -195,22 +178,12 @@ sub read
return unless defined $self->{handle};
- #check for timeout
- my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
-
- if(@sockets == 0){
- die new Thrift::TException('TSocket: timed out reading '.$len.' bytes from '.
- $self->{host}.':'.$self->{port});
- }
-
- my $sock = $sockets[0];
-
- my ($buf,$sz);
- $sock->recv($buf, $len);
+ my $sock = $self->__wait();
+ my $buf = $self->__recv($sock, $len);
if (!defined $buf || $buf eq '') {
- die new TException('TSocket: Could not read '.$len.' bytes from '.
+ die new TException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port});
}
@@ -229,30 +202,27 @@ sub write
my $self = shift;
my $buf = shift;
-
return unless defined $self->{handle};
while (length($buf) > 0) {
-
-
#check for timeout
my @sockets = $self->{handle}->can_write( $self->{sendTimeout} / 1000 );
if(@sockets == 0){
- die new Thrift::TException('TSocket: timed out writing to bytes from '.
+ die new Thrift::TException(ref($self).': timed out writing to bytes from '.
$self->{host}.':'.$self->{port});
}
- my $sock = $sockets[0];
-
- my $got = $sock->send($buf);
+ my $sent = $self->__send($sockets[0], $buf);
- if (!defined $got || $got == 0 ) {
- die new Thrift::TException('TSocket: Could not write '.length($buf).' bytes '.
+ if (!defined $sent || $sent == 0 ) {
+
+ die new Thrift::TException(ref($self).': Could not write '.length($buf).' bytes '.
$self->{host}.':'.$self->{host});
+
}
- $buf = substr($buf, $got);
+ $buf = substr($buf, $sent);
}
}
@@ -265,65 +235,82 @@ sub flush
return unless defined $self->{handle};
- my $ret = ($self->{handle}->handles())[0]->flush;
+ my $ret = ($self->{handle}->handles())[0]->flush;
}
+###
+### Overridable methods
+###
#
-# Build a ServerSocket from the ServerTransport base class
+# Open a connection to a server.
#
-package Thrift::ServerSocket;
-
-use base qw( Thrift::Socket Thrift::ServerTransport );
-
-use constant LISTEN_QUEUE_SIZE => 128;
+sub __open
+{
+ my $self = shift;
+ return IO::Socket::INET->new(PeerAddr => $self->{host},
+ PeerPort => $self->{port},
+ Proto => 'tcp',
+ Timeout => $self->{sendTimeout} / 1000);
+}
-sub new
+#
+# Close the connection
+#
+sub __close
{
- my $classname = shift;
- my $port = shift;
+ my $self = shift;
+ CORE::close(($self->{handle}->handles())[0]);
+}
- my $self = $classname->SUPER::new(undef, $port, undef);
- return bless($self,$classname);
+#
+# Read data
+#
+# @param[in] $sock the socket
+# @param[in] $len the length to read
+# @returns the data buffer that was read
+#
+sub __recv
+{
+ my $self = shift;
+ my $sock = shift;
+ my $len = shift;
+ my $buf = undef;
+ $sock->recv($buf, $len);
+ return $buf;
}
-sub listen
+#
+# Send data
+#
+# @param[in] $sock the socket
+# @param[in] $buf the data buffer
+# @returns the number of bytes written
+#
+sub __send
{
my $self = shift;
-
- # Listen to a new socket
- my $sock = IO::Socket::INET->new(LocalAddr => undef, # any addr
- LocalPort => $self->{port},
- Proto => 'tcp',
- Listen => LISTEN_QUEUE_SIZE,
- ReuseAddr => 1)
- || do {
- my $error = 'TServerSocket: Could not bind to ' .
- $self->{host} . ':' . $self->{port} . ' (' . $! . ')';
-
- if ($self->{debug}) {
- $self->{debugHandler}->($error);
- }
-
- die new Thrift::TException($error);
- };
-
- $self->{handle} = $sock;
+ my $sock = shift;
+ my $buf = shift;
+ return $sock->send($buf);
}
-sub accept
+#
+# Wait for data to be readable
+#
+# @returns a socket that can be read
+#
+sub __wait
{
my $self = shift;
+ my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
- if ( exists $self->{handle} and defined $self->{handle} )
- {
- my $client = $self->{handle}->accept();
- my $result = new Thrift::Socket;
- $result->{handle} = new IO::Select($client);
- return $result;
+ if (@sockets == 0) {
+ die new Thrift::TException(ref($self).': timed out reading from '.
+ $self->{host}.':'.$self->{port});
}
- return 0;
+ return $sockets[0];
}
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/test/known_failures_Linux.json
----------------------------------------------------------------------
diff --git a/test/known_failures_Linux.json b/test/known_failures_Linux.json
index 0cf9601..416a53d 100644
--- a/test/known_failures_Linux.json
+++ b/test/known_failures_Linux.json
@@ -229,6 +229,9 @@
"go-nodejs_json_framed-ip",
"go-nodejs_json_framed-ip-ssl",
"go-perl_binary_buffered-ip",
+ "go-perl_binary_buffered-ip-ssl",
+ "go-perl_binary_framed-ip",
+ "go-perl_binary_framed-ip-ssl",
"go-php_binary_buffered-ip",
"go-php_binary_framed-ip",
"go-php_compact_buffered-ip",
@@ -436,6 +439,7 @@
"nodejs-rb_compact_framed-ip",
"nodejs-rb_json_buffered-ip",
"nodejs-rb_json_framed-ip",
+ "perl-php_binary_framed-ip",
"py-c_glib_accel-binary_buffered-ip",
"py-c_glib_accel-binary_framed-ip",
"py-c_glib_binary_buffered-ip",
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/test/perl/TestClient.pl
----------------------------------------------------------------------
diff --git a/test/perl/TestClient.pl b/test/perl/TestClient.pl
old mode 100644
new mode 100755
index 5a9a6f1..0f1ce65
--- a/test/perl/TestClient.pl
+++ b/test/perl/TestClient.pl
@@ -23,6 +23,7 @@ require 5.6.0;
use strict;
use warnings;
use Data::Dumper;
+use Getopt::Long qw(GetOptions);
use Time::HiRes qw(gettimeofday);
use lib '../../lib/perl/lib';
@@ -30,33 +31,89 @@ use lib 'gen-perl';
use Thrift;
use Thrift::BinaryProtocol;
-use Thrift::Socket;
use Thrift::BufferedTransport;
+use Thrift::FramedTransport;
+use Thrift::SSLSocket;
+use Thrift::Socket;
use ThriftTest::ThriftTest;
use ThriftTest::Types;
$|++;
-my $host = 'localhost';
-my $port = 9090;
+sub usage {
+ print <<EOF;
+Usage: $0 [OPTIONS]
+
+Options: (default)
+ --cert Certificate to use.
+ Required if using --ssl.
+ --help Show usage.
+ --port <portnum> 9090 Port to use.
+ --protocol {binary} binary Protocol to use.
+ --ssl If present, use SSL.
+ --transport {buffered|framed} buffered Transport to use.
+
+EOF
+}
+
+my %opts = (
+ 'port' => 9090,
+ 'protocol' => 'binary',
+ 'transport' => 'buffered'
+);
+
+GetOptions(\%opts, qw (
+ cert=s
+ help
+ host=s
+ port=i
+ protocol=s
+ ssl
+ transport=s
+)) || exit 1;
+
+if ($opts{help}) {
+ usage();
+ exit 0;
+}
-foreach my $arg (@ARGV) {
- if($arg =~ /^--port=([0-9]+)/) {
- $port = $1;
- }
+if ($opts{ssl} and not defined $opts{cert}) {
+ usage();
+ exit 1;
}
-my $socket = new Thrift::Socket($host, $port);
+my $socket = undef;
+if ($opts{ssl}) {
+ $socket = new Thrift::SSLSocket($opts{host}, $opts{port});
+} else {
+ $socket = new Thrift::Socket($opts{host}, $opts{port});
+}
+
+my $transport;
+if ($opts{transport} eq 'buffered') {
+ $transport = new Thrift::BufferedTransport($socket, 1024, 1024);
+} elsif ($opts{transport} eq 'framed') {
+ $transport = new Thrift::FramedTransport($socket);
+} else {
+ usage();
+ exit 1;
+}
+
+my $protocol;
+if ($opts{protocol} eq 'binary') {
+ $protocol = new Thrift::BinaryProtocol($transport);
+} else {
+ usage();
+ exit 1;
+}
-my $bufferedSocket = new Thrift::BufferedTransport($socket, 1024, 1024);
-my $transport = $bufferedSocket;
-my $protocol = new Thrift::BinaryProtocol($transport);
my $testClient = new ThriftTest::ThriftTestClient($protocol);
-eval{
-$transport->open();
-}; if($@){
+eval {
+ $transport->open();
+};
+if($@){
die(Dumper($@));
}
my $start = gettimeofday();
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/test/perl/TestServer.pl
----------------------------------------------------------------------
diff --git a/test/perl/TestServer.pl b/test/perl/TestServer.pl
new file mode 100644
index 0000000..57a1367
--- /dev/null
+++ b/test/perl/TestServer.pl
@@ -0,0 +1,380 @@
+#!/usr/bin/env perl
+
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+use Data::Dumper;
+use Getopt::Long qw(GetOptions);
+use Time::HiRes qw(gettimeofday);
+
+use lib '../../lib/perl/lib';
+use lib 'gen-perl';
+
+use Thrift;
+use Thrift::BinaryProtocol;
+use Thrift::BufferedTransport;
+use Thrift::FramedTransport;
+use Thrift::SSLServerSocket;
+use Thrift::ServerSocket;
+use Thrift::Server;
+
+use ThriftTest::ThriftTest;
+use ThriftTest::Types;
+
+$|++;
+
+sub usage {
+ print <<EOF;
+Usage: $0 [OPTIONS]
+
+Options: (default)
+ --ca Certificate authority file (optional).
+ --cert Certificate file.
+ Required if using --ssl.
+ --help Show usage.
+ --key Private key file for certificate.
+ Required if using --ssl and private key is
+ not in the certificate file.
+ --port <portnum> 9090 Port to use.
+ --protocol {binary} binary Protocol to use.
+ --ssl If present, use SSL/TLS.
+ --transport {buffered|framed} buffered Transport to use.
+
+EOF
+}
+
+my %opts = (
+ 'port' => 9090,
+ 'protocol' => 'binary',
+ 'transport' => 'buffered'
+);
+
+GetOptions(\%opts, qw (
+ ca=s
+ cert=s
+ help
+ host=s
+ key=s
+ port=i
+ protocol=s
+ ssl
+ transport=s
+)) || exit 1;
+
+if ($opts{help}) {
+ usage();
+ exit 0;
+}
+
+if ($opts{ssl} and not defined $opts{cert}) {
+ usage();
+ exit 1;
+}
+
+my $handler = new ThriftTestHandler();
+my $processor = new ThriftTest::ThriftTestProcessor($handler);
+my $serversocket;
+if ($opts{ssl}) {
+ $serversocket = new Thrift::SSLServerSocket(\%opts);
+} else {
+ $serversocket = new Thrift::ServerSocket(\%opts);
+}
+my $transport;
+if ($opts{transport} eq 'buffered') {
+ $transport = new Thrift::BufferedTransportFactory();
+} elsif ($opts{transport} eq 'framed') {
+ $transport = new Thrift::FramedTransportFactory();
+} else {
+ usage();
+ exit 1;
+}
+my $protocol;
+if ($opts{protocol} eq 'binary') {
+ $protocol = new Thrift::BinaryProtocolFactory();
+} else {
+ usage();
+ exit 1;
+}
+
+my $ssltag = '';
+if ($opts{ssl}) {
+ $ssltag = "(SSL)";
+}
+my $server = new Thrift::SimpleServer($processor, $serversocket, $transport, $protocol);
+print "Starting \"simple\" server ($opts{transport}/$opts{protocol}) listen on: $opts{port} $ssltag\n";
+$server->serve();
+
+###
+### Test server implementation
+###
+
+package ThriftTestHandler;
+
+use base qw( ThriftTest::ThriftTestIf );
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+ return bless($self, $classname);
+}
+
+sub testVoid() {
+ print("testVoid()\n");
+}
+
+sub testString() {
+ my $self = shift;
+ my $thing = shift;
+ print("testString($thing)\n");
+ return $thing;
+}
+
+sub testByte() {
+ my $self = shift;
+ my $thing = shift;
+ print("testByte($thing)\n");
+ return $thing;
+}
+
+sub testI32() {
+ my $self = shift;
+ my $thing = shift;
+ print("testI32($thing)\n");
+ return $thing;
+}
+
+sub testI64() {
+ my $self = shift;
+ my $thing = shift;
+ print("testI64($thing)\n");
+ return $thing;
+}
+
+sub testDouble() {
+ my $self = shift;
+ my $thing = shift;
+ print("testDouble($thing)\n");
+ return $thing;
+}
+
+sub testBinary() {
+ my $self = shift;
+ my $thing = shift;
+ my @bytes = split //, $thing;
+ print("testBinary(");
+ foreach (@bytes)
+ {
+ printf "%02lx", ord $_;
+ }
+ print(")\n");
+ return $thing;
+}
+
+sub testStruct() {
+ my $self = shift;
+ my $thing = shift;
+ printf("testStruct({\"%s\", %d, %d, %lld})\n",
+ $thing->{string_thing},
+ $thing->{byte_thing},
+ $thing->{i32_thing},
+ $thing->{i64_thing});
+ return $thing;
+}
+
+sub testNest() {
+ my $self = shift;
+ my $nest = shift;
+ my $thing = $nest->{struct_thing};
+ printf("testNest({%d, {\"%s\", %d, %d, %lld}, %d})\n",
+ $nest->{byte_thing},
+ $thing->{string_thing},
+ $thing->{byte_thing},
+ $thing->{i32_thing},
+ $thing->{i64_thing},
+ $nest->{i32_thing});
+ return $nest;
+}
+
+sub testMap() {
+ my $self = shift;
+ my $thing = shift;
+ print("testMap({");
+ my $first = 1;
+ foreach my $key (keys %$thing) {
+ if ($first) {
+ $first = 0;
+ } else {
+ print(", ");
+ }
+ print("$key => $thing->{$key}");
+ }
+ print("})\n");
+ return $thing;
+}
+
+sub testStringMap() {
+ my $self = shift;
+ my $thing = shift;
+ print("testStringMap({");
+ my $first = 1;
+ foreach my $key (keys %$thing) {
+ if ($first) {
+ $first = 0;
+ } else {
+ print(", ");
+ }
+ print("$key => $thing->{$key}");
+ }
+ print("})\n");
+ return $thing;
+}
+
+sub testSet() {
+ my $self = shift;
+ my $thing = shift;
+ my @arr;
+ my $result = \@arr;
+ print("testSet({");
+ my $first = 1;
+ foreach my $key (keys %$thing) {
+ if ($first) {
+ $first = 0;
+ } else {
+ print(", ");
+ }
+ print("$key");
+ push($result, $key);
+ }
+ print("})\n");
+ return $result;
+}
+
+sub testList() {
+ my $self = shift;
+ my $thing = shift;
+ print("testList({");
+ my $first = 1;
+ foreach my $key (@$thing) {
+ if ($first) {
+ $first = 0;
+ } else {
+ print(", ");
+ }
+ print("$key");
+ }
+ print("})\n");
+ return $thing;
+}
+
+sub testEnum() {
+ my $self = shift;
+ my $thing = shift;
+ print("testEnum($thing)\n");
+ return $thing;
+}
+
+sub testTypedef() {
+ my $self = shift;
+ my $thing = shift;
+ print("testTypedef($thing)\n");
+ return $thing;
+}
+
+sub testMapMap() {
+ my $self = shift;
+ my $hello = shift;
+
+ printf("testMapMap(%d)\n", $hello);
+ my $result = { 4 => { 1 => 1, 2 => 2, 3 => 3, 4 => 4 }, -4 => { -1 => -1, -2 => -2, -3 => -3, -4 => -4 } };
+ return $result;
+}
+
+sub testInsanity() {
+ my $self = shift;
+ my $argument = shift;
+ print("testInsanity()\n");
+
+ my $hello = new ThriftTest::Xtruct({string_thing => "Hello2", byte_thing => 2, i32_thing => 2, i64_thing => 2});
+ my @hellos;
+ push(@hellos, $hello);
+ my $goodbye = new ThriftTest::Xtruct({string_thing => "Goodbye4", byte_thing => 4, i32_thing => 4, i64_thing => 4});
+ my @goodbyes;
+ push(@goodbyes, $goodbye);
+ my $crazy = new ThriftTest::Insanity({userMap => { ThriftTest::Numberz::EIGHT => 8 }, xtructs => \@goodbyes});
+ my $loony = new ThriftTest::Insanity({userMap => { ThriftTest::Numberz::FIVE => 5 }, xtructs => \@hellos});
+ my $result = { 1 => { ThriftTest::Numberz::TWO => $crazy, ThriftTest::Numberz::THREE => $crazy },
+ 2 => { ThriftTest::Numberz::SIX => $loony } };
+ return $result;
+}
+
+sub testMulti() {
+ my $self = shift;
+ my $arg0 = shift;
+ my $arg1 = shift;
+ my $arg2 = shift;
+ my $arg3 = shift;
+ my $arg4 = shift;
+ my $arg5 = shift;
+
+ print("testMulti()\n");
+ return new ThriftTest::Xtruct({string_thing => "Hello2", byte_thing => $arg0, i32_thing => $arg1, i64_thing => $arg2});
+}
+
+sub testException() {
+ my $self = shift;
+ my $arg = shift;
+ print("testException($arg)\n");
+ if ($arg eq "Xception") {
+ die new ThriftTest::Xception({errorCode => 1001, message => $arg});
+ } elsif ($arg eq "TException") {
+ die "astring"; # all unhandled exceptions become TExceptions
+ } else {
+ return new ThriftTest::Xtruct({string_thing => $arg});
+ }
+}
+
+sub testMultiException() {
+ my $self = shift;
+ my $arg0 = shift;
+ my $arg1 = shift;
+
+ printf("testMultiException(%s, %s)\n", $arg0, $arg1);
+ if ($arg0 eq "Xception") {
+ die new ThriftTest::Xception({errorCode => 1001, message => "This is an Xception"});
+ } elsif ($arg0 eq "Xception2") {
+ my $struct_thing = new ThriftTest::Xtruct({string_thing => "This is an Xception2"});
+ die new ThriftTest::Xception2({errorCode => 2002, struct_thing => $struct_thing});
+ } else {
+ return new ThriftTest::Xtruct({string_thing => $arg1});
+ }
+}
+
+sub testOneway() {
+ my $self = shift;
+ my $sleepFor = shift;
+ print("testOneway($sleepFor): Sleeping...\n");
+ sleep $sleepFor;
+ print("testOneway($sleepFor): done sleeping!\n");
+}
+
+
+1;
http://git-wip-us.apache.org/repos/asf/thrift/blob/f5f1b35a/test/tests.json
----------------------------------------------------------------------
diff --git a/test/tests.json b/test/tests.json
index 04142cb..d7caccb 100644
--- a/test/tests.json
+++ b/test/tests.json
@@ -301,21 +301,34 @@
},
{
"name": "perl",
+ "transports": [
+ "buffered",
+ "framed"
+ ],
+ "sockets": [
+ "ip",
+ "ip-ssl"
+ ],
+ "protocols": [
+ "binary"
+ ],
"client": {
- "transports": [
- "buffered"
- ],
- "sockets": [
- "ip"
- ],
- "protocols": [
- "binary"
- ],
"command": [
"perl",
"-Igen-perl/",
"-I../../lib/perl/lib/",
- "TestClient.pl"
+ "TestClient.pl",
+ "--cert=../../test/keys/client.pem"
+ ]
+ },
+ "server": {
+ "command": [
+ "perl",
+ "-Igen-perl/",
+ "-I../../lib/perl/lib/",
+ "TestServer.pl",
+ "--cert=../../test/keys/server.pem",
+ "--key=../../test/keys/server.key"
]
},
"workdir": "perl"