File Coverage

blib/lib/Thrift/Server.pm
Criterion Covered Total %
statement 38 150 25.3
branch 0 30 0.0
condition 0 9 0.0
subroutine 13 26 50.0
pod 0 2 0.0
total 51 217 23.5


line stmt bran cond sub pod time code
1             #
2             # Licensed to the Apache Software Foundation (ASF) under one
3             # or more contributor license agreements. See the NOTICE file
4             # distributed with this work for additional information
5             # regarding copyright ownership. The ASF licenses this file
6             # to you under the Apache License, Version 2.0 (the
7             # "License"); you may not use this file except in compliance
8             # with the License. You may obtain a copy of the License at
9             #
10             # http://www.apache.org/licenses/LICENSE-2.0
11             #
12             # Unless required by applicable law or agreed to in writing,
13             # software distributed under the License is distributed on an
14             # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15             # KIND, either express or implied. See the License for the
16             # specific language governing permissions and limitations
17             # under the License.
18             #
19              
20 1     1   568 use 5.10.0;
  1         4  
21 1     1   6 use strict;
  1         3  
  1         34  
22 1     1   6 use warnings;
  1         2  
  1         32  
23              
24 1     1   5 use Thrift;
  1         2  
  1         47  
25 1     1   6 use Thrift::BinaryProtocol;
  1         3  
  1         22  
26 1     1   416 use Thrift::BufferedTransport;
  1         4  
  1         25  
27 1     1   7 use Thrift::Exception;
  1         1  
  1         33  
28              
29             #
30             # Server base class module
31             #
32             package Thrift::Server;
33 1     1   5 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  1         13  
  1         6  
34              
35             #
36             # 3 possible constructors:
37             # 1. (processor, serverTransport)
38             # Uses a BufferedTransportFactory and a BinaryProtocolFactory.
39             # 2. (processor, serverTransport, transportFactory, protocolFactory)
40             # Uses the same factory for input and output of each type.
41             # 3. (processor, serverTransport,
42             # inputTransportFactory, outputTransportFactory,
43             # inputProtocolFactory, outputProtocolFactory)
44             #
45             sub new
46             {
47 0     0 0   my $classname = shift;
48 0           my @args = @_;
49              
50 0           my $self;
51              
52 0 0         if (scalar @args == 2)
    0          
    0          
53             {
54 0           $self = _init($args[0], $args[1],
55             Thrift::BufferedTransportFactory->new(),
56             Thrift::BufferedTransportFactory->new(),
57             Thrift::BinaryProtocolFactory->new(),
58             Thrift::BinaryProtocolFactory->new());
59             }
60             elsif (scalar @args == 4)
61             {
62 0           $self = _init($args[0], $args[1], $args[2], $args[2], $args[3], $args[3]);
63             }
64             elsif (scalar @args == 6)
65             {
66 0           $self = _init($args[0], $args[1], $args[2], $args[3], $args[4], $args[5]);
67             }
68             else
69             {
70 0           die Thrift::TException->new('Thrift::Server expects exactly 2, 4, or 6 args');
71             }
72              
73 0           return bless($self,$classname);
74             }
75              
76             sub _init
77             {
78 0     0     my $processor = shift;
79 0           my $serverTransport = shift;
80 0           my $inputTransportFactory = shift;
81 0           my $outputTransportFactory = shift;
82 0           my $inputProtocolFactory = shift;
83 0           my $outputProtocolFactory = shift;
84              
85 0           my $self = {
86             processor => $processor,
87             serverTransport => $serverTransport,
88             inputTransportFactory => $inputTransportFactory,
89             outputTransportFactory => $outputTransportFactory,
90             inputProtocolFactory => $inputProtocolFactory,
91             outputProtocolFactory => $outputProtocolFactory,
92             };
93             }
94              
95             sub serve
96             {
97 0     0 0   die 'abstract';
98             }
99              
100             sub _clientBegin
101             {
102 0     0     my $self = shift;
103 0           my $iprot = shift;
104 0           my $oprot = shift;
105              
106 0 0 0       if (exists $self->{serverEventHandler} and
107             defined $self->{serverEventHandler})
108             {
109 0           $self->{serverEventHandler}->clientBegin($iprot, $oprot);
110             }
111             }
112              
113             sub _handleException
114             {
115 0     0     my $self = shift;
116 0           my $e = shift;
117              
118 0 0 0       if ($e->isa('Thrift::TException') and exists $e->{message}) {
119 0           my $message = $e->{message};
120 0           my $code = $e->{code};
121 0           my $out = $code . ':' . $message;
122              
123 0 0         $message =~ m/TTransportException/ and die $out;
124 0 0         if ($message =~ m/Socket/) {
125             # suppress Socket messages
126             }
127             else {
128 0           warn $out;
129             }
130             }
131             else {
132 0           warn $e;
133             }
134             }
135              
136             #
137             # SimpleServer from the Server base class that handles one connection at a time
138             #
139             package Thrift::SimpleServer;
140 1     1   558 use parent -norequire, 'Thrift::Server';
  1         10  
  1         11  
141 1     1   51 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  1         13  
  1         7  
142              
143             sub new
144             {
145 0     0     my $classname = shift;
146              
147 0           my $self = $classname->SUPER::new(@_);
148              
149 0           return bless($self,$classname);
150             }
151              
152             sub serve
153             {
154 0     0     my $self = shift;
155 0           my $stop = 0;
156              
157 0           $self->{serverTransport}->listen();
158 0           while (!$stop) {
159 0           my $client = $self->{serverTransport}->accept();
160 0 0         if (defined $client) {
161 0           my $itrans = $self->{inputTransportFactory}->getTransport($client);
162 0           my $otrans = $self->{outputTransportFactory}->getTransport($client);
163 0           my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
164 0           my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
165 0           eval {
166 0           $self->_clientBegin($iprot, $oprot);
167 0           while (1)
168             {
169 0           $self->{processor}->process($iprot, $oprot);
170             }
171             };
172 0 0         if($@) {
173 0           $self->_handleException($@);
174             }
175 0           $itrans->close();
176 0           $otrans->close();
177             } else {
178 0           $stop = 1;
179             }
180             }
181             }
182              
183              
184             #
185             # ForkingServer that forks a new process for each request
186             #
187             package Thrift::ForkingServer;
188 1     1   403 use parent -norequire, 'Thrift::Server';
  1         2  
  1         6  
189 1     1   621 use POSIX ':sys_wait_h';
  1         6763  
  1         5  
190 1     1   1645 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  1         20  
  1         7  
191              
192             sub new
193             {
194 0     0     my $classname = shift;
195 0           my @args = @_;
196              
197 0           my $self = $classname->SUPER::new(@args);
198 0           return bless($self,$classname);
199             }
200              
201              
202             sub serve
203             {
204 0     0     my $self = shift;
205              
206             # THRIFT-3848: without ignoring SIGCHLD, perl ForkingServer goes into a tight loop
207 0           $SIG{CHLD} = 'IGNORE';
208              
209 0           $self->{serverTransport}->listen();
210 0           while (1)
211             {
212 0           my $client = $self->{serverTransport}->accept();
213 0           $self->_client($client);
214             }
215             }
216              
217             sub _client
218             {
219 0     0     my $self = shift;
220 0           my $client = shift;
221              
222 0           eval {
223 0           my $itrans = $self->{inputTransportFactory}->getTransport($client);
224 0           my $otrans = $self->{outputTransportFactory}->getTransport($client);
225              
226 0           my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
227 0           my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
228              
229 0           $self->_clientBegin($iprot, $oprot);
230              
231 0           my $pid = fork();
232              
233 0 0         if ($pid)
234             {
235 0           $self->_parent($pid, $itrans, $otrans);
236             }
237             else {
238 0           $self->_child($itrans, $otrans, $iprot, $oprot);
239             }
240             };
241 0 0         if($@) {
242 0           $self->_handleException($@);
243             }
244             }
245              
246             sub _parent
247             {
248 0     0     my $self = shift;
249 0           my $pid = shift;
250 0           my $itrans = shift;
251 0           my $otrans = shift;
252              
253             # Parent must close socket or the connection may not get closed promptly
254 0           $self->tryClose($itrans);
255 0           $self->tryClose($otrans);
256             }
257              
258             sub _child
259             {
260 0     0     my $self = shift;
261 0           my $itrans = shift;
262 0           my $otrans = shift;
263 0           my $iprot = shift;
264 0           my $oprot = shift;
265              
266 0           my $ecode = 0;
267 0           eval {
268             # THRIFT-4065 ensure child process has normal signal handling in case thrift handler uses it
269 0           $SIG{CHLD} = 'DEFAULT';
270 0           while (1)
271             {
272 0           $self->{processor}->process($iprot, $oprot);
273             }
274             };
275 0 0         if($@) {
276 0           $ecode = 1;
277 0           $self->_handleException($@);
278             }
279              
280 0           $self->tryClose($itrans);
281 0           $self->tryClose($otrans);
282              
283 0           exit($ecode);
284             }
285              
286             sub tryClose
287             {
288 0     0     my $self = shift;
289 0           my $file = shift;
290              
291 0           eval {
292 0 0         if (defined $file)
293             {
294 0           $file->close();
295             }
296             };
297 0 0         if($@) {
298 0 0 0       if ($@->isa('Thrift::TException') and exists $@->{message}) {
299 0           my $message = $@->{message};
300 0           my $code = $@->{code};
301 0           my $out = $code . ':' . $message;
302              
303 0           warn $out;
304             }
305             else {
306 0           warn $@;
307             }
308             }
309             }
310              
311             1;