+Client side HTTP Cookie management,

+TBaseProxy implements IServiceProtocol to expose its serializer and transport
+TBaseTransport unimplemented methods now throw exception
+"Filter" implementation for synapse

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1312 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/client_utils.pas

@@ -21,6 +21,9 @@ uses
 Type
 
 {$M+}
+  
+  { TBaseTransport }
+
   TBaseTransport = class(TSimpleFactoryItem,ITransport)
   Private
     FPropMngr : IPropertyManager;
@@ -36,7 +39,8 @@ Type
     constructor Create();override;
     destructor Destroy();override;
     function GetPropertyManager():IPropertyManager;
-    procedure SendAndReceive(ARequest,AResponse:TStream); virtual; abstract;
+    procedure SendAndReceive(ARequest,AResponse:TStream); virtual; 
+    function GetCookieManager() : ICookieManager; virtual; 
   published
     property FilterString : string read GetFilterString write SetFilterString;
   End;
@@ -61,6 +65,16 @@ begin
   inherited;
 end;
 
+procedure TBaseTransport.SendAndReceive(ARequest, AResponse : TStream); 
+begin
+  raise ETransportExecption.CreateFmt(SERR_UnsupportedOperation,['SendAndReceive']);
+end;
+
+function TBaseTransport.GetCookieManager() : ICookieManager; 
+begin
+  raise ETransportExecption.CreateFmt(SERR_UnsupportedOperation,['GetCookieManager']);
+end;
+
 procedure TBaseTransport.FilterInput(ASource, ADest: TStream);
 var
   locInBuffer, locBuffer : TByteDynArray;
@@ -140,7 +154,7 @@ begin
   Result := locRes;
 end;
 
-function TBaseTransport.GetPropertyManager: IPropertyManager;
+function TBaseTransport.GetPropertyManager() : IPropertyManager;
 begin
   Result := FPropMngr;
 end;

wst/trunk/indy_http_protocol.pas

@@ -13,20 +13,38 @@
 {$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, filter_intf,
+  service_intf, imp_utils, base_service_intf, wst_types,
-  client_utils, IdHTTP;
+  client_utils, IdHTTP, IdCookie;
 
 Const
   sTRANSPORT_NAME = 'HTTP';
 
 Type
 
+  { TIndyCookieManager }
+
+  TIndyCookieManager = class(TInterfacedObject,ICookieManager)
+  private
+    FReferencedObject : TIdCookies;
+  protected
+    property ReferencedObject : TIdCookies read FReferencedObject;
+  protected  
+    function GetCount() : Integer;
+    function GetName(const AIndex : Integer) : string;
+    function GetValue(const AIndex : Integer) : string; overload;
+    function GetValue(const AName : string) : string; overload;
+    procedure SetValue(const AIndex : Integer; const AValue : string); overload;
+    procedure SetValue(const AName : string; const AValue : string); overload;
+  public
+    constructor Create(AReferencedObject : TIdCookies);
+  end; 
+  
   { THTTPTransport }
   THTTPTransport = class(TBaseTransport,ITransport)
   Private
@@ -34,6 +52,7 @@ Type
     FConnection : TidHttp;
     FSoapAction: string;
     FContentType: string;
+    FCookieManager : ICookieManager;  
   private
     function GetAddress: string;
     function GetProtocolVersion : string;
@@ -51,6 +70,7 @@ Type
     constructor Create();override;
     destructor Destroy();override;
     procedure SendAndReceive(ARequest,AResponse:TStream); override;
+    function GetCookieManager() : ICookieManager; override;        
   published
     property ContentType : string Read FContentType Write FContentType;
     property Address : string Read GetAddress Write SetAddress;
@@ -223,10 +243,78 @@ begin
   {$ENDIF WST_DBG}
 end;
 
+function THTTPTransport.GetCookieManager() : ICookieManager;  
+begin  
+  if (FCookieManager = nil) then
+    FCookieManager := TIndyCookieManager.Create(FConnection.CookieManager.CookieCollection);
+  Result := FCookieManager;    
+end;
+
 procedure INDY_RegisterHTTP_Transport();
 begin
   GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory);
 end;
 
 
+{ TIndyCookieManager }
+
+function TIndyCookieManager.GetCount() : Integer; 
+begin
+  Result := ReferencedObject.Count;
+end;
+
+function TIndyCookieManager.GetName(const AIndex : Integer) : string; 
+begin
+  Result := ReferencedObject[AIndex].CookieName;
+end;
+
+function TIndyCookieManager.GetValue(const AIndex : Integer) : string; 
+begin
+  Result := ReferencedObject[AIndex].Value;
+end;
+
+function TIndyCookieManager.GetValue(const AName : string) : string; 
+var
+  i : Integer;
+begin       
+  i := ReferencedObject.GetCookieIndex(0,AName);
+  if (i >= 0) then
+    Result := ReferencedObject[i].Value
+  else
+    Result := '';
+end;
+
+procedure TIndyCookieManager.SetValue(
+  const AIndex : Integer;  
+  const AValue : string
+); 
+begin
+  ReferencedObject[AIndex].Value := AValue; 
+end;
+
+procedure TIndyCookieManager.SetValue(
+  const AName : string;  
+  const AValue : string
+); 
+var
+  i : Integer;
+  locItem : TIdNetscapeCookie;
+begin
+  i := ReferencedObject.GetCookieIndex(0,AName);  
+  if (i >= 0) then begin
+    ReferencedObject[i].Value := AValue;
+  end else begin
+    locItem := ReferencedObject.Add();
+    locItem.CookieName := AName;
+    locItem.Value := AValue;
+  end;
+end;
+
+constructor TIndyCookieManager.Create(AReferencedObject : TIdCookies); 
+begin
+  if (AReferencedObject = nil) then
+    raise ETransportExecption.CreateFmt(SERR_InvalidParameter,['AReferencedObject']); 
+  FReferencedObject := AReferencedObject;
+end;
+
 end.

wst/trunk/library_protocol.pas

@@ -20,7 +20,7 @@ interface
 uses
   Classes, SysUtils,
   service_intf, imp_utils, base_service_intf, library_base_intf,
-  library_imp_utils, wst_types;
+  library_imp_utils, wst_types, client_utils;
 
 const
   sTRANSPORT_NAME = 'LIB';
@@ -29,24 +29,22 @@ Type
 
 {$M+}
   { TLIBTransport }
-  TLIBTransport = class(TSimpleFactoryItem,ITransport)
+  TLIBTransport = class(TBaseTransport,ITransport)
   Private
-    FPropMngr : IPropertyManager;
     FModule : IwstModule;
     FHandler : TwstLibraryHandlerFunction;
   private
     FContentType: string;
     FFileName: string;
     FTarget: string;
-  private
     FFormat : string;
+  private
     procedure SetFileName(const AValue: string);
     procedure LoadModule();
   public
     constructor Create();override;
     destructor Destroy();override;
-    function GetPropertyManager():IPropertyManager;
+    procedure SendAndReceive(ARequest,AResponse:TStream); override;
-    procedure SendAndReceive(ARequest,AResponse:TStream);
   published
     property ContentType : string read FContentType write FContentType;
     property Target : string read FTarget write FTarget;
@@ -82,24 +80,17 @@ end;
 constructor TLIBTransport.Create();
 begin
   inherited Create();
-  FPropMngr := TPublishedPropertyManager.Create(Self);
   FModule := nil;
   FHandler := nil
 end;
 
 destructor TLIBTransport.Destroy();
 begin
-  FPropMngr := Nil;
   FModule := nil;
   FHandler := nil;
   inherited Destroy();
 end;
 
-function TLIBTransport.GetPropertyManager(): IPropertyManager;
-begin
-  Result := FPropMngr;
-end;
-
 const MAX_ERR_LEN = 500;
 procedure TLIBTransport.SendAndReceive(ARequest, AResponse: TStream);
 Var

wst/trunk/service_intf.pas

@@ -26,10 +26,21 @@ Const
   
 Type
 
+  ICookieManager = interface
+    ['{C04EFE37-A6BA-409E-9D9C-25836938858F}']
+    function GetCount() : Integer;
+    function GetName(const AIndex : Integer) : string;
+    function GetValue(const AIndex : Integer) : string; overload;
+    function GetValue(const AName : string) : string; overload;
+    procedure SetValue(const AIndex : Integer; const AValue : string); overload;
+    procedure SetValue(const AName : string; const AValue : string); overload;
+  end;
+  
   ITransport = Interface
     ['{AEB6677A-9620-4E7D-82A0-43E3C4C52B43}']
     function GetPropertyManager():IPropertyManager;
     procedure SendAndReceive(ARequest,AResponse:TStream);
+    function GetCookieManager() : ICookieManager;
   End;
 
   //The client formater interface, used to marshall parameters.
@@ -72,7 +83,7 @@ Type
 
   { TBaseProxy }
   (* The base class for service proxy *)
-  TBaseProxy = Class(TInterfacedObject,IInterface,ICallContext)
+  TBaseProxy = Class(TInterfacedObject,IInterface,ICallContext,IServiceProtocol)
   private
     FTarget : String;
     FProtocol : IServiceProtocol;
@@ -81,9 +92,10 @@ Type
     procedure LoadProperties();
   protected
     function GetTarget():String;{$IFDEF USE_INLINE}inline;{$ENDIF}
-    function GetSerializer() : IFormatterClient;{$IFDEF USE_INLINE}inline;{$ENDIF}
+    function GetSerializer() : IFormatterClient;
-    function GetCallHandler() : ICallMaker;{$IFDEF USE_INLINE}inline;{$ENDIF}
+    function GetCallHandler() : ICallMaker;
-    function GetTransport() : ITransport;{$IFDEF USE_INLINE}inline;{$ENDIF}
+    function GetTransport() : ITransport;
+    procedure SetTransport(AValue : ITransport);  
     procedure MakeCall();
     class function GetServiceType() : PTypeInfo;virtual;abstract;
 
@@ -225,6 +237,11 @@ begin
   Result := FProtocol.GetTransport();
 end;
 
+procedure TBaseProxy.SetTransport(AValue : ITransport); 
+begin
+  FProtocol.SetTransport(AValue);
+end;
+
 procedure TBaseProxy.MakeCall();
 var
   trans : ITransport;

wst/trunk/synapse_http_protocol.pas

@@ -13,13 +13,13 @@
 {$INCLUDE wst_global.inc}
 unit synapse_http_protocol;
 
-{$DEFINE WST_DBG}
+//{$DEFINE WST_DBG}
 
 interface
 
 uses
   Classes, SysUtils,{$IFDEF WST_DBG}Dialogs,{$ENDIF}
-  wst_types, service_intf, imp_utils, base_service_intf,
+  wst_types, service_intf, imp_utils, base_service_intf, client_utils,
   httpsend;
 
 Const
@@ -27,16 +27,34 @@ Const
 
 Type
 
+  { TSynapseCookieManager }
+
+  TSynapseCookieManager = class(TInterfacedObject,ICookieManager)
+  private
+    FReferencedObject : TStrings;
+  protected
+    property ReferencedObject : TStrings read FReferencedObject;
+  protected  
+    function GetCount() : Integer;
+    function GetName(const AIndex : Integer) : string;
+    function GetValue(const AIndex : Integer) : string; overload;
+    function GetValue(const AName : string) : string; overload;
+    procedure SetValue(const AIndex : Integer; const AValue : string); overload;
+    procedure SetValue(const AName : string; const AValue : string); overload;
+  public
+    constructor Create(AReferencedObject : TStrings);
+  end;
+  
 {$M+}
   { THTTPTransport }
-  THTTPTransport = class(TSimpleFactoryItem,ITransport)
+  THTTPTransport = class(TBaseTransport,ITransport)
   Private
-    FPropMngr : IPropertyManager;
     FConnection : THTTPSend;
     FAddress : string;
-  private
     FFormat : string;
     FSoapAction: string;
+    FCookieManager : ICookieManager; 
+  private  
     function GetAddress: string;
     function GetContentType: string;
     function GetProxyPassword: string;
@@ -52,8 +70,8 @@ Type
   Public
     constructor Create();override;
     destructor Destroy();override;
-    function GetPropertyManager():IPropertyManager;
+    procedure SendAndReceive(ARequest,AResponse:TStream); override;
-    procedure SendAndReceive(ARequest,AResponse:TStream);
+    function GetCookieManager() : ICookieManager; override;
   Published
     property ContentType : string Read GetContentType Write SetContentType;
     property Address : string Read GetAddress Write SetAddress;
@@ -137,7 +155,6 @@ end;
 constructor THTTPTransport.Create();
 begin
   inherited Create();
-  FPropMngr := TPublishedPropertyManager.Create(Self);
   FConnection := THTTPSend.Create();
   FConnection.Protocol := '1.1';
 end;
@@ -145,15 +162,9 @@ 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}
   procedure Display(const AStr : string);
@@ -163,20 +174,45 @@ procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
     {else
       ShowMessage(AStr)};
   end;
-
+{$ENDIF WST_DBG}
 var
+{$IFDEF WST_DBG}
   s : TBinaryString;
-{$ENDIF}
+{$ENDIF WST_DBG}
+  locTempStream, locTempRes : TMemoryStream;
 begin
 {$IFDEF WST_DBG}
   TMemoryStream(ARequest).SaveToFile('request-1.log');
 {$ENDIF}
   FConnection.Document.Size := 0;
   FConnection.Headers.Add('soapAction:' + SoapAction);
-  FConnection.Document.CopyFrom(ARequest,0);
+  if not HasFilter() then begin
-  if not FConnection.HTTPMethod('POST',FAddress) then
+    FConnection.Document.CopyFrom(ARequest,0);
-    raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
+    if not FConnection.HTTPMethod('POST',FAddress) then
-  AResponse.CopyFrom(FConnection.Document,0);
+      raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
+    AResponse.CopyFrom(FConnection.Document,0);
+  end else begin
+    locTempRes := nil;
+    locTempStream := TMemoryStream.Create();
+    try
+      FilterInput(ARequest,locTempStream);
+{$IFDEF WST_DBG}
+      TMemoryStream(locTempStream).SaveToFile('request.log.wire');
+{$ENDIF WST_DBG}
+      FConnection.Document.CopyFrom(locTempStream,0);
+      if not FConnection.HTTPMethod('POST',FAddress) then
+        raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
+      locTempRes := TMemoryStream.Create();
+      locTempRes.CopyFrom(FConnection.Document,0);
+  {$IFDEF WST_DBG}
+      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
+  {$ENDIF WST_DBG}
+      FilterOutput(locTempRes,AResponse);
+    finally
+      locTempRes.Free();
+      locTempStream.Free();
+    end;
+  end;
   FConnection.Clear();
 {$IFDEF WST_DBG}
   TMemoryStream(ARequest).SaveToFile('request.log');
@@ -190,9 +226,61 @@ begin
 {$ENDIF}
 end;
 
+function THTTPTransport.GetCookieManager() : ICookieManager; 
+begin
+  if (FCookieManager = nil) then
+    FCookieManager := TSynapseCookieManager.Create(FConnection.Cookies);
+  Result := FCookieManager;
+end;
+
 procedure SYNAPSE_RegisterHTTP_Transport();
 begin
   GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory);
 end;
 
+{ TSynapseCookieManager }
+
+function TSynapseCookieManager.GetCount() : Integer; 
+begin
+  Result := ReferencedObject.Count;
+end;
+
+function TSynapseCookieManager.GetName(const AIndex : Integer) : string; 
+begin
+  Result := ReferencedObject.Names[AIndex];
+end;
+
+function TSynapseCookieManager.GetValue(const AIndex : Integer) : string; 
+begin
+  Result := ReferencedObject.ValueFromIndex[AIndex];
+end;
+
+function TSynapseCookieManager.GetValue(const AName : string) : string; 
+begin
+  Result := ReferencedObject.Values[AName];
+end;
+
+procedure TSynapseCookieManager.SetValue(
+  const AIndex : Integer;  
+  const AValue : string
+); 
+begin
+  ReferencedObject.ValueFromIndex[AIndex] := AValue;
+end;
+
+procedure TSynapseCookieManager.SetValue(
+  const AName : string;  
+  const AValue : string
+); 
+begin
+  ReferencedObject.Values[AName] := AValue;
+end;
+
+constructor TSynapseCookieManager.Create(AReferencedObject : TStrings); 
+begin
+  if (AReferencedObject = nil) then
+    raise ETransportExecption.CreateFmt(SERR_InvalidParameter,['AReferencedObject']); 
+  FReferencedObject := AReferencedObject;
+end;
+
 end.

wst/trunk/synapse_tcp_protocol.pas

@@ -17,7 +17,7 @@ interface
 
 uses
   Classes, SysUtils,
-  service_intf, imp_utils, base_service_intf,
+  service_intf, imp_utils, base_service_intf, client_utils,
   blcksock;
 
 //{$DEFINE WST_DBG}
@@ -32,10 +32,9 @@ Type
   
 {$M+}
   { TTCPTransport }
-  TTCPTransport = class(TSimpleFactoryItem,ITransport)
+  TTCPTransport = class(TBaseTransport,ITransport)
   Private
     FFormat : string;
-    FPropMngr : IPropertyManager;
     FConnection : TTCPBlockSocket;
     FContentType : string;
     FTarget: string;
@@ -47,8 +46,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;
@@ -89,7 +87,7 @@ end;
 
 constructor TTCPTransport.Create();
 begin
-  FPropMngr := TPublishedPropertyManager.Create(Self);
+  inherited Create();
   FConnection := TTCPBlockSocket.Create();
   FConnection.RaiseExcept := True;
   FDefaultTimeOut := 90000;
@@ -98,23 +96,47 @@ 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);
+
+  procedure ReadResponse(ADest : TStream);
+  var
+    bufferLen : LongInt;
+    i, j, c : PtrInt;
+    locBinBuff : TByteDynArray;
+  begin
+    bufferLen := 0;
+    FConnection.RecvBufferEx(@bufferLen,SizeOf(bufferLen),DefaultTimeOut);
+    FConnection.ExceptCheck();
+    bufferLen := Reverse_32(bufferLen);
+    ADest.Size := bufferLen;
+    if ( bufferLen > 0 ) then begin
+      c := 0;
+      i := 1024;
+      if ( i > bufferLen ) then
+        i := bufferLen;
+      SetLength(locBinBuff,i);
+      repeat
+        j := FConnection.RecvBufferEx(@(locBinBuff[0]),i,DefaultTimeOut);
+        FConnection.ExceptCheck();
+        ADest.Write(locBinBuff[0],j);
+        Inc(c,j);
+        i := Min(1024,(bufferLen-c));
+      until ( i =0 ) or ( j <= 0 );
+    end;
+    ADest.Position := 0;
+  end;
+
 Var
   wrtr : IDataStore;
   buffStream : TMemoryStream;
   binBuff : TByteDynArray;
-  bufferLen : LongInt;
+  locTempStream, locTempRes : TMemoryStream;
-  i, j, c : PtrInt;
 begin
+  locTempStream := nil;
+  locTempRes := nil;
   buffStream := TMemoryStream.Create();
   Try
     wrtr := CreateBinaryWriter(buffStream);
@@ -122,42 +144,46 @@ 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);
+    buffStream.Position := 0;
 
-    //if ( FConnection.Socket = NOT(0) ) then
-      //FConnection.Connect(Address,Port);
     Connect();
     FConnection.SendBuffer(buffStream.Memory,buffStream.Size);
 
-    bufferLen := 0;
+    if not HasFilter() then begin
-    FConnection.RecvBufferEx(@bufferLen,SizeOf(bufferLen),DefaultTimeOut);
+      ReadResponse(AResponse);
-    FConnection.ExceptCheck();
+    end else begin
-    bufferLen := Reverse_32(bufferLen);
+      locTempRes := TMemoryStream.Create();
-    AResponse.Size := bufferLen;
+      ReadResponse(locTempRes);
-    if ( bufferLen > 0 ) then begin
+  {$IFDEF WST_DBG}
-      c := 0;
+      TMemoryStream(locTempRes).SaveToFile('response.log.wire');
-      i := 1024;
+  {$ENDIF WST_DBG}
-      if ( i > bufferLen ) then
+      FilterOutput(locTempRes,AResponse);
-        i := bufferLen;
-      SetLength(binBuff,i);
-      repeat
-        j := FConnection.RecvBufferEx(@(binBuff[0]),i,DefaultTimeOut);
-        FConnection.ExceptCheck();
-        AResponse.Write(binBuff[0],j);
-        Inc(c,j);
-        i := Min(1024,(bufferLen-c));
-      until ( i =0 ) or ( j <= 0 );
     end;
-    AResponse.Position := 0;
+
     {$IFDEF WST_DBG}
     TMemoryStream(AResponse).SaveToFile('response.log');
     {$ENDIF WST_DBG}
   Finally
+    locTempStream.Free();
+    locTempRes.Free();
     buffStream.Free();
   End;
 end;