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 unit TestServer;
21
22 {$I ../src/Thrift.Defines.inc}
23 {$WARN SYMBOL_PLATFORM OFF}
24
25 {.$DEFINE RunEndless} // activate to interactively stress-test the server stop routines via Ctrl+C
26
27 interface
28
29 uses
30 Windows, SysUtils,
31 Generics.Collections,
32 Thrift.Server,
33 Thrift.Transport,
34 Thrift.Transport.Pipes,
35 Thrift.Protocol,
36 Thrift.Protocol.JSON,
37 Thrift.Protocol.Compact,
38 Thrift.Collections,
39 Thrift.Configuration,
40 Thrift.Utils,
41 Thrift.Test,
42 Thrift,
43 TestConstants,
44 TestServerEvents,
45 ConsoleHelper,
46 Contnrs;
47
48 type
49 TTestServer = class
50 public
51 type
52
53 ITestHandler = interface( TThriftTest.Iface )
54 procedure SetServer( const AServer : IServer );
55 procedure TestStop;
56 end;
57
58 TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
59 strict private
60 FServer : IServer;
61 strict protected
62 procedure testVoid();
testBoolnull63 function testBool(thing: Boolean): Boolean;
testStringnull64 function testString(const thing: string): string;
testBytenull65 function testByte(thing: ShortInt): ShortInt;
testI32null66 function testI32(thing: Integer): Integer;
testI64null67 function testI64(const thing: Int64): Int64;
testDoublenull68 function testDouble(const thing: Double): Double;
testBinarynull69 function testBinary(const thing: TBytes): TBytes;
testStructnull70 function testStruct(const thing: IXtruct): IXtruct;
testNestnull71 function testNest(const thing: IXtruct2): IXtruct2;
testMapnull72 function testMap(const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
testStringMapnull73 function testStringMap(const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
testSetnull74 function testSet(const thing: IHashSet<Integer>): IHashSet<Integer>;
testListnull75 function testList(const thing: IThriftList<Integer>): IThriftList<Integer>;
testEnumnull76 function testEnum(thing: TNumberz): TNumberz;
testTypedefnull77 function testTypedef(const thing: Int64): Int64;
testMapMapnull78 function testMapMap(hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
testInsanitynull79 function testInsanity(const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
testMultinull80 function testMulti(arg0: ShortInt; arg1: Integer; const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz; const arg5: Int64): IXtruct;
81 procedure testException(const arg: string);
testMultiExceptionnull82 function testMultiException(const arg0: string; const arg1: string): IXtruct;
83 procedure testOneway(secondsToSleep: Integer);
84
85 procedure TestStop;
86 procedure SetServer( const AServer : IServer );
87 end;
88
89 class procedure PrintCmdLineHelp;
90 class procedure InvalidArgs;
IsSwitchnull91 class function IsSwitch( const aArgument, aSwitch : string; out sValue : string) : Boolean;
92
93 class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
94 class procedure Execute( const arguments : array of string);
95 end;
96
97 implementation
98
99
100 var g_Handler : TTestServer.ITestHandler = nil;
101
102
MyConsoleEventHandlernull103 function MyConsoleEventHandler( dwCtrlType : DWORD) : BOOL; stdcall;
104 // Note that this Handler procedure is called from another thread
105 var handler : TTestServer.ITestHandler;
106 begin
107 result := TRUE;
108 try
109 case dwCtrlType of
110 CTRL_C_EVENT : Console.WriteLine( 'Ctrl+C pressed');
111 CTRL_BREAK_EVENT : Console.WriteLine( 'Ctrl+Break pressed');
112 CTRL_CLOSE_EVENT : Console.WriteLine( 'Received CloseTask signal');
113 CTRL_LOGOFF_EVENT : Console.WriteLine( 'Received LogOff signal');
114 CTRL_SHUTDOWN_EVENT : Console.WriteLine( 'Received Shutdown signal');
115 else
116 Console.WriteLine( 'Received console event #'+IntToStr(Integer(dwCtrlType)));
117 end;
118
119 handler := g_Handler;
120 if handler <> nil then handler.TestStop;
121
122 except
123 // catch all
124 end;
125 end;
126
127
128 { TTestServer.TTestHandlerImpl }
129
130 procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer);
131 begin
132 FServer := AServer;
133 end;
134
TTestServer.TTestHandlerImpl.testBytenull135 function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
136 begin
137 Console.WriteLine('testByte("' + IntToStr( thing) + '")');
138 Result := thing;
139 end;
140
TTestHandlerImplnull141 function TTestServer.TTestHandlerImpl.testDouble( const thing: Double): Double;
142 begin
143 Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
144 Result := thing;
145 end;
146
TTestServer.TTestHandlerImpl.testBinarynull147 function TTestServer.TTestHandlerImpl.testBinary(const thing: TBytes): TBytes;
148 begin
149 Console.WriteLine('testBinary('+IntToStr(Length(thing)) + ' bytes)');
150 Result := thing;
151 end;
152
TTestServer.TTestHandlerImpl.testEnumnull153 function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
154 begin
155 Console.WriteLine('testEnum(' + EnumUtils<TNumberz>.ToString(Ord(thing)) + ')');
156 Result := thing;
157 end;
158
159 procedure TTestServer.TTestHandlerImpl.testException(const arg: string);
160 begin
161 Console.WriteLine('testException(' + arg + ')');
162 if ( arg = 'Xception') then begin
163 raise TXception.Create( 1001, arg);
164 end;
165
166 if (arg = 'TException') then begin
167 raise TException.Create('TException');
168 end;
169
170 // else do not throw anything
171 end;
172
TTestServer.TTestHandlerImpl.testI32null173 function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
174 begin
175 Console.WriteLine('testI32("' + IntToStr( thing) + '")');
176 Result := thing;
177 end;
178
TTestServer.TTestHandlerImpl.testI64null179 function TTestServer.TTestHandlerImpl.testI64( const thing: Int64): Int64;
180 begin
181 Console.WriteLine('testI64("' + IntToStr( thing) + '")');
182 Result := thing;
183 end;
184
TTestServer.TTestHandlerImpl.testInsanitynull185 function TTestServer.TTestHandlerImpl.testInsanity(
186 const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
187 var
188 looney : IInsanity;
189 first_map : IThriftDictionary<TNumberz, IInsanity>;
190 second_map : IThriftDictionary<TNumberz, IInsanity>;
191 insane : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
192
193 begin
194 Console.Write('testInsanity(');
195 if argument <> nil then Console.Write(argument.ToString);
196 Console.WriteLine(')');
197
198
199 (**
200 * So you think you've got this all worked, out eh?
201 *
202 * Creates a the returned map with these values and prints it out:
203 * { 1 => { 2 => argument,
204 * 3 => argument,
205 * },
206 * 2 => { 6 => <empty Insanity struct>, },
207 * }
208 * @return map<UserId, map<Numberz,Insanity>> - a map with the above values
209 *)
210
211 first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
212 second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
213
214 first_map.AddOrSetValue( TNumberz.TWO, argument);
215 first_map.AddOrSetValue( TNumberz.THREE, argument);
216
217 looney := TInsanityImpl.Create;
218 second_map.AddOrSetValue( TNumberz.SIX, looney);
219
220 insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
221
222 insane.AddOrSetValue( 1, first_map);
223 insane.AddOrSetValue( 2, second_map);
224
225 Result := insane;
226 end;
227
TTestHandlerImplnull228 function TTestServer.TTestHandlerImpl.testList( const thing: IThriftList<Integer>): IThriftList<Integer>;
229 begin
230 Console.Write('testList(');
231 if thing <> nil then Console.Write(thing.ToString);
232 Console.WriteLine(')');
233 Result := thing;
234 end;
235
TTestServer.TTestHandlerImpl.testMapnull236 function TTestServer.TTestHandlerImpl.testMap(
237 const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
238 begin
239 Console.Write('testMap(');
240 if thing <> nil then Console.Write(thing.ToString);
241 Console.WriteLine(')');
242 Result := thing;
243 end;
244
TTestServer.TTestHandlerImpl.TestMapMapnull245 function TTestServer.TTestHandlerImpl.TestMapMap(
246 hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
247 var
248 mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
249 pos : IThriftDictionary<Integer, Integer>;
250 neg : IThriftDictionary<Integer, Integer>;
251 i : Integer;
252 begin
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;
257
258 for i := 1 to 4 do
259 begin
260 pos.AddOrSetValue( i, i);
261 neg.AddOrSetValue( -i, -i);
262 end;
263
264 mapmap.AddOrSetValue(4, pos);
265 mapmap.AddOrSetValue( -4, neg);
266
267 Result := mapmap;
268 end;
269
TTestHandlerImplnull270 function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
271 const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>;
272 arg4: TNumberz; const arg5: Int64): IXtruct;
273 var
274 hello : IXtruct;
275 begin
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;
282 Result := hello;
283 end;
284
TTestHandlerImplnull285 function TTestServer.TTestHandlerImpl.testMultiException( const arg0, arg1: string): IXtruct;
286 var
287 x2 : TXception2;
288 begin
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
292 end;
293
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;
300 raise x2;
301 end;
302
303 Result := TXtructImpl.Create;
304 Result.String_thing := arg1;
305 end;
306
TTestServer.TTestHandlerImpl.testNestnull307 function TTestServer.TTestHandlerImpl.testNest( const thing: IXtruct2): IXtruct2;
308 begin
309 Console.Write('testNest(');
310 if thing <> nil then Console.Write(thing.ToString);
311 Console.WriteLine(')');
312
313 Result := thing;
314 end;
315
316 procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
317 begin
318 Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
319 Sleep(secondsToSleep * 1000);
320 Console.WriteLine('testOneway finished');
321 end;
322
TTestServer.TTestHandlerImpl.testSetnull323 function TTestServer.TTestHandlerImpl.testSet( const thing: IHashSet<Integer>):IHashSet<Integer>;
324 begin
325 Console.Write('testSet(');
326 if thing <> nil then Console.Write(thing.ToString);
327 Console.WriteLine(')');;
328
329 Result := thing;
330 end;
331
332 procedure TTestServer.TTestHandlerImpl.testStop;
333 begin
334 if FServer <> nil then begin
335 FServer.Stop;
336 end;
337 end;
338
TTestHandlerImplnull339 function TTestServer.TTestHandlerImpl.testBool(thing: Boolean): Boolean;
340 begin
341 Console.WriteLine('testBool(' + BoolToStr(thing,true) + ')');
342 Result := thing;
343 end;
344
TTestServer.TTestHandlerImpl.testStringnull345 function TTestServer.TTestHandlerImpl.testString( const thing: string): string;
346 begin
347 Console.WriteLine('teststring("' + thing + '")');
348 Result := thing;
349 end;
350
TTestServer.TTestHandlerImpl.testStringMapnull351 function TTestServer.TTestHandlerImpl.testStringMap(
352 const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
353 begin
354 Console.Write('testStringMap(');
355 if thing <> nil then Console.Write(thing.ToString);
356 Console.WriteLine(')');
357
358 Result := thing;
359 end;
360
TTestServer.TTestHandlerImpl.testTypedefnull361 function TTestServer.TTestHandlerImpl.testTypedef( const thing: Int64): Int64;
362 begin
363 Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
364 Result := thing;
365 end;
366
367 procedure TTestServer.TTestHandlerImpl.TestVoid;
368 begin
369 Console.WriteLine('testVoid()');
370 end;
371
TTestHandlerImplnull372 function TTestServer.TTestHandlerImpl.testStruct( const thing: IXtruct): IXtruct;
373 begin
374 Console.Write('testStruct(');
375 if thing <> nil then Console.Write(thing.ToString);
376 Console.WriteLine(')');
377
378 Result := thing;
379 end;
380
381
382 { TTestServer }
383
384
385 class procedure TTestServer.PrintCmdLineHelp;
386 const HELPTEXT = ' [options]'#10
387 + #10
388 + 'Allowed options:'#10
389 + ' -h | --help Produces this help message'#10
390 + ' --port=arg (9090) Port number to connect'#10
391 + ' --pipe=arg Windows Named Pipe (e.g. MyThriftPipe)'#10
392 + ' --anon-pipes Windows Anonymous Pipes server, auto-starts client.exe'#10
393 + ' --server-type=arg (simple) Type of server (simple, thread-pool, threaded, nonblocking)'#10
394 + ' --transport=arg (sockets) Transport: buffered, framed, anonpipe'#10
395 + ' --protocol=arg (binary) Protocol: binary, compact, json'#10
396 + ' --ssl Encrypted Transport using SSL'#10
397 + ' --processor-events Enable processor-events'#10
398 + ' -n=num | --workers=num (4) Number of thread-pool server workers'#10
399 ;
400 begin
401 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
402 end;
403
404 class procedure TTestServer.InvalidArgs;
405 begin
406 Console.WriteLine( 'Invalid args.');
407 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
408 Abort;
409 end;
410
TTestServer.IsSwitchnull411 class function TTestServer.IsSwitch( const aArgument, aSwitch : string; out sValue : string) : Boolean;
412 begin
413 sValue := '';
414 result := (Copy( aArgument, 1, Length(aSwitch)) = aSwitch);
415 if result then begin
416 if (Copy( aArgument, 1, Length(aSwitch)+1) = (aSwitch+'='))
417 then sValue := Copy( aArgument, Length(aSwitch)+2, MAXINT);
418 end;
419 end;
420
421 class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
422 //Launch child process and pass R/W anonymous pipe handles on cmd line.
423 //This is a simple example and does not include elevation or other
424 //advanced features.
425 var pi : PROCESS_INFORMATION;
426 si : STARTUPINFO;
427 sArg, sHandles, sCmdLine : string;
428 i : Integer;
429 begin
430 GetStartupInfo( si); //set startupinfo for the spawned process
431
432 // preformat handles args
433 sHandles := Format( '%d %d',
434 [ Integer(transport.ClientAnonRead),
435 Integer(transport.ClientAnonWrite)]);
436
437 // pass all settings to client
438 sCmdLine := app;
439 for i := 1 to ParamCount do begin
440 sArg := ParamStr(i);
441
442 // add anonymous handles and quote strings where appropriate
443 if sArg = '--anon-pipes'
444 then sArg := sArg +' '+ sHandles
445 else begin
446 if Pos(' ',sArg) > 0
447 then sArg := '"'+sArg+'"';
448 end;;
449
450 sCmdLine := sCmdLine +' '+ sArg;
451 end;
452
453 // spawn the child process
454 Console.WriteLine('Starting client '+sCmdLine);
455 Win32Check( CreateProcess( nil, PChar(sCmdLine), nil,nil,TRUE,0,nil,nil,si,pi));
456
457 CloseHandle( pi.hThread);
458 CloseHandle( pi.hProcess);
459 end;
460
461
462 class procedure TTestServer.Execute( const arguments : array of string);
463 var
464 Port : Integer;
465 ServerEvents : Boolean;
466 sPipeName : string;
467 testHandler : ITestHandler;
468 testProcessor : IProcessor;
469 ServerTrans : IServerTransport;
470 ServerEngine : IServer;
471 anonymouspipe : IAnonymousPipeServerTransport;
472 namedpipe : INamedPipeServerTransport;
473 TransportFactory : ITransportFactory;
474 ProtocolFactory : IProtocolFactory;
475 iArg, numWorker : Integer;
476 sArg, sValue : string;
477 protType : TKnownProtocol;
478 servertype : TServerType;
479 endpoint : TEndpointTransport;
480 layered : TLayeredTransports;
481 UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
482 begin
483 try
484 ServerEvents := FALSE;
485 protType := prot_Binary;
486 servertype := srv_Simple;
487 endpoint := trns_Sockets;
488 layered := [];
489 UseSSL := FALSE;
490 Port := 9090;
491 sPipeName := '';
492 numWorker := 4;
493
494 iArg := 0;
495 while iArg < Length(arguments) do begin
496 sArg := arguments[iArg];
497 Inc(iArg);
498
499 // Allowed options:
500 if IsSwitch( sArg, '-h', sValue)
501 or IsSwitch( sArg, '--help', sValue)
502 then begin
503 // -h | --help produce help message
504 PrintCmdLineHelp;
505 Exit;
506 end
507 else if IsSwitch( sArg, '--port', sValue) then begin
508 // --port arg (=9090) Port number to listen
509 Port := StrToIntDef( sValue, Port);
510 end
511 else if IsSwitch( sArg, '--anon-pipes', sValue) then begin
512 endpoint := trns_AnonPipes;
513 end
514 else if IsSwitch( sArg, '--pipe', sValue) then begin
515 // --pipe arg Windows Named Pipe (e.g. MyThriftPipe)
516 endpoint := trns_NamedPipes;
517 sPipeName := sValue; // --pipe <name>
518 end
519 else if IsSwitch( sArg, '--server-type', sValue) then begin
520 // --server-type arg (=simple) type of server,
521 // arg = "simple", "thread-pool", "threaded", or "nonblocking"
522 if sValue = 'simple' then servertype := srv_Simple
523 else if sValue = 'thread-pool' then servertype := srv_Threadpool
524 else if sValue = 'threaded' then servertype := srv_Threaded
525 else if sValue = 'nonblocking' then servertype := srv_Nonblocking
526 else InvalidArgs;
527 end
528 else if IsSwitch( sArg, '--transport', sValue) then begin
529 // --transport arg (=buffered) transport: buffered, framed, http
530 if sValue = 'buffered' then Include( layered, trns_Buffered)
531 else if sValue = 'framed' then Include( layered, trns_Framed)
532 else if sValue = 'http' then endpoint := trns_MsxmlHttp
533 else if sValue = 'winhttp' then endpoint := trns_WinHttp
534 else if sValue = 'anonpipe' then endpoint := trns_AnonPipes
535 else InvalidArgs;
536 end
537 else if IsSwitch( sArg, '--protocol', sValue) then begin
538 // --protocol arg (=binary) protocol: binary, compact, json
539 if sValue = 'binary' then protType := prot_Binary
540 else if sValue = 'compact' then protType := prot_Compact
541 else if sValue = 'json' then protType := prot_JSON
542 else InvalidArgs;
543 end
544 else if IsSwitch( sArg, '--ssl', sValue) then begin
545 // --ssl Encrypted Transport using SSL
546 UseSSL := TRUE;
547 end
548 else if IsSwitch( sArg, '--processor-events', sValue) then begin
549 // --processor-events processor-events
550 ServerEvents := TRUE;
551 end
552 else if IsSwitch( sArg, '-n', sValue) or IsSwitch( sArg, '--workers', sValue) then begin
553 // -n [ --workers ] arg (=4) Number of thread pools workers.
554 // Only valid for thread-pool server type
555 numWorker := StrToIntDef(sValue,4);
556 end
557 else begin
558 InvalidArgs;
559 end;
560 end;
561
562
563 Console.WriteLine('Server configuration: ');
564
565 // create protocol factory, default to BinaryProtocol
566 case protType of
567 prot_Binary : ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
568 prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
569 prot_Compact : ProtocolFactory := TCompactProtocolImpl.TFactory.Create;
570 else
571 raise Exception.Create('Unhandled protocol');
572 end;
573 ASSERT( ProtocolFactory <> nil);
574 Console.WriteLine('- '+THRIFT_PROTOCOLS[protType]+' protocol');
575
576 case endpoint of
577
578 trns_Sockets : begin
579 Console.WriteLine('- sockets (port '+IntToStr(port)+')');
580 if (trns_Buffered in layered) then Console.WriteLine('- buffered');
581 servertrans := TServerSocketImpl.Create( Port, DEFAULT_THRIFT_TIMEOUT, (trns_Buffered in layered));
582 end;
583
584 trns_MsxmlHttp,
585 trns_WinHttp : begin
586 raise Exception.Create('HTTP server transport not implemented');
587 end;
588
589 trns_NamedPipes : begin
590 Console.WriteLine('- named pipe ('+sPipeName+')');
591 namedpipe := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES, INFINITE);
592 servertrans := namedpipe;
593 end;
594
595 trns_AnonPipes : begin
596 Console.WriteLine('- anonymous pipes');
597 anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
598 servertrans := anonymouspipe;
599 end
600
601 else
602 raise Exception.Create('Unhandled endpoint transport');
603 end;
604 ASSERT( servertrans <> nil);
605
606 if UseSSL then begin
607 raise Exception.Create('SSL not implemented');
608 end;
609
610 if (trns_Framed in layered) then begin
611 Console.WriteLine('- framed transport');
612 TransportFactory := TFramedTransportImpl.TFactory.Create;
613 end
614 else begin
615 TransportFactory := TTransportFactoryImpl.Create;
616 end;
617 ASSERT( TransportFactory <> nil);
618
619 testHandler := TTestHandlerImpl.Create;
620 testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
621
622 case servertype of
623 srv_Simple : begin
624 ServerEngine := TSimpleServer.Create( testProcessor, ServerTrans, TransportFactory, ProtocolFactory);
625 end;
626
627 srv_Nonblocking : begin
628 raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
629 end;
630
631 srv_Threadpool,
632 srv_Threaded: begin
633 if numWorker > 1 then {use here};
634 raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
635 end;
636
637 else
638 raise Exception.Create('Unhandled server type');
639 end;
640 ASSERT( ServerEngine <> nil);
641
642 testHandler.SetServer( ServerEngine);
643
644 // test events?
645 if ServerEvents then begin
646 Console.WriteLine('- server events test enabled');
647 ServerEngine.ServerEvents := TServerEventsImpl.Create;
648 end;
649
650 // start the client now when we have the anon handles, but before the server starts
651 if endpoint = trns_AnonPipes
652 then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
653
654 // install Ctrl+C handler before the server starts
655 g_Handler := testHandler;
656 SetConsoleCtrlHandler( @MyConsoleEventHandler, TRUE);
657
658 Console.WriteLine('');
659 repeat
660 Console.WriteLine('Starting the server ...');
661 serverEngine.Serve;
662 until {$IFDEF RunEndless} FALSE {$ELSE} TRUE {$ENDIF};
663
664 testHandler.SetServer( nil);
665 g_Handler := nil;
666
667 except
668 on E: EAbort do raise;
669 on E: Exception do begin
670 Console.WriteLine( E.Message + #10 + E.StackTrace );
671 end;
672 end;
673 Console.WriteLine( 'done.');
674 end;
675
676
677 end.
678