diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
| commit | 19fcec84d8d7d21e796c7624e521b60d28ee21ed (patch) | |
| tree | 42d26aa27d1e3f7c0b8bd3fd14e7d7082f5008dc /src/jaegertracing/thrift/lib/perl | |
| parent | Initial commit. (diff) | |
| download | ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.tar.xz ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.zip | |
Adding upstream version 16.2.11+ds.upstream/16.2.11+dsupstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'src/jaegertracing/thrift/lib/perl')
33 files changed, 4687 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP b/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP new file mode 100644 index 000000000..9b044509e --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP @@ -0,0 +1,14 @@ +blib/.*$ +build-cpan-dist.sh +FixupDist.pl +MANIFEST.bak +MANIFEST.SKIP +MYMETA.json +Makefile +Makefile.am +Makefile.in +pm_to_blib +t/Makefile +t/Makefile.am +t/Makefile.in +tools/FixupDist.pl diff --git a/src/jaegertracing/thrift/lib/perl/Makefile.PL b/src/jaegertracing/thrift/lib/perl/Makefile.PL new file mode 100644 index 000000000..5e60ab40a --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/Makefile.PL @@ -0,0 +1,49 @@ +# +# 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 ExtUtils::MakeMaker; + +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 + }, +# SIGN => 1, + VERSION_FROM => 'lib/Thrift.pm' ); + +# THRIFT-4691 +package MY; # so that "SUPER" works right +sub test { + # Adds gen-perl and gen-perl2 to the test execution as include paths + # Could not find anything in MakeMaker that would do this... + my @result; + for (@result = shift->SUPER::test(@_)) { + s/\$\(TEST_FILES\)/-Igen-perl -Igen-perl2 \$(TEST_FILES)/ig; + } + @result; +} diff --git a/src/jaegertracing/thrift/lib/perl/Makefile.am b/src/jaegertracing/thrift/lib/perl/Makefile.am new file mode 100644 index 000000000..abae1e77f --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/Makefile.am @@ -0,0 +1,108 @@ +# +# 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. +# + +SUBDIRS = t + +Makefile-perl.mk : Makefile.PL + $(PERL) Makefile.PL MAKEFILE=Makefile-perl.mk INSTALLDIRS=$(INSTALLDIRS) INSTALL_BASE=$(PERL_PREFIX) + +all-local: Makefile-perl.mk + $(MAKE) -f $< + find blib -name 'Makefile*' -exec rm -f {} \; + +install-exec-local: Makefile-perl.mk + $(MAKE) -f $< install DESTDIR=$(DESTDIR)/ + +clean-local: + if test -f Makefile-perl.mk ; then \ + $(MAKE) -f Makefile-perl.mk clean ; \ + fi + $(RM) Makefile-perl.mk.old + $(RM) -r gen-perl gen-perl2 + +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 \ + lib/Thrift/MessageType.pm \ + lib/Thrift/MultiplexedProcessor.pm \ + lib/Thrift/MultiplexedProtocol.pm \ + lib/Thrift/Protocol.pm \ + lib/Thrift/ProtocolDecorator.pm \ + lib/Thrift/Server.pm \ + lib/Thrift/ServerSocket.pm \ + lib/Thrift/Socket.pm \ + lib/Thrift/SSLSocket.pm \ + lib/Thrift/SSLServerSocket.pm \ + lib/Thrift/UnixServerSocket.pm \ + lib/Thrift/UnixSocket.pm \ + lib/Thrift/Type.pm \ + lib/Thrift/Transport.pm \ + README.md + +THRIFT = @top_builddir@/compiler/cpp/thrift +THRIFT_IF = @top_srcdir@/test/ThriftTest.thrift +NAME_BENCHMARKSERVICE = @top_srcdir@/lib/rb/benchmark/Benchmark.thrift +NAME_AGGR = @top_srcdir@/contrib/async-test/aggr.thrift + +THRIFTTEST_GEN = \ + gen-perl/ThriftTest/Constants.pm \ + gen-perl/ThriftTest/SecondService.pm \ + gen-perl/ThriftTest/ThriftTest.pm \ + gen-perl/ThriftTest/Types.pm + +BENCHMARK_GEN = \ + gen-perl/BenchmarkService.pm \ + gen-perl/Constants.pm \ + gen-perl/Types.pm + +AGGR_GEN = \ + gen-perl2/Aggr.pm \ + gen-perl2/Constants.pm \ + gen-perl2/Types.pm + +PERL_GEN = \ + $(THRIFTTEST_GEN) \ + $(BENCHMARK_GEN) \ + $(AGGR_GEN) + +BUILT_SOURCES = $(PERL_GEN) + +check-local: $(PERL_GEN) + $(PERL) -Iblib/lib -I@abs_srcdir@ -I@builddir@/gen-perl2 -I@builddir@/gen-perl \ + @abs_srcdir@/test.pl @abs_srcdir@/t/*.t + +$(THRIFTTEST_GEN): $(THRIFT_IF) $(THRIFT) + $(THRIFT) --gen perl $< + +$(BENCHMARK_GEN): $(NAME_BENCHMARKSERVICE) $(THRIFT) + $(THRIFT) --gen perl $< + +$(AGGR_GEN): $(NAME_AGGR) $(THRIFT) + $(MKDIR_P) gen-perl2 + $(THRIFT) -out gen-perl2 --gen perl $< diff --git a/src/jaegertracing/thrift/lib/perl/README.md b/src/jaegertracing/thrift/lib/perl/README.md new file mode 100644 index 000000000..bd1e5b2e4 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/README.md @@ -0,0 +1,124 @@ +Thrift Perl Software Library + +# 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 +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. + +# For More Information + +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 +of the exception is delivered as the message. + +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. + +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. + diff --git a/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh b/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh new file mode 100755 index 000000000..c92fd76b5 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh @@ -0,0 +1,56 @@ +#!/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 Log::Log4perl +cpan install CPAN +cpan install CPAN::Meta ExtUtils::MakeMaker JSON::PP +# cpan install Module::Signature + +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 . +cp -pr ../gen-perl . +cp -pr ../gen-perl2 . +perl ../tools/FixupDist.pl +cd .. +tar cvzf --hard-dereference $DISTFILE $DISTDIR +rm -r $DISTDIR diff --git a/src/jaegertracing/thrift/lib/perl/coding_standards.md b/src/jaegertracing/thrift/lib/perl/coding_standards.md new file mode 100644 index 000000000..e4e825555 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/coding_standards.md @@ -0,0 +1,2 @@ +Please follow [General Coding Standards](/doc/coding_standards.md). +Additional perl coding standards can be found in [perlstyle](http://perldoc.perl.org/perlstyle.html). diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm new file mode 100644 index 000000000..01985ea87 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm @@ -0,0 +1,36 @@ +# +# 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; + +# +# Versioning +# +# 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. +# + +package Thrift; +use version 0.77; our $VERSION = version->declare("v0.13.0"); + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm new file mode 100644 index 000000000..d62509a56 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm @@ -0,0 +1,518 @@ +# +# 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 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; +use constant IS_BIG_ENDIAN => unpack('h*', pack('s', 1)) =~ m/01/; + +sub new +{ + my $classname = shift; + my $trans = shift; + my $self = $classname->SUPER::new($trans); + + return bless($self,$classname); +} + +sub writeMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + return + $self->writeI32(VERSION_1 | $type) + + $self->writeString($name) + + $self->writeI32($seqid); +} + +sub writeMessageEnd +{ + my $self = shift; + return 0; +} + +sub writeStructBegin +{ + my $self = shift; + my $name = shift; + return 0; +} + +sub writeStructEnd +{ + my $self = shift; + return 0; +} + +sub writeFieldBegin +{ + my $self = shift; + my ($fieldName, $fieldType, $fieldId) = @_; + + return + $self->writeByte($fieldType) + + $self->writeI16($fieldId); +} + +sub writeFieldEnd +{ + my $self = shift; + return 0; +} + +sub writeFieldStop +{ + my $self = shift; + return $self->writeByte(Thrift::TType::STOP); +} + +sub writeMapBegin +{ + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return + $self->writeByte($keyType) + + $self->writeByte($valType) + + $self->writeI32($size); +} + +sub writeMapEnd +{ + my $self = shift; + return 0; +} + +sub writeListBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->writeByte($elemType) + + $self->writeI32($size); +} + +sub writeListEnd +{ + my $self = shift; + return 0; +} + +sub writeSetBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->writeByte($elemType) + + $self->writeI32($size); +} + +sub writeSetEnd +{ + my $self = shift; + return 0; +} + +sub writeBool +{ + my $self = shift; + my $value = shift; + + my $data = pack('c', $value ? 1 : 0); + $self->{trans}->write($data, 1); + return 1; +} + +sub writeByte +{ + my $self = shift; + my $value= shift; + + my $data = pack('c', $value); + $self->{trans}->write($data, 1); + return 1; +} + +sub writeI16 +{ + my $self = shift; + my $value= shift; + + my $data = pack('n', $value); + $self->{trans}->write($data, 2); + return 2; +} + +sub writeI32 +{ + my $self = shift; + my $value= shift; + + my $data = pack('N', $value); + $self->{trans}->write($data, 4); + return 4; +} + +sub writeI64 +{ + my $self = shift; + my $value= shift; + my $data; + + my $vec; + #stop annoying error + $vec = Bit::Vector->new_Dec(64, $value); + $data = pack 'NN', $vec->Chunk_Read(32, 32), $vec->Chunk_Read(32, 0); + + $self->{trans}->write($data, 8); + + return 8; +} + + +sub writeDouble +{ + my $self = shift; + my $value= shift; + + my $data = pack('d', $value); + if (IS_BIG_ENDIAN) { + $self->{trans}->write($data, 8); + } + else { + $self->{trans}->write(scalar reverse($data), 8); + } + return 8; +} + +sub writeString{ + my $self = shift; + my $value= shift; + + if( utf8::is_utf8($value) ){ + $value = Encode::encode_utf8($value); + } + + my $len = length($value); + + my $result = $self->writeI32($len); + + if ($len) { + $self->{trans}->write($value,$len); + } + return $result + $len; + } + + +# +#All references +# +sub readMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + my $version = 0; + my $result = $self->readI32(\$version); + if (($version & VERSION_MASK) > 0) { + if (($version & VERSION_MASK) != VERSION_1) { + die Thrift::TProtocolException->new('Missing version identifier', + Thrift::TProtocolException::BAD_VERSION); + } + $$type = $version & 0x000000ff; + return + $result + + $self->readString($name) + + $self->readI32($seqid); + } + else { # old client support code + return + $result + + $self->readStringBody($name, $version) + # version here holds the size of the string + $self->readByte($type) + + $self->readI32($seqid); + } +} + +sub readMessageEnd +{ + my $self = shift; + return 0; +} + +sub readStructBegin +{ + my $self = shift; + my $name = shift; + + $$name = ''; + + return 0; +} + +sub readStructEnd +{ + my $self = shift; + return 0; +} + +sub readFieldBegin +{ + my $self = shift; + my ($name, $fieldType, $fieldId) = @_; + + my $result = $self->readByte($fieldType); + + if ($$fieldType == Thrift::TType::STOP) { + $$fieldId = 0; + return $result; + } + + $result += $self->readI16($fieldId); + + return $result; +} + +sub readFieldEnd() { + my $self = shift; + return 0; +} + +sub readMapBegin +{ + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return + $self->readByte($keyType) + + $self->readByte($valType) + + $self->readI32($size); +} + +sub readMapEnd() +{ + my $self = shift; + return 0; +} + +sub readListBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->readByte($elemType) + + $self->readI32($size); +} + +sub readListEnd +{ + my $self = shift; + return 0; +} + +sub readSetBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->readByte($elemType) + + $self->readI32($size); +} + +sub readSetEnd +{ + my $self = shift; + return 0; +} + +sub readBool +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(1); + my @arr = unpack('c', $data); + $$value = $arr[0] == 1; + return 1; +} + +sub readByte +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(1); + my @arr = unpack('c', $data); + $$value = $arr[0]; + return 1; +} + +sub readI16 +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(2); + + my @arr = unpack('n', $data); + + $$value = $arr[0]; + + if ($$value > 0x7fff) { + $$value = 0 - (($$value - 1) ^ 0xffff); + } + + return 2; +} + +sub readI32 +{ + my $self = shift; + my $value= shift; + + my $data = $self->{trans}->readAll(4); + my @arr = unpack('N', $data); + + $$value = $arr[0]; + if ($$value > 0x7fffffff) { + $$value = 0 - (($$value - 1) ^ 0xffffffff); + } + return 4; +} + +sub readI64 +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(8); + + my ($hi,$lo)=unpack('NN',$data); + + my $vec = Bit::Vector->new(64); + + $vec->Chunk_Store(32,32,$hi); + $vec->Chunk_Store(32,0,$lo); + + $$value = $vec->to_Dec(); + + return 8; +} + +sub readDouble +{ + my $self = shift; + my $value = shift; + + my $data; + if (IS_BIG_ENDIAN) { + $data = $self->{trans}->readAll(8); + } + else { + $data = scalar reverse($self->{trans}->readAll(8)); + } + + my @arr = unpack('d', $data); + + $$value = $arr[0]; + + return 8; +} + +sub readString +{ + my $self = shift; + my $value = shift; + + my $len; + my $result = $self->readI32(\$len); + + if ($len) { + $$value = $self->{trans}->readAll($len); + } + else { + $$value = ''; + } + + return $result + $len; +} + +sub readStringBody +{ + my $self = shift; + my $value = shift; + my $len = shift; + + if ($len) { + $$value = $self->{trans}->readAll($len); + } + else { + $$value = ''; + } + + return $len; +} + +# +# Binary Protocol Factory +# +package Thrift::BinaryProtocolFactory; +use base('Thrift::TProtocolFactory'); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + my $self = $classname->SUPER::new(); + + return bless($self,$classname); +} + +sub getProtocol{ + my $self = shift; + my $trans = shift; + + return Thrift::BinaryProtocol->new($trans); +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm new file mode 100644 index 000000000..6b5bf7a4c --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm @@ -0,0 +1,139 @@ +# +# 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::Exception; +use Thrift::Transport; + +package Thrift::BufferedTransport; +use base('Thrift::Transport'); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + my $transport = shift; + my $rBufSize = shift || 512; + my $wBufSize = shift || 512; + + my $self = { + transport => $transport, + rBufSize => $rBufSize, + wBufSize => $wBufSize, + wBuf => '', + rBuf => '', + }; + + return bless($self,$classname); +} + +sub isOpen +{ + my $self = shift; + + return $self->{transport}->isOpen(); +} + +sub open +{ + my $self = shift; + $self->{transport}->open(); +} + +sub close() +{ + my $self = shift; + $self->{transport}->close(); +} + +sub readAll +{ + my $self = shift; + my $len = shift; + + return $self->{transport}->readAll($len); +} + +sub read +{ + my $self = shift; + my $len = shift; + my $ret; + + # Methinks Perl is already buffering these for us + return $self->{transport}->read($len); +} + +sub write +{ + my $self = shift; + my $buf = shift; + + $self->{wBuf} .= $buf; + if (length($self->{wBuf}) >= $self->{wBufSize}) { + $self->{transport}->write($self->{wBuf}); + $self->{wBuf} = ''; + } +} + +sub flush +{ + my $self = shift; + + if (length($self->{wBuf}) > 0) { + $self->{transport}->write($self->{wBuf}); + $self->{wBuf} = ''; + } + $self->{transport}->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; + my $self = {}; + + return bless($self,$classname); +} + +# +# Build a buffered transport from the base transport +# +# @return Thrift::BufferedTransport transport +# +sub getTransport +{ + my $self = shift; + my $trans = shift; + + my $buffered = Thrift::BufferedTransport->new($trans); + return $buffered; +} + + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm new file mode 100644 index 000000000..e4040689c --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm @@ -0,0 +1,161 @@ +# +# 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 + sprintf '%s error: %s (code %s)', + ref( $_[0] ), + ( $_[0]->{message} || 'empty message' ), + ( 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; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm new file mode 100644 index 000000000..ba89ba3e0 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm @@ -0,0 +1,194 @@ +# +# 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::Transport; + +# +# Framed transport. Writes and reads data in chunks that are stamped with +# their length. +# +# @package thrift.transport +# +package Thrift::FramedTransport; +use base('Thrift::Transport'); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + my $transport = shift; + my $read = shift || 1; + my $write = shift || 1; + + my $self = { + transport => $transport, + read => $read, + write => $write, + wBuf => '', + rBuf => '', + }; + + return bless($self,$classname); +} + +sub isOpen +{ + my $self = shift; + return $self->{transport}->isOpen(); +} + +sub open +{ + my $self = shift; + + $self->{transport}->open(); +} + +sub close +{ + my $self = shift; + + if (defined $self->{transport}) { + $self->{transport}->close(); + } +} + +# +# Reads from the buffer. When more data is required reads another entire +# chunk and serves future reads out of that. +# +# @param int $len How much data +# +sub read +{ + + my $self = shift; + my $len = shift; + + if (!$self->{read}) { + return $self->{transport}->read($len); + } + + if (length($self->{rBuf}) == 0) { + $self->_readFrame(); + } + + + # Just return full buff + if ($len > length($self->{rBuf})) { + my $out = $self->{rBuf}; + $self->{rBuf} = ''; + return $out; + } + + # Return substr + my $out = substr($self->{rBuf}, 0, $len); + $self->{rBuf} = substr($self->{rBuf}, $len); + return $out; +} + +# +# Reads a chunk of data into the internal read buffer. +# (private) +sub _readFrame +{ + my $self = shift; + my $buf = $self->{transport}->readAll(4); + my @val = unpack('N', $buf); + my $sz = $val[0]; + + $self->{rBuf} = $self->{transport}->readAll($sz); +} + +# +# Writes some data to the pending output buffer. +# +# @param string $buf The data +# @param int $len Limit of bytes to write +# +sub write +{ + my $self = shift; + my $buf = shift; + my $len = shift; + + unless($self->{write}) { + return $self->{transport}->write($buf, $len); + } + + if ( defined $len && $len < length($buf)) { + $buf = substr($buf, 0, $len); + } + + $self->{wBuf} .= $buf; + } + +# +# Writes the output buffer to the stream in the format of a 4-byte length +# followed by the actual data. +# +sub flush +{ + my $self = shift; + + unless ($self->{write}) { + return $self->{transport}->flush(); + } + + my $out = pack('N', length($self->{wBuf})); + $out .= $self->{wBuf}; + $self->{transport}->write($out); + $self->{transport}->flush(); + $self->{wBuf} = ''; + +} + +# +# 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; + 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/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm new file mode 100644 index 000000000..40ec9ce20 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm @@ -0,0 +1,204 @@ +# +# 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 HTTP::Request; +use IO::String; +use LWP::UserAgent; +use Thrift; +use Thrift::Exception; +use Thrift::Transport; + +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 $out = IO::String->new; + binmode($out); + + my $self = { + url => $url, + out => $out, + 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; + + warn 'setSendTimeout is deprecated - use setTimeout instead'; + + $self->setTimeout($timeout); +} + +sub setHeader +{ + my $self = shift; + my ($name, $value) = @_; + + $self->{headers}->{$name} = $value; +} + +# +# Tests whether this is open +# +# @return bool true if the socket is open +# +sub isOpen +{ + return 1; +} + +sub open {} + +# +# Cleans up the buffer. +# +sub close +{ + my $self = shift; + if (defined($self->{io})) { + close($self->{io}); + $self->{io} = undef; + } +} + +# +# Guarantees that the full amount of data is read. +# +# @return string The data, of exact length +# @throws TTransportException if cannot read data +# +sub readAll +{ + my $self = shift; + my $len = shift; + + my $buf = $self->read($len); + + if (!defined($buf)) { + die Thrift::TTransportException->new("TSocket: Could not read $len bytes from input buffer", + Thrift::TTransportException::END_OF_FILE); + } + return $buf; +} + +# +# Read and return string +# +sub read +{ + my $self = shift; + my $len = shift; + + my $buf; + + my $in = $self->{in}; + + if (!defined($in)) { + die Thrift::TTransportException->new('Response buffer is empty, no request.', + Thrift::TTransportException::END_OF_FILE); + } + eval { + my $ret = sysread($in, $buf, $len); + if (! defined($ret)) { + die Thrift::TTransportException->new('No more data available.', + Thrift::TTransportException::TIMED_OUT); + } + }; + if($@){ + die Thrift::TTransportException->new("$@", Thrift::TTransportException::UNKNOWN); + } + + return $buf; +} + +# +# Write string +# +sub write +{ + my $self = shift; + my $buf = shift; + $self->{out}->print($buf); +} + +# +# Flush output (do the actual HTTP/HTTPS request) +# +sub flush +{ + my $self = shift; + + my $ua = LWP::UserAgent->new( + 'timeout' => ($self->{timeout} / 1000), + 'agent' => 'Perl/THttpClient' + ); + $ua->default_header('Accept' => 'application/x-thrift'); + $ua->default_header('Content-Type' => 'application/x-thrift'); + $ua->cookie_jar({}); # hash to remember cookies between redirects + + my $out = $self->{out}; + $out->setpos(0); # rewind + my $buf = join('', <$out>); + + my $request = HTTP::Request->new(POST => $self->{url}, ($self->{headers} || undef), $buf); + my $response = $ua->request($request); + my $content_ref = $response->content_ref; + + my $in = IO::String->new($content_ref); + binmode($in); + $self->{in} = $in; + $in->setpos(0); # rewind + + # reset write buffer + $out = IO::String->new; + binmode($out); + $self->{out} = $out; +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm new file mode 100644 index 000000000..be97ce4f8 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm @@ -0,0 +1,148 @@ +# +# 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::Transport; + +package Thrift::MemoryBuffer; +use base('Thrift::Transport'); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + + my $bufferSize= shift || 1024; + + my $self = { + buffer => '', + bufferSize => $bufferSize, + wPos => 0, + rPos => 0, + }; + + return bless($self,$classname); +} + +sub isOpen +{ + return 1; +} + +sub open +{ + +} + +sub close +{ + +} + +sub peek +{ + my $self = shift; + return($self->{rPos} < $self->{wPos}); +} + + +sub getBuffer +{ + my $self = shift; + return $self->{buffer}; +} + +sub resetBuffer +{ + my $self = shift; + + my $new_buffer = shift || ''; + + $self->{buffer} = $new_buffer; + $self->{bufferSize} = length($new_buffer); + $self->{wPos} = length($new_buffer); + $self->{rPos} = 0; +} + +sub available +{ + my $self = shift; + return ($self->{wPos} - $self->{rPos}); +} + +sub read +{ + my $self = shift; + my $len = shift; + my $ret; + + my $avail = ($self->{wPos} - $self->{rPos}); + return '' if $avail == 0; + + #how much to give + my $give = $len; + $give = $avail if $avail < $len; + + $ret = substr($self->{buffer},$self->{rPos},$give); + + $self->{rPos} += $give; + + return $ret; +} + +sub readAll +{ + my $self = shift; + my $len = shift; + + my $avail = ($self->{wPos} - $self->{rPos}); + if ($avail < $len) { + die TTransportException->new("Attempt to readAll($len) found only $avail available", + Thrift::TTransportException::END_OF_FILE); + } + + my $data = ''; + my $got = 0; + + while (($got = length($data)) < $len) { + $data .= $self->read($len - $got); + } + + return $data; +} + +sub write +{ + my $self = shift; + my $buf = shift; + + $self->{buffer} .= $buf; + $self->{wPos} += length($buf); +} + +sub flush +{ + +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm new file mode 100644 index 000000000..d25c2f771 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm @@ -0,0 +1,37 @@ +# +# 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; + +# +# 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; + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm new file mode 100644 index 000000000..ae925d7cd --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm @@ -0,0 +1,133 @@ +# +# 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::MessageType; +use Thrift::MultiplexedProtocol; +use Thrift::Protocol; +use Thrift::ProtocolDecorator; + +package Thrift::StoredMessageProtocol; +use base qw(Thrift::ProtocolDecorator); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new { + my $classname = shift; + my $protocol = shift; + my $fname = shift; + my $mtype = shift; + my $rseqid = shift; + my $self = $classname->SUPER::new($protocol); + + $self->{fname} = $fname; + $self->{mtype} = $mtype; + $self->{rseqid} = $rseqid; + + return bless($self,$classname); +} + +sub readMessageBegin +{ + my $self = shift; + my $name = shift; + my $type = shift; + my $seqid = shift; + + $$name = $self->{fname}; + $$type = $self->{mtype}; + $$seqid = $self->{rseqid}; +} + +package Thrift::MultiplexedProcessor; +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 { + my $self = shift; + my $input = shift; + my $output = shift; + + # + # Use the actual underlying protocol (e.g. BinaryProtocol) to read the + # message header. This pulls the message "off the wire", which we'll + # deal with at the end of this method. + # + + my ($fname, $mtype, $rseqid); + $input->readMessageBegin(\$fname, \$mtype, \$rseqid); + + if ($mtype ne Thrift::TMessageType::CALL && $mtype ne Thrift::TMessageType::ONEWAY) { + die Thrift::TException->new('This should not have happened!?'); + } + + # Extract the service name and the new Message name. + if (index($fname, Thrift::MultiplexedProtocol::SEPARATOR) == -1) { + if (defined $self->{defaultProcessor}) { + return $self->{defaultProcessor}->process( + Thrift::StoredMessageProtocol->new($input, $fname, $mtype, $rseqid), $output + ); + } else { + die Thrift::TException->new("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 Thrift::TException->new("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( + Thrift::StoredMessageProtocol->new($input, $messageName, $mtype, $rseqid), $output + ); +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm new file mode 100644 index 000000000..5b5b60bc7 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.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. +# + +use 5.10.0; +use strict; +use warnings; + +use Thrift; +use Thrift::MessageType; +use Thrift::Protocol; +use Thrift::ProtocolDecorator; + +package Thrift::MultiplexedProtocol; +use base qw(Thrift::ProtocolDecorator); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +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); +} + +# +# Writes the message header. +# Prepends the service name to the function name, separated by MultiplexedProtocol::SEPARATOR. +# +# @param string $name Function name. +# @param int $type Message type. +# @param int $seqid The sequence id of this message. +# +sub writeMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + 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); + } +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm new file mode 100644 index 000000000..26ef46a00 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm @@ -0,0 +1,549 @@ +# +# 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::Exception; +use Thrift::Type; + +# +# Protocol exceptions +# +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 NOT_IMPLEMENTED => 5; +use constant DEPTH_LIMIT => 6; + +sub new { + my $classname = shift; + + my $self = $classname->SUPER::new(); + + return bless($self,$classname); +} + +# +# Protocol base class module. +# +package Thrift::Protocol; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new { + my $classname = shift; + my $self = {}; + + my $trans = shift; + $self->{trans}= $trans; + + return bless($self,$classname); +} + +sub getTransport +{ + my $self = shift; + + return $self->{trans}; +} + +# +# Writes the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @param int $seqid The sequence id of this message +# +sub writeMessageBegin +{ + my ($name, $type, $seqid); + die 'abstract'; +} + +# +# Close the message +# +sub writeMessageEnd { + die 'abstract'; +} + +# +# Writes a struct header. +# +# @param string $name Struct name +# @throws TProtocolException on write error +# @return int How many bytes written +# +sub writeStructBegin { + my ($name); + + die 'abstract'; +} + +# +# Close a struct. +# +# @throws TProtocolException on write error +# @return int How many bytes written +# +sub writeStructEnd { + die 'abstract'; +} + +# +# Starts a field. +# +# @param string $name Field name +# @param int $type Field type +# @param int $fid Field id +# @throws TProtocolException on write error +# @return int How many bytes written +# +sub writeFieldBegin { + my ($fieldName, $fieldType, $fieldId); + + die 'abstract'; +} + +sub writeFieldEnd { + die 'abstract'; +} + +sub writeFieldStop { + die 'abstract'; +} + +sub writeMapBegin { + my ($keyType, $valType, $size); + + die 'abstract'; +} + +sub writeMapEnd { + die 'abstract'; +} + +sub writeListBegin { + my ($elemType, $size); + die 'abstract'; +} + +sub writeListEnd { + die 'abstract'; +} + +sub writeSetBegin { + my ($elemType, $size); + die 'abstract'; +} + +sub writeSetEnd { + die 'abstract'; +} + +sub writeBool { + my ($bool); + die 'abstract'; +} + +sub writeByte { + my ($byte); + die 'abstract'; +} + +sub writeI16 { + my ($i16); + die 'abstract'; +} + +sub writeI32 { + my ($i32); + die 'abstract'; +} + +sub writeI64 { + my ($i64); + die 'abstract'; +} + +sub writeDouble { + my ($dub); + die 'abstract'; +} + +sub writeString +{ + my ($str); + die 'abstract'; +} + +# +# Reads the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @parem int $seqid The sequence id of this message +# +sub readMessageBegin +{ + my ($name, $type, $seqid); + die 'abstract'; +} + +# +# Read the close of message +# +sub readMessageEnd +{ + die 'abstract'; +} + +sub readStructBegin +{ + my($name); + + die 'abstract'; +} + +sub readStructEnd +{ + die 'abstract'; +} + +sub readFieldBegin +{ + my ($name, $fieldType, $fieldId); + die 'abstract'; +} + +sub readFieldEnd +{ + die 'abstract'; +} + +sub readMapBegin +{ + my ($keyType, $valType, $size); + die 'abstract'; +} + +sub readMapEnd +{ + die 'abstract'; +} + +sub readListBegin +{ + my ($elemType, $size); + die 'abstract'; +} + +sub readListEnd +{ + die 'abstract'; +} + +sub readSetBegin +{ + my ($elemType, $size); + die 'abstract'; +} + +sub readSetEnd +{ + die 'abstract'; +} + +sub readBool +{ + my ($bool); + die 'abstract'; +} + +sub readByte +{ + my ($byte); + die 'abstract'; +} + +sub readI16 +{ + my ($i16); + die 'abstract'; +} + +sub readI32 +{ + my ($i32); + die 'abstract'; +} + +sub readI64 +{ + my ($i64); + die 'abstract'; +} + +sub readDouble +{ + my ($dub); + die 'abstract'; +} + +sub readString +{ + my ($str); + die 'abstract'; +} + +# +# The skip function is a utility to parse over unrecognized data without +# causing corruption. +# +# @param TType $type What type is it +# +sub skip +{ + my $self = shift; + my $type = shift; + + my $ref; + my $result; + my $i; + + if($type == Thrift::TType::BOOL) + { + return $self->readBool(\$ref); + } + elsif($type == Thrift::TType::BYTE){ + return $self->readByte(\$ref); + } + elsif($type == Thrift::TType::I16){ + return $self->readI16(\$ref); + } + elsif($type == Thrift::TType::I32){ + return $self->readI32(\$ref); + } + elsif($type == Thrift::TType::I64){ + return $self->readI64(\$ref); + } + elsif($type == Thrift::TType::DOUBLE){ + return $self->readDouble(\$ref); + } + elsif($type == Thrift::TType::STRING) + { + return $self->readString(\$ref); + } + elsif($type == Thrift::TType::STRUCT) + { + $result = $self->readStructBegin(\$ref); + while (1) { + my ($ftype,$fid); + $result += $self->readFieldBegin(\$ref, \$ftype, \$fid); + if ($ftype == Thrift::TType::STOP) { + last; + } + $result += $self->skip($ftype); + $result += $self->readFieldEnd(); + } + $result += $self->readStructEnd(); + return $result; + } + elsif($type == Thrift::TType::MAP) + { + my($keyType,$valType,$size); + $result = $self->readMapBegin(\$keyType, \$valType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($keyType); + $result += $self->skip($valType); + } + $result += $self->readMapEnd(); + return $result; + } + elsif($type == Thrift::TType::SET) + { + my ($elemType,$size); + $result = $self->readSetBegin(\$elemType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($elemType); + } + $result += $self->readSetEnd(); + return $result; + } + elsif($type == Thrift::TType::LIST) + { + my ($elemType,$size); + $result = $self->readListBegin(\$elemType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($elemType); + } + $result += $self->readListEnd(); + return $result; + } + + die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?", + Thrift::TProtocolException::INVALID_DATA); + + } + +# +# Utility for skipping binary data +# +# @param TTransport $itrans TTransport object +# @param int $type Field type +# +sub skipBinary +{ + my $self = shift; + my $itrans = shift; + my $type = shift; + + if($type == Thrift::TType::BOOL) + { + return $itrans->readAll(1); + } + elsif($type == Thrift::TType::BYTE) + { + return $itrans->readAll(1); + } + elsif($type == Thrift::TType::I16) + { + return $itrans->readAll(2); + } + elsif($type == Thrift::TType::I32) + { + return $itrans->readAll(4); + } + elsif($type == Thrift::TType::I64) + { + return $itrans->readAll(8); + } + elsif($type == Thrift::TType::DOUBLE) + { + return $itrans->readAll(8); + } + elsif( $type == Thrift::TType::STRING ) + { + my @len = unpack('N', $itrans->readAll(4)); + my $len = $len[0]; + if ($len > 0x7fffffff) { + $len = 0 - (($len - 1) ^ 0xffffffff); + } + return 4 + $itrans->readAll($len); + } + elsif( $type == Thrift::TType::STRUCT ) + { + my $result = 0; + while (1) { + my $ftype = 0; + my $fid = 0; + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + $ftype = $arr[0]; + if ($ftype == Thrift::TType::STOP) { + last; + } + # I16 field id + $result += $itrans->readAll(2); + $result += $self->skipBinary($itrans, $ftype); + } + return $result; + } + elsif($type == Thrift::TType::MAP) + { + # Ktype + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + my $ktype = $arr[0]; + # Vtype + $data = $itrans->readAll(1); + @arr = unpack('c', $data); + my $vtype = $arr[0]; + # Size + $data = $itrans->readAll(4); + @arr = unpack('N', $data); + my $size = $arr[0]; + if ($size > 0x7fffffff) { + $size = 0 - (($size - 1) ^ 0xffffffff); + } + my $result = 6; + for (my $i = 0; $i < $size; $i++) { + $result += $self->skipBinary($itrans, $ktype); + $result += $self->skipBinary($itrans, $vtype); + } + return $result; + } + elsif($type == Thrift::TType::SET || $type == Thrift::TType::LIST) + { + # Vtype + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + my $vtype = $arr[0]; + # Size + $data = $itrans->readAll(4); + @arr = unpack('N', $data); + my $size = $arr[0]; + if ($size > 0x7fffffff) { + $size = 0 - (($size - 1) ^ 0xffffffff); + } + my $result = 5; + for (my $i = 0; $i < $size; $i++) { + $result += $self->skipBinary($itrans, $vtype); + } + return $result; + } + + die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?", + Thrift::TProtocolException::INVALID_DATA); +} + +# +# Protocol factory creates protocol objects from transports +# +package Thrift::TProtocolFactory; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new { + my $classname = shift; + my $self = {}; + + return bless($self,$classname); +} + +# +# Build a protocol from the base transport +# +# @return TProtcol protocol +# +sub getProtocol +{ + my ($trans); + die 'interface'; +} + + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm new file mode 100644 index 000000000..cc5c9dae0 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm @@ -0,0 +1,363 @@ +# +# 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::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); +} + +# +# Writes the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @param int $seqid The sequence id of this message +# +sub writeMessageBegin { + my $self = shift; + my ($name, $type, $seqid) = @_; + + return $self->{concreteProtocol}->writeMessageBegin($name, $type, $seqid); +} + +# +# Close the message +# +sub writeMessageEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeMessageEnd(); +} + +# +# Writes a struct header. +# +# @param string $name Struct name +# @throws TException on write error +# @return int How many bytes written +# +sub writeStructBegin { + my $self = shift; + my ($name) = @_; + + return $self->{concreteProtocol}->writeStructBegin($name); +} + +# +# Close a struct. +# +# @throws TException on write error +# @return int How many bytes written +# +sub writeStructEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeStructEnd(); +} + +# +# Starts a field. +# +# @param string $name Field name +# @param int $type Field type +# @param int $fid Field id +# @throws TException on write error +# @return int How many bytes written +# +sub writeFieldBegin { + my $self = shift; + my ($fieldName, $fieldType, $fieldId) = @_; + + return $self->{concreteProtocol}->writeFieldBegin($fieldName, $fieldType, $fieldId); +} + +sub writeFieldEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeFieldEnd(); +} + +sub writeFieldStop { + my $self = shift; + + return $self->{concreteProtocol}->writeFieldStop(); +} + +sub writeMapBegin { + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return $self->{concreteProtocol}->writeMapBegin($keyType, $valType, $size); +} + +sub writeMapEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeMapEnd(); +} + +sub writeListBegin { + my $self = shift; + my ($elemType, $size) = @_; + + return $self->{concreteProtocol}->writeListBegin($elemType, $size); +} + +sub writeListEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeListEnd(); +} + +sub writeSetBegin { + my $self = shift; + my ($elemType, $size) = @_; + + return $self->{concreteProtocol}->writeSetBegin($elemType, $size); +} + +sub writeSetEnd { + my $self = shift; + + return $self->{concreteProtocol}->writeListEnd(); +} + +sub writeBool { + my $self = shift; + my $bool = shift; + + return $self->{concreteProtocol}->writeBool($bool); +} + +sub writeByte { + my $self = shift; + my $byte = shift; + + return $self->{concreteProtocol}->writeByte($byte); +} + +sub writeI16 { + my $self = shift; + my $i16 = shift; + + return $self->{concreteProtocol}->writeI16($i16); +} + +sub writeI32 { + my $self = shift; + my ($i32) = @_; + + return $self->{concreteProtocol}->writeI32($i32); + +} + +sub writeI64 { + my $self = shift; + my $i64 = shift; + + return $self->{concreteProtocol}->writeI64($i64); +} + +sub writeDouble { + my $self = shift; + my $dub = shift; + + return $self->{concreteProtocol}->writeDouble($dub); +} + +sub writeString { + my $self = shift; + my $str = shift; + + return $self->{concreteProtocol}->writeString($str); +} + +# +# Reads the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @parem int $seqid The sequence id of this message +# +sub readMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + return $self->{concreteProtocol}->readMessageBegin($name, $type, $seqid); +} + +# +# Read the close of message +# +sub readMessageEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readMessageEnd(); +} + +sub readStructBegin +{ + my $self = shift; + my $name = shift; + + return $self->{concreteProtocol}->readStructBegin($name); +} + +sub readStructEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readStructEnd(); +} + +sub readFieldBegin +{ + my $self = shift; + my ($name, $fieldType, $fieldId) = @_; + + return $self->{concreteProtocol}->readFieldBegin($name, $fieldType, $fieldId); +} + +sub readFieldEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readFieldEnd(); +} + +sub readMapBegin +{ + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return $self->{concreteProtocol}->readMapBegin($keyType, $valType, $size); +} + +sub readMapEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readMapEnd(); +} + +sub readListBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return $self->{concreteProtocol}->readListBegin($elemType, $size); +} + +sub readListEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readListEnd(); +} + +sub readSetBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return $self->{concreteProtocol}->readSetBegin($elemType, $size); +} + +sub readSetEnd +{ + my $self = shift; + + return $self->{concreteProtocol}->readSetEnd(); +} + +sub readBool +{ + my $self = shift; + my $bool = shift; + + return $self->{concreteProtocol}->readBool($bool); +} + +sub readByte +{ + my $self = shift; + my $byte = shift; + + return $self->{concreteProtocol}->readByte($byte); +} + +sub readI16 +{ + my $self = shift; + my $i16 = shift; + + return $self->{concreteProtocol}->readI16($i16); +} + +sub readI32 +{ + my $self = shift; + my $i32 = shift; + + return $self->{concreteProtocol}->readI32($i32); +} + +sub readI64 +{ + my $self = shift; + my $i64 = shift; + + return $self->{concreteProtocol}->readI64($i64); +} + +sub readDouble +{ + my $self = shift; + my $dub = shift; + + return $self->{concreteProtocol}->readDouble($dub); +} + +sub readString +{ + my $self = shift; + my $str = shift; + + return $self->{concreteProtocol}->readString($str); +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm new file mode 100644 index 000000000..7b0643102 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm @@ -0,0 +1,76 @@ +# +# 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::SSLSocket; +use Thrift::ServerSocket; + +use IO::Socket::SSL; + +package Thrift::SSLServerSocket; +use base qw( Thrift::ServerSocket ); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +# +# Constructor. +# Takes a hash: +# 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 +# +sub new +{ + my $classname = shift; + my $self = $classname->SUPER::new(@_); + return bless($self, $classname); +} + +sub __client +{ + return Thrift::SSLSocket->new(); +} + +sub __listen +{ + my $self = shift; + 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; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm new file mode 100644 index 000000000..e34924df4 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm @@ -0,0 +1,126 @@ +# +# 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::Socket; + +use IO::Socket::SSL; + +package Thrift::SSLSocket; +use base qw( Thrift::Socket ); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +# +# Construction and usage +# +# my $opts = {} +# my $socket = Thrift::SSLSocket->new(\%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 +{ + my $classname = shift; + my $self = $classname->SUPER::new(@_); + + return bless($self, $classname); +} + +sub __open +{ + my $self = shift; + 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 +{ + my $self = shift; + my $sock = ($self->{handle}->handles())[0]; + if ($sock) { + $sock->close(SSL_no_shutdown => 1); + } +} + +sub __recv +{ + my $self = shift; + my $sock = shift; + my $len = shift; + my $buf = undef; + if ($sock) { + 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 and $sock->pending() eq 0) { + return $self->SUPER::__wait(); + } + return $sock; +} + + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm new file mode 100644 index 000000000..28822e874 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm @@ -0,0 +1,311 @@ +# +# 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::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; + my @args = @_; + + my $self; + + if (scalar @args == 2) + { + $self = _init($args[0], $args[1], + Thrift::BufferedTransportFactory->new(), + Thrift::BufferedTransportFactory->new(), + Thrift::BinaryProtocolFactory->new(), + Thrift::BinaryProtocolFactory->new()); + } + elsif (scalar @args == 4) + { + $self = _init($args[0], $args[1], $args[2], $args[2], $args[3], $args[3]); + } + elsif (scalar @args == 6) + { + $self = _init($args[0], $args[1], $args[2], $args[3], $args[4], $args[5]); + } + else + { + die Thrift::TException->new('Thrift::Server expects exactly 2, 4, or 6 args'); + } + + return bless($self,$classname); +} + +sub _init +{ + my $processor = shift; + my $serverTransport = shift; + my $inputTransportFactory = shift; + my $outputTransportFactory = shift; + my $inputProtocolFactory = shift; + my $outputProtocolFactory = shift; + + my $self = { + processor => $processor, + serverTransport => $serverTransport, + inputTransportFactory => $inputTransportFactory, + outputTransportFactory => $outputTransportFactory, + inputProtocolFactory => $inputProtocolFactory, + outputProtocolFactory => $outputProtocolFactory, + }; +} + +sub serve +{ + die 'abstract'; +} + +sub _clientBegin +{ + my $self = shift; + my $iprot = shift; + my $oprot = shift; + + if (exists $self->{serverEventHandler} and + defined $self->{serverEventHandler}) + { + $self->{serverEventHandler}->clientBegin($iprot, $oprot); + } +} + +sub _handleException +{ + my $self = shift; + my $e = shift; + + if ($e->isa('Thrift::TException') and exists $e->{message}) { + my $message = $e->{message}; + my $code = $e->{code}; + my $out = $code . ':' . $message; + + $message =~ m/TTransportException/ and die $out; + if ($message =~ m/Socket/) { + # suppress Socket messages + } + else { + warn $out; + } + } + else { + warn $e; + } +} + +# +# SimpleServer from the Server base class that handles one connection at a time +# +package Thrift::SimpleServer; +use parent -norequire, 'Thrift::Server'; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + + my $self = $classname->SUPER::new(@_); + + return bless($self,$classname); +} + +sub serve +{ + my $self = shift; + my $stop = 0; + + $self->{serverTransport}->listen(); + while (!$stop) { + my $client = $self->{serverTransport}->accept(); + 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($@); + } + $itrans->close(); + $otrans->close(); + } else { + $stop = 1; + } + } +} + + +# +# ForkingServer that forks a new process for each request +# +package Thrift::ForkingServer; +use parent -norequire, 'Thrift::Server'; +use POSIX ':sys_wait_h'; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub new +{ + my $classname = shift; + my @args = @_; + + my $self = $classname->SUPER::new(@args); + return bless($self,$classname); +} + + +sub serve +{ + my $self = shift; + + # THRIFT-3848: without ignoring SIGCHLD, perl ForkingServer goes into a tight loop + $SIG{CHLD} = 'IGNORE'; + + $self->{serverTransport}->listen(); + while (1) + { + my $client = $self->{serverTransport}->accept(); + $self->_client($client); + } +} + +sub _client +{ + my $self = shift; + my $client = shift; + + eval { + my $itrans = $self->{inputTransportFactory}->getTransport($client); + my $otrans = $self->{outputTransportFactory}->getTransport($client); + + my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans); + my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans); + + $self->_clientBegin($iprot, $oprot); + + my $pid = fork(); + + if ($pid) + { + $self->_parent($pid, $itrans, $otrans); + } + else { + $self->_child($itrans, $otrans, $iprot, $oprot); + } + }; + if($@) { + $self->_handleException($@); + } +} + +sub _parent +{ + my $self = shift; + my $pid = shift; + my $itrans = shift; + my $otrans = shift; + + # Parent must close socket or the connection may not get closed promptly + $self->tryClose($itrans); + $self->tryClose($otrans); +} + +sub _child +{ + my $self = shift; + my $itrans = shift; + my $otrans = shift; + my $iprot = shift; + my $oprot = shift; + + 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); + } + }; + if($@) { + $ecode = 1; + $self->_handleException($@); + } + + $self->tryClose($itrans); + $self->tryClose($otrans); + + exit($ecode); +} + +sub tryClose +{ + my $self = shift; + my $file = shift; + + eval { + if (defined $file) + { + $file->close(); + } + }; + if($@) { + if ($@->isa('Thrift::TException') and exists $@->{message}) { + my $message = $@->{message}; + my $code = $@->{code}; + my $out = $code . ':' . $message; + + warn $out; + } + else { + warn $@; + } + } +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm new file mode 100644 index 000000000..39726438b --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm @@ -0,0 +1,125 @@ +# +# 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 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. +# 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 = Thrift::ServerSocket->new(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->{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 Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN); + }; + + $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} = IO::Select->new($client); + return $result; + } + + return undef; +} + +sub close +{ + my $self = shift; + + if ( exists $self->{handle} and defined $self->{handle} ) + { + $self->{handle}->close(); + } +} + +### +### Overridable methods +### + +sub __client +{ + return Thrift::Socket->new(); +} + +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/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm new file mode 100644 index 000000000..ba0db5eb4 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm @@ -0,0 +1,327 @@ +# +# 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::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 = Thrift::Socket->new(\%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 $opts = shift; + + # default settings: + my $self = { + host => 'localhost', + port => 9090, + recvTimeout => 10000, + 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); +} + + +sub setSendTimeout +{ + my $self = shift; + my $timeout = shift; + + $self->{sendTimeout} = $timeout; +} + +sub setRecvTimeout +{ + my $self = shift; + my $timeout = shift; + + $self->{recvTimeout} = $timeout; +} + + +# +# Tests whether this is open +# +# @return bool true if the socket is open +# +sub isOpen +{ + my $self = shift; + + if( defined $self->{handle} ){ + return ($self->{handle}->handles())[0]->connected; + } + + return 0; +} + +# +# Connects the socket. +# +sub open +{ + my $self = shift; + + my $sock = $self->__open() || do { + my $error = ref($self).': Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')'; + die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN); + }; + + $self->{handle} = IO::Select->new( $sock ); +} + +# +# Closes the socket. +# +sub close +{ + my $self = shift; + if( defined $self->{handle} ) { + $self->__close(); + } +} + +# +# Uses stream get contents to do the reading +# +# @param int $len How many bytes +# @return string Binary data +# +sub readAll +{ + my $self = shift; + my $len = shift; + + + return unless defined $self->{handle}; + + my $pre = ""; + while (1) { + + my $sock = $self->__wait(); + my $buf = $self->__recv($sock, $len); + + if (!defined $buf || $buf eq '') { + + die Thrift::TTransportException->new(ref($self).': Could not read '.$len.' bytes from '. + $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE); + + } + elsif ((my $sz = length($buf)) < $len) { + + $pre .= $buf; + $len -= $sz; + + } + else { + return $pre.$buf; + } + } +} + +# +# Read from the socket +# +# @param int $len How many bytes +# @return string Binary data +# +sub read +{ + my $self = shift; + my $len = shift; + + return unless defined $self->{handle}; + + my $sock = $self->__wait(); + my $buf = $self->__recv($sock, $len); + + if (!defined $buf || $buf eq '') { + + die Thrift::TTransportException->new(ref($self).': Could not read '.$len.' bytes from '. + $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE); + + } + + return $buf; +} + + +# +# Write to the socket. +# +# @param string $buf The data to write +# +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 Thrift::TTransportException->new(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 Thrift::TTransportException->new(ref($self).': Could not write '.length($buf).' bytes '. + $self->{host}.':'.$self->{host}, Thrift::TTransportException::END_OF_FILE); + + } + + $buf = substr($buf, $sent); + } +} + +# +# Flush output to the socket. +# +sub flush +{ + my $self = shift; + + return unless defined $self->{handle}; + + my $ret = ($self->{handle}->handles())[0]->flush; +} + +### +### Overridable methods +### + +# +# Open a connection to a server. +# +sub __open +{ + my $self = shift; + return IO::Socket::INET->new(PeerAddr => $self->{host}, + PeerPort => $self->{port}, + Proto => 'tcp', + Timeout => $self->{sendTimeout} / 1000); +} + +# +# Close the connection +# +sub __close +{ + my $self = shift; + CORE::close(($self->{handle}->handles())[0]); +} + +# +# 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; +} + +# +# Send data +# +# @param[in] $sock the socket +# @param[in] $buf the data buffer +# @returns the number of bytes written +# +sub __send +{ + my $self = shift; + my $sock = shift; + my $buf = shift; + return $sock->send($buf); +} + +# +# 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 (@sockets == 0) { + die Thrift::TTransportException->new(ref($self).': timed out reading from '. + $self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT); + } + + return $sockets[0]; +} + + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm new file mode 100644 index 000000000..41b7e150f --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm @@ -0,0 +1,180 @@ +# +# 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::Exception; + +# +# Transport exceptions +# +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; +use constant ALREADY_OPEN => 2; +use constant TIMED_OUT => 3; +use constant END_OF_FILE => 4; + +sub new { + my $classname = shift; + my $self = $classname->SUPER::new(@_); + + return bless($self,$classname); +} + +package Thrift::Transport; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +# +# Whether this transport is open. +# +# @return boolean true if open +# +sub isOpen +{ + die 'abstract'; +} + +# +# Open the transport for reading/writing +# +# @throws TTransportException if cannot open +# +sub open +{ + die 'abstract'; +} + +# +# Close the transport. +# +sub close +{ + die 'abstract'; +} + +# +# Read some data into the array. +# +# @param int $len How much to read +# @return string The data that has been read +# @throws TTransportException if cannot read any more data +# +sub read +{ + die 'abstract'; +} + +# +# Guarantees that the full amount of data is read. +# +# @return string The data, of exact length +# @throws TTransportException if cannot read data +# +sub readAll +{ + my $self = shift; + my $len = shift; + + my $data = ''; + my $got = 0; + + while (($got = length($data)) < $len) { + $data .= $self->read($len - $got); + } + + return $data; +} + +# +# Writes the given data out. +# +# @param string $buf The data to write +# @throws TTransportException if writing fails +# +sub write +{ + die 'abstract'; +} + +# +# Flushes any pending data out of a buffer +# +# @throws TTransportException if a writing error occurs +# +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; + my $self = {}; + + return bless($self,$classname); +} + +# +# Build a transport from the base transport +# +# @return Thrift::Transport transport +# +sub getTransport +{ + my $self = shift; + my $trans = shift; + + return $trans; +} + + +# +# ServerTransport base class module +# +package Thrift::ServerTransport; +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +sub listen +{ + die 'abstract'; +} + +sub accept +{ + die 'abstract'; +} + +sub close +{ + die 'abstract'; +} + + +1; + diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm new file mode 100644 index 000000000..ad8da3b6c --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm @@ -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; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm new file mode 100644 index 000000000..875e8049a --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm @@ -0,0 +1,84 @@ +# +# 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::ServerSocket; +use Thrift::UnixSocket; + +use IO::Socket::UNIX; + +package Thrift::UnixServerSocket; +use base qw( Thrift::ServerSocket ); +use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); + +# +# Constructor. +# If a single argument is given that is not a hash, that is the unix domain socket path. +# If a single argument is given that is a hash: +# @param[in] path unix domain socket file name +# @param[in] queue the listen queue size (default is not specified is supplied by ServerSocket) +# @example my $serversock = Thrift::UnixServerSocket->new($path); +# @example my $serversock = Thrift::UnixServerSocket->new(path => "somepath", queue => 64); +# +sub new +{ + my $classname = shift; + my $args = shift; + my $self; + + if (ref($args) eq 'HASH') { + $self = $classname->SUPER::new($args); + } else { + $self = $classname->SUPER::new(); + $self->{path} = $args; + } + + return bless($self, $classname); +} + +sub __client +{ + return Thrift::UnixSocket->new(); +} + +sub __listen +{ + my $self = shift; + + my $sock = IO::Socket::UNIX->new( + Type => IO::Socket::SOCK_STREAM, + Local => $self->{path}, + Listen => $self->{queue}) + || do { + my $error = 'UnixServerSocket: Could not bind to ' . + $self->{path} . ' (' . $! . ')'; + if ($self->{debug}) { + $self->{debugHandler}->($error); + } + die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN); + }; + + return $sock; +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm new file mode 100644 index 000000000..ba386d1ce --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm @@ -0,0 +1,67 @@ +# +# 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::Socket; + +use IO::Socket::UNIX; + +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 Thrift::Socket for base class parameters. +# @param[in] path path to unix socket file +# @example my $sock = Thrift::UnixSocket->new($path); +# +sub new +{ + my $classname = shift; + my $self = $classname->SUPER::new(); + $self->{path} = shift; + return bless($self, $classname); +} + +sub __open +{ + my $self = shift; + + my $sock = IO::Socket::UNIX->new( + Type => IO::Socket::SOCK_STREAM, + Peer => $self->{path}) + || do { + my $error = 'UnixSocket: Could not connect to ' . + $self->{path} . ' (' . $! . ')'; + if ($self->{debug}) { + $self->{debugHandler}->($error); + } + die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN); + }; + + return $sock; +} + +1; diff --git a/src/jaegertracing/thrift/lib/perl/t/Makefile.am b/src/jaegertracing/thrift/lib/perl/t/Makefile.am new file mode 100644 index 000000000..de0397186 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/t/Makefile.am @@ -0,0 +1,20 @@ +# +# 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. +# + +EXTRA_DIST = memory_buffer.t processor.t multiplex.t diff --git a/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t b/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t new file mode 100644 index 000000000..8fa9fd72e --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t @@ -0,0 +1,53 @@ +# +# 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 Test::More tests => 6; + +use strict; +use warnings; + +use Data::Dumper; + +use Thrift::BinaryProtocol; +use Thrift::MemoryBuffer; + +use ThriftTest::Types; + + +my $transport = Thrift::MemoryBuffer->new(); +my $protocol = Thrift::BinaryProtocol->new($transport); + +my $a = ThriftTest::Xtruct->new(); +$a->i32_thing(10); +$a->i64_thing(30); +$a->string_thing('Hello, world!'); +$a->write($protocol); + +my $b = ThriftTest::Xtruct->new(); +$b->read($protocol); +is($b->i32_thing, $a->i32_thing); +is($b->i64_thing, $a->i64_thing); +is($b->string_thing, $a->string_thing); + +$b->write($protocol); +my $c = ThriftTest::Xtruct->new(); +$c->read($protocol); +is($c->i32_thing, $a->i32_thing); +is($c->i64_thing, $a->i64_thing); +is($c->string_thing, $a->string_thing); diff --git a/src/jaegertracing/thrift/lib/perl/t/multiplex.t b/src/jaegertracing/thrift/lib/perl/t/multiplex.t new file mode 100644 index 000000000..90a9b4d02 --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/t/multiplex.t @@ -0,0 +1,201 @@ +# +# 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 Test::More tests => 6; + +use strict; +use warnings; + +use Thrift::BinaryProtocol; +use Thrift::FramedTransport; +use Thrift::MemoryBuffer; +use Thrift::MessageType; +use Thrift::MultiplexedProcessor; +use Thrift::Server; +use Thrift::Socket; + +use BenchmarkService; +use Aggr; + +use constant NAME_BENCHMARKSERVICE => 'BenchmarkService'; +use constant NAME_AGGR => 'Aggr'; + +my $buffer = Thrift::MemoryBuffer->new(1024); +my $aggr_protocol = Thrift::MultiplexedProtocol->new(Thrift::BinaryProtocol->new($buffer), NAME_AGGR); +my $aggr_client = AggrClient->new($aggr_protocol); +my $benchmark_protocol = Thrift::MultiplexedProtocol->new(Thrift::BinaryProtocol->new($buffer), NAME_BENCHMARKSERVICE); +my $benchmark_client = BenchmarkServiceClient->new($benchmark_protocol); + +$buffer->open(); + +for(my $i = 1; $i <= 5; $i++) { + $aggr_client->send_addValue($i); + $aggr_client->{seqid}++; +} + +$aggr_client->send_getValues(); + +for(my $i = 1; $i <= 5; $i++) { + $benchmark_client->send_fibonacci($i); + $benchmark_client->{seqid}++; +} +$benchmark_client->{seqid}--; + +my $client_command_binary = $buffer->getBuffer; +$buffer->resetBuffer; + + +# Process by server +my $server_output_binary; +{ + my $benchmark_handler = My::BenchmarkService->new(); + my $benchmark_processor = BenchmarkServiceProcessor->new($benchmark_handler); + my $aggr_handler = My::Aggr->new(); + my $aggr_processor = AggrProcessor->new($aggr_handler); + + my $protocol_factory = Thrift::BinaryProtocolFactory->new(); + + my $input_buffer = Thrift::MemoryBuffer->new(); + $input_buffer->write($client_command_binary); + + my $input_protocol = $protocol_factory->getProtocol($input_buffer); + + my $output_buffer = Thrift::MemoryBuffer->new(); + my $output_protocol = $protocol_factory->getProtocol($output_buffer); + + my $processor = Thrift::MultiplexedProcessor->new(); + + $processor->registerProcessor(NAME_BENCHMARKSERVICE, $benchmark_processor); + $processor->registerProcessor(NAME_AGGR, $aggr_processor); + my $result; + for(my $i = 1; $i <= 11; $i++) { + $result = $processor->process($input_protocol, $output_protocol); + print "process resulted in $result\n"; + } + + $server_output_binary = $output_buffer->getBuffer(); +} + +$buffer->write($server_output_binary); + + + +for(my $i = 1; $i <= 5; $i++) { + my ($function_name, $message_type, $sequence_id); + + $aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id); + + if ($message_type == Thrift::TMessageType::EXCEPTION) { + die; + } + + my $aggr_result = Aggr_addValue_result->new(); + $aggr_result->read($aggr_protocol); + $aggr_protocol->readMessageEnd(); +} + +my ($function_name, $message_type, $sequence_id); + +$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id); + +if ($message_type == Thrift::TMessageType::EXCEPTION) { + die; +} + +my $aggr_result = Aggr_getValues_result->new(); +$aggr_result->read($aggr_protocol); +$aggr_protocol->readMessageEnd(); + +is_deeply($aggr_result->success(), [1,2,3,4,5]); + + +foreach my $val((1,2,3,5,8)) { + my ($function_name, $message_type, $sequence_id); + + $benchmark_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id); + + if ($message_type == Thrift::TMessageType::EXCEPTION) { + die; + } + my $benchmark_result = BenchmarkService_fibonacci_result->new(); + $benchmark_result->read($benchmark_protocol); + $benchmark_protocol->readMessageEnd(); + + is($benchmark_result->success(), $val); +} + + +package My::Aggr; +use base qw(AggrIf); + +use strict; +use warnings; + +sub new { + my $classname = shift; + my $self = {}; + + $self->{values} = (); + + return bless($self,$classname); +} + +sub addValue{ + my $self = shift; + my $value = shift; + + push (@{$self->{values}}, $value); +} + +sub getValues{ + my $self = shift; + + return $self->{values}; +} + + + +package My::BenchmarkService; +use base qw(BenchmarkServiceIf); + +use strict; +use warnings; + +sub new { + my $class = shift; + return bless {}, $class; +} + +sub fibonacci { + my ($self, $n) = @_; + + my $prev = 0; + my $next; + my $result = 1; + + while ($n > 0) { + $next = $result + $prev; + $prev = $result; + $result = $next; + --$n; + } + + return $result; +} + diff --git a/src/jaegertracing/thrift/lib/perl/t/processor.t b/src/jaegertracing/thrift/lib/perl/t/processor.t new file mode 100644 index 000000000..f8330354f --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/t/processor.t @@ -0,0 +1,104 @@ +# +# 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 Test::More tests => 2; + +use strict; +use warnings; + +use Thrift::BinaryProtocol; +use Thrift::MemoryBuffer; +use Thrift::MessageType; + +use ThriftTest::ThriftTest; +use ThriftTest::Types; + +use Data::Dumper; + +my $buffer = Thrift::MemoryBuffer->new(1024); +my $protocol = Thrift::BinaryProtocol->new($buffer); +my $client = ThriftTest::ThriftTestClient->new($protocol); + +$buffer->open(); +$client->send_testString("foo"); +$client->{seqid}++; +$client->send_testString("bar"); + +my $client_command_binary = $buffer->getBuffer; +$buffer->resetBuffer; + +# Process by server + +my $server_output_binary; +{ + my $protocol_factory = Thrift::BinaryProtocolFactory->new(); + + my $input_buffer = Thrift::MemoryBuffer->new(); + $input_buffer->write($client_command_binary); + my $input_protocol = $protocol_factory->getProtocol($input_buffer); + + my $output_buffer = Thrift::MemoryBuffer->new(); + my $output_protocol = $protocol_factory->getProtocol($output_buffer); + + my $processor = ThriftTest::ThriftTestProcessor->new( My::ThriftTest->new() ); + my $result = $processor->process($input_protocol, $output_protocol); + print "process resulted in $result\n"; + $result = $processor->process($input_protocol, $output_protocol); + print "process resulted in $result\n"; + $server_output_binary = $output_buffer->getBuffer(); +} + +$buffer->write($server_output_binary); + +foreach my $val (("got foo","got bar")){ + my ($function_name, $message_type, $sequence_id); + + $protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id); + print " $function_name, $message_type, $sequence_id\n"; + + if ($message_type == Thrift::TMessageType::EXCEPTION) { + die; + } + + my $result = ThriftTest::ThriftTest_testString_result->new(); + $result->read($protocol); + $protocol->readMessageEnd(); + + is($result->success(),$val); +} + + +package My::ThriftTest; + +use strict; +use warnings; +use Data::Dumper; + +sub new { + my $class = shift; + return bless {}, $class; +} + +sub testString { + my ($self, $string) = @_; + + print __PACKAGE__ . "->testString()\n"; + + return "got ".$string; +} diff --git a/src/jaegertracing/thrift/lib/perl/test.pl b/src/jaegertracing/thrift/lib/perl/test.pl new file mode 100644 index 000000000..7e068402f --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/test.pl @@ -0,0 +1,25 @@ +# +# 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 strict; +use warnings; + +use Test::Harness; + +runtests(@ARGV); diff --git a/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl b/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl new file mode 100644 index 000000000..24a2b200a --- /dev/null +++ b/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl @@ -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'); |