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

wst/trunk/base_service_intf.pas

@@ -63,6 +63,7 @@ const
 type
 
   EServiceException = class(Exception) end;
+  EServiceExtensionException = class(Exception) end;
   ETransportExecption = class(EServiceException) end;
 
   EBaseRemoteException = class(EServiceException)

wst/trunk/client_utils.pas

@@ -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.

wst/trunk/filter_intf.pas

@@ -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.

wst/trunk/indy_http_protocol.pas

@@ -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,
+  service_intf, imp_utils, base_service_intf, wst_types, filter_intf,
-  IdHTTP;
+  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); override;
-    procedure SendAndReceive(ARequest,AResponse:TStream);
+  published
-  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;
+      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
-  SetLength(s,i);
+  {$ENDIF WST_DBG}
-  Move(TMemoryStream(AResponse).Memory^,s[1],i);
+      FilterOutput(locTempRes,AResponse);
-  WriteLn('--------------------------------------------');
+    finally
-  WriteLn(s);
+      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.

wst/trunk/indy_tcp_protocol.pas

@@ -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); override;
-    procedure SendAndReceive(ARequest,AResponse:TStream);
   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);
+    if not HasFilter() then begin
-    ARequest.Position := 0;
+      SetLength(binBuff,ARequest.Size);
-    ARequest.Read(binBuff[0],Length(binBuff));
+      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 not HasFilter() then begin
-    if ( bufferLen > 0 ) then begin
+      AResponse.Size := bufferLen;
-      AResponse.Position := 0;
+      if ( bufferLen > 0 ) then begin
-      FConnection.IOHandler.ReadStream(AResponse,bufferLen,False);
+        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;

wst/trunk/indy_tcp_server.pas

@@ -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;

wst/trunk/logger_extension.pas

@@ -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.

wst/trunk/server_filter_extension.pas

@@ -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.

wst/trunk/server_service_intf.pas

@@ -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);
+    for i := Low(AExtensionList) to High(AExtensionList) do
-    strBuffer := '';
+      RegisterExtension(AExtensionList[i],'');
-    for i := Low(AExtensionList) to High(AExtensionList) do begin
+  end;
-      s := Trim(AExtensionList[i]);
+end;
-      if ( Length(s) > 0 ) then
+
-        strBuffer := strBuffer + ';' + s;
+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
+  end;
-      s:= Trim(pmngr.GetProperty(sLIST));
+
+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 := strBuffer
-      s := 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;
 

wst/trunk/synapse_http_protocol.pas

@@ -13,7 +13,7 @@
 {$INCLUDE wst_global.inc}
 unit synapse_http_protocol;
 
-//{$DEFINE WST_DBG}
+{$DEFINE WST_DBG}
 
 interface
 

wst/trunk/wst_consts.pas

@@ -19,9 +19,10 @@ interface
 const
   sWST_SIGNATURE = 'WST_METADATA_0.6';
 
-resourcestring  
+resourcestring
-  SERR_CannotMakeInternalSymbolName  ='Unable to make an internal symbol Name from "%s".';             
+  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.';