]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
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 | use 5.10.0; | |
21 | use strict; | |
22 | use warnings; | |
23 | ||
24 | use Thrift; | |
25 | use Thrift::BinaryProtocol; | |
26 | use Thrift::BufferedTransport; | |
27 | use Thrift::Exception; | |
28 | ||
29 | # | |
30 | # Server base class module | |
31 | # | |
32 | package Thrift::Server; | |
33 | use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); | |
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 | my $classname = shift; | |
48 | my @args = @_; | |
49 | ||
50 | my $self; | |
51 | ||
52 | if (scalar @args == 2) | |
53 | { | |
54 | $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 | $self = _init($args[0], $args[1], $args[2], $args[2], $args[3], $args[3]); | |
63 | } | |
64 | elsif (scalar @args == 6) | |
65 | { | |
66 | $self = _init($args[0], $args[1], $args[2], $args[3], $args[4], $args[5]); | |
67 | } | |
68 | else | |
69 | { | |
70 | die Thrift::TException->new('Thrift::Server expects exactly 2, 4, or 6 args'); | |
71 | } | |
72 | ||
73 | return bless($self,$classname); | |
74 | } | |
75 | ||
76 | sub _init | |
77 | { | |
78 | my $processor = shift; | |
79 | my $serverTransport = shift; | |
80 | my $inputTransportFactory = shift; | |
81 | my $outputTransportFactory = shift; | |
82 | my $inputProtocolFactory = shift; | |
83 | my $outputProtocolFactory = shift; | |
84 | ||
85 | 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 | die 'abstract'; | |
98 | } | |
99 | ||
100 | sub _clientBegin | |
101 | { | |
102 | my $self = shift; | |
103 | my $iprot = shift; | |
104 | my $oprot = shift; | |
105 | ||
106 | if (exists $self->{serverEventHandler} and | |
107 | defined $self->{serverEventHandler}) | |
108 | { | |
109 | $self->{serverEventHandler}->clientBegin($iprot, $oprot); | |
110 | } | |
111 | } | |
112 | ||
113 | sub _handleException | |
114 | { | |
115 | my $self = shift; | |
116 | my $e = shift; | |
117 | ||
118 | if ($e->isa('Thrift::TException') and exists $e->{message}) { | |
119 | my $message = $e->{message}; | |
120 | my $code = $e->{code}; | |
121 | my $out = $code . ':' . $message; | |
122 | ||
123 | $message =~ m/TTransportException/ and die $out; | |
124 | if ($message =~ m/Socket/) { | |
125 | # suppress Socket messages | |
126 | } | |
127 | else { | |
128 | warn $out; | |
129 | } | |
130 | } | |
131 | else { | |
132 | 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 | use parent -norequire, 'Thrift::Server'; | |
141 | use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); | |
142 | ||
143 | sub new | |
144 | { | |
145 | my $classname = shift; | |
146 | ||
147 | my $self = $classname->SUPER::new(@_); | |
148 | ||
149 | return bless($self,$classname); | |
150 | } | |
151 | ||
152 | sub serve | |
153 | { | |
154 | my $self = shift; | |
155 | my $stop = 0; | |
156 | ||
157 | $self->{serverTransport}->listen(); | |
158 | while (!$stop) { | |
159 | my $client = $self->{serverTransport}->accept(); | |
160 | if (defined $client) { | |
161 | my $itrans = $self->{inputTransportFactory}->getTransport($client); | |
162 | my $otrans = $self->{outputTransportFactory}->getTransport($client); | |
163 | my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans); | |
164 | my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans); | |
165 | eval { | |
166 | $self->_clientBegin($iprot, $oprot); | |
167 | while (1) | |
168 | { | |
169 | $self->{processor}->process($iprot, $oprot); | |
170 | } | |
171 | }; | |
172 | if($@) { | |
173 | $self->_handleException($@); | |
174 | } | |
175 | $itrans->close(); | |
176 | $otrans->close(); | |
177 | } else { | |
178 | $stop = 1; | |
179 | } | |
180 | } | |
181 | } | |
182 | ||
183 | ||
184 | # | |
185 | # ForkingServer that forks a new process for each request | |
186 | # | |
187 | package Thrift::ForkingServer; | |
188 | use parent -norequire, 'Thrift::Server'; | |
189 | use POSIX ':sys_wait_h'; | |
190 | use version 0.77; our $VERSION = version->declare("$Thrift::VERSION"); | |
191 | ||
192 | sub new | |
193 | { | |
194 | my $classname = shift; | |
195 | my @args = @_; | |
196 | ||
197 | my $self = $classname->SUPER::new(@args); | |
198 | return bless($self,$classname); | |
199 | } | |
200 | ||
201 | ||
202 | sub serve | |
203 | { | |
204 | my $self = shift; | |
205 | ||
206 | # THRIFT-3848: without ignoring SIGCHLD, perl ForkingServer goes into a tight loop | |
207 | $SIG{CHLD} = 'IGNORE'; | |
208 | ||
209 | $self->{serverTransport}->listen(); | |
210 | while (1) | |
211 | { | |
212 | my $client = $self->{serverTransport}->accept(); | |
213 | $self->_client($client); | |
214 | } | |
215 | } | |
216 | ||
217 | sub _client | |
218 | { | |
219 | my $self = shift; | |
220 | my $client = shift; | |
221 | ||
222 | eval { | |
223 | my $itrans = $self->{inputTransportFactory}->getTransport($client); | |
224 | my $otrans = $self->{outputTransportFactory}->getTransport($client); | |
225 | ||
226 | my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans); | |
227 | my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans); | |
228 | ||
229 | $self->_clientBegin($iprot, $oprot); | |
230 | ||
231 | my $pid = fork(); | |
232 | ||
233 | if ($pid) | |
234 | { | |
235 | $self->_parent($pid, $itrans, $otrans); | |
236 | } | |
237 | else { | |
238 | $self->_child($itrans, $otrans, $iprot, $oprot); | |
239 | } | |
240 | }; | |
241 | if($@) { | |
242 | $self->_handleException($@); | |
243 | } | |
244 | } | |
245 | ||
246 | sub _parent | |
247 | { | |
248 | my $self = shift; | |
249 | my $pid = shift; | |
250 | my $itrans = shift; | |
251 | my $otrans = shift; | |
252 | ||
253 | # Parent must close socket or the connection may not get closed promptly | |
254 | $self->tryClose($itrans); | |
255 | $self->tryClose($otrans); | |
256 | } | |
257 | ||
258 | sub _child | |
259 | { | |
260 | my $self = shift; | |
261 | my $itrans = shift; | |
262 | my $otrans = shift; | |
263 | my $iprot = shift; | |
264 | my $oprot = shift; | |
265 | ||
266 | my $ecode = 0; | |
267 | eval { | |
268 | # THRIFT-4065 ensure child process has normal signal handling in case thrift handler uses it | |
269 | $SIG{CHLD} = 'DEFAULT'; | |
270 | while (1) | |
271 | { | |
272 | $self->{processor}->process($iprot, $oprot); | |
273 | } | |
274 | }; | |
275 | if($@) { | |
276 | $ecode = 1; | |
277 | $self->_handleException($@); | |
278 | } | |
279 | ||
280 | $self->tryClose($itrans); | |
281 | $self->tryClose($otrans); | |
282 | ||
283 | exit($ecode); | |
284 | } | |
285 | ||
286 | sub tryClose | |
287 | { | |
288 | my $self = shift; | |
289 | my $file = shift; | |
290 | ||
291 | eval { | |
292 | if (defined $file) | |
293 | { | |
294 | $file->close(); | |
295 | } | |
296 | }; | |
297 | if($@) { | |
298 | if ($@->isa('Thrift::TException') and exists $@->{message}) { | |
299 | my $message = $@->{message}; | |
300 | my $code = $@->{code}; | |
301 | my $out = $code . ':' . $message; | |
302 | ||
303 | warn $out; | |
304 | } | |
305 | else { | |
306 | warn $@; | |
307 | } | |
308 | } | |
309 | } | |
310 | ||
311 | 1; |