Upgrading dependency to Thrift 0.12.0

This commit is contained in:
Renan DelValle 2018-11-27 18:03:50 -08:00
parent 3e4590dcc0
commit 356978cb42
No known key found for this signature in database
GPG key ID: C240AD6D6F443EC9
1302 changed files with 101701 additions and 26784 deletions

View file

@ -0,0 +1,13 @@
blib/.*$
build-cpan-dist.sh
FixupDist.pl
MANIFEST.bak
MANIFEST.SKIP
MYMETA.json
Makefile
Makefile.am
Makefile.in
pm_to_blib
test/Makefile.am
test/Makefile.in
tools/FixupDist.pl

View file

@ -17,13 +17,20 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile( 'NAME' => 'Thrift',
'VERSION_FROM' => 'lib/Thrift.pm',
'PREREQ_PM' => {
'Bit::Vector' => 0,
WriteMakefile( ABSTRACT => 'Apache Thrift is a software framework for scalable cross-language services development.',
AUTHOR => 'Apache Thrift <dev@thrift.apache.org>',
LICENSE => 'apache_2_0',
MIN_PERL_VERSION => '5.010000',
NAME => 'Thrift',
NEEDS_LINKING => 0,
PREREQ_PM => {
'Bit::Vector' => 0,
'Class::Accessor' => 0
},
($] >= 5.005 ?
( AUTHOR => 'Apache Thrift <dev@thrift.apache.org>') : ()),
);
VERSION_FROM => 'lib/Thrift.pm' );

View file

@ -38,12 +38,14 @@ clean-local:
EXTRA_DIST = \
coding_standards.md \
build-cpan-dist.sh \
Makefile.PL \
test.pl \
lib/Thrift.pm \
lib/Thrift.pm \
lib/Thrift/BinaryProtocol.pm \
lib/Thrift/BufferedTransport.pm \
lib/Thrift/Exception.pm \
lib/Thrift/FramedTransport.pm \
lib/Thrift/HttpClient.pm \
lib/Thrift/MemoryBuffer.pm \
@ -59,6 +61,7 @@ EXTRA_DIST = \
lib/Thrift/SSLServerSocket.pm \
lib/Thrift/UnixServerSocket.pm \
lib/Thrift/UnixSocket.pm \
lib/Thrift/Type.pm \
lib/Thrift/Transport.pm \
README.md

View file

@ -1,7 +1,13 @@
Thrift Perl Software Library
License
=======
# Summary
Apache Thrift is a software framework for scalable cross-language services development.
It combines a software stack with a code generation engine to build services that work
efficiently and seamlessly between many programming languages. A language-neutral IDL
is used to generate functioning client libraries and server-side handling frameworks.
# License
Licensed to the Apache Software Foundation (ASF) under one
or more contributor license agreements. See the NOTICE file
@ -20,10 +26,13 @@ KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
Using Thrift with Perl
=====================
# For More Information
Thrift requires Perl >= 5.6.0
See the [Apache Thrift Web Site](http://thrift.apache.org/) for more information.
# Using Thrift with Perl
Thrift requires Perl >= 5.10.0
Unexpected exceptions in a service handler are converted to
TApplicationException with type INTERNAL ERROR and the string
@ -34,12 +43,82 @@ to wrap eval{} statments around any code that contains exceptions.
Please see tutoral and test dirs for examples.
Dependencies
============
The Perl ForkingServer ignores SIGCHLD allowing the forks to be
reaped by the operating system naturally when they exit. This means
one cannot use a custom SIGCHLD handler in the consuming perl
implementation that calls serve(). It is acceptable to use
a custom SIGCHLD handler within a thrift handler implementation
as the ForkingServer resets the forked child process to use
default signal handling.
# Dependencies
The following modules are not provided by Perl 5.10.0 but are required
to use Thrift.
## Runtime
* Bit::Vector
* Class::Accessor
### HttpClient Transport
These are only required if using Thrift::HttpClient:
* HTTP::Request
* IO::String
* LWP::UserAgent
### SSL/TLS
These are only required if using Thrift::SSLSocket or Thrift::SSLServerSocket:
* IO::Socket::SSL
# Breaking Changes
## 0.10.0
The socket classes were refactored in 0.10.0 so that there is one package per
file. This means `use Socket;` no longer defines SSLSocket. You can use this
technique to make your application run against 0.10.0 as well as earlier versions:
`eval { require Thrift::SSLSocket; } or do { require Thrift::Socket; }`
## 0.11.0
* Namespaces of packages that were not scoped within Thrift have been fixed.
** TApplicationException is now Thrift::TApplicationException
** TException is now Thrift::TException
** TMessageType is now Thrift::TMessageType
** TProtocolException is now Thrift::TProtocolException
** TProtocolFactory is now Thrift::TProtocolFactory
** TTransportException is now Thrift::TTransportException
** TType is now Thrift::TType
If you need a single version of your code to work with both older and newer thrift
namespace changes, you can make the new, correct namespaces behave like the old ones
in your files with this technique to create an alias, which will allow you code to
run against either version of the perl runtime for thrift:
`BEGIN {*TType:: = *Thrift::TType::}`
* Packages found in Thrift.pm were moved into the Thrift/ directory in separate files:
** Thrift::TApplicationException is now in Thrift/Exception.pm
** Thrift::TException is now in Thrift/Exception.pm
** Thrift::TMessageType is now in Thrift/MessageType.pm
** Thrift::TType is now in Thrift/Type.pm
If you need to modify your code to work against both older or newer thrift versions,
you can deal with these changes in a backwards compatible way in your projects using eval:
`eval { require Thrift::Exception; require Thrift::MessageType; require Thrift::Type; }
or do { require Thrift; }`
# Deprecations
## 0.11.0
Thrift::HttpClient setRecvTimeout() and setSendTimeout() are deprecated.
Use setTimeout instead.
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

53
vendor/git.apache.org/thrift.git/lib/perl/build-cpan-dist.sh generated vendored Executable file
View file

@ -0,0 +1,53 @@
#!/bin/bash
#
# This script is intended to be used after tagging the repository and updating
# the version files for a release. It will create a CPAN archive. Run this
# from inside a docker image like ubuntu-xenial.
#
set -e
rm -f MANIFEST
rm -rf Thrift-*
# setup cpan without a prompt
echo | cpan
cpan install HTTP::Date
cpan install CPAN
cpan install CPAN::Meta ExtUtils::MakeMaker JSON::PP
perl Makefile.PL
rm MYMETA.yml
make manifest
make dist
#
# We unpack the archive so we can add version metadata for CPAN
# so that it properly indexes Thrift and remove unnecessary files.
#
echo '-----------------------------------------------------------'
set -x
DISTFILE=$(ls Thrift*.gz)
NEWFILE=${DISTFILE/t-v/t-}
if [[ "$DISTFILE" != "$NEWFILE" ]]; then
mv $DISTFILE $NEWFILE
DISTFILE="$NEWFILE"
fi
tar xzf $DISTFILE
rm $DISTFILE
DISTDIR=$(ls -d Thrift*)
# cpan doesn't like "Thrift-v0.nn.0 as a directory name
# needs to be Thrift-0.nn.0
NEWDIR=${DISTDIR/t-v/t-}
if [[ "$DISTDIR" != "$NEWDIR" ]]; then
mv $DISTDIR $NEWDIR
DISTDIR="$NEWDIR"
fi
cd $DISTDIR
cp -p ../Makefile.PL .
perl ../tools/FixupDist.pl
cd ..
tar cvzf $DISTFILE $DISTDIR
rm -r $DISTDIR

View file

@ -1 +1,2 @@
Please follow [General Coding Standards](/doc/coding_standards.md)
Please follow [General Coding Standards](/doc/coding_standards.md).
Additional perl coding standards can be found in [perlstyle](http://perldoc.perl.org/perlstyle.html).

View file

@ -17,177 +17,20 @@
# under the License.
#
package Thrift;
our $VERSION = '0.10.0';
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
#
# Data types that can be sent via Thrift
# Versioning
#
package TType;
use constant STOP => 0;
use constant VOID => 1;
use constant BOOL => 2;
use constant BYTE => 3;
use constant I08 => 3;
use constant DOUBLE => 4;
use constant I16 => 6;
use constant I32 => 8;
use constant I64 => 10;
use constant STRING => 11;
use constant UTF7 => 11;
use constant STRUCT => 12;
use constant MAP => 13;
use constant SET => 14;
use constant LIST => 15;
use constant UTF8 => 16;
use constant UTF16 => 17;
1;
# Every perl module for Thrift will have the same version
# declaration. For a production build, change it below to
# something like "v0.11.0" and all of the packages in all
# of the files will pick it up from here.
#
# Message types for RPC
#
package TMessageType;
use constant CALL => 1;
use constant REPLY => 2;
use constant EXCEPTION => 3;
use constant ONEWAY => 4;
1;
package Thrift::TException;
use overload '""' => sub {
return
ref( $_[0] )
. " error: "
. ( $_[0]->{message} || 'empty message' )
. " (code "
. ( defined $_[0]->{code} ? $_[0]->{code} : 'undefined' ) . ")";
};
sub new {
my $classname = shift;
my $self = {message => shift, code => shift || 0};
return bless($self,$classname);
}
1;
package TApplicationException;
use base('Thrift::TException');
use constant UNKNOWN => 0;
use constant UNKNOWN_METHOD => 1;
use constant INVALID_MESSAGE_TYPE => 2;
use constant WRONG_METHOD_NAME => 3;
use constant BAD_SEQUENCE_ID => 4;
use constant MISSING_RESULT => 5;
use constant INTERNAL_ERROR => 6;
use constant PROTOCOL_ERROR => 7;
use constant INVALID_TRANSFORM => 8;
use constant INVALID_PROTOCOL => 9;
use constant UNSUPPORTED_CLIENT_TYPE => 10;
sub new {
my $classname = shift;
my $self = $classname->SUPER::new(@_);
return bless($self,$classname);
}
sub read {
my $self = shift;
my $input = shift;
my $xfer = 0;
my $fname = undef;
my $ftype = 0;
my $fid = 0;
$xfer += $input->readStructBegin(\$fname);
while (1)
{
$xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
if ($ftype == TType::STOP) {
last; next;
}
SWITCH: for($fid)
{
/1/ && do{
if ($ftype == TType::STRING) {
$xfer += $input->readString(\$self->{message});
} else {
$xfer += $input->skip($ftype);
}
last;
};
/2/ && do{
if ($ftype == TType::I32) {
$xfer += $input->readI32(\$self->{code});
} else {
$xfer += $input->skip($ftype);
}
last;
};
$xfer += $input->skip($ftype);
}
$xfer += $input->readFieldEnd();
}
$xfer += $input->readStructEnd();
return $xfer;
}
sub write {
my $self = shift;
my $output = shift;
my $xfer = 0;
$xfer += $output->writeStructBegin('TApplicationException');
if ($self->getMessage()) {
$xfer += $output->writeFieldBegin('message', TType::STRING, 1);
$xfer += $output->writeString($self->getMessage());
$xfer += $output->writeFieldEnd();
}
if ($self->getCode()) {
$xfer += $output->writeFieldBegin('type', TType::I32, 2);
$xfer += $output->writeI32($self->getCode());
$xfer += $output->writeFieldEnd();
}
$xfer += $output->writeFieldStop();
$xfer += $output->writeStructEnd();
return $xfer;
}
sub getMessage
{
my $self = shift;
return $self->{message};
}
sub getCode
{
my $self = shift;
return $self->{code};
}
package Thrift;
use version 0.77; our $VERSION = version->declare("v1.0_0");
1;

View file

@ -17,24 +17,25 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use utf8;
use Encode;
use Thrift;
use Thrift::Protocol;
use Bit::Vector;
use Encode;
use Thrift;
use Thrift::Exception;
use Thrift::MessageType;
use Thrift::Protocol;
use Thrift::Type;
use utf8;
#
# Binary implementation of the Thrift protocol.
#
package Thrift::BinaryProtocol;
use base('Thrift::Protocol');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant VERSION_MASK => 0xffff0000;
use constant VERSION_1 => 0x80010000;
@ -97,7 +98,7 @@ sub writeFieldEnd
sub writeFieldStop
{
my $self = shift;
return $self->writeByte(TType::STOP);
return $self->writeByte(Thrift::TType::STOP);
}
sub writeMapBegin
@ -252,7 +253,8 @@ sub readMessageBegin
my $result = $self->readI32(\$version);
if (($version & VERSION_MASK) > 0) {
if (($version & VERSION_MASK) != VERSION_1) {
die new Thrift::TException('Missing version identifier')
die new Thrift::TProtocolException('Missing version identifier',
Thrift::TProtocolException::BAD_VERSION);
}
$$type = $version & 0x000000ff;
return
@ -297,7 +299,7 @@ sub readFieldBegin
my $result = $self->readByte($fieldType);
if ($$fieldType == TType::STOP) {
if ($$fieldType == Thrift::TType::STOP) {
$$fieldId = 0;
return $result;
}
@ -447,7 +449,7 @@ sub readDouble
else {
$data = scalar reverse($self->{trans}->readAll(8));
}
my @arr = unpack('d', $data);
$$value = $arr[0];
@ -491,7 +493,8 @@ sub readStringBody
# Binary Protocol Factory
#
package Thrift::BinaryProtocolFactory;
use base('TProtocolFactory');
use base('Thrift::TProtocolFactory');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{

View file

@ -17,15 +17,17 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Exception;
use Thrift::Transport;
package Thrift::BufferedTransport;
use base('Thrift::Transport');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@ -110,6 +112,7 @@ sub flush
# BufferedTransport factory creates buffered transport objects from transports
#
package Thrift::BufferedTransportFactory;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;

View file

@ -0,0 +1,160 @@
#
# 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.
#
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Type;
package Thrift::TException;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use overload '""' => sub {
return
ref( $_[0] )
. " error: "
. ( $_[0]->{message} || 'empty message' )
. " (code "
. ( defined $_[0]->{code} ? $_[0]->{code} : 'undefined' ) . ")";
};
sub new {
my $classname = shift;
my $self = {message => shift, code => shift || 0};
return bless($self,$classname);
}
package Thrift::TApplicationException;
use parent -norequire, 'Thrift::TException';
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant UNKNOWN => 0;
use constant UNKNOWN_METHOD => 1;
use constant INVALID_MESSAGE_TYPE => 2;
use constant WRONG_METHOD_NAME => 3;
use constant BAD_SEQUENCE_ID => 4;
use constant MISSING_RESULT => 5;
use constant INTERNAL_ERROR => 6;
use constant PROTOCOL_ERROR => 7;
use constant INVALID_TRANSFORM => 8;
use constant INVALID_PROTOCOL => 9;
use constant UNSUPPORTED_CLIENT_TYPE => 10;
sub new {
my $classname = shift;
my $self = $classname->SUPER::new(@_);
return bless($self,$classname);
}
sub read {
my $self = shift;
my $input = shift;
my $xfer = 0;
my $fname = undef;
my $ftype = 0;
my $fid = 0;
$xfer += $input->readStructBegin(\$fname);
while (1)
{
$xfer += $input->readFieldBegin(\$fname, \$ftype, \$fid);
if ($ftype == Thrift::TType::STOP) {
last; next;
}
SWITCH: for($fid)
{
/1/ && do{
if ($ftype == Thrift::TType::STRING) {
$xfer += $input->readString(\$self->{message});
} else {
$xfer += $input->skip($ftype);
}
last;
};
/2/ && do{
if ($ftype == Thrift::TType::I32) {
$xfer += $input->readI32(\$self->{code});
} else {
$xfer += $input->skip($ftype);
}
last;
};
$xfer += $input->skip($ftype);
}
$xfer += $input->readFieldEnd();
}
$xfer += $input->readStructEnd();
return $xfer;
}
sub write {
my $self = shift;
my $output = shift;
my $xfer = 0;
$xfer += $output->writeStructBegin('TApplicationException');
if ($self->getMessage()) {
$xfer += $output->writeFieldBegin('message', Thrift::TType::STRING, 1);
$xfer += $output->writeString($self->getMessage());
$xfer += $output->writeFieldEnd();
}
if ($self->getCode()) {
$xfer += $output->writeFieldBegin('type', Thrift::TType::I32, 2);
$xfer += $output->writeI32($self->getCode());
$xfer += $output->writeFieldEnd();
}
$xfer += $output->writeFieldStop();
$xfer += $output->writeStructEnd();
return $xfer;
}
sub getMessage
{
my $self = shift;
return $self->{message};
}
sub getCode
{
my $self = shift;
return $self->{code};
}
1;

View file

@ -17,6 +17,7 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
@ -30,8 +31,8 @@ use Thrift::Transport;
# @package thrift.transport
#
package Thrift::FramedTransport;
use base('Thrift::Transport');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@ -167,6 +168,7 @@ sub flush
# FramedTransport factory creates framed transport objects from transports
#
package Thrift::FramedTransportFactory;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@ -189,5 +191,4 @@ sub getTransport
return $buffered;
}
1;

View file

@ -17,26 +17,25 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use HTTP::Request;
use IO::String;
use LWP::UserAgent;
use Thrift;
use Thrift::Exception;
use Thrift::Transport;
use HTTP::Request;
use LWP::UserAgent;
use IO::String;
package Thrift::HttpClient;
use base('Thrift::Transport');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
my $classname = shift;
my $url = shift || 'http://localhost:9090';
my $debugHandler = shift;
my $out = IO::String->new;
binmode($out);
@ -44,44 +43,44 @@ sub new
my $self = {
url => $url,
out => $out,
debugHandler => $debugHandler,
debug => 0,
sendTimeout => 100,
recvTimeout => 750,
timeout => 100,
handle => undef,
headers => {},
};
return bless($self,$classname);
}
sub setTimeout
{
my $self = shift;
my $timeout = shift;
$self->{timeout} = $timeout;
}
sub setRecvTimeout
{
warn "setRecvTimeout is deprecated - use setTimeout instead";
# note: recvTimeout was never used so we do not need to do anything here
}
sub setSendTimeout
{
my $self = shift;
my $timeout = shift;
$self->{sendTimeout} = $timeout;
warn "setSendTimeout is deprecated - use setTimeout instead";
$self->setTimeout($timeout);
}
sub setRecvTimeout
sub setHeader
{
my $self = shift;
my $timeout = shift;
my $self = shift;
my ($name, $value) = @_;
$self->{recvTimeout} = $timeout;
}
#
#Sets debugging output on or off
#
# @param bool $debug
#
sub setDebug
{
my $self = shift;
my $debug = shift;
$self->{debug} = $debug;
$self->{headers}->{$name} = $value;
}
#
@ -122,7 +121,8 @@ sub readAll
my $buf = $self->read($len);
if (!defined($buf)) {
die new Thrift::TException('TSocket: Could not read '.$len.' bytes from input buffer');
die new Thrift::TTransportException("TSocket: Could not read $len bytes from input buffer",
Thrift::TTransportException::END_OF_FILE);
}
return $buf;
}
@ -140,15 +140,17 @@ sub read
my $in = $self->{in};
if (!defined($in)) {
die new Thrift::TException("Response buffer is empty, no request.");
die new Thrift::TTransportException("Response buffer is empty, no request.",
Thrift::TTransportException::END_OF_FILE);
}
eval {
my $ret = sysread($in, $buf, $len);
if (! defined($ret)) {
die new Thrift::TException("No more data available.");
die new Thrift::TTransportException("No more data available.",
Thrift::TTransportException::TIMED_OUT);
}
}; if($@){
die new Thrift::TException($@);
die new Thrift::TTransportException("$@", Thrift::TTransportException::UNKNOWN);
}
return $buf;
@ -171,7 +173,7 @@ sub flush
{
my $self = shift;
my $ua = LWP::UserAgent->new('timeout' => ($self->{sendTimeout} / 1000),
my $ua = LWP::UserAgent->new('timeout' => ($self->{timeout} / 1000),
'agent' => 'Perl/THttpClient'
);
$ua->default_header('Accept' => 'application/x-thrift');
@ -183,6 +185,7 @@ sub flush
my $buf = join('', <$out>);
my $request = new HTTP::Request(POST => $self->{url}, undef, $buf);
map { $request->header($_ => $self->{headers}->{$_}) } keys %{$self->{headers}};
my $response = $ua->request($request);
my $content_ref = $response->content_ref;

View file

@ -17,7 +17,7 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
@ -26,6 +26,7 @@ use Thrift::Transport;
package Thrift::MemoryBuffer;
use base('Thrift::Transport');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@ -116,7 +117,8 @@ sub readAll
my $avail = ($self->{wPos} - $self->{rPos});
if ($avail < $len) {
die new TTransportException("Attempt to readAll($len) found only $avail available");
die new TTransportException("Attempt to readAll($len) found only $avail available",
Thrift::TTransportException::END_OF_FILE);
}
my $data = '';

View file

@ -17,16 +17,21 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
package Thrift::MessageType;
use Thrift;
use strict;
#
# Message types for RPC
#
package Thrift::TMessageType;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant CALL => 1;
use constant REPLY => 2;
use constant EXCEPTION => 3;
use constant ONEWAY => 4;
use constant CALL => 1;
use constant REPLY => 2;
use constant EXCEPTION => 3;
use constant ONEWAY => 4;
1;
1;

View file

@ -17,19 +17,19 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Protocol;
use Thrift::MultiplexedProtocol;
use Thrift::ProtocolDecorator;
use Thrift::MessageType;
use Thrift::MultiplexedProtocol;
use Thrift::Protocol;
use Thrift::ProtocolDecorator;
package Thrift::StoredMessageProtocol;
use base qw(Thrift::ProtocolDecorator);
use strict;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@ -46,7 +46,7 @@ sub new {
return bless($self,$classname);
}
sub readMessageBegin
sub readMessageBegin
{
my $self = shift;
my $name = shift;
@ -59,27 +59,34 @@ sub readMessageBegin
}
package Thrift::MultiplexedProcessor;
use strict;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
my $self = {};
$self->{serviceProcessorMap} = {};
$self->{defaultProcessor} = undef;
return bless($self,$classname);
}
sub defaultProcessor {
my $self = shift;
my $processor = shift;
$self->{defaultProcessor} = $processor;
}
sub registerProcessor {
my $self = shift;
my $serviceName = shift;
my $processor = shift;
$self->{serviceProcessorMap}->{$serviceName} = $processor;
}
sub process{
sub process {
my $self = shift;
my $input = shift;
my $output = shift;
@ -92,30 +99,35 @@ sub process{
my ($fname, $mtype, $rseqid);
$input->readMessageBegin(\$fname, \$mtype, \$rseqid);
if ($mtype ne Thrift::MessageType::CALL && $mtype ne Thrift::MessageType::ONEWAY) {
die new Thrift::TException("This should not have happened!?");
if ($mtype ne Thrift::TMessageType::CALL && $mtype ne Thrift::TMessageType::ONEWAY) {
die new Thrift::TException("This should not have happened!?");
}
# Extract the service name and the new Message name.
if (index($fname, Thrift::MultiplexedProtocol::SEPARATOR) == -1) {
die new Thrift::TException("Service name not found in message name: {$fname}. Did you " .
"forget to use a MultiplexProtocol in your client?");
if (defined $self->{defaultProcessor}) {
return $self->{defaultProcessor}->process(
new Thrift::StoredMessageProtocol($input, $fname, $mtype, $rseqid), $output
);
} else {
die new Thrift::TException("Service name not found in message name: {$fname} and no default processor defined. Did you " .
"forget to use a MultiplexProtocol in your client?");
}
}
(my $serviceName, my $messageName) = split(':', $fname, 2);
if (!exists($self->{serviceProcessorMap}->{$serviceName})) {
die new Thrift::TException("Service name not found: {$serviceName}. Did you forget " .
die new Thrift::TException("Service name not found: {$serviceName}. Did you forget " .
"to call registerProcessor()?");
}
#Dispatch processing to the stored processor
my $processor = $self->{serviceProcessorMap}->{$serviceName};
return $processor->process(
# Dispatch processing to the stored processor
my $processor = $self->{serviceProcessorMap}->{$serviceName};
return $processor->process(
new Thrift::StoredMessageProtocol($input, $messageName, $mtype, $rseqid), $output
);
);
}
1;
1;

View file

@ -17,26 +17,27 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::MessageType;
use Thrift::Protocol;
use Thrift::ProtocolDecorator;
use Thrift::MessageType;
package Thrift::MultiplexedProtocol;
use base qw(Thrift::ProtocolDecorator);
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use strict;
use constant SEPARATOR => ':';
use constant SEPARATOR => ':';
sub new {
my $classname = shift;
my $protocol = shift;
my $serviceName = shift;
my $self = $classname->SUPER::new($protocol);
$self->{serviceName} = $serviceName;
return bless($self,$classname);
@ -50,18 +51,18 @@ sub new {
# @param int $type Message type.
# @param int $seqid The sequence id of this message.
#
sub writeMessageBegin
sub writeMessageBegin
{
my $self = shift;
my $self = shift;
my ($name, $type, $seqid) = @_;
if ($type == Thrift::MessageType::CALL || $type == Thrift::MessageType::ONEWAY) {
if ($type == Thrift::TMessageType::CALL || $type == Thrift::TMessageType::ONEWAY) {
my $nameWithService = $self->{serviceName}.SEPARATOR.$name;
$self->SUPER::writeMessageBegin($nameWithService, $type, $seqid);
}
else {
$self->SUPER::writeMessageBegin($name, $type, $seqid);
$self->SUPER::writeMessageBegin($name, $type, $seqid);
}
}
1;
1;

View file

@ -17,26 +17,28 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Exception;
use Thrift::Type;
#
# Protocol exceptions
#
package TProtocolException;
package Thrift::TProtocolException;
use base('Thrift::TException');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant UNKNOWN => 0;
use constant INVALID_DATA => 1;
use constant NEGATIVE_SIZE => 2;
use constant SIZE_LIMIT => 3;
use constant BAD_VERSION => 4;
use constant UNKNOWN => 0;
use constant INVALID_DATA => 1;
use constant NEGATIVE_SIZE => 2;
use constant SIZE_LIMIT => 3;
use constant BAD_VERSION => 4;
use constant NOT_IMPLEMENTED => 5;
use constant DEPTH_LIMIT => 6;
use constant DEPTH_LIMIT => 6;
sub new {
my $classname = shift;
@ -50,6 +52,7 @@ sub new {
# Protocol base class module.
#
package Thrift::Protocol;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@ -92,7 +95,7 @@ sub writeMessageEnd {
# Writes a struct header.
#
# @param string $name Struct name
# @throws TException on write error
# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeStructBegin {
@ -104,7 +107,7 @@ sub writeStructBegin {
#
# Close a struct.
#
# @throws TException on write error
# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeStructEnd {
@ -117,7 +120,7 @@ sub writeStructEnd {
# @param string $name Field name
# @param int $type Field type
# @param int $fid Field id
# @throws TException on write error
# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeFieldBegin {
@ -332,36 +335,36 @@ sub skip
my $result;
my $i;
if($type == TType::BOOL)
if($type == Thrift::TType::BOOL)
{
return $self->readBool(\$ref);
}
elsif($type == TType::BYTE){
elsif($type == Thrift::TType::BYTE){
return $self->readByte(\$ref);
}
elsif($type == TType::I16){
elsif($type == Thrift::TType::I16){
return $self->readI16(\$ref);
}
elsif($type == TType::I32){
elsif($type == Thrift::TType::I32){
return $self->readI32(\$ref);
}
elsif($type == TType::I64){
elsif($type == Thrift::TType::I64){
return $self->readI64(\$ref);
}
elsif($type == TType::DOUBLE){
elsif($type == Thrift::TType::DOUBLE){
return $self->readDouble(\$ref);
}
elsif($type == TType::STRING)
elsif($type == Thrift::TType::STRING)
{
return $self->readString(\$ref);
}
elsif($type == TType::STRUCT)
elsif($type == Thrift::TType::STRUCT)
{
$result = $self->readStructBegin(\$ref);
while (1) {
my ($ftype,$fid);
$result += $self->readFieldBegin(\$ref, \$ftype, \$fid);
if ($ftype == TType::STOP) {
if ($ftype == Thrift::TType::STOP) {
last;
}
$result += $self->skip($ftype);
@ -370,7 +373,7 @@ sub skip
$result += $self->readStructEnd();
return $result;
}
elsif($type == TType::MAP)
elsif($type == Thrift::TType::MAP)
{
my($keyType,$valType,$size);
$result = $self->readMapBegin(\$keyType, \$valType, \$size);
@ -381,7 +384,7 @@ sub skip
$result += $self->readMapEnd();
return $result;
}
elsif($type == TType::SET)
elsif($type == Thrift::TType::SET)
{
my ($elemType,$size);
$result = $self->readSetBegin(\$elemType, \$size);
@ -391,7 +394,7 @@ sub skip
$result += $self->readSetEnd();
return $result;
}
elsif($type == TType::LIST)
elsif($type == Thrift::TType::LIST)
{
my ($elemType,$size);
$result = $self->readListBegin(\$elemType, \$size);
@ -402,7 +405,8 @@ sub skip
return $result;
}
die new Thrift::TException("Type $type not recognised --- corrupt data?");
die new Thrift::TProtocolException("Type $type not recognized --- corrupt data?",
Thrift::TProtocolException::INVALID_DATA);
}
@ -418,31 +422,31 @@ sub skipBinary
my $itrans = shift;
my $type = shift;
if($type == TType::BOOL)
if($type == Thrift::TType::BOOL)
{
return $itrans->readAll(1);
}
elsif($type == TType::BYTE)
elsif($type == Thrift::TType::BYTE)
{
return $itrans->readAll(1);
}
elsif($type == TType::I16)
elsif($type == Thrift::TType::I16)
{
return $itrans->readAll(2);
}
elsif($type == TType::I32)
elsif($type == Thrift::TType::I32)
{
return $itrans->readAll(4);
}
elsif($type == TType::I64)
elsif($type == Thrift::TType::I64)
{
return $itrans->readAll(8);
}
elsif($type == TType::DOUBLE)
elsif($type == Thrift::TType::DOUBLE)
{
return $itrans->readAll(8);
}
elsif( $type == TType::STRING )
elsif( $type == Thrift::TType::STRING )
{
my @len = unpack('N', $itrans->readAll(4));
my $len = $len[0];
@ -451,7 +455,7 @@ sub skipBinary
}
return 4 + $itrans->readAll($len);
}
elsif( $type == TType::STRUCT )
elsif( $type == Thrift::TType::STRUCT )
{
my $result = 0;
while (1) {
@ -460,7 +464,7 @@ sub skipBinary
my $data = $itrans->readAll(1);
my @arr = unpack('c', $data);
$ftype = $arr[0];
if ($ftype == TType::STOP) {
if ($ftype == Thrift::TType::STOP) {
last;
}
# I16 field id
@ -469,7 +473,7 @@ sub skipBinary
}
return $result;
}
elsif($type == TType::MAP)
elsif($type == Thrift::TType::MAP)
{
# Ktype
my $data = $itrans->readAll(1);
@ -493,7 +497,7 @@ sub skipBinary
}
return $result;
}
elsif($type == TType::SET || $type == TType::LIST)
elsif($type == Thrift::TType::SET || $type == Thrift::TType::LIST)
{
# Vtype
my $data = $itrans->readAll(1);
@ -513,14 +517,15 @@ sub skipBinary
return $result;
}
die new Thrift::TException("Type $type not recognised --- corrupt data?");
die new Thrift::TProtocolException("Type $type not recognized --- corrupt data?",
Thrift::TProtocolException::INVALID_DATA);
}
#
# Protocol factory creates protocol objects from transports
#
package TProtocolFactory;
package Thrift::TProtocolFactory;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;

View file

@ -17,19 +17,22 @@
# under the License.
#
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Protocol;
package Thrift::ProtocolDecorator;
use base qw(Thrift::Protocol);
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
my $protocol = shift;
my $self = $classname->SUPER::new($protocol->getTransport());
$self->{concreteProtocol} = $protocol;
return bless($self,$classname);
@ -45,7 +48,7 @@ sub new {
sub writeMessageBegin {
my $self = shift;
my ($name, $type, $seqid) = @_;
return $self->{concreteProtocol}->writeMessageBegin($name, $type, $seqid);
}
@ -54,7 +57,7 @@ sub writeMessageBegin {
#
sub writeMessageEnd {
my $self = shift;
return $self->{concreteProtocol}->writeMessageEnd();
}
@ -79,7 +82,7 @@ sub writeStructBegin {
# @return int How many bytes written
#
sub writeStructEnd {
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->writeStructEnd();
}
@ -101,13 +104,13 @@ sub writeFieldBegin {
}
sub writeFieldEnd {
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->writeFieldEnd();
}
sub writeFieldStop {
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->writeFieldStop();
}
@ -121,7 +124,7 @@ sub writeMapBegin {
sub writeMapEnd {
my $self = shift;
return $self->{concreteProtocol}->writeMapEnd();
}
@ -134,7 +137,7 @@ sub writeListBegin {
sub writeListEnd {
my $self = shift;
return $self->{concreteProtocol}->writeListEnd();
}
@ -147,7 +150,7 @@ sub writeSetBegin {
sub writeSetEnd {
my $self = shift;
return $self->{concreteProtocol}->writeListEnd();
}
@ -177,7 +180,7 @@ sub writeI32 {
my ($i32) = @_;
return $self->{concreteProtocol}->writeI32($i32);
}
sub writeI64 {
@ -221,7 +224,7 @@ sub readMessageBegin
#
sub readMessageEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readMessageEnd();
}
@ -236,7 +239,7 @@ sub readStructBegin
sub readStructEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readStructEnd();
}
@ -251,7 +254,7 @@ sub readFieldBegin
sub readFieldEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readFieldEnd();
}
@ -266,7 +269,7 @@ sub readMapBegin
sub readMapEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readMapEnd();
}
@ -281,7 +284,7 @@ sub readListBegin
sub readListEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readListEnd();
}
@ -296,7 +299,7 @@ sub readSetBegin
sub readSetEnd
{
my $self = shift;
my $self = shift;
return $self->{concreteProtocol}->readSetEnd();
}

View file

@ -17,24 +17,24 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::SSLSocket;
use Thrift::ServerSocket;
use IO::Socket::SSL;
use IO::Select;
package Thrift::SSLServerSocket;
use base qw( Thrift::ServerSocket );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
# Takes a hash:
# See Thirft::Socket for base class parameters.
# See Thrift::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
@ -48,21 +48,29 @@ sub new
sub __client
{
return new Thrift::SSLSocket();
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});
my $opts = {Listen => $self->{queue},
LocalAddr => $self->{host},
LocalPort => $self->{port},
Proto => 'tcp',
ReuseAddr => 1};
my $verify = IO::Socket::SSL::SSL_VERIFY_PEER | IO::Socket::SSL::SSL_VERIFY_FAIL_IF_NO_PEER_CERT | IO::Socket::SSL::SSL_VERIFY_CLIENT_ONCE;
$opts->{SSL_ca_file} = $self->{ca} if defined $self->{ca};
$opts->{SSL_cert_file} = $self->{cert} if defined $self->{cert};
$opts->{SSL_cipher_list} = $self->{ciphers} if defined $self->{ciphers};
$opts->{SSL_key_file} = $self->{key} if defined $self->{key};
$opts->{SSL_use_cert} = (defined $self->{cert}) ? 1 : 0;
$opts->{SSL_verify_mode} = (defined $self->{ca}) ? $verify : IO::Socket::SSL::SSL_VERIFY_NONE;
$opts->{SSL_version} = (defined $self->{version}) ? $self->{version} : 'SSLv23:!SSLv3:!SSLv2';
return IO::Socket::SSL->new(%$opts);
}
1;

View file

@ -17,21 +17,42 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Transport;
use Thrift::Socket;
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 );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Construction and usage
#
# my $opts = {}
# my $socket = new Thrift::SSLSocket(\%opts);
#
# options:
#
# Any option from Socket.pm is valid, and then:
#
# ca => certificate authority file (PEM file) to authenticate the
# server against; if not specified then the server is not
# authenticated
# cert => certificate to use as the client; if not specified then
# the client does not present one but still connects using
# secure protocol
# ciphers => allowed cipher list
# (see http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS)
# key => certificate key for "cert" option
# version => acceptable SSL/TLS versions - if not specified then the
# default is to use SSLv23 handshake but only negotiate
# at TLSv1.0 or later
#
sub new
{
@ -44,10 +65,22 @@ sub new
sub __open
{
my $self = shift;
return IO::Socket::SSL->new(PeerAddr => $self->{host},
PeerPort => $self->{port},
Proto => 'tcp',
Timeout => $self->{sendTimeout} / 1000);
my $opts = {PeerAddr => $self->{host},
PeerPort => $self->{port},
Proto => 'tcp',
Timeout => $self->{sendTimeout} / 1000};
my $verify = IO::Socket::SSL::SSL_VERIFY_PEER | IO::Socket::SSL::SSL_VERIFY_FAIL_IF_NO_PEER_CERT | IO::Socket::SSL::SSL_VERIFY_CLIENT_ONCE;
$opts->{SSL_ca_file} = $self->{ca} if defined $self->{ca};
$opts->{SSL_cert_file} = $self->{cert} if defined $self->{cert};
$opts->{SSL_cipher_list} = $self->{ciphers} if defined $self->{ciphers};
$opts->{SSL_key_file} = $self->{key} if defined $self->{key};
$opts->{SSL_use_cert} = (defined $self->{cert}) ? 1 : 0;
$opts->{SSL_verify_mode} = (defined $self->{ca}) ? $verify : IO::Socket::SSL::SSL_VERIFY_NONE;
$opts->{SSL_version} = (defined $self->{version}) ? $self->{version} : 'SSLv23:!SSLv3:!SSLv2';
return IO::Socket::SSL->new(%$opts);
}
sub __close
@ -61,10 +94,10 @@ sub __close
sub __recv
{
my $self = shift;
my $sock = shift;
my $len = shift;
my $buf = undef;
my $self = shift;
my $sock = shift;
my $len = shift;
my $buf = undef;
if ($sock) {
sysread($sock, $buf, $len);
}

View file

@ -17,25 +17,31 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::BufferedTransport;
use Thrift::BinaryProtocol;
use Thrift::BufferedTransport;
use Thrift::Exception;
#
# Server base class module
#
package Thrift::Server;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# 3 possible constructors:
# 1. (processor, serverTransport)
# Uses a BufferedTransportFactory and a BinaryProtocolFactory.
# 2. (processor, serverTransport, transportFactory, protocolFactory)
# Uses the same factory for input and output of each type.
# 3. (processor, serverTransport,
# inputTransportFactory, outputTransportFactory,
# inputProtocolFactory, outputProtocolFactory)
#
sub new
{
my $classname = shift;
@ -61,7 +67,7 @@ sub new
}
else
{
die "Thrift::Server expects exactly 2, 4, or 6 args";
die new Thrift::TException("Thrift::Server expects exactly 2, 4, or 6 args");
}
return bless($self,$classname);
@ -109,7 +115,7 @@ sub _handleException
my $self = shift;
my $e = shift;
if ($e =~ m/TException/ and exists $e->{message}) {
if ($e->isa("Thrift::TException") and exists $e->{message}) {
my $message = $e->{message};
my $code = $e->{code};
my $out = $code . ':' . $message;
@ -129,41 +135,46 @@ sub _handleException
# SimpleServer from the Server base class that handles one connection at a time
#
package Thrift::SimpleServer;
use base qw( Thrift::Server );
use parent -norequire, 'Thrift::Server';
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
my $classname = shift;
my @args = @_;
my $self = $classname->SUPER::new(@args);
my $self = $classname->SUPER::new(@_);
return bless($self,$classname);
}
sub serve
{
my $self = shift;
my $stop = 0;
$self->{serverTransport}->listen();
while (1)
{
while (!$stop) {
my $client = $self->{serverTransport}->accept();
my $itrans = $self->{inputTransportFactory}->getTransport($client);
my $otrans = $self->{outputTransportFactory}->getTransport($client);
my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
eval {
$self->_clientBegin($iprot, $oprot);
while (1)
{
$self->{processor}->process($iprot, $oprot);
if (defined $client) {
my $itrans = $self->{inputTransportFactory}->getTransport($client);
my $otrans = $self->{outputTransportFactory}->getTransport($client);
my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
eval {
$self->_clientBegin($iprot, $oprot);
while (1)
{
$self->{processor}->process($iprot, $oprot);
}
}; if($@) {
$self->_handleException($@);
}
}; if($@) {
$self->_handleException($@);
}
$itrans->close();
$otrans->close();
$itrans->close();
$otrans->close();
} else {
$stop = 1;
}
}
}
@ -172,9 +183,9 @@ sub serve
# ForkingServer that forks a new process for each request
#
package Thrift::ForkingServer;
use base qw( Thrift::Server );
use parent -norequire, 'Thrift::Server';
use POSIX ":sys_wait_h";
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@ -217,7 +228,7 @@ sub _client
my $pid = fork();
if ($pid) #parent
if ($pid)
{
$self->_parent($pid, $itrans, $otrans);
} else {
@ -235,10 +246,6 @@ sub _parent
my $itrans = shift;
my $otrans = shift;
# add before collect, otherwise you race w/ waitpid
$self->{children}->{$pid} = 1;
$self->_collectChildren();
# Parent must close socket or the connection may not get closed promptly
$self->tryClose($itrans);
$self->tryClose($otrans);
@ -254,6 +261,8 @@ sub _child
my $ecode = 0;
eval {
# THRIFT-4065 ensure child process has normal signal handling in case thrift handler uses it
$SIG{CHLD} = 'DEFAULT';
while (1)
{
$self->{processor}->process($iprot, $oprot);
@ -280,7 +289,7 @@ sub tryClose
$file->close();
}
}; if($@) {
if ($@ =~ m/TException/ and exists $@->{message}) {
if ($@->isa("Thrift::TException") and exists $@->{message}) {
my $message = $@->{message};
my $code = $@->{code};
my $out = $code . ':' . $message;
@ -292,24 +301,4 @@ sub tryClose
}
}
sub _collectChildren
{
my $self = shift;
while (scalar keys %{$self->{children}})
{
my $pid = waitpid(-1, WNOHANG);
if ($pid>0)
{
delete $self->{children}->{$pid};
}
else
{
last;
}
}
}
1;

View file

@ -17,18 +17,19 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;
use Thrift;
use Thrift::Transport;
use Thrift::Socket;
package Thrift::ServerSocket;
use base qw( Thrift::ServerTransport );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
@ -44,7 +45,7 @@ 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;
@ -55,7 +56,7 @@ sub new
if (not defined $self->{queue}) {
$self->{queue} = 128;
}
return bless($self, $classname);
}
@ -70,7 +71,7 @@ sub listen
$self->{debugHandler}->($error);
}
die new Thrift::TException($error);
die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
$self->{handle} = $sock;
@ -80,15 +81,24 @@ sub accept
{
my $self = shift;
if ( exists $self->{handle} and defined $self->{handle} )
{
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;
return undef;
}
sub close
{
my $self = shift;
if ( exists $self->{handle} and defined $self->{handle} )
{
$self->{handle}->close();
}
}
###
@ -97,7 +107,7 @@ sub accept
sub __client
{
return new Thrift::Socket();
return new Thrift::Socket();
}
sub __listen

View file

@ -17,37 +17,63 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Exception;
use Thrift::Transport;
use IO::Socket::INET;
use IO::Select;
package Thrift::Socket;
use base qw( Thrift::Transport );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Construction and usage
#
# my $opts = {}
# my $socket = new Thrift::Socket(\%opts);
#
# options:
#
# host => host to connect to
# port => port to connect to
# sendTimeout => timeout used for send and for connect
# recvTimeout => timeout used for recv
#
sub new
{
my $classname = shift;
my $host = shift || "localhost";
my $port = shift || 9090;
my $debugHandler = shift;
my $classname = shift;
my $opts = shift;
# default settings:
my $self = {
host => $host,
port => $port,
debugHandler => $debugHandler,
debug => 0,
sendTimeout => 10000,
host => 'localhost',
port => 9090,
recvTimeout => 10000,
handle => undef,
sendTimeout => 10000,
handle => undef
};
if (defined $opts and ref $opts eq ref {}) {
# argument is a hash of options so override the defaults
$self->{$_} = $opts->{$_} for keys %$opts;
} else {
# older style constructor takes 3 arguments, none of which are required
$self->{host} = $opts || 'localhost';
$self->{port} = shift || 9090;
}
return bless($self,$classname);
}
@ -69,19 +95,6 @@ sub setRecvTimeout
}
#
#Sets debugging output on or off
#
# @param bool $debug
#
sub setDebug
{
my $self = shift;
my $debug = shift;
$self->{debug} = $debug;
}
#
# Tests whether this is open
#
@ -107,12 +120,7 @@ sub open
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);
die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
$self->{handle} = new IO::Select( $sock );
@ -125,7 +133,7 @@ sub close
{
my $self = shift;
if( defined $self->{handle} ) {
$self->__close();
$self->__close();
}
}
@ -151,8 +159,8 @@ sub readAll
if (!defined $buf || $buf eq '') {
die new Thrift::TException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port});
die new Thrift::TTransportException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
} elsif ((my $sz = length($buf)) < $len) {
@ -183,8 +191,8 @@ sub read
if (!defined $buf || $buf eq '') {
die new TException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port});
die new Thrift::TTransportException(ref($self).': Could not read '.$len.' bytes from '.
$self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
}
@ -209,16 +217,16 @@ sub write
my @sockets = $self->{handle}->can_write( $self->{sendTimeout} / 1000 );
if(@sockets == 0){
die new Thrift::TException(ref($self).': timed out writing to bytes from '.
$self->{host}.':'.$self->{port});
die new Thrift::TTransportException(ref($self).': timed out writing to bytes from '.
$self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT);
}
my $sent = $self->__send($sockets[0], $buf);
if (!defined $sent || $sent == 0 ) {
die new Thrift::TException(ref($self).': Could not write '.length($buf).' bytes '.
$self->{host}.':'.$self->{host});
die new Thrift::TTransportException(ref($self).': Could not write '.length($buf).' bytes '.
$self->{host}.':'.$self->{host}, Thrift::TTransportException::END_OF_FILE);
}
@ -259,7 +267,7 @@ sub __open
#
sub __close
{
my $self = shift;
my $self = shift;
CORE::close(($self->{handle}->handles())[0]);
}
@ -272,12 +280,12 @@ sub __close
#
sub __recv
{
my $self = shift;
my $sock = shift;
my $len = shift;
my $buf = undef;
$sock->recv($buf, $len);
return $buf;
my $self = shift;
my $sock = shift;
my $len = shift;
my $buf = undef;
$sock->recv($buf, $len);
return $buf;
}
#
@ -306,8 +314,8 @@ sub __wait
my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
if (@sockets == 0) {
die new Thrift::TException(ref($self).': timed out reading from '.
$self->{host}.':'.$self->{port});
die new Thrift::TTransportException(ref($self).': timed out reading from '.
$self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT);
}
return $sockets[0];

View file

@ -17,17 +17,19 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Exception;
#
# Transport exceptions
#
package TTransportException;
package Thrift::TTransportException;
use base('Thrift::TException');
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant UNKNOWN => 0;
use constant NOT_OPEN => 1;
@ -35,7 +37,7 @@ use constant ALREADY_OPEN => 2;
use constant TIMED_OUT => 3;
use constant END_OF_FILE => 4;
sub new{
sub new {
my $classname = shift;
my $self = $classname->SUPER::new(@_);
@ -43,6 +45,7 @@ sub new{
}
package Thrift::Transport;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Whether this transport is open.
@ -81,8 +84,7 @@ sub close
#
sub read
{
my ($len);
die("abstract");
die "abstract";
}
#
@ -114,7 +116,6 @@ sub readAll
#
sub write
{
my ($buf);
die "abstract";
}
@ -130,6 +131,7 @@ sub flush {}
# TransportFactory creates transport objects from transports
#
package Thrift::TransportFactory;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@ -156,6 +158,7 @@ sub getTransport
# ServerTransport base class module
#
package Thrift::ServerTransport;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub listen
{

View file

@ -0,0 +1,50 @@
#
# 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.
#
use 5.10.0;
use strict;
use warnings;
use Thrift;
#
# Data types that can be sent via Thrift
#
package Thrift::TType;
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
use constant STOP => 0;
use constant VOID => 1;
use constant BOOL => 2;
use constant BYTE => 3;
use constant I08 => 3;
use constant DOUBLE => 4;
use constant I16 => 6;
use constant I32 => 8;
use constant I64 => 10;
use constant STRING => 11;
use constant UTF7 => 11;
use constant STRUCT => 12;
use constant MAP => 13;
use constant SET => 14;
use constant LIST => 15;
use constant UTF8 => 16;
use constant UTF16 => 17;
1;

View file

@ -17,19 +17,19 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::ServerSocket;
use Thrift::UnixSocket;
use IO::Socket::UNIX;
use IO::Select;
package Thrift::UnixServerSocket;
use base qw( Thrift::ServerSocket );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
@ -58,7 +58,7 @@ sub new
sub __client
{
return new Thrift::UnixSocket();
return new Thrift::UnixSocket();
}
sub __listen
@ -75,7 +75,7 @@ sub __listen
if ($self->{debug}) {
$self->{debugHandler}->($error);
}
die new Thrift::TException($error);
die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
return $sock;

View file

@ -17,24 +17,23 @@
# under the License.
#
require 5.6.0;
use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::Transport;
use Thrift::Socket;
use IO::Socket::UNIX;
use IO::Select;
package Thrift::UnixSocket;
use base qw( Thrift::Socket );
use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
# Takes a unix domain socket filename.
# See Thirft::Socket for base class parameters.
# See Thrift::Socket for base class parameters.
# @param[in] path path to unix socket file
# @example my $sock = new Thrift::UnixSocket($path);
#
@ -42,7 +41,7 @@ sub new
{
my $classname = shift;
my $self = $classname->SUPER::new();
$self->{path} = shift;
$self->{path} = shift;
return bless($self, $classname);
}
@ -59,7 +58,7 @@ sub __open
if ($self->{debug}) {
$self->{debugHandler}->($error);
}
die new Thrift::TException($error);
die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
return $sock;

View file

@ -22,15 +22,13 @@ use Test::More tests => 6;
use strict;
use warnings;
use Thrift;
use Thrift::Socket;
use Thrift::Server;
use Thrift::MultiplexedProcessor;
use Thrift::BinaryProtocol;
use Thrift::MemoryBuffer;
use Thrift::FramedTransport;
use Thrift::MemoryBuffer;
use Thrift::MessageType;
use Thrift::MultiplexedProcessor;
use Thrift::Server;
use Thrift::Socket;
use BenchmarkService;
use Aggr;
@ -103,7 +101,7 @@ for(my $i = 1; $i <= 5; $i++) {
$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
if ($message_type == TMessageType::EXCEPTION) {
if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
@ -116,7 +114,7 @@ my ($function_name, $message_type, $sequence_id);
$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
if ($message_type == TMessageType::EXCEPTION) {
if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
@ -132,7 +130,7 @@ foreach my $val((1,2,3,5,8)) {
$benchmark_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
if ($message_type == TMessageType::EXCEPTION) {
if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
my $benchmark_result = BenchmarkService_fibonacci_result->new();

View file

@ -22,9 +22,9 @@ use Test::More tests => 2;
use strict;
use warnings;
use Thrift;
use Thrift::BinaryProtocol;
use Thrift::MemoryBuffer;
use Thrift::MessageType;
use ThriftTest::ThriftTest;
use ThriftTest::Types;
@ -72,7 +72,7 @@ foreach my $val (("got foo","got bar")){
$protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
print " $function_name, $message_type, $sequence_id\n";
if ($message_type == TMessageType::EXCEPTION) {
if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}

View file

@ -0,0 +1,35 @@
#
# 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.
#
#
# This will fix up the distribution so that CPAN properly
# indexes Thrift.
#
use 5.10.0;
use strict;
use warnings;
use utf8;
use Data::Dumper;
use CPAN::Meta;
my $meta = CPAN::Meta->load_file('META.json');
$meta->{'provides'} = { 'Thrift' => { 'file' => 'lib/Thrift.pm', 'version' => $meta->version() } };
$meta->save('META.json');