diff options
Diffstat (limited to 'src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm')
-rw-r--r-- | src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm | 311 |
1 files changed, 311 insertions, 0 deletions
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; |