From 49f5096da07af54b867b83aee9ae67c2ab0d46e6 Mon Sep 17 00:00:00 2001 From: Jim King Date: Wed, 24 Jun 2015 13:47:24 -0400 Subject: [PATCH] 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. --- 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(-) create mode 100644 lib/perl/lib/Thrift/SSLServerSocket.pm create mode 100644 lib/perl/lib/Thrift/SSLSocket.pm create mode 100644 lib/perl/lib/Thrift/ServerSocket.pm mode change 100644 => 100755 test/perl/TestClient.pl create mode 100644 test/perl/TestServer.pl diff --git a/build/travis/installDependencies.sh b/build/travis/installDependencies.sh index dd9256804e5..5b74140db57 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 diff --git a/compiler/cpp/src/generate/t_perl_generator.cc b/compiler/cpp/src/generate/t_perl_generator.cc index 6c823c04d25..5f52c24439b 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(); diff --git a/lib/perl/README.md b/lib/perl/README.md index c48ce2591e6..51247e04428 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 diff --git a/lib/perl/lib/Thrift.pm b/lib/perl/lib/Thrift.pm index 67186f23cf9..06e110b4807 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); } diff --git a/lib/perl/lib/Thrift/FramedTransport.pm b/lib/perl/lib/Thrift/FramedTransport.pm index e8e85dcae9b..6f2d2cf7ca6 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; diff --git a/lib/perl/lib/Thrift/SSLServerSocket.pm b/lib/perl/lib/Thrift/SSLServerSocket.pm new file mode 100644 index 00000000000..2efdfffea51 --- /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; diff --git a/lib/perl/lib/Thrift/SSLSocket.pm b/lib/perl/lib/Thrift/SSLSocket.pm new file mode 100644 index 00000000000..b70d46fac1a --- /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; diff --git a/lib/perl/lib/Thrift/Server.pm b/lib/perl/lib/Thrift/Server.pm index 960fbd12139..97e662061ee 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; } diff --git a/lib/perl/lib/Thrift/ServerSocket.pm b/lib/perl/lib/Thrift/ServerSocket.pm new file mode 100644 index 00000000000..a41b319e7be --- /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; diff --git a/lib/perl/lib/Thrift/Socket.pm b/lib/perl/lib/Thrift/Socket.pm index 7ebea356f9e..eaf8b9e2beb 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]; } diff --git a/test/known_failures_Linux.json b/test/known_failures_Linux.json index 0cf960166aa..416a53d8220 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 5a9a6f1c743..0f1ce657707 --- 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 < 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(); diff --git a/test/perl/TestServer.pl b/test/perl/TestServer.pl new file mode 100644 index 00000000000..57a136766f5 --- /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 < 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 04142cb1be2..d7caccbb2bc 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"