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.
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",
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 @@
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 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]
-foreach my $arg (@ARGV) {
- if($arg =~ /^--port=([0-9]+)/) {
- $port = $1;
- }
+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 $socket = new Thrift::Socket($host, $port);
+my %opts = (
+ 'port' => 9090,
+ 'protocol' => 'binary',
+ 'transport' => 'buffered'
+);
-my $bufferedSocket = new Thrift::BufferedTransport($socket, 1024, 1024);
-my $transport = $bufferedSocket;
-my $protocol = new Thrift::BinaryProtocol($transport);
+GetOptions(\%opts, qw (
+ cert=s
+ help
+ host=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 $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 $testClient = new ThriftTest::ThriftTestClient($protocol);
-eval{
-$transport->open();
-}; if($@){
+eval {
+ $transport->open();
+};
+if($@){
die(Dumper($@));
}
my $start = gettimeofday();
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;
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"