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
10 * http://www.apache.org/licenses/LICENSE-2.0
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
22 {$I ../src/Thrift.Defines.inc}
23 {$WARN SYMBOL_PLATFORM OFF}
25 {.$DEFINE RunEndless} // activate to interactively stress-test the server stop routines via Ctrl+C
34 Thrift.Transport.Pipes,
37 Thrift.Protocol.Compact,
52 ITestHandler = interface( TThriftTest.Iface )
53 procedure SetServer( const AServer : IServer );
57 TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
62 function testBool(thing: Boolean): Boolean;
63 function testString(const thing: string): string;
64 function testByte(thing: ShortInt): ShortInt;
65 function testI32(thing: Integer): Integer;
66 function testI64(const thing: Int64): Int64;
67 function testDouble(const thing: Double): Double;
68 function testBinary(const thing: TBytes): TBytes;
69 function testStruct(const thing: IXtruct): IXtruct;
70 function testNest(const thing: IXtruct2): IXtruct2;
71 function testMap(const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
72 function testStringMap(const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
73 function testSet(const thing: IHashSet<Integer>): IHashSet<Integer>;
74 function testList(const thing: IThriftList<Integer>): IThriftList<Integer>;
75 function testEnum(thing: TNumberz): TNumberz;
76 function testTypedef(const thing: Int64): Int64;
77 function testMapMap(hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
78 function testInsanity(const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
79 function testMulti(arg0: ShortInt; arg1: Integer; const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz; const arg5: Int64): IXtruct;
80 procedure testException(const arg: string);
81 function testMultiException(const arg0: string; const arg1: string): IXtruct;
82 procedure testOneway(secondsToSleep: Integer);
85 procedure SetServer( const AServer : IServer );
88 class procedure PrintCmdLineHelp;
89 class procedure InvalidArgs;
91 class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
92 class procedure Execute( const args: array of string);
98 var g_Handler : TTestServer.ITestHandler = nil;
101 function MyConsoleEventHandler( dwCtrlType : DWORD) : BOOL; stdcall;
102 // Note that this Handler procedure is called from another thread
103 var handler : TTestServer.ITestHandler;
108 CTRL_C_EVENT : Console.WriteLine( 'Ctrl+C pressed');
109 CTRL_BREAK_EVENT : Console.WriteLine( 'Ctrl+Break pressed');
110 CTRL_CLOSE_EVENT : Console.WriteLine( 'Received CloseTask signal');
111 CTRL_LOGOFF_EVENT : Console.WriteLine( 'Received LogOff signal');
112 CTRL_SHUTDOWN_EVENT : Console.WriteLine( 'Received Shutdown signal');
114 Console.WriteLine( 'Received console event #'+IntToStr(Integer(dwCtrlType)));
117 handler := g_Handler;
118 if handler <> nil then handler.TestStop;
126 { TTestServer.TTestHandlerImpl }
128 procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer);
133 function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
135 Console.WriteLine('testByte("' + IntToStr( thing) + '")');
139 function TTestServer.TTestHandlerImpl.testDouble( const thing: Double): Double;
141 Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
145 function TTestServer.TTestHandlerImpl.testBinary(const thing: TBytes): TBytes;
147 Console.WriteLine('testBinary('+IntToStr(Length(thing)) + ' bytes)');
151 function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
153 Console.WriteLine('testEnum(' + EnumUtils<TNumberz>.ToString(Ord(thing)) + ')');
157 procedure TTestServer.TTestHandlerImpl.testException(const arg: string);
159 Console.WriteLine('testException(' + arg + ')');
160 if ( arg = 'Xception') then
162 raise TXception.Create( 1001, arg);
165 if (arg = 'TException') then
167 raise TException.Create('TException');
170 // else do not throw anything
173 function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
175 Console.WriteLine('testI32("' + IntToStr( thing) + '")');
179 function TTestServer.TTestHandlerImpl.testI64( const thing: Int64): Int64;
181 Console.WriteLine('testI64("' + IntToStr( thing) + '")');
185 function TTestServer.TTestHandlerImpl.testInsanity(
186 const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
189 first_map : IThriftDictionary<TNumberz, IInsanity>;
190 second_map : IThriftDictionary<TNumberz, IInsanity>;
191 insane : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
194 Console.Write('testInsanity(');
195 if argument <> nil then Console.Write(argument.ToString);
196 Console.WriteLine(')');
200 * So you think you've got this all worked, out eh?
202 * Creates a the returned map with these values and prints it out:
203 * { 1 => { 2 => argument,
206 * 2 => { 6 => <empty Insanity struct>, },
208 * @return map<UserId, map<Numberz,Insanity>> - a map with the above values
211 first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
212 second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
214 first_map.AddOrSetValue( TNumberz.TWO, argument);
215 first_map.AddOrSetValue( TNumberz.THREE, argument);
217 looney := TInsanityImpl.Create;
218 second_map.AddOrSetValue( TNumberz.SIX, looney);
220 insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
222 insane.AddOrSetValue( 1, first_map);
223 insane.AddOrSetValue( 2, second_map);
228 function TTestServer.TTestHandlerImpl.testList( const thing: IThriftList<Integer>): IThriftList<Integer>;
230 Console.Write('testList(');
231 if thing <> nil then Console.Write(thing.ToString);
232 Console.WriteLine(')');
236 function TTestServer.TTestHandlerImpl.testMap(
237 const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
239 Console.Write('testMap(');
240 if thing <> nil then Console.Write(thing.ToString);
241 Console.WriteLine(')');
245 function TTestServer.TTestHandlerImpl.TestMapMap(
246 hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
248 mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
249 pos : IThriftDictionary<Integer, Integer>;
250 neg : IThriftDictionary<Integer, Integer>;
253 Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');
254 mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;
255 pos := TThriftDictionaryImpl<Integer, Integer>.Create;
256 neg := TThriftDictionaryImpl<Integer, Integer>.Create;
260 pos.AddOrSetValue( i, i);
261 neg.AddOrSetValue( -i, -i);
264 mapmap.AddOrSetValue(4, pos);
265 mapmap.AddOrSetValue( -4, neg);
270 function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
271 const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>;
272 arg4: TNumberz; const arg5: Int64): IXtruct;
276 Console.WriteLine('testMulti()');
277 hello := TXtructImpl.Create;
278 hello.String_thing := 'Hello2';
279 hello.Byte_thing := arg0;
280 hello.I32_thing := arg1;
281 hello.I64_thing := arg2;
285 function TTestServer.TTestHandlerImpl.testMultiException( const arg0, arg1: string): IXtruct;
289 Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');
290 if ( arg0 = 'Xception') then begin
291 raise TXception.Create( 1001, 'This is an Xception'); // test the new rich CTOR
294 if ( arg0 = 'Xception2') then begin
295 x2 := TXception2.Create; // the old way still works too?
296 x2.ErrorCode := 2002;
297 x2.Struct_thing := TXtructImpl.Create;
298 x2.Struct_thing.String_thing := 'This is an Xception2';
299 x2.UpdateMessageProperty;
303 Result := TXtructImpl.Create;
304 Result.String_thing := arg1;
307 function TTestServer.TTestHandlerImpl.testNest( const thing: IXtruct2): IXtruct2;
309 Console.Write('testNest(');
310 if thing <> nil then Console.Write(thing.ToString);
311 Console.WriteLine(')');
316 procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
318 Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
319 Sleep(secondsToSleep * 1000);
320 Console.WriteLine('testOneway finished');
323 function TTestServer.TTestHandlerImpl.testSet( const thing: IHashSet<Integer>):IHashSet<Integer>;
325 Console.Write('testSet(');
326 if thing <> nil then Console.Write(thing.ToString);
327 Console.WriteLine(')');;
332 procedure TTestServer.TTestHandlerImpl.testStop;
334 if FServer <> nil then begin
339 function TTestServer.TTestHandlerImpl.testBool(thing: Boolean): Boolean;
341 Console.WriteLine('testBool(' + BoolToStr(thing,true) + ')');
345 function TTestServer.TTestHandlerImpl.testString( const thing: string): string;
347 Console.WriteLine('teststring("' + thing + '")');
351 function TTestServer.TTestHandlerImpl.testStringMap(
352 const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
354 Console.Write('testStringMap(');
355 if thing <> nil then Console.Write(thing.ToString);
356 Console.WriteLine(')');
361 function TTestServer.TTestHandlerImpl.testTypedef( const thing: Int64): Int64;
363 Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
367 procedure TTestServer.TTestHandlerImpl.TestVoid;
369 Console.WriteLine('testVoid()');
372 function TTestServer.TTestHandlerImpl.testStruct( const thing: IXtruct): IXtruct;
374 Console.Write('testStruct(');
375 if thing <> nil then Console.Write(thing.ToString);
376 Console.WriteLine(')');
385 class procedure TTestServer.PrintCmdLineHelp;
386 const HELPTEXT = ' [options]'#10
388 + 'Allowed options:'#10
389 + ' -h [ --help ] produce help message'#10
390 + ' --port arg (=9090) Port number to listen'#10
391 + ' --domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)'#10
392 + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
393 + ' --server-type arg (=simple) type of server, "simple", "thread-pool",'#10
394 + ' "threaded", or "nonblocking"'#10
395 + ' --transport arg (=socket) transport: buffered, framed, http, anonpipe'#10
396 + ' --protocol arg (=binary) protocol: binary, compact, json'#10
397 + ' --ssl Encrypted Transport using SSL'#10
398 + ' --processor-events processor-events'#10
399 + ' -n [ --workers ] arg (=4) Number of thread pools workers. Only valid for'#10
400 + ' thread-pool server type'#10
403 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
406 class procedure TTestServer.InvalidArgs;
408 Console.WriteLine( 'Invalid args.');
409 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
413 class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
414 //Launch child process and pass R/W anonymous pipe handles on cmd line.
415 //This is a simple example and does not include elevation or other
417 var pi : PROCESS_INFORMATION;
419 sArg, sHandles, sCmdLine : string;
422 GetStartupInfo( si); //set startupinfo for the spawned process
424 // preformat handles args
425 sHandles := Format( '%d %d',
426 [ Integer(transport.ClientAnonRead),
427 Integer(transport.ClientAnonWrite)]);
429 // pass all settings to client
431 for i := 1 to ParamCount do begin
434 // add anonymous handles and quote strings where appropriate
436 then sArg := sArg +' '+ sHandles
439 then sArg := '"'+sArg+'"';
442 sCmdLine := sCmdLine +' '+ sArg;
445 // spawn the child process
446 Console.WriteLine('Starting client '+sCmdLine);
447 Win32Check( CreateProcess( nil, PChar(sCmdLine), nil,nil,TRUE,0,nil,nil,si,pi));
449 CloseHandle( pi.hThread);
450 CloseHandle( pi.hProcess);
454 class procedure TTestServer.Execute( const args: array of string);
457 ServerEvents : Boolean;
459 testHandler : ITestHandler;
460 testProcessor : IProcessor;
461 ServerTrans : IServerTransport;
462 ServerEngine : IServer;
463 anonymouspipe : IAnonymousPipeServerTransport;
464 namedpipe : INamedPipeServerTransport;
465 TransportFactory : ITransportFactory;
466 ProtocolFactory : IProtocolFactory;
467 i, numWorker : Integer;
469 protType : TKnownProtocol;
470 servertype : TServerType;
471 endpoint : TEndpointTransport;
472 layered : TLayeredTransports;
473 UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
476 ServerEvents := FALSE;
477 protType := prot_Binary;
478 servertype := srv_Simple;
479 endpoint := trns_Sockets;
487 while ( i < Length(args) ) do begin
492 if (s = '-h') or (s = '--help') then begin
493 // -h [ --help ] produce help message
497 else if (s = '--port') then begin
498 // --port arg (=9090) Port number to listen
501 Port := StrToIntDef( s, Port);
503 else if (s = '--domain-socket') then begin
504 // --domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)
505 raise Exception.Create('domain-socket not supported');
507 else if (s = '--named-pipe') then begin
508 // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
509 endpoint := trns_NamedPipes;
510 sPipeName := args[i]; // -pipe <name>
513 else if (s = '--server-type') then begin
514 // --server-type arg (=simple) type of server,
515 // arg = "simple", "thread-pool", "threaded", or "nonblocking"
519 if s = 'simple' then servertype := srv_Simple
520 else if s = 'thread-pool' then servertype := srv_Threadpool
521 else if s = 'threaded' then servertype := srv_Threaded
522 else if s = 'nonblocking' then servertype := srv_Nonblocking
525 else if (s = '--transport') then begin
526 // --transport arg (=buffered) transport: buffered, framed, http
530 if s = 'buffered' then Include( layered, trns_Buffered)
531 else if s = 'framed' then Include( layered, trns_Framed)
532 else if s = 'http' then endpoint := trns_MsxmlHttp
533 else if s = 'winhttp' then endpoint := trns_WinHttp
534 else if s = 'anonpipe' then endpoint := trns_AnonPipes
537 else if (s = '--protocol') then begin
538 // --protocol arg (=binary) protocol: binary, compact, json
542 if s = 'binary' then protType := prot_Binary
543 else if s = 'compact' then protType := prot_Compact
544 else if s = 'json' then protType := prot_JSON
547 else if (s = '--ssl') then begin
548 // --ssl Encrypted Transport using SSL
551 else if (s = '--processor-events') then begin
552 // --processor-events processor-events
553 ServerEvents := TRUE;
555 else if (s = '-n') or (s = '--workers') then begin
556 // -n [ --workers ] arg (=4) Number of thread pools workers.
557 // Only valid for thread-pool server type
559 numWorker := StrToIntDef(s,0);
570 Console.WriteLine('Server configuration: ');
572 // create protocol factory, default to BinaryProtocol
574 prot_Binary : ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
575 prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
576 prot_Compact : ProtocolFactory := TCompactProtocolImpl.TFactory.Create;
578 raise Exception.Create('Unhandled protocol');
580 ASSERT( ProtocolFactory <> nil);
581 Console.WriteLine('- '+THRIFT_PROTOCOLS[protType]+' protocol');
586 Console.WriteLine('- sockets (port '+IntToStr(port)+')');
587 if (trns_Buffered in layered) then Console.WriteLine('- buffered');
588 servertrans := TServerSocketImpl.Create( Port, 0, (trns_Buffered in layered));
593 raise Exception.Create('HTTP server transport not implemented');
596 trns_NamedPipes : begin
597 Console.WriteLine('- named pipe ('+sPipeName+')');
598 namedpipe := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES);
599 servertrans := namedpipe;
602 trns_AnonPipes : begin
603 Console.WriteLine('- anonymous pipes');
604 anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
605 servertrans := anonymouspipe;
609 raise Exception.Create('Unhandled endpoint transport');
611 ASSERT( servertrans <> nil);
614 raise Exception.Create('SSL not implemented');
617 if (trns_Framed in layered) then begin
618 Console.WriteLine('- framed transport');
619 TransportFactory := TFramedTransportImpl.TFactory.Create
622 TransportFactory := TTransportFactoryImpl.Create;
624 ASSERT( TransportFactory <> nil);
626 testHandler := TTestHandlerImpl.Create;
627 testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
631 ServerEngine := TSimpleServer.Create( testProcessor, ServerTrans, TransportFactory, ProtocolFactory);
634 srv_Nonblocking : begin
635 raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
640 if numWorker > 1 then {use here};
641 raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
645 raise Exception.Create('Unhandled server type');
647 ASSERT( ServerEngine <> nil);
649 testHandler.SetServer( ServerEngine);
652 if ServerEvents then begin
653 Console.WriteLine('- server events test enabled');
654 ServerEngine.ServerEvents := TServerEventsImpl.Create;
657 // start the client now when we have the anon handles, but before the server starts
658 if endpoint = trns_AnonPipes
659 then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
661 // install Ctrl+C handler before the server starts
662 g_Handler := testHandler;
663 SetConsoleCtrlHandler( @MyConsoleEventHandler, TRUE);
665 Console.WriteLine('');
667 Console.WriteLine('Starting the server ...');
669 until {$IFDEF RunEndless} FALSE {$ELSE} TRUE {$ENDIF};
671 testHandler.SetServer( nil);
675 on E: EAbort do raise;
676 on E: Exception do begin
677 Console.WriteLine( E.Message + #10 + E.StackTrace );
680 Console.WriteLine( 'done.');