ridv/gorealis-v2
1
0
Fork 0
Code Issues Pull requests Projects Releases 13 Packages Wiki Activity Actions

Moving from govendor to dep, updated dependencies (#48)

Browse source 
* Moving from govendor to dep.

* Making the pull request template more friendly.

* Fixing akward space in PR template.

* goimports run on whole project using ` goimports -w $(find . -type f -name '*.go' -not -path "./vendor/*" -not -path "./gen-go/*")`

source of command: https://gist.github.com/bgentry/fd1ffef7dbde01857f66
This commit is contained in:
Renan DelValle 2018-01-07 13:13:47 -08:00 • committed by GitHub
parent 9631aa3aab
commit 8d445c1c77
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2186 changed files with 400410 additions and 352 deletions
Download patch file Download diff file Expand all files Collapse all files

619
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Collections.pas generated vendored Normal file
View file

@ -0,0 +1,619 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Collections;
interface
uses
Generics.Collections, Generics.Defaults, Thrift.Utils;
type
{$IF CompilerVersion < 21.0}
TArray<T> = array of T;
{$IFEND}
IThriftContainer = interface
['{93DEF5A0-D162-461A-AB22-5B4EE0734050}']
function ToString: string;
end;
IThriftDictionary<TKey,TValue> = interface(IThriftContainer)
['{25EDD506-F9D1-4008-A40F-5940364B7E46}']
function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
function GetValues: TDictionary<TKey,TValue>.TValueCollection;
function GetItem(const Key: TKey): TValue;
procedure SetItem(const Key: TKey; const Value: TValue);
function GetCount: Integer;
procedure Add(const Key: TKey; const Value: TValue);
procedure Remove(const Key: TKey);
{$IF CompilerVersion >= 21.0}
function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
{$IFEND}
procedure Clear;
procedure TrimExcess;
function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
procedure AddOrSetValue(const Key: TKey; const Value: TValue);
function ContainsKey(const Key: TKey): Boolean;
function ContainsValue(const Value: TValue): Boolean;
function ToArray: TArray<TPair<TKey,TValue>>;
property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
property Count: Integer read GetCount;
property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
end;
TThriftDictionaryImpl<TKey,TValue> = class( TInterfacedObject, IThriftDictionary<TKey,TValue>)
private
FDictionaly : TDictionary<TKey,TValue>;
protected
function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
function GetValues: TDictionary<TKey,TValue>.TValueCollection;
function GetItem(const Key: TKey): TValue;
procedure SetItem(const Key: TKey; const Value: TValue);
function GetCount: Integer;
procedure Add(const Key: TKey; const Value: TValue);
procedure Remove(const Key: TKey);
{$IF CompilerVersion >= 21.0}
function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
{$IFEND}
procedure Clear;
procedure TrimExcess;
function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
procedure AddOrSetValue(const Key: TKey; const Value: TValue);
function ContainsKey(const Key: TKey): Boolean;
function ContainsValue(const Value: TValue): Boolean;
function ToArray: TArray<TPair<TKey,TValue>>;
property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
property Count: Integer read GetCount;
property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
public
constructor Create(ACapacity: Integer = 0);
destructor Destroy; override;
end;
IThriftList<T> = interface(IThriftContainer)
['{29BEEE31-9CB4-401B-AA04-5148A75F473B}']
function GetEnumerator: TEnumerator<T>;
function GetCapacity: Integer;
procedure SetCapacity(Value: Integer);
function GetCount: Integer;
procedure SetCount(Value: Integer);
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function Add(const Value: T): Integer;
procedure AddRange(const Values: array of T); overload;
procedure AddRange(const Collection: IEnumerable<T>); overload;
procedure AddRange(Collection: TEnumerable<T>); overload;
procedure Insert(Index: Integer; const Value: T);
procedure InsertRange(Index: Integer; const Values: array of T); overload;
procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
function Remove(const Value: T): Integer;
procedure Delete(Index: Integer);
procedure DeleteRange(AIndex, ACount: Integer);
function Extract(const Value: T): T;
{$IF CompilerVersion >= 21.0}
procedure Exchange(Index1, Index2: Integer);
procedure Move(CurIndex, NewIndex: Integer);
function First: T;
function Last: T;
{$IFEND}
procedure Clear;
function Contains(const Value: T): Boolean;
function IndexOf(const Value: T): Integer;
function LastIndexOf(const Value: T): Integer;
procedure Reverse;
procedure Sort; overload;
procedure Sort(const AComparer: IComparer<T>); overload;
function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
procedure TrimExcess;
function ToArray: TArray<T>;
property Capacity: Integer read GetCapacity write SetCapacity;
property Count: Integer read GetCount write SetCount;
property Items[Index: Integer]: T read GetItem write SetItem; default;
end;
TThriftListImpl<T> = class( TInterfacedObject, IThriftList<T>)
private
FList : TList<T>;
protected
function GetEnumerator: TEnumerator<T>;
function GetCapacity: Integer;
procedure SetCapacity(Value: Integer);
function GetCount: Integer;
procedure SetCount(Value: Integer);
function GetItem(Index: Integer): T;
procedure SetItem(Index: Integer; const Value: T);
function Add(const Value: T): Integer;
procedure AddRange(const Values: array of T); overload;
procedure AddRange(const Collection: IEnumerable<T>); overload;
procedure AddRange(Collection: TEnumerable<T>); overload;
procedure Insert(Index: Integer; const Value: T);
procedure InsertRange(Index: Integer; const Values: array of T); overload;
procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
function Remove(const Value: T): Integer;
procedure Delete(Index: Integer);
procedure DeleteRange(AIndex, ACount: Integer);
function Extract(const Value: T): T;
{$IF CompilerVersion >= 21.0}
procedure Exchange(Index1, Index2: Integer);
procedure Move(CurIndex, NewIndex: Integer);
function First: T;
function Last: T;
{$IFEND}
procedure Clear;
function Contains(const Value: T): Boolean;
function IndexOf(const Value: T): Integer;
function LastIndexOf(const Value: T): Integer;
procedure Reverse;
procedure Sort; overload;
procedure Sort(const AComparer: IComparer<T>); overload;
function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
procedure TrimExcess;
function ToArray: TArray<T>;
property Capacity: Integer read GetCapacity write SetCapacity;
property Count: Integer read GetCount write SetCount;
property Items[Index: Integer]: T read GetItem write SetItem; default;
public
constructor Create;
destructor Destroy; override;
end;
IHashSet<TValue> = interface(IThriftContainer)
['{0923A3B5-D4D4-48A8-91AD-40238E2EAD66}']
function GetEnumerator: TEnumerator<TValue>;
function GetIsReadOnly: Boolean;
function GetCount: Integer;
property Count: Integer read GetCount;
property IsReadOnly: Boolean read GetIsReadOnly;
procedure Add( const item: TValue);
procedure Clear;
function Contains( const item: TValue): Boolean;
procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
function Remove( const item: TValue ): Boolean;
end;
THashSetImpl<TValue> = class( TInterfacedObject, IHashSet<TValue>)
private
FDictionary : IThriftDictionary<TValue,Integer>;
FIsReadOnly: Boolean;
protected
function GetEnumerator: TEnumerator<TValue>;
function GetIsReadOnly: Boolean;
function GetCount: Integer;
property Count: Integer read GetCount;
property IsReadOnly: Boolean read FIsReadOnly;
procedure Add( const item: TValue);
procedure Clear;
function Contains( const item: TValue): Boolean;
procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
function Remove( const item: TValue ): Boolean;
public
constructor Create;
end;
implementation
{ THashSetImpl<TValue> }
procedure THashSetImpl<TValue>.Add( const item: TValue);
begin
if not FDictionary.ContainsKey(item) then
begin
FDictionary.Add( item, 0);
end;
end;
procedure THashSetImpl<TValue>.Clear;
begin
FDictionary.Clear;
end;
function THashSetImpl<TValue>.Contains( const item: TValue): Boolean;
begin
Result := FDictionary.ContainsKey(item);
end;
procedure THashSetImpl<TValue>.CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
var
i : Integer;
Enumlator : TEnumerator<TValue>;
begin
Enumlator := GetEnumerator;
while Enumlator.MoveNext do
begin
A[arrayIndex] := Enumlator.Current;
Inc(arrayIndex);
end;
end;
constructor THashSetImpl<TValue>.Create;
begin
inherited;
FDictionary := TThriftDictionaryImpl<TValue,Integer>.Create;
end;
function THashSetImpl<TValue>.GetCount: Integer;
begin
Result := FDictionary.Count;
end;
function THashSetImpl<TValue>.GetEnumerator: TEnumerator<TValue>;
begin
Result := FDictionary.Keys.GetEnumerator;
end;
function THashSetImpl<TValue>.GetIsReadOnly: Boolean;
begin
Result := FIsReadOnly;
end;
function THashSetImpl<TValue>.Remove( const item: TValue): Boolean;
begin
Result := False;
if FDictionary.ContainsKey( item ) then
begin
FDictionary.Remove( item );
Result := not FDictionary.ContainsKey( item );
end;
end;
{ TThriftDictionaryImpl<TKey, TValue> }
procedure TThriftDictionaryImpl<TKey, TValue>.Add(const Key: TKey;
const Value: TValue);
begin
FDictionaly.Add( Key, Value);
end;
procedure TThriftDictionaryImpl<TKey, TValue>.AddOrSetValue(const Key: TKey;
const Value: TValue);
begin
FDictionaly.AddOrSetValue( Key, Value);
end;
procedure TThriftDictionaryImpl<TKey, TValue>.Clear;
begin
FDictionaly.Clear;
end;
function TThriftDictionaryImpl<TKey, TValue>.ContainsKey(
const Key: TKey): Boolean;
begin
Result := FDictionaly.ContainsKey( Key );
end;
function TThriftDictionaryImpl<TKey, TValue>.ContainsValue(
const Value: TValue): Boolean;
begin
Result := FDictionaly.ContainsValue( Value );
end;
constructor TThriftDictionaryImpl<TKey, TValue>.Create(ACapacity: Integer);
begin
inherited Create;
FDictionaly := TDictionary<TKey,TValue>.Create( ACapacity );
end;
destructor TThriftDictionaryImpl<TKey, TValue>.Destroy;
begin
FDictionaly.Free;
inherited;
end;
{$IF CompilerVersion >= 21.0}
function TThriftDictionaryImpl<TKey, TValue>.ExtractPair( const Key: TKey): TPair<TKey, TValue>;
begin
Result := FDictionaly.ExtractPair( Key);
end;
{$IFEND}
function TThriftDictionaryImpl<TKey, TValue>.GetCount: Integer;
begin
Result := FDictionaly.Count;
end;
function TThriftDictionaryImpl<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
begin
Result := FDictionaly.GetEnumerator;
end;
function TThriftDictionaryImpl<TKey, TValue>.GetItem(const Key: TKey): TValue;
begin
Result := FDictionaly.Items[Key];
end;
function TThriftDictionaryImpl<TKey, TValue>.GetKeys: TDictionary<TKey, TValue>.TKeyCollection;
begin
Result := FDictionaly.Keys;
end;
function TThriftDictionaryImpl<TKey, TValue>.GetValues: TDictionary<TKey, TValue>.TValueCollection;
begin
Result := FDictionaly.Values;
end;
procedure TThriftDictionaryImpl<TKey, TValue>.Remove(const Key: TKey);
begin
FDictionaly.Remove( Key );
end;
procedure TThriftDictionaryImpl<TKey, TValue>.SetItem(const Key: TKey;
const Value: TValue);
begin
FDictionaly.AddOrSetValue( Key, Value);
end;
function TThriftDictionaryImpl<TKey, TValue>.ToArray: TArray<TPair<TKey, TValue>>;
{$IF CompilerVersion < 22.0}
var
x : TPair<TKey, TValue>;
i : Integer;
{$IFEND}
begin
{$IF CompilerVersion < 22.0}
SetLength(Result, Count);
i := 0;
for x in FDictionaly do
begin
Result[i] := x;
Inc( i );
end;
{$ELSE}
Result := FDictionaly.ToArray;
{$IFEND}
end;
procedure TThriftDictionaryImpl<TKey, TValue>.TrimExcess;
begin
FDictionaly.TrimExcess;
end;
function TThriftDictionaryImpl<TKey, TValue>.TryGetValue(const Key: TKey;
out Value: TValue): Boolean;
begin
Result := FDictionaly.TryGetValue( Key, Value);
end;
{ TThriftListImpl<T> }
function TThriftListImpl<T>.Add(const Value: T): Integer;
begin
Result := FList.Add( Value );
end;
procedure TThriftListImpl<T>.AddRange(Collection: TEnumerable<T>);
begin
FList.AddRange( Collection );
end;
procedure TThriftListImpl<T>.AddRange(const Collection: IEnumerable<T>);
begin
FList.AddRange( Collection );
end;
procedure TThriftListImpl<T>.AddRange(const Values: array of T);
begin
FList.AddRange( Values );
end;
function TThriftListImpl<T>.BinarySearch(const Item: T;
out Index: Integer): Boolean;
begin
Result := FList.BinarySearch( Item, Index);
end;
function TThriftListImpl<T>.BinarySearch(const Item: T; out Index: Integer;
const AComparer: IComparer<T>): Boolean;
begin
Result := FList.BinarySearch( Item, Index, AComparer);
end;
procedure TThriftListImpl<T>.Clear;
begin
FList.Clear;
end;
function TThriftListImpl<T>.Contains(const Value: T): Boolean;
begin
Result := FList.Contains( Value );
end;
constructor TThriftListImpl<T>.Create;
begin
inherited;
FList := TList<T>.Create;
end;
procedure TThriftListImpl<T>.Delete(Index: Integer);
begin
FList.Delete( Index )
end;
procedure TThriftListImpl<T>.DeleteRange(AIndex, ACount: Integer);
begin
FList.DeleteRange( AIndex, ACount)
end;
destructor TThriftListImpl<T>.Destroy;
begin
FList.Free;
inherited;
end;
{$IF CompilerVersion >= 21.0}
procedure TThriftListImpl<T>.Exchange(Index1, Index2: Integer);
begin
FList.Exchange( Index1, Index2 )
end;
{$IFEND}
function TThriftListImpl<T>.Extract(const Value: T): T;
begin
Result := FList.Extract( Value )
end;
{$IF CompilerVersion >= 21.0}
function TThriftListImpl<T>.First: T;
begin
Result := FList.First;
end;
{$IFEND}
function TThriftListImpl<T>.GetCapacity: Integer;
begin
Result := FList.Capacity;
end;
function TThriftListImpl<T>.GetCount: Integer;
begin
Result := FList.Count;
end;
function TThriftListImpl<T>.GetEnumerator: TEnumerator<T>;
begin
Result := FList.GetEnumerator;
end;
function TThriftListImpl<T>.GetItem(Index: Integer): T;
begin
Result := FList[Index];
end;
function TThriftListImpl<T>.IndexOf(const Value: T): Integer;
begin
Result := FList.IndexOf( Value );
end;
procedure TThriftListImpl<T>.Insert(Index: Integer; const Value: T);
begin
FList.Insert( Index, Value);
end;
procedure TThriftListImpl<T>.InsertRange(Index: Integer;
const Collection: TEnumerable<T>);
begin
FList.InsertRange( Index, Collection );
end;
procedure TThriftListImpl<T>.InsertRange(Index: Integer;
const Values: array of T);
begin
FList.InsertRange( Index, Values);
end;
procedure TThriftListImpl<T>.InsertRange(Index: Integer;
const Collection: IEnumerable<T>);
begin
FList.InsertRange( Index, Collection );
end;
{$IF CompilerVersion >= 21.0}
function TThriftListImpl<T>.Last: T;
begin
Result := FList.Last;
end;
{$IFEND}
function TThriftListImpl<T>.LastIndexOf(const Value: T): Integer;
begin
Result := FList.LastIndexOf( Value );
end;
{$IF CompilerVersion >= 21.0}
procedure TThriftListImpl<T>.Move(CurIndex, NewIndex: Integer);
begin
FList.Move( CurIndex, NewIndex);
end;
{$IFEND}
function TThriftListImpl<T>.Remove(const Value: T): Integer;
begin
Result := FList.Remove( Value );
end;
procedure TThriftListImpl<T>.Reverse;
begin
FList.Reverse;
end;
procedure TThriftListImpl<T>.SetCapacity(Value: Integer);
begin
FList.Capacity := Value;
end;
procedure TThriftListImpl<T>.SetCount(Value: Integer);
begin
FList.Count := Value;
end;
procedure TThriftListImpl<T>.SetItem(Index: Integer; const Value: T);
begin
FList[Index] := Value;
end;
procedure TThriftListImpl<T>.Sort;
begin
FList.Sort;
end;
procedure TThriftListImpl<T>.Sort(const AComparer: IComparer<T>);
begin
FList.Sort;
end;
function TThriftListImpl<T>.ToArray: TArray<T>;
{$IF CompilerVersion < 22.0}
var
x : T;
i : Integer;
{$IFEND}
begin
{$IF CompilerVersion < 22.0}
SetLength(Result, Count);
i := 0;
for x in FList do
begin
Result[i] := x;
Inc( i );
end;
{$ELSE}
Result := FList.ToArray;
{$IFEND}
end;
procedure TThriftListImpl<T>.TrimExcess;
begin
FList.TrimExcess;
end;
end.

133
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Console.pas generated vendored Normal file
View file

@ -0,0 +1,133 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Console;
interface
uses Classes;
type
TThriftConsole = class
public
procedure Write( const S: string); virtual;
procedure WriteLine( const S: string); virtual;
end;
TGUIConsole = class( TThriftConsole )
private
FLineBreak : Boolean;
FMemo : TStrings;
procedure InternalWrite( const S: string; bWriteLine: Boolean);
public
procedure Write( const S: string); override;
procedure WriteLine( const S: string); override;
constructor Create( AMemo: TStrings);
end;
function Console: TThriftConsole;
procedure ChangeConsole( AConsole: TThriftConsole );
procedure RestoreConsoleToDefault;
implementation
var
FDefaultConsole : TThriftConsole;
FConsole : TThriftConsole;
function Console: TThriftConsole;
begin
Result := FConsole;
end;
{ TThriftConsole }
procedure TThriftConsole.Write(const S: string);
begin
System.Write( S );
end;
procedure TThriftConsole.WriteLine(const S: string);
begin
System.Writeln( S );
end;
procedure ChangeConsole( AConsole: TThriftConsole );
begin
FConsole := AConsole;
end;
procedure RestoreConsoleToDefault;
begin
FConsole := FDefaultConsole;
end;
{ TGUIConsole }
constructor TGUIConsole.Create( AMemo: TStrings);
begin
inherited Create;
FMemo := AMemo;
FLineBreak := True;
end;
procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
var
idx : Integer;
begin
if FLineBreak then
begin
FMemo.Add( S );
end else
begin
idx := FMemo.Count - 1;
if idx < 0 then
begin
FMemo.Add( S );
end;
FMemo[idx] := FMemo[idx] + S;
end;
FLineBreak := bWriteLine;
end;
procedure TGUIConsole.Write(const S: string);
begin
InternalWrite( S, False);
end;
procedure TGUIConsole.WriteLine(const S: string);
begin
InternalWrite( S, True);
end;
initialization
begin
FDefaultConsole := TThriftConsole.Create;
FConsole := FDefaultConsole;
end;
finalization
begin
FDefaultConsole.Free;
end;
end.

50
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Defines.inc generated vendored Normal file
View file

@ -0,0 +1,50 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
// Good lists of Delphi version numbers
// https://github.com/project-jedi/jedi/blob/master/jedi.inc
// http://docwiki.embarcadero.com/RADStudio/Seattle/en/Compiler_Versions
// start with most backwards compatible defaults
{$DEFINE OLD_UNIT_NAMES}
{$DEFINE OLD_SOCKETS} // TODO: add socket support for CompilerVersion >= 28.0
{$UNDEF HAVE_CLASS_CTOR}
// enable features as they are available
{$IF CompilerVersion >= 21.0} // Delphi 2010
{$DEFINE HAVE_CLASS_CTOR}
{$IFEND}
{$IF CompilerVersion >= 23.0} // Delphi XE2
{$UNDEF OLD_UNIT_NAMES}
{$IFEND}
{$IF CompilerVersion >= 28.0} // Delphi XE7
{$UNDEF OLD_SOCKETS}
{$IFEND}
// EOF

216
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Processor.Multiplex.pas generated vendored Normal file
View file

@ -0,0 +1,216 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Processor.Multiplex;
interface
uses
SysUtils,
Generics.Collections,
Thrift,
Thrift.Protocol,
Thrift.Protocol.Multiplex;
{ TMultiplexedProcessor is a TProcessor allowing a single TServer to provide multiple services.
To do so, you instantiate the processor and then register additional processors with it,
as shown in the following example:
TMultiplexedProcessor processor = new TMultiplexedProcessor();
processor.registerProcessor(
"Calculator",
new Calculator.Processor(new CalculatorHandler()));
processor.registerProcessor(
"WeatherReport",
new WeatherReport.Processor(new WeatherReportHandler()));
TServerTransport t = new TServerSocket(9090);
TSimpleServer server = new TSimpleServer(processor, t);
server.serve();
}
type
IMultiplexedProcessor = interface( IProcessor)
['{810FF32D-22A2-4D58-B129-B0590703ECEC}']
// Register a service with this TMultiplexedProcessor. This allows us
// to broker requests to individual services by using the service name
// to select them at request time.
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
end;
TMultiplexedProcessorImpl = class( TInterfacedObject, IMultiplexedProcessor, IProcessor)
private type
// Our goal was to work with any protocol. In order to do that, we needed
// to allow them to call readMessageBegin() and get a TMessage in exactly
// the standard format, without the service name prepended to TMessage.name.
TStoredMessageProtocol = class( TProtocolDecorator)
private
FMessageBegin : IMessage;
public
constructor Create( const protocol : IProtocol; const aMsgBegin : IMessage);
function ReadMessageBegin: IMessage; override;
end;
private
FServiceProcessorMap : TDictionary<String, IProcessor>;
procedure Error( const oprot : IProtocol; const msg : IMessage;
extype : TApplicationExceptionSpecializedClass; const etxt : string);
public
constructor Create;
destructor Destroy; override;
// Register a service with this TMultiplexedProcessorImpl. This allows us
// to broker requests to individual services by using the service name
// to select them at request time.
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
{ This implementation of process performs the following steps:
- Read the beginning of the message.
- Extract the service name from the message.
- Using the service name to locate the appropriate processor.
- Dispatch to the processor, with a decorated instance of TProtocol
that allows readMessageBegin() to return the original TMessage.
An exception is thrown if the message type is not CALL or ONEWAY
or if the service is unknown (or not properly registered).
}
function Process( const iprot, oprot: IProtocol; const events : IProcessorEvents = nil): Boolean;
end;
implementation
constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : IMessage);
begin
inherited Create( protocol);
FMessageBegin := aMsgBegin;
end;
function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: IMessage;
begin
result := FMessageBegin;
end;
constructor TMultiplexedProcessorImpl.Create;
begin
inherited Create;
FServiceProcessorMap := TDictionary<string,IProcessor>.Create;
end;
destructor TMultiplexedProcessorImpl.Destroy;
begin
try
FreeAndNil( FServiceProcessorMap);
finally
inherited Destroy;
end;
end;
procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor);
begin
FServiceProcessorMap.Add( serviceName, processor);
end;
procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : IMessage;
extype : TApplicationExceptionSpecializedClass;
const etxt : string);
var appex : TApplicationException;
newMsg : IMessage;
begin
appex := extype.Create(etxt);
try
newMsg := TMessageImpl.Create( msg.Name, TMessageType.Exception, msg.SeqID);
oprot.WriteMessageBegin(newMsg);
appex.Write(oprot);
oprot.WriteMessageEnd();
oprot.Transport.Flush();
finally
appex.Free;
end;
end;
function TMultiplexedProcessorImpl.Process(const iprot, oprot : IProtocol; const events : IProcessorEvents = nil): Boolean;
var msg, newMsg : IMessage;
idx : Integer;
sService : string;
processor : IProcessor;
protocol : IProtocol;
const
ERROR_INVALID_MSGTYPE = 'Message must be "call" or "oneway"';
ERROR_INCOMPATIBLE_PROT = 'No service name found in "%s". Client is expected to use TMultiplexProtocol.';
ERROR_UNKNOWN_SERVICE = 'Service "%s" is not registered with MultiplexedProcessor';
begin
// Use the actual underlying protocol (e.g. TBinaryProtocol) to read the message header.
// This pulls the message "off the wire", which we'll deal with at the end of this method.
msg := iprot.readMessageBegin();
if not (msg.Type_ in [TMessageType.Call, TMessageType.Oneway]) then begin
Error( oprot, msg,
TApplicationExceptionInvalidMessageType,
ERROR_INVALID_MSGTYPE);
Exit( FALSE);
end;
// Extract the service name
idx := Pos( TMultiplexedProtocol.SEPARATOR, msg.Name);
if idx < 1 then begin
Error( oprot, msg,
TApplicationExceptionInvalidProtocol,
Format(ERROR_INCOMPATIBLE_PROT,[msg.Name]));
Exit( FALSE);
end;
// Create a new TMessage, something that can be consumed by any TProtocol
sService := Copy( msg.Name, 1, idx-1);
if not FServiceProcessorMap.TryGetValue( sService, processor)
then begin
Error( oprot, msg,
TApplicationExceptionInternalError,
Format(ERROR_UNKNOWN_SERVICE,[sService]));
Exit( FALSE);
end;
// Create a new TMessage, removing the service name
Inc( idx, Length(TMultiplexedProtocol.SEPARATOR));
newMsg := TMessageImpl.Create( Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
// Dispatch processing to the stored processor
protocol := TStoredMessageProtocol.Create( iprot, newMsg);
result := processor.process( protocol, oprot, events);
end;
end.

1105
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Compact.pas generated vendored Normal file
View file

File diff suppressed because it is too large Load diff

1239
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.JSON.pas generated vendored Normal file
View file

File diff suppressed because it is too large Load diff

107
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Multiplex.pas generated vendored Normal file
View file

@ -0,0 +1,107 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Protocol.Multiplex;
interface
uses Thrift.Protocol;
{ TMultiplexedProtocol is a protocol-independent concrete decorator
that allows a Thrift client to communicate with a multiplexing Thrift server,
by prepending the service name to the function name during function calls.
NOTE: THIS IS NOT USED BY SERVERS.
On the server, use TMultiplexedProcessor to handle requests from a multiplexing client.
This example uses a single socket transport to invoke two services:
TSocket transport = new TSocket("localhost", 9090);
transport.open();
TBinaryProtocol protocol = new TBinaryProtocol(transport);
TMultiplexedProtocol mp = new TMultiplexedProtocol(protocol, "Calculator");
Calculator.Client service = new Calculator.Client(mp);
TMultiplexedProtocol mp2 = new TMultiplexedProtocol(protocol, "WeatherReport");
WeatherReport.Client service2 = new WeatherReport.Client(mp2);
System.out.println(service.add(2,2));
System.out.println(service2.getTemperature());
}
type
TMultiplexedProtocol = class( TProtocolDecorator)
public const
{ Used to delimit the service name from the function name }
SEPARATOR = ':';
private
FServiceName : String;
public
{ Wrap the specified protocol, allowing it to be used to communicate with a multiplexing server.
The serviceName is required as it is prepended to the message header so that the multiplexing
server can broker the function call to the proper service.
Args:
protocol ....... Your communication protocol of choice, e.g. TBinaryProtocol.
serviceName .... The service name of the service communicating via this protocol.
}
constructor Create( const aProtocol : IProtocol; const aServiceName : string);
{ Prepends the service name to the function name, separated by SEPARATOR.
Args: The original message.
}
procedure WriteMessageBegin( const msg: IMessage); override;
end;
implementation
constructor TMultiplexedProtocol.Create(const aProtocol: IProtocol; const aServiceName: string);
begin
ASSERT( aServiceName <> '');
inherited Create(aProtocol);
FServiceName := aServiceName;
end;
procedure TMultiplexedProtocol.WriteMessageBegin( const msg: IMessage);
// Prepends the service name to the function name, separated by TMultiplexedProtocol.SEPARATOR.
var newMsg : IMessage;
begin
case msg.Type_ of
TMessageType.Call,
TMessageType.Oneway : begin
newMsg := TMessageImpl.Create( FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
inherited WriteMessageBegin( newMsg);
end;
else
inherited WriteMessageBegin( msg);
end;
end;
end.

1724
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.pas generated vendored Normal file
View file

File diff suppressed because it is too large Load diff

230
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Serializer.pas generated vendored Normal file
View file

@ -0,0 +1,230 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Serializer;
{$I Thrift.Defines.inc}
interface
uses
{$IFDEF OLD_UNIT_NAMES}
Classes, Windows, SysUtils,
{$ELSE}
System.Classes, Winapi.Windows, System.SysUtils,
{$ENDIF}
Thrift.Protocol,
Thrift.Transport,
Thrift.Stream;
type
// Generic utility for easily serializing objects into a byte array or Stream.
TSerializer = class
private
FStream : TMemoryStream;
FTransport : ITransport;
FProtocol : IProtocol;
public
// Create a new TSerializer that uses the TBinaryProtocol by default.
constructor Create; overload;
// Create a new TSerializer.
// It will use the TProtocol specified by the factory that is passed in.
constructor Create( const factory : IProtocolFactory); overload;
// DTOR
destructor Destroy; override;
// Serialize the Thrift object.
function Serialize( const input : IBase) : TBytes; overload;
procedure Serialize( const input : IBase; const aStm : TStream); overload;
end;
// Generic utility for easily deserializing objects from byte array or Stream.
TDeserializer = class
private
FStream : TMemoryStream;
FTransport : ITransport;
FProtocol : IProtocol;
public
// Create a new TDeserializer that uses the TBinaryProtocol by default.
constructor Create; overload;
// Create a new TDeserializer.
// It will use the TProtocol specified by the factory that is passed in.
constructor Create( const factory : IProtocolFactory); overload;
// DTOR
destructor Destroy; override;
// Deserialize the Thrift object data.
procedure Deserialize( const input : TBytes; const target : IBase); overload;
procedure Deserialize( const input : TStream; const target : IBase); overload;
end;
implementation
{ TSerializer }
constructor TSerializer.Create();
// Create a new TSerializer that uses the TBinaryProtocol by default.
begin
//no inherited;
Create( TBinaryProtocolImpl.TFactory.Create);
end;
constructor TSerializer.Create( const factory : IProtocolFactory);
// Create a new TSerializer.
// It will use the TProtocol specified by the factory that is passed in.
var adapter : IThriftStream;
begin
inherited Create;
FStream := TMemoryStream.Create;
adapter := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
FTransport := TStreamTransportImpl.Create( nil, adapter);
FProtocol := factory.GetProtocol( FTransport);
end;
destructor TSerializer.Destroy;
begin
try
FProtocol := nil;
FTransport := nil;
FreeAndNil( FStream);
finally
inherited Destroy;
end;
end;
function TSerializer.Serialize( const input : IBase) : TBytes;
// Serialize the Thrift object into a byte array. The process is simple,
// just clear the byte array output, write the object into it, and grab the
// raw bytes.
var iBytes : Int64;
begin
try
FStream.Size := 0;
input.Write( FProtocol);
SetLength( result, FStream.Size);
iBytes := Length(result);
if iBytes > 0
then Move( FStream.Memory^, result[0], iBytes);
finally
FStream.Size := 0; // free any allocated memory
end;
end;
procedure TSerializer.Serialize( const input : IBase; const aStm : TStream);
// Serialize the Thrift object into a byte array. The process is simple,
// just clear the byte array output, write the object into it, and grab the
// raw bytes.
const COPY_ENTIRE_STREAM = 0;
begin
try
FStream.Size := 0;
input.Write( FProtocol);
aStm.CopyFrom( FStream, COPY_ENTIRE_STREAM);
finally
FStream.Size := 0; // free any allocated memory
end;
end;
{ TDeserializer }
constructor TDeserializer.Create();
// Create a new TDeserializer that uses the TBinaryProtocol by default.
begin
//no inherited;
Create( TBinaryProtocolImpl.TFactory.Create);
end;
constructor TDeserializer.Create( const factory : IProtocolFactory);
// Create a new TDeserializer.
// It will use the TProtocol specified by the factory that is passed in.
var adapter : IThriftStream;
begin
inherited Create;
FStream := TMemoryStream.Create;
adapter := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
FTransport := TStreamTransportImpl.Create( adapter, nil);
FProtocol := factory.GetProtocol( FTransport);
end;
destructor TDeserializer.Destroy;
begin
try
FProtocol := nil;
FTransport := nil;
FreeAndNil( FStream);
finally
inherited Destroy;
end;
end;
procedure TDeserializer.Deserialize( const input : TBytes; const target : IBase);
// Deserialize the Thrift object data from the byte array.
var iBytes : Int64;
begin
try
iBytes := Length(input);
FStream.Size := iBytes;
if iBytes > 0
then Move( input[0], FStream.Memory^, iBytes);
target.Read( FProtocol);
finally
FStream.Size := 0; // free any allocated memory
end;
end;
procedure TDeserializer.Deserialize( const input : TStream; const target : IBase);
// Deserialize the Thrift object data from the byte array.
const COPY_ENTIRE_STREAM = 0;
var before : Int64;
begin
try
before := FStream.Position;
FStream.CopyFrom( input, COPY_ENTIRE_STREAM);
FStream.Position := before;
target.Read( FProtocol);
finally
FStream.Size := 0; // free any allocated memory
end;
end;
end.

423
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Server.pas generated vendored Normal file
View file

@ -0,0 +1,423 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Server;
{$I Thrift.Defines.inc}
{$I-} // prevent annoying errors with default log delegate and no console
interface
uses
{$IFDEF OLD_UNIT_NAMES}
Windows, SysUtils,
{$ELSE}
Winapi.Windows, System.SysUtils,
{$ENDIF}
Thrift,
Thrift.Protocol,
Thrift.Transport;
type
IServerEvents = interface
['{9E2A99C5-EE85-40B2-9A52-2D1722B18176}']
// Called before the server begins.
procedure PreServe;
// Called when the server transport is ready to accept requests
procedure PreAccept;
// Called when a new client has connected and the server is about to being processing.
function CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
end;
IServer = interface
['{ADC46F2D-8199-4D1C-96D2-87FD54351723}']
procedure Serve;
procedure Stop;
function GetServerEvents : IServerEvents;
procedure SetServerEvents( const value : IServerEvents);
property ServerEvents : IServerEvents read GetServerEvents write SetServerEvents;
end;
TServerImpl = class abstract( TInterfacedObject, IServer )
public
type
TLogDelegate = reference to procedure( const str: string);
protected
FProcessor : IProcessor;
FServerTransport : IServerTransport;
FInputTransportFactory : ITransportFactory;
FOutputTransportFactory : ITransportFactory;
FInputProtocolFactory : IProtocolFactory;
FOutputProtocolFactory : IProtocolFactory;
FLogDelegate : TLogDelegate;
FServerEvents : IServerEvents;
class procedure DefaultLogDelegate( const str: string);
function GetServerEvents : IServerEvents;
procedure SetServerEvents( const value : IServerEvents);
procedure Serve; virtual; abstract;
procedure Stop; virtual; abstract;
public
constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport;
const AInputTransportFactory : ITransportFactory;
const AOutputTransportFactory : ITransportFactory;
const AInputProtocolFactory : IProtocolFactory;
const AOutputProtocolFactory : IProtocolFactory;
const ALogDelegate : TLogDelegate
); overload;
constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport
); overload;
constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport;
const ALogDelegate: TLogDelegate
); overload;
constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport;
const ATransportFactory : ITransportFactory
); overload;
constructor Create(
const AProcessor :IProcessor;
const AServerTransport: IServerTransport;
const ATransportFactory : ITransportFactory;
const AProtocolFactory : IProtocolFactory
); overload;
end;
TSimpleServer = class( TServerImpl)
private
FStop : Boolean;
public
constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport); overload;
constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
ALogDel: TServerImpl.TLogDelegate); overload;
constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
const ATransportFactory: ITransportFactory); overload;
constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
const ATransportFactory: ITransportFactory; const AProtocolFactory: IProtocolFactory); overload;
procedure Serve; override;
procedure Stop; override;
end;
implementation
{ TServerImpl }
constructor TServerImpl.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport; const ALogDelegate: TLogDelegate);
var
InputFactory, OutputFactory : IProtocolFactory;
InputTransFactory, OutputTransFactory : ITransportFactory;
begin
InputFactory := TBinaryProtocolImpl.TFactory.Create;
OutputFactory := TBinaryProtocolImpl.TFactory.Create;
InputTransFactory := TTransportFactoryImpl.Create;
OutputTransFactory := TTransportFactoryImpl.Create;
//no inherited;
Create(
AProcessor,
AServerTransport,
InputTransFactory,
OutputTransFactory,
InputFactory,
OutputFactory,
ALogDelegate
);
end;
constructor TServerImpl.Create(const AProcessor: IProcessor;
const AServerTransport: IServerTransport);
var
InputFactory, OutputFactory : IProtocolFactory;
InputTransFactory, OutputTransFactory : ITransportFactory;
begin
InputFactory := TBinaryProtocolImpl.TFactory.Create;
OutputFactory := TBinaryProtocolImpl.TFactory.Create;
InputTransFactory := TTransportFactoryImpl.Create;
OutputTransFactory := TTransportFactoryImpl.Create;
//no inherited;
Create(
AProcessor,
AServerTransport,
InputTransFactory,
OutputTransFactory,
InputFactory,
OutputFactory,
DefaultLogDelegate
);
end;
constructor TServerImpl.Create(const AProcessor: IProcessor;
const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory);
var
InputProtocolFactory : IProtocolFactory;
OutputProtocolFactory : IProtocolFactory;
begin
InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
//no inherited;
Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory,
InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
end;
constructor TServerImpl.Create(const AProcessor: IProcessor;
const AServerTransport: IServerTransport;
const AInputTransportFactory, AOutputTransportFactory: ITransportFactory;
const AInputProtocolFactory, AOutputProtocolFactory: IProtocolFactory;
const ALogDelegate : TLogDelegate);
begin
inherited Create;
FProcessor := AProcessor;
FServerTransport := AServerTransport;
FInputTransportFactory := AInputTransportFactory;
FOutputTransportFactory := AOutputTransportFactory;
FInputProtocolFactory := AInputProtocolFactory;
FOutputProtocolFactory := AOutputProtocolFactory;
FLogDelegate := ALogDelegate;
end;
class procedure TServerImpl.DefaultLogDelegate( const str: string);
begin
try
Writeln( str);
if IoResult <> 0 then OutputDebugString(PChar(str));
except
OutputDebugString(PChar(str));
end;
end;
constructor TServerImpl.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory;
const AProtocolFactory: IProtocolFactory);
begin
//no inherited;
Create( AProcessor, AServerTransport,
ATransportFactory, ATransportFactory,
AProtocolFactory, AProtocolFactory,
DefaultLogDelegate);
end;
function TServerImpl.GetServerEvents : IServerEvents;
begin
result := FServerEvents;
end;
procedure TServerImpl.SetServerEvents( const value : IServerEvents);
begin
// if you need more than one, provide a specialized IServerEvents implementation
FServerEvents := value;
end;
{ TSimpleServer }
constructor TSimpleServer.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport);
var
InputProtocolFactory : IProtocolFactory;
OutputProtocolFactory : IProtocolFactory;
InputTransportFactory : ITransportFactory;
OutputTransportFactory : ITransportFactory;
begin
InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
InputTransportFactory := TTransportFactoryImpl.Create;
OutputTransportFactory := TTransportFactoryImpl.Create;
inherited Create( AProcessor, AServerTransport, InputTransportFactory,
OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
end;
constructor TSimpleServer.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate);
var
InputProtocolFactory : IProtocolFactory;
OutputProtocolFactory : IProtocolFactory;
InputTransportFactory : ITransportFactory;
OutputTransportFactory : ITransportFactory;
begin
InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
InputTransportFactory := TTransportFactoryImpl.Create;
OutputTransportFactory := TTransportFactoryImpl.Create;
inherited Create( AProcessor, AServerTransport, InputTransportFactory,
OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel);
end;
constructor TSimpleServer.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory);
begin
inherited Create( AProcessor, AServerTransport, ATransportFactory,
ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate);
end;
constructor TSimpleServer.Create( const AProcessor: IProcessor;
const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory;
const AProtocolFactory: IProtocolFactory);
begin
inherited Create( AProcessor, AServerTransport, ATransportFactory,
ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate);
end;
procedure TSimpleServer.Serve;
var
client : ITransport;
InputTransport : ITransport;
OutputTransport : ITransport;
InputProtocol : IProtocol;
OutputProtocol : IProtocol;
context : IProcessorEvents;
begin
try
FServerTransport.Listen;
except
on E: Exception do
begin
FLogDelegate( E.ToString);
end;
end;
if FServerEvents <> nil
then FServerEvents.PreServe;
client := nil;
while (not FStop) do
begin
try
// clean up any old instances before waiting for clients
InputTransport := nil;
OutputTransport := nil;
InputProtocol := nil;
OutputProtocol := nil;
// close any old connections before before waiting for new clients
if client <> nil then try
try
client.Close;
finally
client := nil;
end;
except
// catch all, we can't do much about it at this point
end;
client := FServerTransport.Accept( procedure
begin
if FServerEvents <> nil
then FServerEvents.PreAccept;
end);
if client = nil then begin
if FStop
then Abort // silent exception
else raise TTransportExceptionUnknown.Create('ServerTransport.Accept() may not return NULL');
end;
FLogDelegate( 'Client Connected!');
InputTransport := FInputTransportFactory.GetTransport( client );
OutputTransport := FOutputTransportFactory.GetTransport( client );
InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport );
OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport );
if FServerEvents <> nil
then context := FServerEvents.CreateProcessingContext( InputProtocol, OutputProtocol)
else context := nil;
while not FStop do begin
if context <> nil
then context.Processing( client);
if not FProcessor.Process( InputProtocol, OutputProtocol, context)
then Break;
end;
except
on E: TTransportException do
begin
if FStop
then FLogDelegate('TSimpleServer was shutting down, caught ' + E.ToString)
else FLogDelegate( E.ToString);
end;
on E: Exception do
begin
FLogDelegate( E.ToString);
end;
end;
if context <> nil
then begin
context.CleanupContext;
context := nil;
end;
if InputTransport <> nil then
begin
InputTransport.Close;
end;
if OutputTransport <> nil then
begin
OutputTransport.Close;
end;
end;
if FStop then
begin
try
FServerTransport.Close;
except
on E: TTransportException do
begin
FLogDelegate('TServerTranport failed on close: ' + E.Message);
end;
end;
FStop := False;
end;
end;
procedure TSimpleServer.Stop;
begin
FStop := True;
FServerTransport.Close;
end;
end.

1617
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Socket.pas generated vendored Normal file
View file

File diff suppressed because it is too large Load diff

288
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Stream.pas generated vendored Normal file
View file

@ -0,0 +1,288 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Stream;
{$I Thrift.Defines.inc}
interface
uses
Classes,
SysUtils,
SysConst,
RTLConsts,
{$IFDEF OLD_UNIT_NAMES}
ActiveX,
{$ELSE}
Winapi.ActiveX,
{$ENDIF}
Thrift.Utils;
type
IThriftStream = interface
['{732621B3-F697-4D76-A1B0-B4DD5A8E4018}']
procedure Write( const buffer: TBytes; offset: Integer; count: Integer);
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
procedure Open;
procedure Close;
procedure Flush;
function IsOpen: Boolean;
function ToArray: TBytes;
end;
TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
private
procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;
procedure Open; virtual; abstract;
procedure Close; virtual; abstract;
procedure Flush; virtual; abstract;
function IsOpen: Boolean; virtual; abstract;
function ToArray: TBytes; virtual; abstract;
end;
TThriftStreamAdapterDelphi = class( TThriftStreamImpl )
private
FStream : TStream;
FOwnsStream : Boolean;
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
public
constructor Create( const AStream: TStream; AOwnsStream : Boolean);
destructor Destroy; override;
end;
TThriftStreamAdapterCOM = class( TThriftStreamImpl)
private
FStream : IStream;
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
public
constructor Create( const AStream: IStream);
end;
implementation
{ TThriftStreamAdapterCOM }
procedure TThriftStreamAdapterCOM.Close;
begin
FStream := nil;
end;
constructor TThriftStreamAdapterCOM.Create( const AStream: IStream);
begin
inherited Create;
FStream := AStream;
end;
procedure TThriftStreamAdapterCOM.Flush;
begin
if IsOpen then begin
if FStream <> nil then begin
FStream.Commit( STGC_DEFAULT );
end;
end;
end;
function TThriftStreamAdapterCOM.IsOpen: Boolean;
begin
Result := FStream <> nil;
end;
procedure TThriftStreamAdapterCOM.Open;
begin
// nothing to do
end;
function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
begin
inherited;
Result := 0;
if FStream <> nil then begin
if count > 0 then begin
FStream.Read( @buffer[offset], count, @Result);
end;
end;
end;
function TThriftStreamAdapterCOM.ToArray: TBytes;
var
statstg: TStatStg;
len : Integer;
NewPos : {$IF CompilerVersion >= 29.0} UInt64 {$ELSE} Int64 {$IFEND};
cbRead : Integer;
begin
FillChar( statstg, SizeOf( statstg), 0);
len := 0;
if IsOpen then begin
if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then begin
len := statstg.cbSize;
end;
end;
SetLength( Result, len );
if len > 0 then begin
if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then begin
FStream.Read( @Result[0], len, @cbRead);
end;
end;
end;
procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
var nWritten : Integer;
begin
inherited;
if IsOpen then begin
if count > 0 then begin
FStream.Write( @buffer[0], count, @nWritten);
end;
end;
end;
{ TThriftStreamImpl }
procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
count: Integer);
var
len : Integer;
begin
if count > 0 then begin
len := Length( buffer );
if (offset < 0) or ( offset >= len) then begin
raise ERangeError.Create( SBitsIndexError );
end;
if count > len then begin
raise ERangeError.Create( SBitsIndexError );
end;
end;
end;
function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
begin
Result := 0;
CheckSizeAndOffset( buffer, offset, count );
end;
procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
begin
CheckSizeAndOffset( buffer, offset, count );
end;
{ TThriftStreamAdapterDelphi }
procedure TThriftStreamAdapterDelphi.Close;
begin
FStream.Free;
FStream := nil;
FOwnsStream := False;
end;
constructor TThriftStreamAdapterDelphi.Create( const AStream: TStream; AOwnsStream: Boolean);
begin
inherited Create;
FStream := AStream;
FOwnsStream := AOwnsStream;
end;
destructor TThriftStreamAdapterDelphi.Destroy;
begin
if FOwnsStream
then Close;
inherited;
end;
procedure TThriftStreamAdapterDelphi.Flush;
begin
// nothing to do
end;
function TThriftStreamAdapterDelphi.IsOpen: Boolean;
begin
Result := FStream <> nil;
end;
procedure TThriftStreamAdapterDelphi.Open;
begin
// nothing to do
end;
function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
count: Integer): Integer;
begin
inherited;
Result := 0;
if count > 0 then begin
Result := FStream.Read( Pointer(@buffer[offset])^, count)
end;
end;
function TThriftStreamAdapterDelphi.ToArray: TBytes;
var
OrgPos : Integer;
len : Integer;
begin
len := 0;
if FStream <> nil then
begin
len := FStream.Size;
end;
SetLength( Result, len );
if len > 0 then
begin
OrgPos := FStream.Position;
try
FStream.Position := 0;
FStream.ReadBuffer( Pointer(@Result[0])^, len );
finally
FStream.Position := OrgPos;
end;
end
end;
procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
count: Integer);
begin
inherited;
if count > 0 then begin
FStream.Write( Pointer(@buffer[offset])^, count)
end;
end;
end.

997
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.Pipes.pas generated vendored Normal file
View file

@ -0,0 +1,997 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Transport.Pipes;
{$WARN SYMBOL_PLATFORM OFF}
{$I Thrift.Defines.inc}
interface
uses
{$IFDEF OLD_UNIT_NAMES}
Windows, SysUtils, Math, AccCtrl, AclAPI, SyncObjs,
{$ELSE}
Winapi.Windows, System.SysUtils, System.Math, Winapi.AccCtrl, Winapi.AclAPI, System.SyncObjs,
{$ENDIF}
Thrift.Transport,
Thrift.Utils,
Thrift.Stream;
const
DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT = 10; // default: fail fast on open
type
//--- Pipe Streams ---
TPipeStreamBase = class( TThriftStreamImpl)
strict protected
FPipe : THandle;
FTimeout : DWORD;
FOpenTimeOut : DWORD; // separate value to allow for fail-fast-on-open scenarios
FOverlapped : Boolean;
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
//procedure Open; override; - see derived classes
procedure Close; override;
procedure Flush; override;
function ReadDirect( var buffer: TBytes; offset: Integer; count: Integer): Integer;
function ReadOverlapped( var buffer: TBytes; offset: Integer; count: Integer): Integer;
procedure WriteDirect( const buffer: TBytes; offset: Integer; count: Integer);
procedure WriteOverlapped( const buffer: TBytes; offset: Integer; count: Integer);
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
public
constructor Create( aEnableOverlapped : Boolean;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT);
destructor Destroy; override;
end;
TNamedPipeStreamImpl = class sealed( TPipeStreamBase)
strict private
FPipeName : string;
FShareMode : DWORD;
FSecurityAttribs : PSecurityAttributes;
strict protected
procedure Open; override;
public
constructor Create( const aPipeName : string;
const aEnableOverlapped : Boolean;
const aShareMode: DWORD = 0;
const aSecurityAttributes: PSecurityAttributes = nil;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT); overload;
end;
THandlePipeStreamImpl = class sealed( TPipeStreamBase)
strict private
FSrcHandle : THandle;
strict protected
procedure Open; override;
public
constructor Create( const aPipeHandle : THandle;
const aOwnsHandle, aEnableOverlapped : Boolean;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT); overload;
destructor Destroy; override;
end;
//--- Pipe Transports ---
IPipeTransport = interface( IStreamTransport)
['{5E05CC85-434F-428F-BFB2-856A168B5558}']
end;
TPipeTransportBase = class( TStreamTransportImpl, IPipeTransport)
public
// ITransport
function GetIsOpen: Boolean; override;
procedure Open; override;
procedure Close; override;
end;
TNamedPipeTransportClientEndImpl = class( TPipeTransportBase)
public
// Named pipe constructors
constructor Create( aPipe : THandle; aOwnsHandle : Boolean;
const aTimeOut : DWORD); overload;
constructor Create( const aPipeName : string;
const aShareMode: DWORD = 0;
const aSecurityAttributes: PSecurityAttributes = nil;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT); overload;
end;
TNamedPipeTransportServerEndImpl = class( TNamedPipeTransportClientEndImpl)
strict private
FHandle : THandle;
public
// ITransport
procedure Close; override;
constructor Create( aPipe : THandle; aOwnsHandle : Boolean;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT); reintroduce;
end;
TAnonymousPipeTransportImpl = class( TPipeTransportBase)
public
// Anonymous pipe constructor
constructor Create(const aPipeRead, aPipeWrite : THandle;
aOwnsHandles : Boolean;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT); overload;
end;
//--- Server Transports ---
IAnonymousPipeServerTransport = interface( IServerTransport)
['{7AEE6793-47B9-4E49-981A-C39E9108E9AD}']
// Server side anonymous pipe ends
function ReadHandle : THandle;
function WriteHandle : THandle;
// Client side anonymous pipe ends
function ClientAnonRead : THandle;
function ClientAnonWrite : THandle;
end;
INamedPipeServerTransport = interface( IServerTransport)
['{9DF9EE48-D065-40AF-8F67-D33037D3D960}']
function Handle : THandle;
end;
TPipeServerTransportBase = class( TServerTransportImpl)
strict protected
FStopServer : TEvent;
procedure InternalClose; virtual; abstract;
function QueryStopServer : Boolean;
public
constructor Create;
destructor Destroy; override;
procedure Listen; override;
procedure Close; override;
end;
TAnonymousPipeServerTransportImpl = class( TPipeServerTransportBase, IAnonymousPipeServerTransport)
strict private
FBufSize : DWORD;
// Server side anonymous pipe handles
FReadHandle,
FWriteHandle : THandle;
//Client side anonymous pipe handles
FClientAnonRead,
FClientAnonWrite : THandle;
FTimeOut: DWORD;
protected
function Accept(const fnAccepting: TProc): ITransport; override;
function CreateAnonPipe : Boolean;
// IAnonymousPipeServerTransport
function ReadHandle : THandle;
function WriteHandle : THandle;
function ClientAnonRead : THandle;
function ClientAnonWrite : THandle;
procedure InternalClose; override;
public
constructor Create(aBufsize : Cardinal = 4096; aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT);
end;
TNamedPipeServerTransportImpl = class( TPipeServerTransportBase, INamedPipeServerTransport)
strict private
FPipeName : string;
FMaxConns : DWORD;
FBufSize : DWORD;
FTimeout : DWORD;
FHandle : THandle;
FConnected : Boolean;
strict protected
function Accept(const fnAccepting: TProc): ITransport; override;
function CreateNamedPipe : THandle;
function CreateTransportInstance : ITransport;
// INamedPipeServerTransport
function Handle : THandle;
procedure InternalClose; override;
public
constructor Create( aPipename : string; aBufsize : Cardinal = 4096;
aMaxConns : Cardinal = PIPE_UNLIMITED_INSTANCES;
aTimeOut : Cardinal = INFINITE);
end;
implementation
procedure ClosePipeHandle( var hPipe : THandle);
begin
if hPipe <> INVALID_HANDLE_VALUE
then try
CloseHandle( hPipe);
finally
hPipe := INVALID_HANDLE_VALUE;
end;
end;
function DuplicatePipeHandle( const hSource : THandle) : THandle;
begin
if not DuplicateHandle( GetCurrentProcess, hSource,
GetCurrentProcess, @result,
0, FALSE, DUPLICATE_SAME_ACCESS)
then raise TTransportExceptionNotOpen.Create('DuplicateHandle: '+SysErrorMessage(GetLastError));
end;
{ TPipeStreamBase }
constructor TPipeStreamBase.Create( aEnableOverlapped : Boolean;
const aTimeOut, aOpenTimeOut : DWORD);
begin
inherited Create;
ASSERT( aTimeout > 0); // aOpenTimeout may be 0
FPipe := INVALID_HANDLE_VALUE;
FTimeout := aTimeOut;
FOpenTimeOut := aOpenTimeOut;
FOverlapped := aEnableOverlapped;
end;
destructor TPipeStreamBase.Destroy;
begin
try
Close;
finally
inherited Destroy;
end;
end;
procedure TPipeStreamBase.Close;
begin
ClosePipeHandle( FPipe);
end;
procedure TPipeStreamBase.Flush;
begin
FlushFileBuffers( FPipe);
end;
function TPipeStreamBase.IsOpen: Boolean;
begin
result := (FPipe <> INVALID_HANDLE_VALUE);
end;
procedure TPipeStreamBase.Write(const buffer: TBytes; offset, count: Integer);
begin
if FOverlapped
then WriteOverlapped( buffer, offset, count)
else WriteDirect( buffer, offset, count);
end;
function TPipeStreamBase.Read( var buffer: TBytes; offset, count: Integer): Integer;
begin
if FOverlapped
then result := ReadOverlapped( buffer, offset, count)
else result := ReadDirect( buffer, offset, count);
end;
procedure TPipeStreamBase.WriteDirect(const buffer: TBytes; offset, count: Integer);
var cbWritten : DWORD;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
end;
function TPipeStreamBase.ReadDirect( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwErr : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
const INTERVAL = 10; // ms
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
// MSDN: Handle can be a handle to a named pipe instance,
// or it can be a handle to the read end of an anonymous pipe,
// The handle must have GENERIC_READ access to the pipe.
if FTimeOut <> INFINITE then begin
retries := Max( 1, Round( 1.0 * FTimeOut / INTERVAL));
while TRUE do begin
if not PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil) then begin
dwErr := GetLastError;
if (dwErr = ERROR_INVALID_HANDLE)
or (dwErr = ERROR_BROKEN_PIPE)
or (dwErr = ERROR_PIPE_NOT_CONNECTED)
then begin
result := 0; // other side closed the pipe
Exit;
end;
end
else if bytes > 0 then begin
Break; // there are data
end;
Dec( retries);
if retries > 0
then Sleep( INTERVAL)
else raise TTransportExceptionTimedOut.Create('Pipe read timed out');
end;
end;
// read the data (or block INFINITE-ly)
bOk := ReadFile( FPipe, buffer[offset], count, cbRead, nil);
if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
then result := 0 // No more data, possibly because client disconnected.
else result := cbRead;
end;
procedure TPipeStreamBase.WriteOverlapped(const buffer: TBytes; offset, count: Integer);
var cbWritten, dwWait, dwError : DWORD;
overlapped : IOverlappedHelper;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
overlapped := TOverlappedHelperImpl.Create;
if not WriteFile( FPipe, buffer[offset], count, cbWritten, overlapped.OverlappedPtr)
then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
if (dwWait = WAIT_TIMEOUT)
then raise TTransportExceptionTimedOut.Create('Pipe write timed out');
if (dwWait <> WAIT_OBJECT_0)
or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbWritten, TRUE)
then raise TTransportExceptionUnknown.Create('Pipe write error');
end;
else
raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
end;
end;
ASSERT( DWORD(count) = cbWritten);
end;
function TPipeStreamBase.ReadOverlapped( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwWait, dwError : DWORD;
bOk : Boolean;
overlapped : IOverlappedHelper;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
overlapped := TOverlappedHelperImpl.Create;
// read the data
bOk := ReadFile( FPipe, buffer[offset], count, cbRead, overlapped.OverlappedPtr);
if not bOk then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
if (dwWait = WAIT_TIMEOUT)
then raise TTransportExceptionTimedOut.Create('Pipe read timed out');
if (dwWait <> WAIT_OBJECT_0)
or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbRead, TRUE)
then raise TTransportExceptionUnknown.Create('Pipe read error');
end;
else
raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
end;
end;
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead = DWORD(count));
result := cbRead;
end;
function TPipeStreamBase.ToArray: TBytes;
var bytes : LongInt;
begin
SetLength( result, 0);
bytes := 0;
if IsOpen
and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
and (bytes > 0)
then begin
SetLength( result, bytes);
Read( result, 0, bytes);
end;
end;
{ TNamedPipeStreamImpl }
constructor TNamedPipeStreamImpl.Create( const aPipeName : string;
const aEnableOverlapped : Boolean;
const aShareMode: DWORD;
const aSecurityAttributes: PSecurityAttributes;
const aTimeOut, aOpenTimeOut : DWORD);
begin
inherited Create( aEnableOverlapped, aTimeout, aOpenTimeOut);
FPipeName := aPipeName;
FShareMode := aShareMode;
FSecurityAttribs := aSecurityAttributes;
if Copy(FPipeName,1,2) <> '\\'
then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
end;
procedure TNamedPipeStreamImpl.Open;
var hPipe : THandle;
retries, timeout, dwErr : DWORD;
const INTERVAL = 10; // ms
begin
if IsOpen then Exit;
retries := Max( 1, Round( 1.0 * FOpenTimeOut / INTERVAL));
timeout := FOpenTimeOut;
// if the server hasn't gotten to the point where the pipe has been created, at least wait the timeout
// According to MSDN, if no instances of the specified named pipe exist, the WaitNamedPipe function
// returns IMMEDIATELY, regardless of the time-out value.
// Always use INTERVAL, since WaitNamedPipe(0) defaults to some other value
while not WaitNamedPipe( PChar(FPipeName), INTERVAL) do begin
dwErr := GetLastError;
if dwErr <> ERROR_FILE_NOT_FOUND
then raise TTransportExceptionNotOpen.Create('Unable to open pipe, '+SysErrorMessage(dwErr));
if timeout <> INFINITE then begin
if (retries > 0)
then Dec(retries)
else raise TTransportExceptionNotOpen.Create('Unable to open pipe, timed out');
end;
Sleep(INTERVAL)
end;
// open that thingy
hPipe := CreateFile( PChar( FPipeName),
GENERIC_READ or GENERIC_WRITE,
FShareMode, // sharing
FSecurityAttribs, // security attributes
OPEN_EXISTING, // opens existing pipe
FILE_FLAG_OVERLAPPED or FILE_FLAG_WRITE_THROUGH, // async+fast, please
0); // no template file
if hPipe = INVALID_HANDLE_VALUE
then raise TTransportExceptionNotOpen.Create('Unable to open pipe, '+SysErrorMessage(GetLastError));
// everything fine
FPipe := hPipe;
end;
{ THandlePipeStreamImpl }
constructor THandlePipeStreamImpl.Create( const aPipeHandle : THandle;
const aOwnsHandle, aEnableOverlapped : Boolean;
const aTimeOut : DWORD);
begin
inherited Create( aEnableOverlapped, aTimeOut);
if aOwnsHandle
then FSrcHandle := aPipeHandle
else FSrcHandle := DuplicatePipeHandle( aPipeHandle);
Open;
end;
destructor THandlePipeStreamImpl.Destroy;
begin
try
ClosePipeHandle( FSrcHandle);
finally
inherited Destroy;
end;
end;
procedure THandlePipeStreamImpl.Open;
begin
if not IsOpen
then FPipe := DuplicatePipeHandle( FSrcHandle);
end;
{ TPipeTransportBase }
function TPipeTransportBase.GetIsOpen: Boolean;
begin
result := (FInputStream <> nil) and (FInputStream.IsOpen)
and (FOutputStream <> nil) and (FOutputStream.IsOpen);
end;
procedure TPipeTransportBase.Open;
begin
FInputStream.Open;
FOutputStream.Open;
end;
procedure TPipeTransportBase.Close;
begin
FInputStream.Close;
FOutputStream.Close;
end;
{ TNamedPipeTransportClientEndImpl }
constructor TNamedPipeTransportClientEndImpl.Create( const aPipeName : string; const aShareMode: DWORD;
const aSecurityAttributes: PSecurityAttributes;
const aTimeOut, aOpenTimeOut : DWORD);
// Named pipe constructor
begin
inherited Create( nil, nil);
FInputStream := TNamedPipeStreamImpl.Create( aPipeName, TRUE, aShareMode, aSecurityAttributes, aTimeOut, aOpenTimeOut);
FOutputStream := FInputStream; // true for named pipes
end;
constructor TNamedPipeTransportClientEndImpl.Create( aPipe : THandle; aOwnsHandle : Boolean;
const aTimeOut : DWORD);
// Named pipe constructor
begin
inherited Create( nil, nil);
FInputStream := THandlePipeStreamImpl.Create( aPipe, TRUE, aOwnsHandle, aTimeOut);
FOutputStream := FInputStream; // true for named pipes
end;
{ TNamedPipeTransportServerEndImpl }
constructor TNamedPipeTransportServerEndImpl.Create( aPipe : THandle; aOwnsHandle : Boolean;
const aTimeOut : DWORD);
// Named pipe constructor
begin
FHandle := DuplicatePipeHandle( aPipe);
inherited Create( aPipe, aOwnsHandle, aTimeOut);
end;
procedure TNamedPipeTransportServerEndImpl.Close;
begin
FlushFileBuffers( FHandle);
DisconnectNamedPipe( FHandle); // force client off the pipe
ClosePipeHandle( FHandle);
inherited Close;
end;
{ TAnonymousPipeTransportImpl }
constructor TAnonymousPipeTransportImpl.Create( const aPipeRead, aPipeWrite : THandle;
aOwnsHandles : Boolean;
const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT);
// Anonymous pipe constructor
begin
inherited Create( nil, nil);
// overlapped is not supported with AnonPipes, see MSDN
FInputStream := THandlePipeStreamImpl.Create( aPipeRead, aOwnsHandles, FALSE, aTimeOut);
FOutputStream := THandlePipeStreamImpl.Create( aPipeWrite, aOwnsHandles, FALSE, aTimeOut);
end;
{ TPipeServerTransportBase }
constructor TPipeServerTransportBase.Create;
begin
inherited Create;
FStopServer := TEvent.Create(nil,TRUE,FALSE,''); // manual reset
end;
destructor TPipeServerTransportBase.Destroy;
begin
try
FreeAndNil( FStopServer);
finally
inherited Destroy;
end;
end;
function TPipeServerTransportBase.QueryStopServer : Boolean;
begin
result := (FStopServer = nil)
or (FStopServer.WaitFor(0) <> wrTimeout);
end;
procedure TPipeServerTransportBase.Listen;
begin
FStopServer.ResetEvent;
end;
procedure TPipeServerTransportBase.Close;
begin
FStopServer.SetEvent;
InternalClose;
end;
{ TAnonymousPipeServerTransportImpl }
constructor TAnonymousPipeServerTransportImpl.Create(aBufsize : Cardinal; aTimeOut : DWORD);
// Anonymous pipe CTOR
begin
inherited Create;
FBufsize := aBufSize;
FReadHandle := INVALID_HANDLE_VALUE;
FWriteHandle := INVALID_HANDLE_VALUE;
FClientAnonRead := INVALID_HANDLE_VALUE;
FClientAnonWrite := INVALID_HANDLE_VALUE;
FTimeOut := aTimeOut;
// The anonymous pipe needs to be created first so that the server can
// pass the handles on to the client before the serve (acceptImpl)
// blocking call.
if not CreateAnonPipe
then raise TTransportExceptionNotOpen.Create(ClassName+'.Create() failed');
end;
function TAnonymousPipeServerTransportImpl.Accept(const fnAccepting: TProc): ITransport;
var buf : Byte;
br : DWORD;
begin
if Assigned(fnAccepting)
then fnAccepting();
// This 0-byte read serves merely as a blocking call.
if not ReadFile( FReadHandle, buf, 0, br, nil)
and (GetLastError() <> ERROR_MORE_DATA)
then raise TTransportExceptionNotOpen.Create('TServerPipe unable to initiate pipe communication');
// create the transport impl
result := TAnonymousPipeTransportImpl.Create( FReadHandle, FWriteHandle, FALSE, FTimeOut);
end;
procedure TAnonymousPipeServerTransportImpl.InternalClose;
begin
ClosePipeHandle( FReadHandle);
ClosePipeHandle( FWriteHandle);
ClosePipeHandle( FClientAnonRead);
ClosePipeHandle( FClientAnonWrite);
end;
function TAnonymousPipeServerTransportImpl.ReadHandle : THandle;
begin
result := FReadHandle;
end;
function TAnonymousPipeServerTransportImpl.WriteHandle : THandle;
begin
result := FWriteHandle;
end;
function TAnonymousPipeServerTransportImpl.ClientAnonRead : THandle;
begin
result := FClientAnonRead;
end;
function TAnonymousPipeServerTransportImpl.ClientAnonWrite : THandle;
begin
result := FClientAnonWrite;
end;
function TAnonymousPipeServerTransportImpl.CreateAnonPipe : Boolean;
var sd : PSECURITY_DESCRIPTOR;
sa : SECURITY_ATTRIBUTES; //TSecurityAttributes;
hCAR, hPipeW, hCAW, hPipe : THandle;
begin
result := FALSE;
sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
try
Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
Win32Check( SetSecurityDescriptorDacl( sd, TRUE, nil, FALSE));
sa.nLength := sizeof( sa);
sa.lpSecurityDescriptor := sd;
sa.bInheritHandle := TRUE; //allow passing handle to child
if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
Exit;
end;
if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin //create stdout pipe
CloseHandle( hCAR);
CloseHandle( hPipeW);
raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
Exit;
end;
FClientAnonRead := hCAR;
FClientAnonWrite := hCAW;
FReadHandle := hPipe;
FWriteHandle := hPipeW;
result := TRUE;
finally
if sd <> nil then LocalFree( Cardinal(sd));
end;
end;
{ TNamedPipeServerTransportImpl }
constructor TNamedPipeServerTransportImpl.Create( aPipename : string; aBufsize, aMaxConns, aTimeOut : Cardinal);
// Named Pipe CTOR
begin
inherited Create;
ASSERT( aTimeout > 0);
FPipeName := aPipename;
FBufsize := aBufSize;
FMaxConns := Max( 1, Min( PIPE_UNLIMITED_INSTANCES, aMaxConns));
FHandle := INVALID_HANDLE_VALUE;
FTimeout := aTimeOut;
FConnected := FALSE;
if Copy(FPipeName,1,2) <> '\\'
then FPipeName := '\\.\pipe\' + FPipeName; // assume localhost
end;
function TNamedPipeServerTransportImpl.Accept(const fnAccepting: TProc): ITransport;
var dwError, dwWait, dwDummy : DWORD;
overlapped : IOverlappedHelper;
handles : array[0..1] of THandle;
begin
overlapped := TOverlappedHelperImpl.Create;
ASSERT( not FConnected);
CreateNamedPipe;
while not FConnected do begin
if QueryStopServer
then Abort;
if Assigned(fnAccepting)
then fnAccepting();
// Wait for the client to connect; if it succeeds, the
// function returns a nonzero value. If the function returns
// zero, GetLastError should return ERROR_PIPE_CONNECTED.
if ConnectNamedPipe( Handle, overlapped.OverlappedPtr) then begin
FConnected := TRUE;
Break;
end;
// ConnectNamedPipe() returns FALSE for OverlappedIO, even if connected.
// We have to check GetLastError() explicitly to find out
dwError := GetLastError;
case dwError of
ERROR_PIPE_CONNECTED : begin
FConnected := not QueryStopServer; // special case: pipe immediately connected
end;
ERROR_IO_PENDING : begin
handles[0] := overlapped.WaitHandle;
handles[1] := FStopServer.Handle;
dwWait := WaitForMultipleObjects( 2, @handles, FALSE, FTimeout);
FConnected := (dwWait = WAIT_OBJECT_0)
and GetOverlappedResult( Handle, overlapped.Overlapped, dwDummy, TRUE)
and not QueryStopServer;
end;
else
InternalClose;
raise TTransportExceptionNotOpen.Create('Client connection failed');
end;
end;
// create the transport impl
result := CreateTransportInstance;
end;
function TNamedPipeServerTransportImpl.CreateTransportInstance : ITransport;
// create the transport impl
var hPipe : THandle;
begin
hPipe := THandle( InterlockedExchangePointer( Pointer(FHandle), Pointer(INVALID_HANDLE_VALUE)));
try
FConnected := FALSE;
result := TNamedPipeTransportServerEndImpl.Create( hPipe, TRUE, FTimeout);
except
ClosePipeHandle(hPipe);
raise;
end;
end;
procedure TNamedPipeServerTransportImpl.InternalClose;
var hPipe : THandle;
begin
hPipe := THandle( InterlockedExchangePointer( Pointer(FHandle), Pointer(INVALID_HANDLE_VALUE)));
if hPipe = INVALID_HANDLE_VALUE then Exit;
try
if FConnected
then FlushFileBuffers( hPipe)
else CancelIo( hPipe);
DisconnectNamedPipe( hPipe);
finally
ClosePipeHandle( hPipe);
FConnected := FALSE;
end;
end;
function TNamedPipeServerTransportImpl.Handle : THandle;
begin
{$IFDEF WIN64}
result := THandle( InterlockedExchangeAdd64( Int64(FHandle), 0));
{$ELSE}
result := THandle( InterlockedExchangeAdd( Integer(FHandle), 0));
{$ENDIF}
end;
function TNamedPipeServerTransportImpl.CreateNamedPipe : THandle;
var SIDAuthWorld : SID_IDENTIFIER_AUTHORITY ;
everyone_sid : PSID;
ea : EXPLICIT_ACCESS;
acl : PACL;
sd : PSECURITY_DESCRIPTOR;
sa : SECURITY_ATTRIBUTES;
const
SECURITY_WORLD_SID_AUTHORITY : TSIDIdentifierAuthority = (Value : (0,0,0,0,0,1));
SECURITY_WORLD_RID = $00000000;
begin
sd := nil;
everyone_sid := nil;
try
ASSERT( (FHandle = INVALID_HANDLE_VALUE) and not FConnected);
// Windows - set security to allow non-elevated apps
// to access pipes created by elevated apps.
SIDAuthWorld := SECURITY_WORLD_SID_AUTHORITY;
AllocateAndInitializeSid( SIDAuthWorld, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, everyone_sid);
ZeroMemory( @ea, SizeOf(ea));
ea.grfAccessPermissions := GENERIC_ALL; //SPECIFIC_RIGHTS_ALL or STANDARD_RIGHTS_ALL;
ea.grfAccessMode := SET_ACCESS;
ea.grfInheritance := NO_INHERITANCE;
ea.Trustee.TrusteeForm := TRUSTEE_IS_SID;
ea.Trustee.TrusteeType := TRUSTEE_IS_WELL_KNOWN_GROUP;
ea.Trustee.ptstrName := PChar(everyone_sid);
acl := nil;
SetEntriesInAcl( 1, @ea, nil, acl);
sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
Win32Check( SetSecurityDescriptorDacl( sd, TRUE, acl, FALSE));
sa.nLength := SizeOf(sa);
sa.lpSecurityDescriptor := sd;
sa.bInheritHandle := FALSE;
// Create an instance of the named pipe
{$IFDEF OLD_UNIT_NAMES}
result := Windows.CreateNamedPipe(
{$ELSE}
result := Winapi.Windows.CreateNamedPipe(
{$ENDIF}
PChar( FPipeName), // pipe name
PIPE_ACCESS_DUPLEX or // read/write access
FILE_FLAG_OVERLAPPED, // async mode
PIPE_TYPE_BYTE or // byte type pipe
PIPE_READMODE_BYTE, // byte read mode
FMaxConns, // max. instances
FBufSize, // output buffer size
FBufSize, // input buffer size
FTimeout, // time-out, see MSDN
@sa // default security attribute
);
if( result <> INVALID_HANDLE_VALUE)
then InterlockedExchangePointer( Pointer(FHandle), Pointer(result))
else raise TTransportExceptionNotOpen.Create('CreateNamedPipe() failed ' + IntToStr(GetLastError));
finally
if sd <> nil then LocalFree( Cardinal( sd));
if acl <> nil then LocalFree( Cardinal( acl));
if everyone_sid <> nil then FreeSid(everyone_sid);
end;
end;
end.

1604
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.pas generated vendored Normal file
View file

File diff suppressed because it is too large Load diff

95
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.TypeRegistry.pas generated vendored Normal file
View file

@ -0,0 +1,95 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.TypeRegistry;
interface
uses
Generics.Collections, TypInfo,
Thrift.Protocol;
type
TFactoryMethod<T> = function:T;
TypeRegistry = class
private
class var FTypeInfoToFactoryLookup : TDictionary<Pointer, Pointer>;
public
class constructor Create;
class destructor Destroy;
class procedure RegisterTypeFactory<F>(const aFactoryMethod: TFactoryMethod<F>);
class function Construct<F>: F;
class function ConstructFromTypeInfo(const aTypeInfo: PTypeInfo): IBase;
end;
implementation
{ TypeRegistration }
class constructor TypeRegistry.Create;
begin
FTypeInfoToFactoryLookup := TDictionary<Pointer, Pointer>.Create;
end;
class destructor TypeRegistry.Destroy;
begin
FTypeInfoToFactoryLookup.Free;
end;
class procedure TypeRegistry.RegisterTypeFactory<F>(const aFactoryMethod: TFactoryMethod<F>);
var
TypeInfo : Pointer;
begin
TypeInfo := System.TypeInfo(F);
if (TypeInfo <> nil) and (PTypeInfo(TypeInfo).Kind = tkInterface)
then FTypeInfoToFactoryLookup.AddOrSetValue(TypeInfo, @aFactoryMethod);
end;
class function TypeRegistry.Construct<F>: F;
var
TypeInfo : PTypeInfo;
Factory : Pointer;
begin
Result := default(F);
TypeInfo := System.TypeInfo(F);
if Assigned(TypeInfo) and (TypeInfo.Kind = tkInterface)
then begin
if FTypeInfoToFactoryLookup.TryGetValue(TypeInfo, Factory)
then Result := TFactoryMethod<F>(Factory)();
end;
end;
class function TypeRegistry.ConstructFromTypeInfo(const aTypeInfo: PTypeInfo): IBase;
var
Factory : Pointer;
begin
Result := nil;
if FTypeInfoToFactoryLookup.TryGetValue(aTypeInfo, Factory)
then Result := IBase(TFactoryMethod<IBase>(Factory)());
end;
end.

244
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Utils.pas generated vendored Normal file
View file

@ -0,0 +1,244 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift.Utils;
interface
{$I Thrift.Defines.inc}
uses
{$IFDEF OLD_UNIT_NAMES}
Classes, Windows, SysUtils, Character, SyncObjs;
{$ELSE}
System.Classes, Winapi.Windows, System.SysUtils, System.Character, System.SyncObjs;
{$ENDIF}
type
IOverlappedHelper = interface
['{A1832EFA-2E02-4884-8F09-F0A0277157FA}']
function Overlapped : TOverlapped;
function OverlappedPtr : POverlapped;
function WaitHandle : THandle;
function WaitFor(dwTimeout: DWORD) : DWORD;
end;
TOverlappedHelperImpl = class( TInterfacedObject, IOverlappedHelper)
strict protected
FOverlapped : TOverlapped;
FEvent : TEvent;
// IOverlappedHelper
function Overlapped : TOverlapped;
function OverlappedPtr : POverlapped;
function WaitHandle : THandle;
function WaitFor(dwTimeout: DWORD) : DWORD;
public
constructor Create;
destructor Destroy; override;
end;
Base64Utils = class sealed
public
class function Encode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer; static;
class function Decode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer; static;
end;
CharUtils = class sealed
public
class function IsHighSurrogate( const c : Char) : Boolean; static; inline;
class function IsLowSurrogate( const c : Char) : Boolean; static; inline;
end;
function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; stdcall;
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
implementation
{ TOverlappedHelperImpl }
constructor TOverlappedHelperImpl.Create;
begin
inherited Create;
FillChar( FOverlapped, SizeOf(FOverlapped), 0);
FEvent := TEvent.Create( nil, TRUE, FALSE, ''); // always ManualReset, see MSDN
FOverlapped.hEvent := FEvent.Handle;
end;
destructor TOverlappedHelperImpl.Destroy;
begin
try
FOverlapped.hEvent := 0;
FreeAndNil( FEvent);
finally
inherited Destroy;
end;
end;
function TOverlappedHelperImpl.Overlapped : TOverlapped;
begin
result := FOverlapped;
end;
function TOverlappedHelperImpl.OverlappedPtr : POverlapped;
begin
result := @FOverlapped;
end;
function TOverlappedHelperImpl.WaitHandle : THandle;
begin
result := FOverlapped.hEvent;
end;
function TOverlappedHelperImpl.WaitFor( dwTimeout : DWORD) : DWORD;
begin
result := WaitForSingleObject( FOverlapped.hEvent, dwTimeout);
end;
{ Base64Utils }
class function Base64Utils.Encode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer;
const ENCODE_TABLE : PAnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
begin
ASSERT( len in [1..3]);
dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff] shr 2) and $3F]);
case len of
3 : begin
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff] shl 4) and $30) or ((src[srcOff + 1] shr 4) and $0F)]);
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff + 1] shl 2) and $3C) or ((src[srcOff + 2] shr 6) and $03)]);
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ src[srcOff + 2] and $3F]);
result := 4;
end;
2 : begin
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff] shl 4) and $30) or ((src[srcOff + 1] shr 4) and $0F)]);
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff + 1] shl 2) and $3C]);
result := 3;
end;
1 : begin
Inc(dstOff);
dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff] shl 4) and $30]);
result := 2;
end;
else
ASSERT( FALSE);
result := 0; // because invalid call
end;
end;
class function Base64Utils.Decode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer;
const DECODE_TABLE : array[0..$FF] of Integer
= ( -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,62,-1,-1,-1,63,
52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1,
-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,
15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1,
-1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1 );
begin
ASSERT( len in [1..4]);
result := 1;
dst[dstOff] := ((DECODE_TABLE[src[srcOff] and $0FF] shl 2)
or (DECODE_TABLE[src[srcOff + 1] and $0FF] shr 4));
if (len > 2) then begin
Inc( result);
Inc( dstOff);
dst[dstOff] := (((DECODE_TABLE[src[srcOff + 1] and $0FF] shl 4) and $F0)
or (DECODE_TABLE[src[srcOff + 2] and $0FF] shr 2));
if (len > 3) then begin
Inc( result);
Inc( dstOff);
dst[dstOff] := (((DECODE_TABLE[src[srcOff + 2] and $0FF] shl 6) and $C0)
or DECODE_TABLE[src[srcOff + 3] and $0FF]);
end;
end;
end;
class function CharUtils.IsHighSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsHighSurrogate( c);
{$ELSE}
result := c.IsHighSurrogate();
{$IFEND}
end;
class function CharUtils.IsLowSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsLowSurrogate( c);
{$ELSE}
result := c.IsLowSurrogate;
{$IFEND}
end;
// natively available since stone age
function InterlockedCompareExchange64;
external KERNEL32 name 'InterlockedCompareExchange64';
// natively available >= Vista
// implemented this way since there are still some people running Windows XP :-(
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
var old : Int64;
begin
repeat
Old := Addend;
until (InterlockedCompareExchange64( Addend, Old + Value, Old) = Old);
result := Old;
end;
end.

258
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.pas generated vendored Normal file
View file

@ -0,0 +1,258 @@
(*
* Licensed to the Apache Software Foundation (ASF) under one
* or more contributor license agreements. See the NOTICE file
* distributed with this work for additional information
* regarding copyright ownership. The ASF licenses this file
* to you under the Apache License, Version 2.0 (the
* "License"); you may not use this file except in compliance
* with the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing,
* software distributed under the License is distributed on an
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
* KIND, either express or implied. See the License for the
* specific language governing permissions and limitations
* under the License.
*)
unit Thrift;
interface
uses
SysUtils, Thrift.Protocol;
const
Version = '0.10.0';
type
TApplicationExceptionSpecializedClass = class of TApplicationExceptionSpecialized;
TApplicationException = class( SysUtils.Exception )
public
type
{$SCOPEDENUMS ON}
TExceptionType = (
Unknown,
UnknownMethod,
InvalidMessageType,
WrongMethodName,
BadSequenceID,
MissingResult,
InternalError,
ProtocolError,
InvalidTransform,
InvalidProtocol,
UnsupportedClientType
);
{$SCOPEDENUMS OFF}
private
function GetType: TExceptionType;
protected
constructor HiddenCreate(const Msg: string);
public
// purposefully hide inherited constructor
class function Create(const Msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
class function Create: TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
class function Create( AType: TExceptionType): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
class function Create( AType: TExceptionType; const msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
class function GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
class function Read( const iprot: IProtocol): TApplicationException;
procedure Write( const oprot: IProtocol );
end;
// Needed to remove deprecation warning
TApplicationExceptionSpecialized = class abstract (TApplicationException)
public
constructor Create(const Msg: string);
end;
TApplicationExceptionUnknown = class (TApplicationExceptionSpecialized);
TApplicationExceptionUnknownMethod = class (TApplicationExceptionSpecialized);
TApplicationExceptionInvalidMessageType = class (TApplicationExceptionSpecialized);
TApplicationExceptionWrongMethodName = class (TApplicationExceptionSpecialized);
TApplicationExceptionBadSequenceID = class (TApplicationExceptionSpecialized);
TApplicationExceptionMissingResult = class (TApplicationExceptionSpecialized);
TApplicationExceptionInternalError = class (TApplicationExceptionSpecialized);
TApplicationExceptionProtocolError = class (TApplicationExceptionSpecialized);
TApplicationExceptionInvalidTransform = class (TApplicationExceptionSpecialized);
TApplicationExceptionInvalidProtocol = class (TApplicationExceptionSpecialized);
TApplicationExceptionUnsupportedClientType = class (TApplicationExceptionSpecialized);
// base class for IDL-generated exceptions
TException = class( SysUtils.Exception)
public
function Message : string; // hide inherited property: allow read, but prevent accidental writes
procedure UpdateMessageProperty; // update inherited message property with toString()
end;
implementation
{ TException }
function TException.Message;
// allow read (exception summary), but prevent accidental writes
// read will return the exception summary
begin
result := Self.ToString;
end;
procedure TException.UpdateMessageProperty;
// Update the inherited Message property to better conform to standard behaviour.
// Nice benefit: The IDE is now able to show the exception message again.
begin
inherited Message := Self.ToString; // produces a summary text
end;
{ TApplicationException }
function TApplicationException.GetType: TExceptionType;
begin
if Self is TApplicationExceptionUnknownMethod then Result := TExceptionType.UnknownMethod
else if Self is TApplicationExceptionInvalidMessageType then Result := TExceptionType.InvalidMessageType
else if Self is TApplicationExceptionWrongMethodName then Result := TExceptionType.WrongMethodName
else if Self is TApplicationExceptionBadSequenceID then Result := TExceptionType.BadSequenceID
else if Self is TApplicationExceptionMissingResult then Result := TExceptionType.MissingResult
else if Self is TApplicationExceptionInternalError then Result := TExceptionType.InternalError
else if Self is TApplicationExceptionProtocolError then Result := TExceptionType.ProtocolError
else if Self is TApplicationExceptionInvalidTransform then Result := TExceptionType.InvalidTransform
else if Self is TApplicationExceptionInvalidProtocol then Result := TExceptionType.InvalidProtocol
else if Self is TApplicationExceptionUnsupportedClientType then Result := TExceptionType.UnsupportedClientType
else Result := TExceptionType.Unknown;
end;
constructor TApplicationException.HiddenCreate(const Msg: string);
begin
inherited Create(Msg);
end;
class function TApplicationException.Create(const Msg: string): TApplicationException;
begin
Result := TApplicationExceptionUnknown.Create(Msg);
end;
class function TApplicationException.Create: TApplicationException;
begin
Result := TApplicationExceptionUnknown.Create('');
end;
class function TApplicationException.Create( AType: TExceptionType): TApplicationException;
begin
{$WARN SYMBOL_DEPRECATED OFF}
Result := Create(AType, '');
{$WARN SYMBOL_DEPRECATED DEFAULT}
end;
class function TApplicationException.Create( AType: TExceptionType; const msg: string): TApplicationException;
begin
Result := GetSpecializedExceptionType(AType).Create(msg);
end;
class function TApplicationException.GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
begin
case AType of
TExceptionType.UnknownMethod: Result := TApplicationExceptionUnknownMethod;
TExceptionType.InvalidMessageType: Result := TApplicationExceptionInvalidMessageType;
TExceptionType.WrongMethodName: Result := TApplicationExceptionWrongMethodName;
TExceptionType.BadSequenceID: Result := TApplicationExceptionBadSequenceID;
TExceptionType.MissingResult: Result := TApplicationExceptionMissingResult;
TExceptionType.InternalError: Result := TApplicationExceptionInternalError;
TExceptionType.ProtocolError: Result := TApplicationExceptionProtocolError;
TExceptionType.InvalidTransform: Result := TApplicationExceptionInvalidTransform;
TExceptionType.InvalidProtocol: Result := TApplicationExceptionInvalidProtocol;
TExceptionType.UnsupportedClientType: Result := TApplicationExceptionUnsupportedClientType;
else
Result := TApplicationExceptionUnknown;
end;
end;
class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
var
field : IField;
msg : string;
typ : TExceptionType;
struc : IStruct;
begin
msg := '';
typ := TExceptionType.Unknown;
struc := iprot.ReadStructBegin;
while ( True ) do
begin
field := iprot.ReadFieldBegin;
if ( field.Type_ = TType.Stop) then
begin
Break;
end;
case field.Id of
1 : begin
if ( field.Type_ = TType.String_) then
begin
msg := iprot.ReadString;
end else
begin
TProtocolUtil.Skip( iprot, field.Type_ );
end;
end;
2 : begin
if ( field.Type_ = TType.I32) then
begin
typ := TExceptionType( iprot.ReadI32 );
end else
begin
TProtocolUtil.Skip( iprot, field.Type_ );
end;
end else
begin
TProtocolUtil.Skip( iprot, field.Type_);
end;
end;
iprot.ReadFieldEnd;
end;
iprot.ReadStructEnd;
Result := GetSpecializedExceptionType(typ).Create(msg);
end;
procedure TApplicationException.Write( const oprot: IProtocol);
var
struc : IStruct;
field : IField;
begin
struc := TStructImpl.Create( 'TApplicationException' );
field := TFieldImpl.Create;
oprot.WriteStructBegin( struc );
if Message <> '' then
begin
field.Name := 'message';
field.Type_ := TType.String_;
field.Id := 1;
oprot.WriteFieldBegin( field );
oprot.WriteString( Message );
oprot.WriteFieldEnd;
end;
field.Name := 'type';
field.Type_ := TType.I32;
field.Id := 2;
oprot.WriteFieldBegin(field);
oprot.WriteI32(Integer(GetType));
oprot.WriteFieldEnd();
oprot.WriteFieldStop();
oprot.WriteStructEnd();
end;
{ TApplicationExceptionSpecialized }
constructor TApplicationExceptionSpecialized.Create(const Msg: string);
begin
inherited HiddenCreate(Msg);
end;
end.