+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
This commit is contained in:
inoussa 2010-09-01 00:42:16 +00:00
parent e39994c6db
commit c9fc9311ef
6 changed files with 305 additions and 81 deletions

View File

@ -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;
@ -179,4 +193,4 @@ begin
FFilter := locFilter;
end;
end.
end.

View File

@ -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,
client_utils, IdHTTP;
service_intf, imp_utils, base_service_intf, wst_types,
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.

View File

@ -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);
procedure SendAndReceive(ARequest,AResponse:TStream); override;
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

View File

@ -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 GetCallHandler() : ICallMaker;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetTransport() : ITransport;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetSerializer() : IFormatterClient;
function GetCallHandler() : ICallMaker;
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;

View File

@ -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);
procedure SendAndReceive(ARequest,AResponse:TStream); override;
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 FConnection.HTTPMethod('POST',FAddress) then
raise ETransportExecption.CreateFmt(SERR_FailedTransportRequest,[sTRANSPORT_NAME,FAddress]);
AResponse.CopyFrom(FConnection.Document,0);
if not HasFilter() then begin
FConnection.Document.CopyFrom(ARequest,0);
if not FConnection.HTTPMethod('POST',FAddress) then
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.

View File

@ -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);
procedure SendAndReceive(ARequest,AResponse:TStream); override;
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;
i, j, c : PtrInt;
locTempStream, locTempRes : TMemoryStream;
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);
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);
buffStream.Position := 0;
//if ( FConnection.Socket = NOT(0) ) then
//FConnection.Connect(Address,Port);
Connect();
FConnection.SendBuffer(buffStream.Memory,buffStream.Size);
bufferLen := 0;
FConnection.RecvBufferEx(@bufferLen,SizeOf(bufferLen),DefaultTimeOut);
FConnection.ExceptCheck();
bufferLen := Reverse_32(bufferLen);
AResponse.Size := bufferLen;
if ( bufferLen > 0 ) then begin
c := 0;
i := 1024;
if ( i > bufferLen ) then
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 );
if not HasFilter() then begin
ReadResponse(AResponse);
end else begin
locTempRes := TMemoryStream.Create();
ReadResponse(locTempRes);
{$IFDEF WST_DBG}
TMemoryStream(locTempRes).SaveToFile('response.log.wire');
{$ENDIF WST_DBG}
FilterOutput(locTempRes,AResponse);
end;
AResponse.Position := 0;
{$IFDEF WST_DBG}
TMemoryStream(AResponse).SaveToFile('response.log');
{$ENDIF WST_DBG}
Finally
locTempStream.Free();
locTempRes.Free();
buffStream.Free();
End;
end;