Add filter feature, implemented as service extension.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1269 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
parent
c3ebc46ed3
commit
cf243fb88b
@ -63,6 +63,7 @@ const
|
||||
type
|
||||
|
||||
EServiceException = class(Exception) end;
|
||||
EServiceExtensionException = class(Exception) end;
|
||||
ETransportExecption = class(EServiceException) end;
|
||||
|
||||
EBaseRemoteException = class(EServiceException)
|
||||
|
||||
182
wst/trunk/client_utils.pas
Normal file
182
wst/trunk/client_utils.pas
Normal file
@ -0,0 +1,182 @@
|
||||
{
|
||||
This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2010 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit client_utils;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
service_intf, imp_utils, base_service_intf, wst_types, filter_intf;
|
||||
|
||||
Type
|
||||
|
||||
{$M+}
|
||||
TBaseTransport = class(TSimpleFactoryItem,ITransport)
|
||||
Private
|
||||
FPropMngr : IPropertyManager;
|
||||
FFilter : IDataFilter;
|
||||
protected
|
||||
function HasFilter() : Boolean;
|
||||
function GetFilter() : IDataFilter;
|
||||
function GetFilterString: string;
|
||||
procedure SetFilterString(const Value: string);
|
||||
procedure FilterInput(ASource, ADest : TStream);
|
||||
procedure FilterOutput(ASource, ADest : TStream);
|
||||
public
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure SendAndReceive(ARequest,AResponse:TStream); virtual; abstract;
|
||||
published
|
||||
property FilterString : string read GetFilterString write SetFilterString;
|
||||
End;
|
||||
{$M+}
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
wst_consts;
|
||||
|
||||
{ TBaseTransport }
|
||||
|
||||
constructor TBaseTransport.Create();
|
||||
begin
|
||||
inherited;
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TBaseTransport.Destroy();
|
||||
begin
|
||||
FPropMngr := Nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TBaseTransport.FilterInput(ASource, ADest: TStream);
|
||||
var
|
||||
locInBuffer, locBuffer : TByteDynArray;
|
||||
locOldPos : Int64;
|
||||
begin
|
||||
if ASource.InheritsFrom(TMemoryStream) then begin
|
||||
locBuffer := FFilter.ExecuteInput(TMemoryStream(ASource).Memory^,ASource.Size);
|
||||
end else begin
|
||||
SetLength(locInBuffer,ASource.Size);
|
||||
locOldPos := ASource.Position;
|
||||
ASource.Position := 0;
|
||||
try
|
||||
ASource.Read(locInBuffer[0],Length(locInBuffer));
|
||||
finally
|
||||
ASource.Position := locOldPos;
|
||||
end;
|
||||
locBuffer := FFilter.ExecuteInput(locInBuffer[0],Length(locInBuffer));
|
||||
end;
|
||||
ADest.Size := Length(locBuffer);
|
||||
ADest.Position := 0;
|
||||
ADest.Write(locBuffer[0],Length(locBuffer));
|
||||
ADest.Position := 0;
|
||||
end;
|
||||
|
||||
procedure TBaseTransport.FilterOutput(ASource, ADest: TStream);
|
||||
var
|
||||
locInBuffer, locBuffer : TByteDynArray;
|
||||
locOldPos : Int64;
|
||||
begin
|
||||
if ASource.InheritsFrom(TMemoryStream) then begin
|
||||
locBuffer := FFilter.ExecuteOutput(TMemoryStream(ASource).Memory^,ASource.Size);
|
||||
end else begin
|
||||
SetLength(locInBuffer,ASource.Size);
|
||||
locOldPos := ASource.Position;
|
||||
ASource.Position := 0;
|
||||
try
|
||||
ASource.Read(locInBuffer[0],Length(locInBuffer));
|
||||
finally
|
||||
ASource.Position := locOldPos;
|
||||
end;
|
||||
locBuffer := FFilter.ExecuteOutput(locInBuffer[0],Length(locInBuffer));
|
||||
end;
|
||||
ADest.Size := Length(locBuffer);
|
||||
ADest.Position := 0;
|
||||
ADest.Write(locBuffer[0],Length(locBuffer));
|
||||
ADest.Position := 0;
|
||||
end;
|
||||
|
||||
function TBaseTransport.GetFilter() : IDataFilter;
|
||||
begin
|
||||
Result := FFilter;
|
||||
end;
|
||||
|
||||
function TBaseTransport.GetFilterString: string;
|
||||
var
|
||||
locPM : IPropertyManager;
|
||||
ls : TStringList;
|
||||
locRes, s : string;
|
||||
i : Integer;
|
||||
begin
|
||||
locRes := '';
|
||||
if ( FFilter <> nil ) then begin
|
||||
locRes := FFilter.GetName();
|
||||
locPM := FFilter.GetPropertyManager();
|
||||
ls := TStringList.Create();
|
||||
try
|
||||
if ( locPM.GetPropertyNames(ls) > 0 ) then begin
|
||||
for i := 0 to Pred(ls.Count) do begin
|
||||
s := ls[i];
|
||||
locRes := Format('%s,%s>%s',[locRes,s,locPM.GetProperty(s)]);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
ls.Free();
|
||||
end;
|
||||
end;
|
||||
Result := locRes;
|
||||
end;
|
||||
|
||||
function TBaseTransport.GetPropertyManager: IPropertyManager;
|
||||
begin
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
function TBaseTransport.HasFilter() : Boolean;
|
||||
begin
|
||||
Result := (FFilter <> nil);
|
||||
end;
|
||||
|
||||
procedure TBaseTransport.SetFilterString(const Value: string);
|
||||
var
|
||||
locBuffer, locName, locValue : string;
|
||||
locPM : IPropertyManager;
|
||||
locFilterManager : IDataFilterRegistry;
|
||||
locFilter : IDataFilter;
|
||||
begin
|
||||
locBuffer := Value;
|
||||
if IsStrEmpty(locBuffer) then begin
|
||||
FFilter := nil;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
//The filter name
|
||||
locName := Trim(GetToken(locBuffer,','));
|
||||
locFilterManager := GetDataFilterRegistry();
|
||||
if not locFilterManager.Find(locName,locFilter) then
|
||||
raise ETransportExecption.CreateFmt(SERR_DataFilterNotFound,[locName]);
|
||||
locPM := locFilter.GetPropertyManager();
|
||||
while True do begin
|
||||
locName := GetToken(locBuffer,'>');
|
||||
if IsStrEmpty(locName) then
|
||||
Break;
|
||||
locValue := GetToken(locBuffer,',');
|
||||
locPM.SetProperty(locName,locValue);
|
||||
end;
|
||||
FFilter := locFilter;
|
||||
end;
|
||||
|
||||
end.
|
||||
89
wst/trunk/filter_intf.pas
Normal file
89
wst/trunk/filter_intf.pas
Normal file
@ -0,0 +1,89 @@
|
||||
{
|
||||
This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2010 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
|
||||
{$INCLUDE wst_global.inc}
|
||||
|
||||
unit filter_intf;
|
||||
|
||||
interface
|
||||
uses
|
||||
SysUtils,
|
||||
wst_types, base_service_intf;
|
||||
|
||||
type
|
||||
|
||||
EFilterException = class(Exception) end;
|
||||
|
||||
IDataFilter = interface
|
||||
['{9D9886A4-37B6-4D62-BD3B-603A8EF00A13}']
|
||||
function GetPropertyManager() : IPropertyManager;
|
||||
function GetName() : string;
|
||||
function ExecuteInput(const AData; const ASize : Integer) : TByteDynArray;
|
||||
function ExecuteOutput(const AData; const ASize : Integer) : TByteDynArray;
|
||||
end;
|
||||
|
||||
IDataFilterRegistry = interface
|
||||
['{06489785-4447-4844-965B-9A50A417B20D}']
|
||||
function Find(
|
||||
const AName : string;
|
||||
out ARes : IDataFilter
|
||||
):Boolean;
|
||||
procedure Register(
|
||||
const AName : string;
|
||||
AFactory : IItemFactory
|
||||
);
|
||||
end;
|
||||
|
||||
function GetDataFilterRegistry():IDataFilterRegistry;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
{ TDataFilterRegistry }
|
||||
TDataFilterRegistry = class(TBaseFactoryRegistry,IInterface,IDataFilterRegistry)
|
||||
protected
|
||||
function Find(
|
||||
const AName : string;
|
||||
out ARes : IDataFilter
|
||||
):Boolean;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
DataFilterRegistryInst : IDataFilterRegistry = nil;
|
||||
function GetDataFilterRegistry():IDataFilterRegistry;
|
||||
begin
|
||||
if not Assigned(DataFilterRegistryInst) then
|
||||
DataFilterRegistryInst := TDataFilterRegistry.Create() as IDataFilterRegistry;// Lock!!!
|
||||
Result := DataFilterRegistryInst;
|
||||
end;
|
||||
|
||||
{ TDataFilterRegistry }
|
||||
|
||||
function TDataFilterRegistry.Find(
|
||||
const AName : string;
|
||||
out ARes : IDataFilter
|
||||
): Boolean;
|
||||
var
|
||||
fct : IItemFactory;
|
||||
begin
|
||||
fct := FindFactory(AName);
|
||||
if Assigned(fct) then begin
|
||||
ARes := fct.CreateInstance() as IDataFilter;
|
||||
Result := True;
|
||||
end else begin
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -13,26 +13,24 @@
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit indy_http_protocol;
|
||||
|
||||
//{$DEFINE WST_DBG}
|
||||
{.$DEFINE WST_DBG}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
service_intf, imp_utils, base_service_intf, wst_types,
|
||||
IdHTTP;
|
||||
service_intf, imp_utils, base_service_intf, wst_types, filter_intf,
|
||||
client_utils, IdHTTP;
|
||||
|
||||
Const
|
||||
sTRANSPORT_NAME = 'HTTP';
|
||||
|
||||
Type
|
||||
|
||||
{$M+}
|
||||
{ THTTPTransport }
|
||||
THTTPTransport = class(TSimpleFactoryItem,ITransport)
|
||||
THTTPTransport = class(TBaseTransport,ITransport)
|
||||
Private
|
||||
FFormat : string;
|
||||
FPropMngr : IPropertyManager;
|
||||
FConnection : TidHttp;
|
||||
FSoapAction: string;
|
||||
FContentType: string;
|
||||
@ -49,12 +47,11 @@ Type
|
||||
procedure SetProxyPort(const AValue: Integer);
|
||||
procedure SetProxyServer(const AValue: string);
|
||||
procedure SetProxyUsername(const AValue: string);
|
||||
Public
|
||||
public
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure SendAndReceive(ARequest,AResponse:TStream);
|
||||
Published
|
||||
procedure SendAndReceive(ARequest,AResponse:TStream); override;
|
||||
published
|
||||
property ContentType : string Read FContentType Write FContentType;
|
||||
property Address : string Read GetAddress Write SetAddress;
|
||||
property ProxyServer : string Read GetProxyServer Write SetProxyServer;
|
||||
@ -65,7 +62,6 @@ Type
|
||||
property Format : string read FFormat write FFormat;
|
||||
property ProtocolVersion : string read GetProtocolVersion write SetProtocolVersion;
|
||||
End;
|
||||
{$M+}
|
||||
|
||||
procedure INDY_RegisterHTTP_Transport();
|
||||
|
||||
@ -164,25 +160,20 @@ end;
|
||||
|
||||
constructor THTTPTransport.Create();
|
||||
begin
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
inherited;
|
||||
FConnection := TidHttp.Create(Nil);
|
||||
end;
|
||||
|
||||
destructor THTTPTransport.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConnection);
|
||||
FPropMngr := Nil;
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
function THTTPTransport.GetPropertyManager(): IPropertyManager;
|
||||
begin
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||
{$IFDEF WST_DBG}
|
||||
var
|
||||
locTempStream, locTempRes : TMemoryStream;
|
||||
{$IFDEF WST_DBG}
|
||||
s : TBinaryString;
|
||||
i : Int64;
|
||||
{$ENDIF WST_DBG}
|
||||
@ -199,13 +190,35 @@ begin
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(ARequest).SaveToFile('request.log');
|
||||
{$ENDIF WST_DBG}
|
||||
FConnection.Post(Address,ARequest, AResponse);
|
||||
if not HasFilter() then begin
|
||||
FConnection.Post(Address,ARequest, AResponse);
|
||||
end else begin
|
||||
locTempRes := nil;
|
||||
locTempStream := TMemoryStream.Create();
|
||||
try
|
||||
FilterInput(ARequest,locTempStream);
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(locTempStream).SaveToFile('request.log.wire');
|
||||
{$ENDIF WST_DBG}
|
||||
locTempRes := TMemoryStream.Create();
|
||||
FConnection.Post(Address,locTempStream,locTempRes);
|
||||
{$IFDEF WST_DBG}
|
||||
i := AResponse.Size;
|
||||
SetLength(s,i);
|
||||
Move(TMemoryStream(AResponse).Memory^,s[1],i);
|
||||
WriteLn('--------------------------------------------');
|
||||
WriteLn(s);
|
||||
TMemoryStream(locTempRes).SaveToFile('response.log.wire');
|
||||
{$ENDIF WST_DBG}
|
||||
FilterOutput(locTempRes,AResponse);
|
||||
finally
|
||||
locTempRes.Free();
|
||||
locTempStream.Free();
|
||||
end;
|
||||
end;
|
||||
{$IFDEF WST_DBG}
|
||||
if IsConsole then begin
|
||||
i := AResponse.Size;
|
||||
SetLength(s,i);
|
||||
Move(TMemoryStream(AResponse).Memory^,s[1],i);
|
||||
WriteLn('--------------------------------------------');
|
||||
WriteLn(s);
|
||||
end;
|
||||
TMemoryStream(AResponse).SaveToFile('response.log');
|
||||
{$ENDIF WST_DBG}
|
||||
end;
|
||||
@ -215,4 +228,5 @@ begin
|
||||
GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -17,10 +17,10 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
service_intf, imp_utils, base_service_intf,
|
||||
service_intf, imp_utils, base_service_intf, client_utils,
|
||||
IdTCPClient;
|
||||
|
||||
//{$DEFINE WST_DBG}
|
||||
{.$DEFINE WST_DBG}
|
||||
|
||||
Const
|
||||
sTRANSPORT_NAME = 'TCP';
|
||||
@ -29,13 +29,11 @@ Type
|
||||
|
||||
ETCPException = class(EServiceException)
|
||||
End;
|
||||
|
||||
{$M+}
|
||||
|
||||
{ TTCPTransport }
|
||||
TTCPTransport = class(TSimpleFactoryItem,ITransport)
|
||||
TTCPTransport = class(TBaseTransport,ITransport)
|
||||
Private
|
||||
FFormat : string;
|
||||
FPropMngr : IPropertyManager;
|
||||
FConnection : TIdTCPClient;
|
||||
FContentType : string;
|
||||
FTarget: string;
|
||||
@ -47,8 +45,7 @@ Type
|
||||
public
|
||||
constructor Create();override;
|
||||
destructor Destroy();override;
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
procedure SendAndReceive(ARequest,AResponse:TStream);
|
||||
procedure SendAndReceive(ARequest,AResponse:TStream); override;
|
||||
Published
|
||||
property Target : string Read FTarget Write FTarget;
|
||||
property ContentType : string Read FContentType Write FContentType;
|
||||
@ -57,7 +54,6 @@ Type
|
||||
property DefaultTimeOut : Integer read FDefaultTimeOut write FDefaultTimeOut;
|
||||
property Format : string read FFormat write FFormat;
|
||||
End;
|
||||
{$M+}
|
||||
|
||||
procedure INDY_RegisterTCP_Transport();
|
||||
|
||||
@ -91,7 +87,7 @@ end;
|
||||
|
||||
constructor TTCPTransport.Create();
|
||||
begin
|
||||
FPropMngr := TPublishedPropertyManager.Create(Self);
|
||||
inherited;
|
||||
FConnection := TIdTCPClient.Create(nil);
|
||||
//FConnection.ReadTimeout:=;
|
||||
FDefaultTimeOut := 90000;
|
||||
@ -100,22 +96,21 @@ end;
|
||||
destructor TTCPTransport.Destroy();
|
||||
begin
|
||||
FreeAndNil(FConnection);
|
||||
FPropMngr := Nil;
|
||||
inherited Destroy();
|
||||
end;
|
||||
|
||||
function TTCPTransport.GetPropertyManager(): IPropertyManager;
|
||||
begin
|
||||
Result := FPropMngr;
|
||||
end;
|
||||
|
||||
procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream);
|
||||
var
|
||||
wrtr : IDataStore;
|
||||
buffStream : TMemoryStream;
|
||||
binBuff : TByteDynArray;
|
||||
bufferLen : LongInt;
|
||||
locTempStream : TMemoryStream;
|
||||
begin
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(ARequest).SaveToFile('request.log');
|
||||
{$ENDIF WST_DBG}
|
||||
locTempStream := nil;
|
||||
buffStream := TMemoryStream.Create();
|
||||
try
|
||||
wrtr := CreateBinaryWriter(buffStream);
|
||||
@ -123,9 +118,21 @@ begin
|
||||
wrtr.WriteAnsiStr(Target);
|
||||
wrtr.WriteAnsiStr(ContentType);
|
||||
wrtr.WriteAnsiStr(Self.Format);
|
||||
SetLength(binBuff,ARequest.Size);
|
||||
ARequest.Position := 0;
|
||||
ARequest.Read(binBuff[0],Length(binBuff));
|
||||
if not HasFilter() then begin
|
||||
SetLength(binBuff,ARequest.Size);
|
||||
ARequest.Position := 0;
|
||||
ARequest.Read(binBuff[0],Length(binBuff));
|
||||
end else begin
|
||||
locTempStream := TMemoryStream.Create();
|
||||
FilterInput(ARequest,locTempStream);
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(locTempStream).SaveToFile('request.log.wire');
|
||||
{$ENDIF WST_DBG}
|
||||
SetLength(binBuff,locTempStream.Size);
|
||||
locTempStream.Position := 0;
|
||||
locTempStream.Read(binBuff[0],Length(binBuff));
|
||||
locTempStream.Size := 0;
|
||||
end;
|
||||
wrtr.WriteBinary(binBuff);
|
||||
buffStream.Position := 0;
|
||||
wrtr.WriteInt32S(buffStream.Size-4);
|
||||
@ -137,16 +144,30 @@ begin
|
||||
bufferLen := 0;
|
||||
bufferLen := FConnection.IOHandler.ReadLongInt(False);
|
||||
bufferLen := Reverse_32(bufferLen);
|
||||
AResponse.Size := bufferLen;
|
||||
if ( bufferLen > 0 ) then begin
|
||||
AResponse.Position := 0;
|
||||
FConnection.IOHandler.ReadStream(AResponse,bufferLen,False);
|
||||
if not HasFilter() then begin
|
||||
AResponse.Size := bufferLen;
|
||||
if ( bufferLen > 0 ) then begin
|
||||
AResponse.Position := 0;
|
||||
FConnection.IOHandler.ReadStream(AResponse,bufferLen,False);
|
||||
end;
|
||||
end else begin
|
||||
locTempStream.Size := bufferLen;
|
||||
if ( bufferLen > 0 ) then begin
|
||||
locTempStream.Position := 0;
|
||||
FConnection.IOHandler.ReadStream(locTempStream,bufferLen,False);
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(locTempStream).SaveToFile('response.log.wire');
|
||||
{$ENDIF WST_DBG}
|
||||
FilterOutput(locTempStream,AResponse);
|
||||
locTempStream.Size := 0;
|
||||
end;
|
||||
end;
|
||||
AResponse.Position := 0;
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(AResponse).SaveToFile('response.log');
|
||||
{$ENDIF WST_DBG}
|
||||
finally
|
||||
locTempStream.Free();
|
||||
buffStream.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -92,7 +92,7 @@ procedure TwstIndyTcpListener.Handle_OnExecute(
|
||||
var
|
||||
strBuff : TIdBytes;
|
||||
bufferLen : LongInt;
|
||||
i, j, c : PtrInt;
|
||||
i, c : PtrInt;
|
||||
begin
|
||||
Result := 0;
|
||||
bufferLen := 0;
|
||||
|
||||
@ -23,6 +23,8 @@ type
|
||||
{ TLoggerServiceExtension }
|
||||
|
||||
TLoggerServiceExtension = class(TSimpleFactoryItem,IServiceExtension)
|
||||
private
|
||||
FPropertyManager : IPropertyManager;
|
||||
protected
|
||||
procedure TraceMessage(const AMsg : string);virtual;
|
||||
protected
|
||||
@ -36,8 +38,9 @@ type
|
||||
- IFormatterResponse on "msAfterDeserialize", "msBeforeSerialize"
|
||||
}
|
||||
);
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
uses TypInfo;
|
||||
|
||||
@ -93,7 +96,14 @@ begin
|
||||
TraceMessage(Format('%sTimeStamp : %s; %s',[sLineBreak,DateTimeToStr(Now()),s]));
|
||||
end;
|
||||
|
||||
function TLoggerServiceExtension.GetPropertyManager: IPropertyManager;
|
||||
begin
|
||||
if ( FPropertyManager = nil ) then
|
||||
FPropertyManager := TStoredPropertyManager.Create();
|
||||
Result := FPropertyManager;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GetServiceExtensionRegistry().Register('TLoggerServiceExtension',TSimpleItemFactory.Create(TLoggerServiceExtension) as IItemFactory);
|
||||
|
||||
|
||||
end.
|
||||
|
||||
232
wst/trunk/server_filter_extension.pas
Normal file
232
wst/trunk/server_filter_extension.pas
Normal file
@ -0,0 +1,232 @@
|
||||
{
|
||||
This file is part of the Web Service Toolkit
|
||||
Copyright (c) 2010 by Inoussa OUEDRAOGO
|
||||
|
||||
This file is provide under modified LGPL licence
|
||||
( the files COPYING.modifiedLGPL and COPYING.LGPL).
|
||||
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit server_filter_extension;
|
||||
|
||||
{.$DEFINE WST_DBG}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
wst_types, base_service_intf, server_service_intf, filter_intf;
|
||||
|
||||
type
|
||||
|
||||
{ TFilterExtension }
|
||||
{$TYPEINFO ON}
|
||||
TFilterExtension = class(TSimpleFactoryItem,IServiceExtension)
|
||||
private
|
||||
FPropertyManager : IPropertyManager;
|
||||
FFilter : IDataFilter;
|
||||
function GetFilterString: string;
|
||||
procedure SetFilterString(const Value: string);
|
||||
private
|
||||
procedure FilterInput(ASource, ADest : TStream);
|
||||
procedure FilterOutput(ASource, ADest : TStream);
|
||||
protected
|
||||
procedure ProcessMessage(
|
||||
const AMessageStage : TMessageStage;
|
||||
ACallContext : ICallContext;
|
||||
AMsgData : IInterface
|
||||
{ The "AMsgData" parameter actual type depends on the message state
|
||||
on correspond to :
|
||||
- IRequestBuffer on "msBeforeDeserialize" and "msAfterSerialize"
|
||||
- IFormatterResponse on "msAfterDeserialize", "msBeforeSerialize"
|
||||
}
|
||||
);
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
public
|
||||
constructor Create(); override;
|
||||
published
|
||||
property FilterString : string read GetFilterString write SetFilterString;
|
||||
end;
|
||||
{$TYPEINFO OFF}
|
||||
|
||||
implementation
|
||||
uses
|
||||
TypInfo, imp_utils, wst_consts;
|
||||
|
||||
{ TFilterExtension }
|
||||
|
||||
procedure TFilterExtension.ProcessMessage(
|
||||
const AMessageStage: TMessageStage;
|
||||
ACallContext: ICallContext;
|
||||
AMsgData: IInterface
|
||||
);
|
||||
var
|
||||
rb : IRequestBuffer;
|
||||
strm : TStream;
|
||||
locStream : TMemoryStream;
|
||||
begin
|
||||
case AMessageStage of
|
||||
msBeforeDeserialize :
|
||||
begin
|
||||
rb := AMsgData as IRequestBuffer;
|
||||
strm := rb.GetContent();
|
||||
{$IFDEF WST_DBG}
|
||||
TMemoryStream(strm).SaveToFile('req.log.wire');
|
||||
{$ENDIF WST_DBG}
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
FilterOutput(strm,locStream);
|
||||
{$IFDEF WST_DBG}
|
||||
locStream.SaveToFile('req.log');
|
||||
{$ENDIF WST_DBG}
|
||||
strm.Size := locStream.Size;
|
||||
strm.Position := 0;
|
||||
strm.CopyFrom(locStream,0);
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
strm.Position := 0;
|
||||
end;
|
||||
msAfterSerialize :
|
||||
begin
|
||||
rb := AMsgData as IRequestBuffer;
|
||||
strm := rb.GetResponse();
|
||||
locStream := TMemoryStream.Create();
|
||||
try
|
||||
FilterInput(strm,locStream);
|
||||
strm.Size := locStream.Size;
|
||||
strm.Position := 0;
|
||||
strm.CopyFrom(locStream,0);
|
||||
finally
|
||||
locStream.Free();
|
||||
end;
|
||||
strm.Position := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFilterExtension.FilterInput(ASource, ADest: TStream);
|
||||
var
|
||||
locInBuffer, locBuffer : TByteDynArray;
|
||||
locOldPos : Int64;
|
||||
begin
|
||||
if ASource.InheritsFrom(TMemoryStream) then begin
|
||||
locBuffer := FFilter.ExecuteInput(TMemoryStream(ASource).Memory^,ASource.Size);
|
||||
end else begin
|
||||
SetLength(locInBuffer,ASource.Size);
|
||||
locOldPos := ASource.Position;
|
||||
ASource.Position := 0;
|
||||
try
|
||||
ASource.Read(locInBuffer[0],Length(locInBuffer));
|
||||
finally
|
||||
ASource.Position := locOldPos;
|
||||
end;
|
||||
locBuffer := FFilter.ExecuteInput(locInBuffer[0],Length(locInBuffer));
|
||||
end;
|
||||
ADest.Size := Length(locBuffer);
|
||||
ADest.Position := 0;
|
||||
ADest.Write(locBuffer[0],Length(locBuffer));
|
||||
ADest.Position := 0;
|
||||
end;
|
||||
|
||||
procedure TFilterExtension.FilterOutput(ASource, ADest: TStream);
|
||||
var
|
||||
locInBuffer, locBuffer : TByteDynArray;
|
||||
locOldPos : Int64;
|
||||
begin
|
||||
if ASource.InheritsFrom(TMemoryStream) then begin
|
||||
locBuffer := FFilter.ExecuteOutput(TMemoryStream(ASource).Memory^,ASource.Size);
|
||||
end else begin
|
||||
SetLength(locInBuffer,ASource.Size);
|
||||
locOldPos := ASource.Position;
|
||||
ASource.Position := 0;
|
||||
try
|
||||
ASource.Read(locInBuffer[0],Length(locInBuffer));
|
||||
finally
|
||||
ASource.Position := locOldPos;
|
||||
end;
|
||||
locBuffer := FFilter.ExecuteOutput(locInBuffer[0],Length(locInBuffer));
|
||||
end;
|
||||
ADest.Size := Length(locBuffer);
|
||||
ADest.Position := 0;
|
||||
ADest.Write(locBuffer[0],Length(locBuffer));
|
||||
ADest.Position := 0;
|
||||
end;
|
||||
|
||||
constructor TFilterExtension.Create;
|
||||
begin
|
||||
inherited;
|
||||
FPropertyManager := TPublishedPropertyManager.Create(Self) as IPropertyManager;
|
||||
end;
|
||||
|
||||
function TFilterExtension.GetPropertyManager: IPropertyManager;
|
||||
begin
|
||||
Result := FPropertyManager;
|
||||
end;
|
||||
|
||||
function TFilterExtension.GetFilterString: string;
|
||||
var
|
||||
locPM : IPropertyManager;
|
||||
ls : TStringList;
|
||||
locRes, s : string;
|
||||
i : Integer;
|
||||
begin
|
||||
locRes := '';
|
||||
if ( FFilter <> nil ) then begin
|
||||
locRes := FFilter.GetName();
|
||||
locPM := FFilter.GetPropertyManager();
|
||||
ls := TStringList.Create();
|
||||
try
|
||||
if ( locPM.GetPropertyNames(ls) > 0 ) then begin
|
||||
for i := 0 to Pred(ls.Count) do begin
|
||||
s := ls[i];
|
||||
locRes := SysUtils.Format('%s,%s>%s',[locRes,s,locPM.GetProperty(s)]);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
ls.Free();
|
||||
end;
|
||||
end;
|
||||
Result := locRes;
|
||||
end;
|
||||
|
||||
procedure TFilterExtension.SetFilterString(const Value: string);
|
||||
var
|
||||
locBuffer, locName, locValue : string;
|
||||
locPM : IPropertyManager;
|
||||
locFilterManager : IDataFilterRegistry;
|
||||
locFilter : IDataFilter;
|
||||
begin
|
||||
locBuffer := Value;
|
||||
if IsStrEmpty(locBuffer) then begin
|
||||
FFilter := nil;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
//The filter name
|
||||
locName := Trim(GetToken(locBuffer,','));
|
||||
locFilterManager := GetDataFilterRegistry();
|
||||
if not locFilterManager.Find(locName,locFilter) then
|
||||
raise EServiceExtensionException.CreateFmt(SERR_DataFilterNotFound,[locName]);
|
||||
locPM := locFilter.GetPropertyManager();
|
||||
while True do begin
|
||||
locName := GetToken(locBuffer,'>');
|
||||
if IsStrEmpty(locName) then
|
||||
Break;
|
||||
locValue := GetToken(locBuffer,',');
|
||||
locPM.SetProperty(locName,locValue);
|
||||
end;
|
||||
FFilter := locFilter;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GetServiceExtensionRegistry().Register(
|
||||
'TFilterExtension',
|
||||
TSimpleItemFactory.Create(TFilterExtension) as IItemFactory
|
||||
);
|
||||
|
||||
end.
|
||||
@ -22,7 +22,8 @@ uses
|
||||
const
|
||||
sREMOTE_IP = 'RemoteIP';
|
||||
sREMOTE_PORT = 'RemotePort';
|
||||
|
||||
sSERVICES_EXTENSIONS = 'extensions';
|
||||
|
||||
type
|
||||
|
||||
IRequestBuffer = interface;
|
||||
@ -73,6 +74,7 @@ type
|
||||
- IFormatterResponse on "msAfterDeserialize", "msBeforeSerialize"
|
||||
}
|
||||
);
|
||||
function GetPropertyManager():IPropertyManager;
|
||||
end;
|
||||
|
||||
IServiceExtensionRegistry = Interface
|
||||
@ -99,10 +101,14 @@ type
|
||||
['{23A745BC-5F63-404D-BF53-55A6E64DE5BE}']
|
||||
procedure RegisterExtension(
|
||||
const AExtensionList : array of string
|
||||
);
|
||||
); overload;
|
||||
function GetExtension(
|
||||
out AExtensionList : string
|
||||
) : Boolean;
|
||||
procedure RegisterExtension(
|
||||
const AExtension : string;
|
||||
const AInitString : string
|
||||
); overload;
|
||||
end;
|
||||
|
||||
IServiceImplementationRegistry = Interface
|
||||
@ -198,10 +204,14 @@ type
|
||||
procedure ReleaseInstance(const AInstance : IInterface);override;
|
||||
procedure RegisterExtension(
|
||||
const AExtensionList : array of string
|
||||
);
|
||||
); overload;
|
||||
function GetExtension(
|
||||
out AExtensionList : string
|
||||
) : Boolean;
|
||||
procedure RegisterExtension(
|
||||
const AExtension : string;
|
||||
const AInitString : string
|
||||
); overload;
|
||||
end;
|
||||
|
||||
|
||||
@ -539,14 +549,16 @@ procedure TBaseServiceBinder.DoProcessMessage(
|
||||
AMsgData : IInterface
|
||||
);
|
||||
var
|
||||
s : string;
|
||||
s, extInitString : string;
|
||||
ls : TStringList;
|
||||
i : Integer;
|
||||
exreg : IServiceExtensionRegistry;
|
||||
se : IServiceExtension;
|
||||
pm : IPropertyManager;
|
||||
begin
|
||||
exreg := GetServiceExtensionRegistry();
|
||||
if FImplementationFactory.GetExtension(s) then begin
|
||||
pm := FImplementationFactory.GetPropertyManager(sSERVICES_EXTENSIONS,True);
|
||||
ls := TStringList.Create();
|
||||
try
|
||||
ls.QuoteChar := #0;
|
||||
@ -555,8 +567,12 @@ begin
|
||||
for i := 0 to Pred(ls.Count) do begin
|
||||
s := ls[i];
|
||||
se := exreg.Find(s);
|
||||
if Assigned(se) then
|
||||
if Assigned(se) then begin
|
||||
extInitString := pm.GetProperty(s);
|
||||
if ( Length(extInitString) > 0 ) then
|
||||
se.GetPropertyManager().SetProperties(extInitString);
|
||||
se.ProcessMessage(AMessageStage,ACallContext,AMsgData);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
ls.Free();
|
||||
@ -700,7 +716,8 @@ end;
|
||||
|
||||
|
||||
{ TImplementationFactory }
|
||||
const sSERVICES_EXTENSIONS = 'extensions';sLIST = 'list';
|
||||
const
|
||||
sLIST = 'list';
|
||||
|
||||
procedure TImplementationFactory.ReleaseInstance(const AInstance : IInterface);
|
||||
var
|
||||
@ -720,25 +737,54 @@ procedure TImplementationFactory.RegisterExtension(
|
||||
const AExtensionList : array of string
|
||||
);
|
||||
var
|
||||
pmngr : IPropertyManager;
|
||||
i : Integer;
|
||||
strBuffer, s : string;
|
||||
begin
|
||||
if ( Length(AExtensionList) > 0 ) then begin
|
||||
pmngr := GetPropertyManager(sSERVICES_EXTENSIONS,True);
|
||||
strBuffer := '';
|
||||
for i := Low(AExtensionList) to High(AExtensionList) do begin
|
||||
s := Trim(AExtensionList[i]);
|
||||
if ( Length(s) > 0 ) then
|
||||
strBuffer := strBuffer + ';' + s;
|
||||
for i := Low(AExtensionList) to High(AExtensionList) do
|
||||
RegisterExtension(AExtensionList[i],'');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TImplementationFactory.RegisterExtension(
|
||||
const AExtension : string;
|
||||
const AInitString : string
|
||||
);
|
||||
|
||||
function IsIn(const AList, AItem : string) : Boolean;
|
||||
var
|
||||
ls : TStringList;
|
||||
begin
|
||||
ls := TStringList.Create();
|
||||
try
|
||||
ls.QuoteChar := #0;
|
||||
ls.Delimiter := PROP_LIST_DELIMITER;
|
||||
ls.DelimitedText := AList;
|
||||
Result := ( ls.IndexOf(AItem) >= 0 );
|
||||
finally
|
||||
ls.Free();
|
||||
end;
|
||||
if ( Length(strBuffer) > 0 ) then begin
|
||||
s:= Trim(pmngr.GetProperty(sLIST));
|
||||
end;
|
||||
|
||||
var
|
||||
pmngr : IPropertyManager;
|
||||
strBuffer, s : string;
|
||||
wasExistent : Boolean;
|
||||
begin
|
||||
strBuffer := Trim(AExtension);
|
||||
if ( Length(strBuffer) > 0 ) then begin
|
||||
pmngr := GetPropertyManager(sSERVICES_EXTENSIONS,True);
|
||||
s := Trim(pmngr.GetProperty(sLIST));
|
||||
wasExistent := IsIn(s,strBuffer);
|
||||
if ( Length(s) = 0 ) or ( not wasExistent ) then begin
|
||||
if ( Length(s) = 0 ) then
|
||||
Delete(strBuffer,1,1);
|
||||
s := s + strBuffer;
|
||||
s := strBuffer
|
||||
else
|
||||
s := Format('%s;%s',[s,strBuffer]);
|
||||
pmngr.SetProperty(sLIST,s);
|
||||
end;
|
||||
s := Trim(AInitString);
|
||||
if wasExistent or ( Length(s) > 0 ) then
|
||||
pmngr.SetProperty(strBuffer,s);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@
|
||||
{$INCLUDE wst_global.inc}
|
||||
unit synapse_http_protocol;
|
||||
|
||||
//{$DEFINE WST_DBG}
|
||||
{$DEFINE WST_DBG}
|
||||
|
||||
interface
|
||||
|
||||
|
||||
@ -19,9 +19,10 @@ interface
|
||||
const
|
||||
sWST_SIGNATURE = 'WST_METADATA_0.6';
|
||||
|
||||
resourcestring
|
||||
SERR_CannotMakeInternalSymbolName ='Unable to make an internal symbol Name from "%s".';
|
||||
resourcestring
|
||||
SERR_CannotMakeInternalSymbolName ='Unable to make an internal symbol Name from "%s".';
|
||||
SERR_CannotResolveNamespace = 'Unable to resolve this namespace : "%s".';
|
||||
SERR_DataFilterNotFound = 'Data Filter not found : "%s".';
|
||||
SERR_DuplicateBindingName = 'Duplicated binding : "%s".';
|
||||
SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".';
|
||||
SERR_FailedTransportRequest = '%s Request to %s failed.';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user