1#!/usr/bin/env perl 2 3# 4# Licensed to the Apache Software Foundation (ASF) under one 5# or more contributor license agreements. See the NOTICE file 6# distributed with this work for additional information 7# regarding copyright ownership. The ASF licenses this file 8# to you under the Apache License, Version 2.0 (the 9# "License"); you may not use this file except in compliance 10# with the License. You may obtain a copy of the License at 11# 12# http://www.apache.org/licenses/LICENSE-2.0 13# 14# Unless required by applicable law or agreed to in writing, 15# software distributed under the License is distributed on an 16# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17# KIND, either express or implied. See the License for the 18# specific language governing permissions and limitations 19# under the License. 20# 21 22use 5.10.0; 23use strict; 24use warnings; 25use Data::Dumper; 26use Getopt::Long qw(GetOptions); 27use Time::HiRes qw(gettimeofday); 28 29$SIG{INT} = \&sigint_handler; 30 31use lib '../../lib/perl/lib'; 32use lib 'gen-perl'; 33 34use Thrift; 35use Thrift::BinaryProtocol; 36use Thrift::BufferedTransport; 37use Thrift::FramedTransport; 38use Thrift::MultiplexedProcessor; 39use Thrift::SSLServerSocket; 40use Thrift::ServerSocket; 41use Thrift::Server; 42use Thrift::UnixServerSocket; 43 44use ThriftTest::SecondService; 45use ThriftTest::ThriftTest; 46use ThriftTest::Types; 47 48$|++; 49 50sub usage { 51 print <<"EOF"; 52Usage: $0 [OPTIONS] 53 54Options: (default) 55 --ca Certificate authority file (optional). 56 --cert Certificate file. 57 Required if using --ssl. 58 --ciphers Acceptable cipher list. 59 --domain-socket <file> Use a unix domain socket. 60 --help Show usage. 61 --key Private key file for certificate. 62 Required if using --ssl and private key is 63 not in the certificate file. 64 --port <portnum> 9090 Port to use. 65 --protocol {binary} binary Protocol to use. 66 --ssl If present, use SSL/TLS. 67 --transport {buffered|framed} buffered Transport to use. 68 69EOF 70} 71 72my %opts = ( 73 'port' => 9090, 74 'protocol' => 'binary', 75 'transport' => 'buffered' 76); 77 78GetOptions(\%opts, qw ( 79 ca=s 80 cert=s 81 ciphers=s 82 domain-socket=s 83 help 84 host=s 85 key=s 86 port=i 87 protocol=s 88 ssl 89 transport=s 90)) || exit 1; 91 92if ($opts{help}) { 93 usage(); 94 exit 0; 95} 96 97if ($opts{ssl} and not defined $opts{cert}) { 98 usage(); 99 exit 1; 100} 101 102my $handler = ThriftTestHandler->new(); 103my $handler2 = SecondServiceHandler->new(); 104my $processor = ThriftTest::ThriftTestProcessor->new($handler); 105my $processor2 = ThriftTest::SecondServiceProcessor->new($handler2); 106 107my $serversocket; 108if ($opts{'domain-socket'}) { 109 unlink($opts{'domain-socket'}); 110 $serversocket = Thrift::UnixServerSocket->new($opts{'domain-socket'}); 111} 112elsif ($opts{ssl}) { 113 $serversocket = Thrift::SSLServerSocket->new(\%opts); 114} 115else { 116 $serversocket = Thrift::ServerSocket->new(\%opts); 117} 118my $transport; 119if ($opts{transport} eq 'buffered') { 120 $transport = Thrift::BufferedTransportFactory->new(); 121} 122elsif ($opts{transport} eq 'framed') { 123 $transport = Thrift::FramedTransportFactory->new(); 124} 125else { 126 usage(); 127 exit 1; 128} 129my $protocol; 130if ($opts{protocol} eq 'binary' || $opts{protocol} eq 'multi') { 131 $protocol = Thrift::BinaryProtocolFactory->new(); 132} 133else { 134 usage(); 135 exit 1; 136} 137 138if (index($opts{protocol}, 'multi') == 0) { 139 my $newProcessor = Thrift::MultiplexedProcessor->new($protocol); 140 $newProcessor->defaultProcessor($processor); 141 $newProcessor->registerProcessor('ThriftTest', $processor); 142 $newProcessor->registerProcessor('SecondService', $processor2); 143 $processor = $newProcessor; 144} 145 146my $ssltag = ''; 147if ($opts{ssl}) { 148 $ssltag = '(SSL)'; 149} 150my $listening_on = "$opts{port} $ssltag"; 151if ($opts{'domain-socket'}) { 152 $listening_on = $opts{'domain-socket'}; 153} 154my $server = Thrift::SimpleServer->new($processor, $serversocket, $transport, $protocol); 155print qq|Starting "simple" server ($opts{transport}/$opts{protocol}) listen on: $listening_on\n|; 156$server->serve(); 157print "done.\n"; 158 159sub sigint_handler { 160 print "received SIGINT, stopping...\n"; 161 $server->stop(); 162} 163 164### 165### Test server implementation 166### 167 168package ThriftTestHandler; 169 170use base qw( ThriftTest::ThriftTestIf ); 171 172sub new { 173 my $classname = shift; 174 my $self = {}; 175 return bless($self, $classname); 176} 177 178sub testVoid { 179 print("testVoid()\n"); 180} 181 182sub testString { 183 my $self = shift; 184 my $thing = shift; 185 print("testString($thing)\n"); 186 return $thing; 187} 188 189sub testBool { 190 my $self = shift; 191 my $thing = shift; 192 my $str = $thing ? 'true' : 'false'; 193 print("testBool($str)\n"); 194 return $thing; 195} 196 197sub testByte { 198 my $self = shift; 199 my $thing = shift; 200 print("testByte($thing)\n"); 201 return $thing; 202} 203 204sub testI32 { 205 my $self = shift; 206 my $thing = shift; 207 print("testI32($thing)\n"); 208 return $thing; 209} 210 211sub testI64 { 212 my $self = shift; 213 my $thing = shift; 214 print("testI64($thing)\n"); 215 return $thing; 216} 217 218sub testDouble { 219 my $self = shift; 220 my $thing = shift; 221 print("testDouble($thing)\n"); 222 return $thing; 223} 224 225sub testBinary { 226 my $self = shift; 227 my $thing = shift; 228 my @bytes = split //, $thing; 229 print 'testBinary('; 230 printf( '%02lx', ord $_ ) foreach (@bytes); 231 print ")\n"; 232 return $thing; 233} 234 235sub testStruct { 236 my $self = shift; 237 my $thing = shift; 238 printf(qq|testStruct({"%s", %d, %d, %lld})\n|, 239 $thing->{string_thing}, 240 $thing->{byte_thing}, 241 $thing->{i32_thing}, 242 $thing->{i64_thing}); 243 return $thing; 244} 245 246sub testNest { 247 my $self = shift; 248 my $nest = shift; 249 my $thing = $nest->{struct_thing}; 250 printf(qq|testNest({%d, {"%s", %d, %d, %lld}, %d})\n|, 251 $nest->{byte_thing}, 252 $thing->{string_thing}, 253 $thing->{byte_thing}, 254 $thing->{i32_thing}, 255 $thing->{i64_thing}, 256 $nest->{i32_thing}); 257 return $nest; 258} 259 260sub testMap { 261 my $self = shift; 262 my $thing = shift; 263 printf "testMap({%s})\n", 264 join( ', ', 265 map { $_ . ' => ' . $thing->{$_} } 266 sort keys %$thing 267 ); 268 return $thing; 269} 270 271sub testStringMap { 272 my $self = shift; 273 my $thing = shift; 274 printf "testStringMap({%s})\n", 275 join( ', ', 276 map { $_ . ' => ' . $thing->{$_} } 277 sort keys %$thing 278 ); 279 return $thing; 280} 281 282sub testSet { 283 my $self = shift; 284 my $thing = shift; 285 my @result = sort keys %$thing; 286 printf "testSet({%s})\n", join(', ', @result ); 287 return \@result; 288} 289 290sub testList { 291 my $self = shift; 292 my $thing = shift; 293 print "testList({%s})\n", join(', ', @$thing); 294 return $thing; 295} 296 297sub testEnum { 298 my $self = shift; 299 my $thing = shift; 300 print "testEnum($thing)\n"; 301 return $thing; 302} 303 304sub testTypedef { 305 my $self = shift; 306 my $thing = shift; 307 print("testTypedef($thing)\n"); 308 return $thing; 309} 310 311sub testMapMap { 312 my $self = shift; 313 my $hello = shift; 314 315 printf("testMapMap(%d)\n", $hello); 316 my $result = { 4 => { 1 => 1, 2 => 2, 3 => 3, 4 => 4 }, -4 => { -1 => -1, -2 => -2, -3 => -3, -4 => -4 } }; 317 return $result; 318} 319 320sub testInsanity { 321 my $self = shift; 322 my $argument = shift; 323 print("testInsanity()\n"); 324 325 my $hello = ThriftTest::Xtruct->new({string_thing => 'Hello2', byte_thing => 2, i32_thing => 2, i64_thing => 2}); 326 my @hellos; 327 push(@hellos, $hello); 328 my $goodbye = ThriftTest::Xtruct->new({string_thing => 'Goodbye4', byte_thing => 4, i32_thing => 4, i64_thing => 4}); 329 my @goodbyes; 330 push(@goodbyes, $goodbye); 331 my $crazy = ThriftTest::Insanity->new({userMap => { ThriftTest::Numberz::EIGHT => 8 }, xtructs => \@goodbyes}); 332 my $loony = ThriftTest::Insanity->new(); 333 my $result = { 1 => { ThriftTest::Numberz::TWO => $argument, ThriftTest::Numberz::THREE => $argument }, 334 2 => { ThriftTest::Numberz::SIX => $loony } }; 335 return $result; 336} 337 338sub testMulti { 339 my $self = shift; 340 my $arg0 = shift; 341 my $arg1 = shift; 342 my $arg2 = shift; 343 my $arg3 = shift; 344 my $arg4 = shift; 345 my $arg5 = shift; 346 347 print("testMulti()\n"); 348 return ThriftTest::Xtruct->new({string_thing => 'Hello2', byte_thing => $arg0, i32_thing => $arg1, i64_thing => $arg2}); 349} 350 351sub testException { 352 my $self = shift; 353 my $arg = shift; 354 print("testException($arg)\n"); 355 if ($arg eq 'Xception') { 356 die ThriftTest::Xception->new({errorCode => 1001, message => $arg}); 357 } 358 elsif ($arg eq 'TException') { 359 die 'astring'; # all unhandled exceptions become TExceptions 360 } 361 else { 362 return ThriftTest::Xtruct->new({string_thing => $arg}); 363 } 364} 365 366sub testMultiException { 367 my $self = shift; 368 my $arg0 = shift; 369 my $arg1 = shift; 370 371 printf("testMultiException(%s, %s)\n", $arg0, $arg1); 372 if ($arg0 eq 'Xception') { 373 die ThriftTest::Xception->new({errorCode => 1001, message => 'This is an Xception'}); 374 } 375 elsif ($arg0 eq 'Xception2') { 376 my $struct_thing = ThriftTest::Xtruct->new({string_thing => 'This is an Xception2'}); 377 die ThriftTest::Xception2->new({errorCode => 2002, struct_thing => $struct_thing}); 378 } 379 else { 380 return ThriftTest::Xtruct->new({string_thing => $arg1}); 381 } 382} 383 384sub testOneway { 385 my $self = shift; 386 my $num = shift; 387 print("testOneway($num): received\n"); 388} 389 390### 391### Test server implementation 392### 393 394package SecondServiceHandler; 395 396use base qw( ThriftTest::SecondServiceIf ); 397 398sub new { 399 my $classname = shift; 400 my $self = {}; 401 return bless($self, $classname); 402} 403 404sub secondtestString { 405 my $self = shift; 406 my $thing = shift; 407 print("testString($thing)\n"); 408 return qq|testString("$thing")|; 409} 410 4111; 412