mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 08:09:33 +02:00
+ Implemented named pipe communication for windows.
git-svn-id: trunk@17568 -
This commit is contained in:
michael
parent
d5a221f6e8
commit
e06adfc73b
@ -25,7 +25,7 @@ uses
|
||||
{$ifdef unix}
|
||||
BaseUnix, TermIO,
|
||||
{$else}
|
||||
winsock2,
|
||||
winsock2, windows,
|
||||
{$endif}
|
||||
Sockets, custweb, custcgi, fastcgi;
|
||||
|
||||
@ -40,6 +40,8 @@ Type
|
||||
TProtocolOptions = Set of TProtocolOption;
|
||||
|
||||
TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
|
||||
TFastCGIReadEvent = Function (AHandle : THandle; Var ABuf; ACount : Integer) : Integer of Object;
|
||||
TFastCGIWriteEvent = Function (AHandle : THandle; Const ABuf; ACount : Integer) : Integer of Object;
|
||||
|
||||
TFCGIRequest = Class(TCGIRequest)
|
||||
Private
|
||||
@ -70,6 +72,7 @@ Type
|
||||
TFCGIResponse = Class(TCGIResponse)
|
||||
private
|
||||
FPO: TProtoColOptions;
|
||||
FOnWrite : TFastCGIWriteEvent;
|
||||
Protected
|
||||
procedure Write_FCGIRecord(ARecord : PFCGI_Header); virtual;
|
||||
Procedure DoSendHeaders(Headers : TStrings); override;
|
||||
@ -98,9 +101,16 @@ Type
|
||||
FAddress: string;
|
||||
FTimeOut,
|
||||
FPort: integer;
|
||||
{$ifdef windows}
|
||||
FIsWinPipe: Boolean;
|
||||
{$endif}
|
||||
function AcceptConnection: Integer;
|
||||
procedure CloseConnection;
|
||||
function Read_FCGIRecord : PFCGI_Header;
|
||||
function DataAvailable : Boolean;
|
||||
protected
|
||||
Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
|
||||
Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
|
||||
function ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean; virtual;
|
||||
procedure SetupSocket(var IAddress: TInetSockAddr; var AddressLength: tsocklen); virtual;
|
||||
function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
|
||||
@ -348,7 +358,7 @@ begin
|
||||
BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header);
|
||||
P:=PByte(Arecord);
|
||||
Repeat
|
||||
BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, P, BytesToWrite, NoSignalAttr);
|
||||
BytesWritten:=FOnWrite(TFCGIRequest(Request).Handle, P^, BytesToWrite);
|
||||
If (BytesWritten<0) then
|
||||
begin
|
||||
// TODO : Better checking for closed connection, EINTR
|
||||
@ -478,10 +488,37 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
|
||||
|
||||
procedure TFCgiHandler.CloseConnection;
|
||||
Var
|
||||
i : Integer;
|
||||
begin
|
||||
{$ifdef windows}
|
||||
if FIsWinPipe then
|
||||
begin
|
||||
if not FlushFileBuffers(FHandle) then
|
||||
begin
|
||||
I:=GetLastError;
|
||||
// Log(etError,Format('Failed to flush file buffers: %d ',[i]));
|
||||
end;
|
||||
if not DisconnectNamedPipe(FHandle) then
|
||||
begin
|
||||
I:=GetLastError;
|
||||
// Log(etError,Format('Failed to disconnect named pipe: %d ',[i]));
|
||||
end
|
||||
end
|
||||
else
|
||||
{$endif}
|
||||
begin
|
||||
i:=fpshutdown(FHandle,SHUT_RDWR);
|
||||
// Log(etError,Format('Shutting down socket: %d ',[i]));
|
||||
i:=CloseSocket(FHandle);
|
||||
// Log(etError,Format('Closing socket %d',[i]));
|
||||
end;
|
||||
FHandle := THandle(-1);
|
||||
end;
|
||||
|
||||
procedure TFCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
|
||||
|
||||
|
||||
begin
|
||||
with FRequestsArray[TFCGIRequest(ARequest).RequestID] do
|
||||
@ -489,13 +526,7 @@ begin
|
||||
Assert(ARequest=Request);
|
||||
Assert(AResponse=Response);
|
||||
if (not TFCGIRequest(ARequest).KeepConnectionAfterRequest) then
|
||||
begin
|
||||
i:=fpshutdown(FHandle,SHUT_RDWR);
|
||||
// Log(etDebug,Format('Shutting down socket: %d ',[i]));
|
||||
i:=CloseSocket(FHandle);
|
||||
// Log(etDebug,Format('Closing socket %d',[i]));
|
||||
FHandle := THandle(-1);
|
||||
end;
|
||||
CloseConnection;
|
||||
Request := Nil;
|
||||
Response := Nil;
|
||||
end;
|
||||
@ -539,7 +570,7 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
|
||||
P:=ReadBuf;
|
||||
if (ByteAmount=0) then exit;
|
||||
Repeat
|
||||
Count:=sockets.fpRecv(FHandle, P, ByteAmount, NoSignalAttr);
|
||||
Count:=DoFastCGIRead(FHandle,P^,ByteAmount);
|
||||
If (Count>0) then
|
||||
begin
|
||||
Dec(ByteAmount,Count);
|
||||
@ -681,6 +712,27 @@ begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
function TFCgiHandler.DoFastCGIRead(AHandle: THandle; var ABuf; ACount: Integer): Integer;
|
||||
begin
|
||||
{$ifdef windows}
|
||||
if FIsWinPipe then
|
||||
Result:=FileRead(FHandle,ABuf,ACount)
|
||||
else
|
||||
{$endif}
|
||||
Result:=sockets.fpRecv(FHandle, @Abuf, ACount, NoSignalAttr);
|
||||
end;
|
||||
|
||||
function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
|
||||
ACount: Integer): Integer;
|
||||
begin
|
||||
{$ifdef windows}
|
||||
if FIsWinPipe then
|
||||
Result := FileWrite(AHandle, ABuf, ACount)
|
||||
else
|
||||
{$endif windows}
|
||||
Result := sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
|
||||
end;
|
||||
|
||||
function TFCgiHandler.ProcessRecord(AFCGI_Record : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
|
||||
|
||||
var
|
||||
@ -716,11 +768,45 @@ begin
|
||||
ARequest:=FRequestsArray[ARequestID].Request;
|
||||
FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
|
||||
FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
|
||||
FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;
|
||||
AResponse:=FRequestsArray[ARequestID].Response;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFCgiHandler.AcceptConnection : Integer;
|
||||
|
||||
Var
|
||||
B : BOOL;
|
||||
{$ifdef windows}
|
||||
pipeMode : DWORD = PIPE_READMODE_BYTE or PIPE_WAIT;
|
||||
i : integer;
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
{$ifndef windows}
|
||||
Result:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
|
||||
{$else}
|
||||
if Not fIsWinPipe then
|
||||
Result:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
|
||||
If FIsWinPipe or ((Result<0) and (socketerror=10038)) then
|
||||
begin
|
||||
B:=ConnectNamedPipe(Socket,Nil);
|
||||
if B or (GetLastError=ERROR_PIPE_CONNECTED) then
|
||||
begin
|
||||
Result:=Socket;
|
||||
if Not FIsWinPipe then // First time, set handle state
|
||||
if not SetNamedPipeHandleState(Result,@PipeMode,Nil,Nil) then
|
||||
begin
|
||||
I:=GetLastError;
|
||||
// Log(etError,'Setting named pipe handle state failed : '+intToStr(i));
|
||||
end;
|
||||
FIsWinPipe:=True;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
|
||||
|
||||
var
|
||||
@ -735,14 +821,12 @@ begin
|
||||
SetupSocket(FIAddress,FAddressLength)
|
||||
else
|
||||
Socket:=StdInputHandle;
|
||||
if FHandle=THandle(-1) then
|
||||
FHandle:=AcceptConnection;
|
||||
if FHandle=THandle(-1) then
|
||||
begin
|
||||
FHandle:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
|
||||
if FHandle=THandle(-1) then
|
||||
begin
|
||||
Terminate;
|
||||
raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
|
||||
end;
|
||||
Terminate;
|
||||
raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
|
||||
end;
|
||||
repeat
|
||||
If (poUseSelect in ProtocolOptions) then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user