mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:29:27 +02:00
* update lNet so latest fpc can compile it (property changes)
git-svn-id: trunk@7323 -
This commit is contained in:
Almindor
parent
73d861e3e9
commit
5736142382
@ -46,10 +46,8 @@ type
|
||||
|
||||
TLHandleEvent = procedure (aHandle: TLHandle) of object;
|
||||
TLHandleErrorEvent = procedure (aHandle: TLHandle; const msg: string) of object;
|
||||
TLEventerErrorCallback = procedure (const msg: string; Sender: TLEventer) of object;
|
||||
TLEventerErrorEvent = procedure (const msg: string; Sender: TLEventer) of object;
|
||||
|
||||
TArrayP = array of Pointer;
|
||||
|
||||
{ TLHandle }
|
||||
|
||||
TLHandle = class(TObject)
|
||||
@ -67,12 +65,12 @@ type
|
||||
FPrev: TLHandle;
|
||||
FNext: TLHandle;
|
||||
FFreeNext: TLHandle;
|
||||
FUserData: Pointer;
|
||||
FInternalData: Pointer;
|
||||
procedure SetIgnoreError(const aValue: Boolean);
|
||||
procedure SetIgnoreWrite(const aValue: Boolean);
|
||||
procedure SetIgnoreRead(const aValue: Boolean);
|
||||
public
|
||||
UserData: Pointer;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Free; virtual; // this is a trick
|
||||
@ -85,7 +83,6 @@ type
|
||||
property OnRead: TLHandleEvent read FOnRead write FOnRead;
|
||||
property OnWrite: TLHandleEvent read FOnWrite write FOnWrite;
|
||||
property OnError: TLHandleErrorEvent read FOnError write FOnError;
|
||||
property UserData: Pointer read FUserData write FUserData;
|
||||
property Dispose: Boolean read FDispose write FDispose;
|
||||
property Handle: THandle read FHandle write FHandle;
|
||||
property Eventer: TLEventer read FEventer;
|
||||
@ -138,7 +135,7 @@ type
|
||||
protected
|
||||
FRoot: TLHandle;
|
||||
FCount: Integer;
|
||||
FOnError: TLEventerErrorCallback;
|
||||
FOnError: TLEventerErrorEvent;
|
||||
FReferences: Integer;
|
||||
FFreeRoot: TLHandle; // the root of "free" list if any
|
||||
FFreeIter: TLHandle; // the last of "free" list if any
|
||||
@ -166,7 +163,7 @@ type
|
||||
procedure AddRef;
|
||||
procedure DeleteRef;
|
||||
property Timeout: DWord read GetTimeout write SetTimeout;
|
||||
property OnError: TLEventerErrorCallback read FOnError write FOnError;
|
||||
property OnError: TLEventerErrorEvent read FOnError write FOnError;
|
||||
property Count: Integer read FCount;
|
||||
end;
|
||||
TLEventerClass = class of TLEventer;
|
||||
@ -231,7 +228,7 @@ begin
|
||||
FOnRead := nil;
|
||||
FOnWrite := nil;
|
||||
FOnError := nil;
|
||||
FUserData := nil;
|
||||
UserData := nil;
|
||||
FEventer := nil;
|
||||
FPrev := nil;
|
||||
FNext := nil;
|
||||
|
||||
@ -33,6 +33,7 @@ uses
|
||||
|
||||
type
|
||||
TLHTTPMethod = (hmHead, hmGet, hmPost, hmUnknown);
|
||||
TLHTTPMethods = set of TLHTTPMethod;
|
||||
TLHTTPParameter = (hpConnection, hpContentLength, hpContentType,
|
||||
hpAccept, hpAcceptCharset, hpAcceptEncoding, hpAcceptLanguage, hpHost,
|
||||
hpFrom, hpReferer, hpUserAgent, hpRange, hpTransferEncoding,
|
||||
@ -338,9 +339,6 @@ type
|
||||
TLHTTPServerSocket = class(TLHTTPSocket)
|
||||
protected
|
||||
FLogMessage: TStringBuffer;
|
||||
FRequestInfo: TRequestInfo;
|
||||
FResponseInfo: TResponseInfo;
|
||||
FHeaderOut: THeaderOutInfo;
|
||||
FSetupEncodingState: TSetupEncodingState;
|
||||
|
||||
procedure AddContentLength(ALength: integer); override;
|
||||
@ -358,24 +356,29 @@ type
|
||||
procedure WriteError(AStatus: TLHTTPStatus); override;
|
||||
procedure WriteHeaders(AHeaderResponse, ADataResponse: TOutputItem);
|
||||
public
|
||||
FHeaderOut: THeaderOutInfo;
|
||||
FRequestInfo: TRequestInfo;
|
||||
FResponseInfo: TResponseInfo;
|
||||
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function SetupEncoding(AOutputItem: TBufferOutput): boolean;
|
||||
procedure StartMemoryResponse(AOutputItem: TMemoryOutput; ACustomErrorMessage: boolean = false);
|
||||
procedure StartResponse(AOutputItem: TBufferOutput; ACustomErrorMessage: boolean = false);
|
||||
|
||||
property HeaderOut: THeaderOutInfo read FHeaderOut;
|
||||
property RequestInfo: TRequestInfo read FRequestInfo;
|
||||
property ResponseInfo: TResponseInfo read FResponseInfo;
|
||||
end;
|
||||
|
||||
TURIHandler = class(TObject)
|
||||
private
|
||||
FNext: TURIHandler;
|
||||
FMethods: TLHTTPMethods;
|
||||
protected
|
||||
function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; virtual; abstract;
|
||||
procedure RegisterWithEventer(AEventer: TLEventer); virtual;
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
property Methods: TLHTTPMethods read FMethods write FMethods;
|
||||
end;
|
||||
|
||||
TLAccessEvent = procedure(AMessage: string) of object;
|
||||
@ -558,6 +561,11 @@ end;
|
||||
|
||||
{ TURIHandler }
|
||||
|
||||
constructor TURIHandler.Create;
|
||||
begin
|
||||
FMethods := [hmHead, hmGet, hmPost];
|
||||
end;
|
||||
|
||||
procedure TURIHandler.RegisterWithEventer(AEventer: TLEventer);
|
||||
begin
|
||||
end;
|
||||
@ -1594,14 +1602,8 @@ begin
|
||||
lPos^ := #0;
|
||||
for I := Low(TLHTTPMethod) to High(TLHTTPMethod) do
|
||||
begin
|
||||
if I = hmUnknown then
|
||||
begin
|
||||
WriteError(hsNotImplemented);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ((lPos-FBufferPos) = Length(HTTPMethodStrings[I]))
|
||||
and CompareMem(FBufferPos, PChar(HTTPMethodStrings[I]), lPos-FBufferPos) then
|
||||
if (I = hmUnknown) or (((lPos-FBufferPos) = Length(HTTPMethodStrings[I]))
|
||||
and CompareMem(FBufferPos, PChar(HTTPMethodStrings[I]), lPos-FBufferPos)) then
|
||||
begin
|
||||
repeat
|
||||
inc(lPos);
|
||||
@ -1913,9 +1915,12 @@ begin
|
||||
lHandler := FHandlerList;
|
||||
while lHandler <> nil do
|
||||
begin
|
||||
Result := lHandler.HandleURI(ASocket);
|
||||
if ASocket.ResponseInfo.Status <> hsOK then break;
|
||||
if Result <> nil then break;
|
||||
if ASocket.FRequestInfo.RequestType in lHandler.Methods then
|
||||
begin
|
||||
Result := lHandler.HandleURI(ASocket);
|
||||
if ASocket.FResponseInfo.Status <> hsOK then break;
|
||||
if Result <> nil then break;
|
||||
end;
|
||||
lHandler := lHandler.FNext;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -93,8 +93,6 @@ type
|
||||
FPeerAddress: TInetSockAddr;
|
||||
FConnected: Boolean;
|
||||
FConnecting: Boolean;
|
||||
FSocketClass: Integer;
|
||||
FProtocol: Integer;
|
||||
FNextSock: TLSocket;
|
||||
FPrevSock: TLSocket;
|
||||
FIgnoreShutdown: Boolean;
|
||||
@ -104,6 +102,8 @@ type
|
||||
FOnFree: TLSocketEvent;
|
||||
FBlocking: Boolean;
|
||||
FListenBacklog: Integer;
|
||||
FProtocol: Integer;
|
||||
FSocketType: Integer;
|
||||
FCreator: TLComponent;
|
||||
protected
|
||||
function DoSend(const TheData; const TheSize: Integer): Integer;
|
||||
@ -142,10 +142,10 @@ type
|
||||
public
|
||||
property Connected: Boolean read FConnected;
|
||||
property Connecting: Boolean read FConnecting;
|
||||
property Blocking: Boolean read FBlocking write SetBlocking;
|
||||
property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
|
||||
property Protocol: Integer read FProtocol write FProtocol;
|
||||
property SocketType: Integer read FSocketClass write FSocketClass;
|
||||
property Blocking: Boolean read FBlocking write SetBlocking;
|
||||
property SocketType: Integer read FSocketType write FSocketType;
|
||||
property PeerAddress: string read GetPeerAddress;
|
||||
property PeerPort: Word read GetPeerPort;
|
||||
property LocalAddress: string read GetLocalAddress;
|
||||
@ -200,14 +200,13 @@ type
|
||||
protected
|
||||
FHost: string;
|
||||
FPort: Word;
|
||||
FSocketClass: TLSocketClass;
|
||||
FCreator: TLComponent;
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
procedure Disconnect; virtual; abstract;
|
||||
procedure CallAction; virtual; abstract;
|
||||
|
||||
property SocketClass: TLSocketClass read FSocketClass write FSocketClass;
|
||||
public
|
||||
SocketClass: TLSocketClass;
|
||||
property Host: string read FHost write FHost;
|
||||
property Port: Word read FPort write FPort;
|
||||
property Creator: TLComponent read FCreator write FCreator;
|
||||
@ -281,8 +280,6 @@ type
|
||||
function IterNext: Boolean; virtual; abstract;
|
||||
procedure IterReset; virtual; abstract;
|
||||
public
|
||||
property Host: string read FHost write FHost;
|
||||
property Port: Word read FPort write FPort;
|
||||
property OnError: TLSocketErrorEvent read FOnError write FOnError;
|
||||
property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
|
||||
property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
|
||||
@ -293,7 +290,6 @@ type
|
||||
property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
|
||||
property Iterator: TLSocket read FIterator;
|
||||
property Timeout: DWord read GetTimeout write SetTimeout;
|
||||
property SocketClass: TLSocketClass read FSocketClass write FSocketClass;
|
||||
property Eventer: TLEventer read FEventer write SetEventer;
|
||||
property EventerClass: TLEventerClass read FEventerClass write FEventerClass;
|
||||
end;
|
||||
@ -404,7 +400,7 @@ begin
|
||||
FConnected := False;
|
||||
FConnecting := False;
|
||||
FIgnoreShutdown := False;
|
||||
FSocketClass := SOCK_STREAM;
|
||||
FSocketType := SOCK_STREAM;
|
||||
FProtocol := LPROTO_TCP;
|
||||
end;
|
||||
|
||||
@ -428,8 +424,8 @@ begin
|
||||
if FConnected or FConnecting then begin
|
||||
FConnected := False;
|
||||
FConnecting := False;
|
||||
if (FSocketClass = SOCK_STREAM) and (not FIgnoreShutdown) and WasConnected then
|
||||
if ShutDown(FHandle, 2) <> 0 then
|
||||
if (FSocketType = SOCK_STREAM) and (not FIgnoreShutdown) and WasConnected then
|
||||
if fpShutDown(FHandle, 2) <> 0 then
|
||||
LogError('Shutdown error', LSocketError);
|
||||
if CloseSocket(FHandle) <> 0 then
|
||||
LogError('Closesocket error', LSocketError);
|
||||
@ -457,7 +453,7 @@ end;
|
||||
function TLSocket.GetPeerAddress: string;
|
||||
begin
|
||||
Result := '';
|
||||
if FSocketClass = SOCK_STREAM then
|
||||
if FSocketType = SOCK_STREAM then
|
||||
Result := NetAddrtoStr(FAddress.Addr)
|
||||
else
|
||||
Result := NetAddrtoStr(FPeerAddress.Addr);
|
||||
@ -469,7 +465,7 @@ var
|
||||
l: Integer;
|
||||
begin
|
||||
l := SizeOf(a);
|
||||
GetSocketName(FHandle, a, l);
|
||||
fpGetSockName(FHandle, @a, @l);
|
||||
Result := HostAddrToStr(LongWord(a.sin_addr));
|
||||
end;
|
||||
|
||||
@ -510,10 +506,10 @@ var
|
||||
begin
|
||||
Result := 0;
|
||||
if CanReceive then begin
|
||||
if FSocketClass = SOCK_STREAM then
|
||||
Result := sockets.Recv(FHandle, aData, aSize, LMSG)
|
||||
if FSocketType = SOCK_STREAM then
|
||||
Result := sockets.fpRecv(FHandle, @aData, aSize, LMSG)
|
||||
else
|
||||
Result := sockets.Recvfrom(FHandle, aData, aSize, LMSG, FPeerAddress, AddressLength);
|
||||
Result := sockets.fpRecvfrom(FHandle, @aData, aSize, LMSG, @FPeerAddress, @AddressLength);
|
||||
if Result = 0 then
|
||||
Disconnect;
|
||||
if Result = SOCKET_ERROR then begin
|
||||
@ -527,11 +523,14 @@ begin
|
||||
end;
|
||||
|
||||
function TLSocket.DoSend(const TheData; const TheSize: Integer): Integer;
|
||||
var
|
||||
AddressLength: Integer;
|
||||
begin
|
||||
if FSocketClass = SOCK_STREAM then
|
||||
Result := sockets.send(FHandle, TheData, TheSize, LMSG)
|
||||
AddressLength := SizeOf(FPeerAddress);
|
||||
if FSocketType = SOCK_STREAM then
|
||||
Result := sockets.fpsend(FHandle, @TheData, TheSize, LMSG)
|
||||
else
|
||||
Result := sockets.sendto(FHandle, TheData, TheSize, LMSG, FPeerAddress, SizeOf(FPeerAddress));
|
||||
Result := sockets.fpsendto(FHandle, @TheData, TheSize, LMSG, @FPeerAddress, AddressLength);
|
||||
end;
|
||||
|
||||
function TLSocket.SetupSocket(const APort: Word; const Address: string): Boolean;
|
||||
@ -542,13 +541,13 @@ begin
|
||||
Result := false;
|
||||
if not FConnected and not FConnecting then begin
|
||||
Done := true;
|
||||
FHandle := fpSocket(AF_INET, FSocketClass, FProtocol);
|
||||
FHandle := fpSocket(AF_INET, FSocketType, FProtocol);
|
||||
if FHandle = INVALID_SOCKET then
|
||||
Bail('Socket error', LSocketError);
|
||||
SetOptions;
|
||||
if FSocketClass = SOCK_DGRAM then begin
|
||||
if FSocketType = SOCK_DGRAM then begin
|
||||
Arg := 1;
|
||||
if SetSocketOptions(FHandle, SOL_SOCKET, SO_BROADCAST, Arg, Sizeof(Arg)) = SOCKET_ERROR then
|
||||
if fpsetsockopt(FHandle, SOL_SOCKET, SO_BROADCAST, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
|
||||
Bail('SetSockOpt error', LSocketError);
|
||||
end;
|
||||
|
||||
@ -579,7 +578,7 @@ begin
|
||||
Bail('Error on bind', LSocketError)
|
||||
else
|
||||
Result := true;
|
||||
if (FSocketClass = SOCK_STREAM) and Result then
|
||||
if (FSocketType = SOCK_STREAM) and Result then
|
||||
if fpListen(FHandle, FListenBacklog) = SOCKET_ERROR then
|
||||
Result := Bail('Error on Listen', LSocketError)
|
||||
else
|
||||
@ -650,7 +649,7 @@ begin
|
||||
FPort := 0;
|
||||
FListenBacklog := LDEFAULT_BACKLOG;
|
||||
FTimeout := 0;
|
||||
FSocketClass := TLSocket;
|
||||
SocketClass := TLSocket;
|
||||
FOnReceive := nil;
|
||||
FOnError := nil;
|
||||
FOnDisconnect := nil;
|
||||
@ -857,7 +856,7 @@ begin
|
||||
if Assigned(FRootSock) and FRootSock.Connected then
|
||||
Disconnect;
|
||||
|
||||
FRootSock := InitSocket(FSocketClass.Create);
|
||||
FRootSock := InitSocket(SocketClass.Create);
|
||||
FIterator := FRootSock;
|
||||
|
||||
Result := FRootSock.SetupSocket(APort, LADDR_ANY);
|
||||
@ -876,7 +875,7 @@ begin
|
||||
if Assigned(FRootSock) and FRootSock.Connected then
|
||||
Disconnect;
|
||||
|
||||
FRootSock := InitSocket(FSocketClass.Create);
|
||||
FRootSock := InitSocket(SocketClass.Create);
|
||||
FIterator := FRootSock;
|
||||
|
||||
if FRootSock.Listen(APort, AIntf) then begin
|
||||
@ -1031,7 +1030,7 @@ begin
|
||||
if Assigned(FRootSock) then
|
||||
Disconnect;
|
||||
|
||||
FRootSock := InitSocket(FSocketClass.Create);
|
||||
FRootSock := InitSocket(SocketClass.Create);
|
||||
Result := FRootSock.Connect(Address, aPort);
|
||||
|
||||
if Result then begin
|
||||
@ -1051,7 +1050,7 @@ begin
|
||||
if Assigned(FRootSock) then
|
||||
Disconnect;
|
||||
|
||||
FRootSock := InitSocket(FSocketClass.Create);
|
||||
FRootSock := InitSocket(SocketClass.Create);
|
||||
FRootSock.FIgnoreShutdown := True;
|
||||
if FRootSock.Listen(APort, AIntf) then begin
|
||||
FRootSock.FConnected := True;
|
||||
@ -1139,7 +1138,7 @@ var
|
||||
begin
|
||||
with TLSocket(aSocket) do begin
|
||||
l := SizeOf(a);
|
||||
if Sockets.GetPeerName(FHandle, a, l) <> 0 then
|
||||
if Sockets.fpGetPeerName(FHandle, @a, @l) <> 0 then
|
||||
Self.Bail('Error on connect: connection refused', TLSocket(aSocket))
|
||||
else begin
|
||||
FConnected := True;
|
||||
@ -1153,7 +1152,7 @@ procedure TLTcp.AcceptAction(aSocket: TLHandle);
|
||||
var
|
||||
Tmp: TLSocket;
|
||||
begin
|
||||
Tmp := InitSocket(FSocketClass.Create);
|
||||
Tmp := InitSocket(SocketClass.Create);
|
||||
if Tmp.Accept(FRootSock.FHandle) then begin
|
||||
if Assigned(FRootSock.FNextSock) then begin
|
||||
Tmp.FNextSock := FRootSock.FNextSock;
|
||||
|
||||
@ -70,11 +70,6 @@ type
|
||||
FParsePos: pchar;
|
||||
FReadPos: integer;
|
||||
FParsingHeaders: boolean;
|
||||
FDocumentRoot: string;
|
||||
FExtraPath: string;
|
||||
FEnvPath: string;
|
||||
FScriptFileName: string;
|
||||
FScriptName: string;
|
||||
|
||||
procedure AddEnvironment(const AName, AValue: string); virtual; abstract;
|
||||
procedure AddHTTPParam(const AName: string; AParam: TLHTTPParameter);
|
||||
@ -83,17 +78,17 @@ type
|
||||
procedure WriteCGIBlock;
|
||||
function WriteCGIData: TWriteBlockStatus; virtual; abstract;
|
||||
public
|
||||
FDocumentRoot: string;
|
||||
FExtraPath: string;
|
||||
FEnvPath: string;
|
||||
FScriptFileName: string;
|
||||
FScriptName: string;
|
||||
|
||||
constructor Create(ASocket: TLHTTPSocket);
|
||||
destructor Destroy; override;
|
||||
|
||||
function FillBuffer: TWriteBlockStatus; override;
|
||||
procedure StartRequest; virtual;
|
||||
|
||||
property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
|
||||
property EnvPath: string read FEnvPath write FEnvPath;
|
||||
property ExtraPath: string read FExtraPath write FExtraPath;
|
||||
property ScriptFileName: string read FScriptFileName write FScriptFileName;
|
||||
property ScriptName: string read FScriptName write FScriptName;
|
||||
end;
|
||||
|
||||
TSimpleCGIOutput = class(TCGIOutput)
|
||||
@ -142,17 +137,12 @@ type
|
||||
|
||||
TCGIHandler = class(TURIHandler)
|
||||
protected
|
||||
FScriptPathPrefix: string;
|
||||
FCGIRoot: string;
|
||||
FDocumentRoot: string;
|
||||
FEnvPath: string;
|
||||
|
||||
function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
|
||||
public
|
||||
property CGIRoot: string read FCGIRoot write FCGIRoot;
|
||||
property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
|
||||
property EnvPath: string read FEnvPath write FEnvPath;
|
||||
property ScriptPathPrefix: string read FScriptPathPrefix write FScriptPathPrefix;
|
||||
FCGIRoot: string;
|
||||
FEnvPath: string;
|
||||
FDocumentRoot: string;
|
||||
FScriptPathPrefix: string;
|
||||
end;
|
||||
|
||||
TDocumentRequest = record
|
||||
@ -183,8 +173,6 @@ type
|
||||
protected
|
||||
FDocHandlerList: TDocumentHandler;
|
||||
FDirIndexList: TStrings;
|
||||
protected
|
||||
FDocumentRoot: string;
|
||||
FMimeTypeFile: string;
|
||||
|
||||
procedure SetMimeTypeFile(const AValue: string);
|
||||
@ -192,13 +180,14 @@ type
|
||||
function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
|
||||
procedure RegisterWithEventer(AEventer: TLEventer); override;
|
||||
public
|
||||
DocumentRoot: string;
|
||||
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure RegisterHandler(AHandler: TDocumentHandler);
|
||||
|
||||
property DirIndexList: TStrings read FDirIndexList;
|
||||
property DocumentRoot: string read FDocumentRoot write FDocumentRoot;
|
||||
property MimeTypeFile: string read FMimeTypeFile write SetMimeTypeFile;
|
||||
end;
|
||||
|
||||
@ -321,25 +310,25 @@ var
|
||||
lOutput: TSimpleCGIOutput;
|
||||
lExecPath: string;
|
||||
begin
|
||||
if StrLComp(ASocket.RequestInfo.Argument, PChar(ScriptPathPrefix),
|
||||
Length(ScriptPathPrefix)) = 0 then
|
||||
if StrLComp(ASocket.FRequestInfo.Argument, PChar(FScriptPathPrefix),
|
||||
Length(FScriptPathPrefix)) = 0 then
|
||||
begin
|
||||
lOutput := TSimpleCGIOutput.Create(ASocket);
|
||||
lOutput.DocumentRoot := FDocumentRoot;
|
||||
lOutput.EnvPath := FEnvPath;
|
||||
lOutput.FDocumentRoot := FDocumentRoot;
|
||||
lOutput.FEnvPath := FEnvPath;
|
||||
lOutput.Process.CurrentDirectory := FCGIRoot;
|
||||
lExecPath := (ASocket.RequestInfo.Argument+Length(ScriptPathPrefix));
|
||||
lExecPath := ASocket.FRequestInfo.Argument+Length(FScriptPathPrefix);
|
||||
DoDirSeparators(lExecPath);
|
||||
lExecPath := FCGIRoot+lExecPath;
|
||||
if SeparatePath(lExecPath, lOutput.ExtraPath, faAnyFile and not faDirectory) then
|
||||
if SeparatePath(lExecPath, lOutput.FExtraPath, faAnyFile and not faDirectory) then
|
||||
begin
|
||||
lOutput.Process.CommandLine := lExecPath;
|
||||
lOutput.ScriptFileName := lExecPath;
|
||||
lOutput.ScriptName := Copy(lExecPath, Length(FCGIRoot),
|
||||
lOutput.FScriptFileName := lExecPath;
|
||||
lOutput.FScriptName := Copy(lExecPath, Length(FCGIRoot),
|
||||
Length(lExecPath)-Length(FCGIRoot)+1);
|
||||
lOutput.StartRequest;
|
||||
end else
|
||||
ASocket.ResponseInfo.Status := hsNotFound;
|
||||
ASocket.FResponseInfo.Status := hsNotFound;
|
||||
Result := lOutput;
|
||||
end else
|
||||
Result := nil;
|
||||
@ -388,9 +377,9 @@ begin
|
||||
Result := nil;
|
||||
if ARequest.InfoValid then
|
||||
begin
|
||||
lReqInfo := @ARequest.Socket.RequestInfo;
|
||||
lRespInfo := @ARequest.Socket.ResponseInfo;
|
||||
lHeaderOut := @ARequest.Socket.HeaderOut;
|
||||
lReqInfo := @ARequest.Socket.FRequestInfo;
|
||||
lRespInfo := @ARequest.Socket.FResponseInfo;
|
||||
lHeaderOut := @ARequest.Socket.FHeaderOut;
|
||||
if not (lReqInfo^.RequestType in [hmHead, hmGet]) then
|
||||
begin
|
||||
lRespInfo^.Status := hsNotAllowed;
|
||||
@ -422,10 +411,11 @@ var
|
||||
begin
|
||||
Result := nil;
|
||||
lDocRequest.Socket := ASocket;
|
||||
lDocRequest.URIPath := ASocket.RequestInfo.Argument;
|
||||
lDocRequest.URIPath := ASocket.FRequestInfo.Argument;
|
||||
lDocRequest.Document := lDocRequest.URIPath;
|
||||
DoDirSeparators(LDocRequest.Document);
|
||||
lDocRequest.Document := IncludeTrailingPathDelimiter(FDocumentRoot)+lDocRequest.Document;
|
||||
lDocRequest.Document := IncludeTrailingPathDelimiter(DocumentRoot)
|
||||
+ lDocRequest.Document;
|
||||
lDocRequest.InfoValid := SeparatePath(lDocRequest.Document,lDocRequest.ExtraPath,
|
||||
faAnyFile, @lDocRequest.Info);
|
||||
if not lDocRequest.InfoValid then
|
||||
@ -461,7 +451,7 @@ begin
|
||||
begin
|
||||
Result := lHandler.HandleDocument(lDocRequest);
|
||||
if Result <> nil then exit;
|
||||
if ASocket.ResponseInfo.Status <> hsOK then exit;
|
||||
if ASocket.FResponseInfo.Status <> hsOK then exit;
|
||||
lHandler := lHandler.FNext;
|
||||
end;
|
||||
|
||||
@ -484,12 +474,12 @@ begin
|
||||
if ExtractFileExt(ARequest.Document) = '.php' then
|
||||
begin
|
||||
lOutput := TSimpleCGIOutput.Create(ARequest.Socket);
|
||||
lOutput.DocumentRoot := FFileHandler.DocumentRoot;
|
||||
lOutput.FDocumentRoot := FFileHandler.DocumentRoot;
|
||||
lOutput.Process.CommandLine := FAppName;
|
||||
lOutput.ScriptName := ARequest.URIPath;
|
||||
lOutput.ScriptFileName := ARequest.Document;
|
||||
lOutput.ExtraPath := ARequest.ExtraPath;
|
||||
lOutput.EnvPath := FEnvPath;
|
||||
lOutput.FScriptName := ARequest.URIPath;
|
||||
lOutput.FScriptFileName := ARequest.Document;
|
||||
lOutput.FExtraPath := ARequest.ExtraPath;
|
||||
lOutput.FEnvPath := FEnvPath;
|
||||
lOutput.StartRequest;
|
||||
Result := lOutput;
|
||||
end else
|
||||
@ -564,17 +554,17 @@ begin
|
||||
if fcgiRequest <> nil then
|
||||
begin
|
||||
lOutput := TFastCGIOutput.Create(ARequest.Socket);
|
||||
lOutput.DocumentRoot := FFileHandler.DocumentRoot;
|
||||
lOutput.ScriptName := ARequest.URIPath;
|
||||
lOutput.ScriptFileName := ARequest.Document;
|
||||
lOutput.ExtraPath := ARequest.ExtraPath;
|
||||
lOutput.EnvPath := FEnvPath;
|
||||
lOutput.FDocumentRoot := FFileHandler.DocumentRoot;
|
||||
lOutput.FScriptName := ARequest.URIPath;
|
||||
lOutput.FScriptFileName := ARequest.Document;
|
||||
lOutput.FExtraPath := ARequest.ExtraPath;
|
||||
lOutput.FEnvPath := FEnvPath;
|
||||
lOutput.Request := fcgiRequest;
|
||||
ARequest.Socket.SetupEncoding(lOutput);
|
||||
lOutput.StartRequest;
|
||||
Result := lOutput;
|
||||
end else begin
|
||||
ARequest.Socket.ResponseInfo.Status := hsInternalError;
|
||||
ARequest.Socket.FResponseInfo.Status := hsInternalError;
|
||||
ARequest.Socket.StartResponse(nil);
|
||||
Result := nil;
|
||||
end;
|
||||
@ -666,21 +656,21 @@ begin
|
||||
AddEnvironment('SERVER_SOFTWARE', tempStr);
|
||||
|
||||
AddEnvironment('GATEWAY_INTERFACE', 'CGI/1.1');
|
||||
AddEnvironment('SERVER_PROTOCOL', lServerSocket.RequestInfo.VersionStr);
|
||||
AddEnvironment('REQUEST_METHOD', lServerSocket.RequestInfo.Method);
|
||||
AddEnvironment('REQUEST_URI', '/'+lServerSocket.RequestInfo.Argument);
|
||||
AddEnvironment('SERVER_PROTOCOL', lServerSocket.FRequestInfo.VersionStr);
|
||||
AddEnvironment('REQUEST_METHOD', lServerSocket.FRequestInfo.Method);
|
||||
AddEnvironment('REQUEST_URI', '/'+lServerSocket.FRequestInfo.Argument);
|
||||
|
||||
if Length(FExtraPath) > 0 then
|
||||
begin
|
||||
AddEnvironment('PATH_INFO', FExtraPath);
|
||||
{ do not set PATH_TRANSLATED: bug in PHP }
|
||||
// AddEnvironment('PATH_TRANSLATED', FDocumentRoot+FExtraPath);
|
||||
// AddEnvironment('PATH_TRANSLATED', DocumentRoot+FExtraPath);
|
||||
end;
|
||||
|
||||
AddEnvironment('SCRIPT_NAME', FScriptName);
|
||||
AddEnvironment('SCRIPT_FILENAME', FScriptFileName);
|
||||
|
||||
AddEnvironment('QUERY_STRING', lServerSocket.RequestInfo.QueryParams);
|
||||
AddEnvironment('QUERY_STRING', lServerSocket.FRequestInfo.QueryParams);
|
||||
AddHTTPParam('CONTENT_TYPE', hpContentType);
|
||||
AddHTTPParam('CONTENT_LENGTH', hpContentLength);
|
||||
|
||||
@ -716,7 +706,8 @@ var
|
||||
|
||||
procedure AddExtraHeader;
|
||||
begin
|
||||
AppendString(lServerSocket.HeaderOut.ExtraHeaders, FParsePos + ': ' + pValue + #13#10);
|
||||
AppendString(lServerSocket.FHeaderOut.ExtraHeaders,
|
||||
FParsePos + ': ' + pValue + #13#10);
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -745,13 +736,13 @@ begin
|
||||
pValue := FParsePos+iEnd+2;
|
||||
if StrIComp(FParsePos, 'Content-type') = 0 then
|
||||
begin
|
||||
lServerSocket.ResponseInfo.ContentType := pValue;
|
||||
lServerSocket.FResponseInfo.ContentType := pValue;
|
||||
end else
|
||||
if StrIComp(FParsePos, 'Location') = 0 then
|
||||
begin
|
||||
if StrLIComp(pValue, 'http://', 7) = 0 then
|
||||
begin
|
||||
lServerSocket.ResponseInfo.Status := hsMovedPermanently;
|
||||
lServerSocket.FResponseInfo.Status := hsMovedPermanently;
|
||||
{ add location header as-is to response }
|
||||
AddExtraHeader;
|
||||
end else
|
||||
@ -768,19 +759,19 @@ begin
|
||||
break;
|
||||
for lHttpStatus := Low(TLHTTPStatus) to High(TLHTTPStatus) do
|
||||
if HTTPStatusCodes[lHttpStatus] = lStatus then
|
||||
lServerSocket.ResponseInfo.Status := lHttpStatus;
|
||||
lServerSocket.FResponseInfo.Status := lHttpStatus;
|
||||
end else
|
||||
if StrIComp(FParsePos, 'Content-Length') = 0 then
|
||||
begin
|
||||
Val(pValue, lLength, lCode);
|
||||
if lCode <> 0 then
|
||||
break;
|
||||
lServerSocket.HeaderOut.ContentLength := lLength;
|
||||
lServerSocket.FHeaderOut.ContentLength := lLength;
|
||||
end else
|
||||
if StrIComp(FParsePos, 'Last-Modified') = 0 then
|
||||
begin
|
||||
if not TryHTTPDateStrToDateTime(pValue,
|
||||
lServerSocket.ResponseInfo.LastModified) then
|
||||
lServerSocket.FResponseInfo.LastModified) then
|
||||
InternalWrite('WARNING: unable to parse last-modified string from CGI script: ' + pValue);
|
||||
end else
|
||||
AddExtraHeader;
|
||||
@ -788,7 +779,7 @@ begin
|
||||
until false;
|
||||
|
||||
{ error happened }
|
||||
lServerSocket.ResponseInfo.Status := hsInternalError;
|
||||
lServerSocket.FResponseInfo.Status := hsInternalError;
|
||||
exit(true);
|
||||
end;
|
||||
|
||||
@ -886,9 +877,9 @@ var
|
||||
ServerSocket: TLHTTPServerSocket absolute FSocket;
|
||||
begin
|
||||
if FProcess.ExitStatus = 127 then
|
||||
ServerSocket.ResponseInfo.Status := hsNotFound
|
||||
ServerSocket.FResponseInfo.Status := hsNotFound
|
||||
else
|
||||
ServerSocket.ResponseInfo.Status := hsInternalError;
|
||||
ServerSocket.FResponseInfo.Status := hsInternalError;
|
||||
end;
|
||||
|
||||
procedure TSimpleCGIOutput.CGIProcNeedInput(AHandle: TLHandle);
|
||||
@ -939,7 +930,7 @@ end;
|
||||
|
||||
procedure TFastCGIOutput.CGIOutputError;
|
||||
begin
|
||||
TLHTTPServerSocket(FSocket).ResponseInfo.Status := hsInternalError;
|
||||
TLHTTPServerSocket(FSocket).FResponseInfo.Status := hsInternalError;
|
||||
end;
|
||||
|
||||
procedure TFastCGIOutput.DoneInput;
|
||||
@ -1201,7 +1192,7 @@ procedure TFormOutput.SetCookie(const AName, AValue: string; const AExpires: TDa
|
||||
var
|
||||
headers: PStringBuffer;
|
||||
begin
|
||||
headers := @TLHTTPServerSocket(FSocket).HeaderOut.ExtraHeaders;
|
||||
headers := @TLHTTPServerSocket(FSocket).FHeaderOut.ExtraHeaders;
|
||||
AppendString(headers^, 'Set-Cookie: ' + HTTPEncode(AName) + '=' + HTTPEncode(AValue));
|
||||
AppendString(headers^, ';path=' + APath + ';expires=' + FormatDateTime(HTTPDateFormat, AExpires));
|
||||
if Length(ADomain) > 0 then
|
||||
@ -1247,7 +1238,7 @@ begin
|
||||
if newFormOutput = nil then
|
||||
exit(nil);
|
||||
|
||||
newFormOutput.AddVariables(ASocket.RequestInfo.QueryParams, -1, URIParamSepChar);
|
||||
newFormOutput.AddVariables(ASocket.FRequestInfo.QueryParams, -1, URIParamSepChar);
|
||||
newFormOutput.AddVariables(ASocket.Parameters[hpCookie], -1, CookieSepChar);
|
||||
contentType := TLHTTPServerSocket(ASocket).Parameters[hpContentType];
|
||||
if StrIComp(contentType, FormURLContentType) = 0 then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user