mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 23:09:24 +02:00
1259 lines
34 KiB
ObjectPascal
1259 lines
34 KiB
ObjectPascal
{ Web server component, built on the HTTP server component
|
|
|
|
Copyright (C) 2006-2008 Micha Nelissen
|
|
|
|
This library is Free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
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. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a Copy of the GNU Library General Public License
|
|
along with This library; if not, Write to the Free Software Foundation,
|
|
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
|
This license has been modified. See file LICENSE.ADDON for more information.
|
|
Should you find these sources without a LICENSE File, please contact
|
|
me at ales@chello.sk
|
|
}
|
|
|
|
unit lwebserver;
|
|
|
|
{$mode objfpc}{$h+}
|
|
{$inline on}
|
|
|
|
interface
|
|
|
|
uses
|
|
sysutils, classes, lhttp, lhttputil, lmimetypes, levents,
|
|
lprocess, process, lfastcgi, fastcgi_base;
|
|
|
|
type
|
|
TLMultipartParameter = (mpContentType, mpContentDisposition, mpContentTransferEncoding,
|
|
mpContentID, mpContentDescription);
|
|
TLMultipartState = (msStart, msBodypartHeader, msBodypartData);
|
|
|
|
const
|
|
URIParamSepChar: char = '&';
|
|
CookieSepChar: char = ';';
|
|
FormURLContentType: pchar = 'application/x-www-form-urlencoded';
|
|
MultipartContentType: pchar = 'multipart/form-data';
|
|
MPParameterStrings: array[TLMultipartParameter] of string =
|
|
('Content-Type', 'Content-Disposition', 'Content-Transfer-Encoding',
|
|
'Content-ID', 'Content-Discription');
|
|
|
|
type
|
|
TDocumentHandler = class;
|
|
TFileHandler = class;
|
|
|
|
TFileOutput = class(TBufferOutput)
|
|
protected
|
|
FFile: file;
|
|
|
|
function GetSize: integer;
|
|
function FillBuffer: TWriteBlockStatus; override;
|
|
public
|
|
constructor Create(ASocket: TLHTTPSocket);
|
|
destructor Destroy; override;
|
|
|
|
function Open(const AFileName: string): boolean;
|
|
|
|
property Size: integer read GetSize;
|
|
end;
|
|
|
|
TCGIOutput = class(TBufferOutput)
|
|
protected
|
|
FParsePos: pchar;
|
|
FReadPos: integer;
|
|
FParsingHeaders: boolean;
|
|
|
|
procedure AddEnvironment(const AName, AValue: string); virtual; abstract;
|
|
procedure AddHTTPParam(const AName: string; AParam: TLHTTPParameter);
|
|
function ParseHeaders: boolean;
|
|
procedure CGIOutputError; virtual; abstract;
|
|
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;
|
|
end;
|
|
|
|
TSimpleCGIOutput = class(TCGIOutput)
|
|
protected
|
|
FProcess: TLProcess;
|
|
|
|
procedure AddEnvironment(const AName, AValue: string); override;
|
|
procedure CGIProcNeedInput(AHandle: TLHandle);
|
|
procedure CGIProcHasOutput(AHandle: TLHandle);
|
|
procedure CGIProcHasStderr(AHandle: TLHandle);
|
|
procedure DoneInput; override;
|
|
function HandleInput(ABuffer: pchar; ASize: integer): integer; override;
|
|
procedure CGIOutputError; override;
|
|
function WriteCGIData: TWriteBlockStatus; override;
|
|
public
|
|
constructor Create(ASocket: TLHTTPSocket);
|
|
destructor Destroy; override;
|
|
|
|
procedure StartRequest; override;
|
|
|
|
property Process: TLProcess read FProcess;
|
|
end;
|
|
|
|
TFastCGIOutput = class(TCGIOutput)
|
|
protected
|
|
FRequest: TLFastCGIRequest;
|
|
|
|
procedure AddEnvironment(const AName, AValue: string); override;
|
|
procedure CGIOutputError; override;
|
|
procedure DoneInput; override;
|
|
procedure RequestEnd(ARequest: TLFastCGIRequest);
|
|
procedure RequestNeedInput(ARequest: TLFastCGIRequest);
|
|
procedure RequestHasOutput(ARequest: TLFastCGIRequest);
|
|
procedure RequestHasStderr(ARequest: TLFastCGIRequest);
|
|
function HandleInput(ABuffer: pchar; ASize: integer): integer; override;
|
|
function WriteCGIData: TWriteBlockStatus; override;
|
|
function WriteBlock: TWriteBlockStatus; override;
|
|
public
|
|
constructor Create(ASocket: TLHTTPSocket);
|
|
destructor Destroy; override;
|
|
|
|
procedure StartRequest; override;
|
|
|
|
property Request: TLFastCGIRequest read FRequest write FRequest;
|
|
end;
|
|
|
|
TCGIHandler = class(TURIHandler)
|
|
protected
|
|
function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
|
|
public
|
|
FCGIRoot: string;
|
|
FEnvPath: string;
|
|
FDocumentRoot: string;
|
|
FScriptPathPrefix: string;
|
|
end;
|
|
|
|
TDocumentRequest = record
|
|
Socket: TLHTTPServerSocket;
|
|
Document: string;
|
|
URIPath: string;
|
|
ExtraPath: string;
|
|
Info: TSearchRec;
|
|
InfoValid: boolean;
|
|
end;
|
|
|
|
TDocumentHandler = class(TObject)
|
|
private
|
|
FNext: TDocumentHandler;
|
|
protected
|
|
FFileHandler: TFileHandler;
|
|
|
|
procedure RegisterWithEventer(AEventer: TLEventer); virtual;
|
|
public
|
|
function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; virtual; abstract;
|
|
|
|
property FileHandler: TFileHandler read FFileHandler;
|
|
end;
|
|
|
|
{ TFileHandler }
|
|
|
|
TFileHandler = class(TURIHandler)
|
|
protected
|
|
FDocHandlerList: TDocumentHandler;
|
|
FDirIndexList: TStrings;
|
|
FMimeTypeFile: string;
|
|
|
|
procedure SetMimeTypeFile(const AValue: string);
|
|
function HandleFile(const ARequest: TDocumentRequest): TOutputItem;
|
|
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 MimeTypeFile: string read FMimeTypeFile write SetMimeTypeFile;
|
|
end;
|
|
|
|
TPHPCGIHandler = class(TDocumentHandler)
|
|
protected
|
|
FAppName: string;
|
|
FEnvPath: string;
|
|
public
|
|
function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; override;
|
|
|
|
property AppName: string read FAppName write FAppName;
|
|
property EnvPath: string read FEnvPath write FEnvPath;
|
|
end;
|
|
|
|
TPHPFastCGIHandler = class(TDocumentHandler)
|
|
protected
|
|
FPool: TLFastCGIPool;
|
|
FEnvPath: string;
|
|
|
|
function GetAppEnv: string;
|
|
function GetAppName: string;
|
|
function GetHost: string;
|
|
function GetPort: integer;
|
|
procedure RegisterWithEventer(AEventer: TLEventer); override;
|
|
procedure SetAppEnv(NewEnv: string);
|
|
procedure SetAppName(NewName: string);
|
|
procedure SetHost(NewHost: string);
|
|
procedure SetPort(NewPort: integer);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function HandleDocument(const ARequest: TDocumentRequest): TOutputItem; override;
|
|
|
|
property AppEnv: string read GetAppEnv write SetAppEnv;
|
|
property AppName: string read GetAppName write SetAppName;
|
|
property EnvPath: string read FEnvPath write FEnvPath;
|
|
property Host: string read GetHost write SetHost;
|
|
property Pool: TLFastCGIPool read FPool;
|
|
property Port: integer read GetPort write SetPort;
|
|
end;
|
|
|
|
{ Forms }
|
|
|
|
TFormOutput = class;
|
|
|
|
TFillBufferEvent = procedure(AFormOutput: TFormOutput; var AStatus: TWriteBlockStatus);
|
|
THandleInputMethod = function(ABuffer: pchar; ASize: integer): integer of object;
|
|
|
|
TFormOutput = class(TBufferOutput)
|
|
protected
|
|
FBoundary: pchar;
|
|
FRequestVars: TStrings;
|
|
FMPParameters: array[TLMultipartParameter] of pchar;
|
|
FMPState: TLMultipartState;
|
|
FOnExtraHeaders: TNotifyEvent;
|
|
FOnFillBuffer: TFillBufferEvent;
|
|
FHandleInput: THandleInputMethod;
|
|
|
|
procedure DoneInput; override;
|
|
function FillBuffer: TWriteBlockStatus; override;
|
|
function FindBoundary(ABuffer: pchar): pchar;
|
|
function HandleInput(ABuffer: pchar; ASize: integer): integer; override;
|
|
function HandleInputDiscard(ABuffer: pchar; ASize: integer): integer;
|
|
function HandleInputFormURL(ABuffer: pchar; ASize: integer): integer;
|
|
function HandleInputMultipart(ABuffer: pchar; ASize: integer): integer;
|
|
procedure ParseMultipartHeader(ABuffer, ALineEnd: pchar);
|
|
public
|
|
constructor Create(ASocket: TLHTTPSocket);
|
|
destructor Destroy; override;
|
|
|
|
function AddVariables(Variables: pchar; ASize: integer; SepChar: char): integer;
|
|
procedure DeleteCookie(const AName: string; const APath: string = '/';
|
|
const ADomain: string = '');
|
|
procedure SetCookie(const AName, AValue: string; const AExpires: TDateTime;
|
|
const APath: string = '/'; const ADomain: string = '');
|
|
|
|
property OnExtraHeaders: TNotifyEvent read FOnExtraHeaders write FOnExtraHeaders;
|
|
property OnFillBuffer: TFillBufferEvent read FOnFillBuffer write FOnFillBuffer;
|
|
end;
|
|
|
|
THandleURIEvent = function(ASocket: TLHTTPServerSocket): TFormOutput;
|
|
|
|
TFormHandler = class(TURIHandler)
|
|
protected
|
|
FOnHandleURI: THandleURIEvent;
|
|
|
|
function HandleURI(ASocket: TLHTTPServerSocket): TOutputItem; override;
|
|
procedure SelectMultipart(AFormOutput: TFormOutput; AContentType: pchar);
|
|
public
|
|
property OnHandleURI: THandleURIEvent read FOnHandleURI write FOnHandleURI;
|
|
end;
|
|
|
|
var
|
|
EnableWriteln: Boolean = True;
|
|
|
|
implementation
|
|
|
|
uses
|
|
lstrbuffer;
|
|
|
|
{ Example handlers }
|
|
|
|
const
|
|
InputBufferEmptyToWriteStatus: array[boolean] of TWriteBlockStatus =
|
|
(wsPendingData, wsWaitingData);
|
|
|
|
procedure InternalWrite(const s: string);
|
|
begin
|
|
if EnableWriteln then
|
|
Writeln(s);
|
|
end;
|
|
|
|
procedure TDocumentHandler.RegisterWithEventer(AEventer: TLEventer);
|
|
begin
|
|
end;
|
|
|
|
function TCGIHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
|
|
var
|
|
lOutput: TSimpleCGIOutput;
|
|
lExecPath: string;
|
|
begin
|
|
if StrLComp(ASocket.FRequestInfo.Argument, PChar(FScriptPathPrefix),
|
|
Length(FScriptPathPrefix)) = 0 then
|
|
begin
|
|
lOutput := TSimpleCGIOutput.Create(ASocket);
|
|
lOutput.FDocumentRoot := FDocumentRoot;
|
|
lOutput.FEnvPath := FEnvPath;
|
|
lOutput.Process.CurrentDirectory := FCGIRoot;
|
|
lExecPath := ASocket.FRequestInfo.Argument+Length(FScriptPathPrefix);
|
|
DoDirSeparators(lExecPath);
|
|
lExecPath := FCGIRoot+lExecPath;
|
|
if SeparatePath(lExecPath, lOutput.FExtraPath, faAnyFile and not faDirectory) then
|
|
begin
|
|
lOutput.Process.CommandLine := lExecPath;
|
|
lOutput.FScriptFileName := lExecPath;
|
|
lOutput.FScriptName := Copy(lExecPath, Length(FCGIRoot),
|
|
Length(lExecPath)-Length(FCGIRoot)+1);
|
|
lOutput.StartRequest;
|
|
end else
|
|
ASocket.FResponseInfo.Status := hsNotFound;
|
|
Result := lOutput;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
constructor TFileHandler.Create;
|
|
begin
|
|
inherited;
|
|
|
|
FDirIndexList := TStringList.Create;
|
|
end;
|
|
|
|
destructor TFileHandler.Destroy;
|
|
begin
|
|
FreeAndNil(FDirIndexList);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TFileHandler.RegisterWithEventer(AEventer: TLEventer);
|
|
var
|
|
lHandler: TDocumentHandler;
|
|
begin
|
|
lHandler := FDocHandlerList;
|
|
while lHandler <> nil do
|
|
begin
|
|
lHandler.RegisterWithEventer(AEventer);
|
|
lHandler := lHandler.FNext;
|
|
end;
|
|
end;
|
|
|
|
procedure TFileHandler.SetMimeTypeFile(const AValue: string);
|
|
begin
|
|
FMimeTypeFile:=AValue;
|
|
InitMimeList(aValue);
|
|
end;
|
|
|
|
function TFileHandler.HandleFile(const ARequest: TDocumentRequest): TOutputItem;
|
|
var
|
|
lFileOutput: TFileOutput;
|
|
lReqInfo: PRequestInfo;
|
|
lRespInfo: PResponseInfo;
|
|
lHeaderOut: PHeaderOutInfo;
|
|
lIndex: integer;
|
|
begin
|
|
Result := nil;
|
|
if ARequest.InfoValid then
|
|
begin
|
|
lReqInfo := @ARequest.Socket.FRequestInfo;
|
|
lRespInfo := @ARequest.Socket.FResponseInfo;
|
|
lHeaderOut := @ARequest.Socket.FHeaderOut;
|
|
if not (lReqInfo^.RequestType in [hmHead, hmGet]) then
|
|
begin
|
|
lRespInfo^.Status := hsNotAllowed;
|
|
end else begin
|
|
lFileOutput := TFileOutput.Create(ARequest.Socket);
|
|
if lFileOutput.Open(ARequest.Document) then
|
|
begin
|
|
lRespInfo^.Status := hsOK;
|
|
lHeaderOut^.ContentLength := ARequest.Info.Size;
|
|
lRespInfo^.LastModified := LocalTimeToGMT(FileDateToDateTime(ARequest.Info.Time));
|
|
lIndex := MimeList.IndexOf(ExtractFileExt(ARequest.Document));
|
|
if lIndex >= 0 then
|
|
lRespInfo^.ContentType := TStringObject(MimeList.Objects[lIndex]).Str;
|
|
Result := lFileOutput;
|
|
ARequest.Socket.StartResponse(lFileOutput);
|
|
end else
|
|
lFileOutput.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFileHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
|
|
var
|
|
lDocRequest: TDocumentRequest;
|
|
lHandler: TDocumentHandler;
|
|
lTempDoc: string;
|
|
lDirIndexFound: boolean;
|
|
I: integer;
|
|
begin
|
|
Result := nil;
|
|
lDocRequest.Socket := ASocket;
|
|
lDocRequest.URIPath := ASocket.FRequestInfo.Argument;
|
|
lDocRequest.Document := lDocRequest.URIPath;
|
|
DoDirSeparators(LDocRequest.Document);
|
|
lDocRequest.Document := IncludeTrailingPathDelimiter(DocumentRoot)
|
|
+ lDocRequest.Document;
|
|
lDocRequest.InfoValid := SeparatePath(lDocRequest.Document,lDocRequest.ExtraPath,
|
|
faAnyFile, @lDocRequest.Info);
|
|
if not lDocRequest.InfoValid then
|
|
exit;
|
|
if (lDocRequest.Info.Attr and faDirectory) <> 0 then
|
|
begin
|
|
lDirIndexFound := false;
|
|
{ if non-trivial ExtraPath, then it's not a pure directory request, so do
|
|
not show default directory document }
|
|
if lDocRequest.ExtraPath = PathDelim then
|
|
begin
|
|
lDocRequest.Document := IncludeTrailingPathDelimiter(lDocRequest.Document);
|
|
for I := 0 to FDirIndexList.Count - 1 do
|
|
begin
|
|
lTempDoc := lDocRequest.Document + FDirIndexList.Strings[I];
|
|
lDocRequest.InfoValid := FindFirst(lTempDoc,
|
|
faAnyFile and not faDirectory, lDocRequest.Info) = 0;
|
|
FindClose(lDocRequest.Info);
|
|
if lDocRequest.InfoValid and ((lDocRequest.Info.Attr and faDirectory) = 0) then
|
|
begin
|
|
lDocRequest.Document := lTempDoc;
|
|
lDirIndexFound := true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
{ requested a directory, but no source to show }
|
|
if not lDirIndexFound then exit;
|
|
end;
|
|
|
|
lHandler := FDocHandlerList;
|
|
while lHandler <> nil do
|
|
begin
|
|
Result := lHandler.HandleDocument(lDocRequest);
|
|
if Result <> nil then exit;
|
|
if ASocket.FResponseInfo.Status <> hsOK then exit;
|
|
lHandler := lHandler.FNext;
|
|
end;
|
|
|
|
{ no dynamic handler, see if it's a plain file }
|
|
Result := HandleFile(lDocRequest);
|
|
end;
|
|
|
|
procedure TFileHandler.RegisterHandler(AHandler: TDocumentHandler);
|
|
begin
|
|
if AHandler = nil then exit;
|
|
AHandler.FFileHandler := Self;
|
|
AHandler.FNext := FDocHandlerList;
|
|
FDocHandlerList := AHandler;
|
|
end;
|
|
|
|
function TPHPCGIHandler.HandleDocument(const ARequest: TDocumentRequest): TOutputItem;
|
|
var
|
|
lOutput: TSimpleCGIOutput;
|
|
begin
|
|
if ExtractFileExt(ARequest.Document) = '.php' then
|
|
begin
|
|
lOutput := TSimpleCGIOutput.Create(ARequest.Socket);
|
|
lOutput.FDocumentRoot := FFileHandler.DocumentRoot;
|
|
lOutput.Process.CommandLine := FAppName;
|
|
lOutput.FScriptName := ARequest.URIPath;
|
|
lOutput.FScriptFileName := ARequest.Document;
|
|
lOutput.FExtraPath := ARequest.ExtraPath;
|
|
lOutput.FEnvPath := FEnvPath;
|
|
lOutput.StartRequest;
|
|
Result := lOutput;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
constructor TPHPFastCGIHandler.Create;
|
|
begin
|
|
inherited;
|
|
FPool := TLFastCGIPool.Create;
|
|
end;
|
|
|
|
destructor TPHPFastCGIHandler.Destroy;
|
|
begin
|
|
inherited;
|
|
FPool.Free;
|
|
end;
|
|
|
|
function TPHPFastCGIHandler.GetAppEnv: string;
|
|
begin
|
|
Result := FPool.AppEnv;
|
|
end;
|
|
|
|
function TPHPFastCGIHandler.GetAppName: string;
|
|
begin
|
|
Result := FPool.AppName;
|
|
end;
|
|
|
|
function TPHPFastCGIHandler.GetHost: string;
|
|
begin
|
|
Result := FPool.Host;
|
|
end;
|
|
|
|
function TPHPFastCGIHandler.GetPort: integer;
|
|
begin
|
|
Result := FPool.Port;
|
|
end;
|
|
|
|
procedure TPHPFastCGIHandler.SetAppEnv(NewEnv: string);
|
|
begin
|
|
FPool.AppEnv := NewEnv;
|
|
end;
|
|
|
|
procedure TPHPFastCGIHandler.SetAppName(NewName: string);
|
|
begin
|
|
FPool.AppName := NewName;
|
|
end;
|
|
|
|
procedure TPHPFastCGIHandler.SetHost(NewHost: string);
|
|
begin
|
|
FPool.Host := NewHost;
|
|
end;
|
|
|
|
procedure TPHPFastCGIHandler.SetPort(NewPort: integer);
|
|
begin
|
|
FPool.Port := NewPort;
|
|
end;
|
|
|
|
procedure TPHPFastCGIHandler.RegisterWithEventer(AEventer: TLEventer);
|
|
begin
|
|
FPool.Eventer := AEventer;
|
|
end;
|
|
|
|
function TPHPFastCGIHandler.HandleDocument(const ARequest: TDocumentRequest): TOutputItem;
|
|
var
|
|
lOutput: TFastCGIOutput;
|
|
fcgiRequest: TLFastCGIRequest;
|
|
begin
|
|
if ExtractFileExt(ARequest.Document) = '.php' then
|
|
begin
|
|
fcgiRequest := FPool.BeginRequest(FCGI_RESPONDER);
|
|
if fcgiRequest <> nil then
|
|
begin
|
|
lOutput := TFastCGIOutput.Create(ARequest.Socket);
|
|
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.FResponseInfo.Status := hsInternalError;
|
|
ARequest.Socket.StartResponse(nil);
|
|
Result := nil;
|
|
end;
|
|
end else
|
|
Result := nil;
|
|
end;
|
|
|
|
{ Output Items }
|
|
|
|
constructor TFileOutput.Create(ASocket: TLHTTPSocket);
|
|
begin
|
|
inherited;
|
|
FEof := true;
|
|
end;
|
|
|
|
destructor TFileOutput.Destroy;
|
|
begin
|
|
inherited;
|
|
|
|
if not FEof then
|
|
Close(FFile);
|
|
end;
|
|
|
|
function TFileOutput.Open(const AFileName: string): boolean;
|
|
begin
|
|
{$I-}
|
|
FileMode := 0;
|
|
Assign(FFile, AFileName);
|
|
Reset(FFile,1);
|
|
{$I+}
|
|
Result := IOResult = 0;
|
|
FEof := false;
|
|
end;
|
|
|
|
function TFileOutput.GetSize: integer; inline;
|
|
begin
|
|
Result := FileSize(FFile);
|
|
end;
|
|
|
|
function TFileOutput.FillBuffer: TWriteBlockStatus;
|
|
var
|
|
lRead: integer;
|
|
begin
|
|
if FEof then
|
|
exit(wsDone);
|
|
BlockRead(FFile, FBuffer[FBufferPos], FBufferSize-FBufferPos, lRead);
|
|
Inc(FBufferPos, lRead);
|
|
if lRead = 0 then
|
|
begin
|
|
{ EOF reached }
|
|
Close(FFile);
|
|
exit(wsDone);
|
|
end;
|
|
Result := wsPendingData;
|
|
end;
|
|
|
|
constructor TCGIOutput.Create(ASocket: TLHTTPSocket);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
destructor TCGIOutput.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCGIOutput.AddHTTPParam(const AName: string; AParam: TLHTTPParameter);
|
|
var
|
|
lValue: pchar;
|
|
begin
|
|
lValue := FSocket.Parameters[AParam];
|
|
if lValue = nil then exit;
|
|
AddEnvironment(AName, lValue);
|
|
end;
|
|
|
|
procedure TCGIOutput.StartRequest;
|
|
var
|
|
lServerSocket: TLHTTPServerSocket;
|
|
tempStr: string;
|
|
begin
|
|
lServerSocket := TLHTTPServerSocket(FSocket);
|
|
{
|
|
FProcess.Environment.Add('SERVER_ADDR=');
|
|
FProcess.Environment.Add('SERVER_ADMIN=');
|
|
FProcess.Environment.Add('SERVER_NAME=');
|
|
FProcess.Environment.Add('SERVER_PORT=');
|
|
}
|
|
Self := nil;
|
|
tempStr := TLHTTPServer(lServerSocket.Creator).ServerSoftware;
|
|
if Length(tempStr) > 0 then
|
|
AddEnvironment('SERVER_SOFTWARE', tempStr);
|
|
|
|
AddEnvironment('GATEWAY_INTERFACE', 'CGI/1.1');
|
|
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', DocumentRoot+FExtraPath);
|
|
end;
|
|
|
|
AddEnvironment('SCRIPT_NAME', FScriptName);
|
|
AddEnvironment('SCRIPT_FILENAME', FScriptFileName);
|
|
|
|
AddEnvironment('QUERY_STRING', lServerSocket.FRequestInfo.QueryParams);
|
|
AddHTTPParam('CONTENT_TYPE', hpContentType);
|
|
AddHTTPParam('CONTENT_LENGTH', hpContentLength);
|
|
|
|
AddEnvironment('REMOTE_ADDR', FSocket.PeerAddress);
|
|
AddEnvironment('REMOTE_PORT', IntToStr(FSocket.LocalPort));
|
|
|
|
{ used when user has authenticated in some way to server }
|
|
// AddEnvironment('AUTH_TYPE='+...);
|
|
// AddEnvironment('REMOTE_USER='+...);
|
|
|
|
AddEnvironment('DOCUMENT_ROOT', FDocumentRoot);
|
|
AddEnvironment('REDIRECT_STATUS', '200');
|
|
AddHTTPParam('HTTP_HOST', hpHost);
|
|
AddHTTPParam('HTTP_COOKIE', hpCookie);
|
|
AddHTTPParam('HTTP_CONNECTION', hpConnection);
|
|
AddHTTPParam('HTTP_REFERER', hpReferer);
|
|
AddHTTPParam('HTTP_USER_AGENT', hpUserAgent);
|
|
AddHTTPParam('HTTP_ACCEPT', hpAccept);
|
|
AddEnvironment('PATH', FEnvPath);
|
|
|
|
FParsingHeaders := true;
|
|
FReadPos := FBufferPos;
|
|
FParsePos := FBuffer+FReadPos;
|
|
end;
|
|
|
|
function TCGIOutput.ParseHeaders: boolean;
|
|
var
|
|
lHttpStatus: TLHTTPStatus;
|
|
iEnd, lCode: integer;
|
|
lStatus, lLength: dword;
|
|
pLineEnd, pNextLine, pValue: pchar;
|
|
lServerSocket: TLHTTPServerSocket;
|
|
|
|
procedure AddExtraHeader;
|
|
begin
|
|
AppendString(lServerSocket.FHeaderOut.ExtraHeaders,
|
|
FParsePos + ': ' + pValue + #13#10);
|
|
end;
|
|
|
|
begin
|
|
lServerSocket := TLHTTPServerSocket(FSocket);
|
|
repeat
|
|
iEnd := IndexByte(FParsePos^, @FBuffer[FReadPos]-FParsePos, 10);
|
|
if iEnd = -1 then exit(false);
|
|
pNextLine := FParsePos+iEnd+1;
|
|
if (iEnd > 0) and (FParsePos[iEnd-1] = #13) then
|
|
dec(iEnd);
|
|
pLineEnd := FParsePos+iEnd;
|
|
pLineEnd^ := #0;
|
|
if pLineEnd = FParsePos then
|
|
begin
|
|
{ empty line signals end of headers }
|
|
FParsingHeaders := false;
|
|
FBufferOffset := pNextLine-FBuffer;
|
|
FBufferPos := FReadPos;
|
|
FReadPos := 0;
|
|
lServerSocket.StartResponse(Self, true);
|
|
exit(false);
|
|
end;
|
|
iEnd := IndexByte(FParsePos^, iEnd, ord(':'));
|
|
if (iEnd = -1) or (FParsePos[iEnd+1] <> ' ') then
|
|
break;
|
|
FParsePos[iEnd] := #0;
|
|
pValue := FParsePos+iEnd+2;
|
|
if StrIComp(FParsePos, 'Content-type') = 0 then
|
|
begin
|
|
lServerSocket.FResponseInfo.ContentType := pValue;
|
|
end else
|
|
if StrIComp(FParsePos, 'Location') = 0 then
|
|
begin
|
|
if StrLIComp(pValue, 'http://', 7) = 0 then
|
|
begin
|
|
lServerSocket.FResponseInfo.Status := hsMovedPermanently;
|
|
{ add location header as-is to response }
|
|
AddExtraHeader;
|
|
end else
|
|
InternalWrite('WARNING: unimplemented ''Location'' response received from CGI script');
|
|
end else
|
|
if StrIComp(FParsePos, 'Status') = 0 then
|
|
begin
|
|
{ sometimes we get '<status code> space <reason>' }
|
|
iEnd := IndexByte(pValue^, pLineEnd-pValue, ord(' '));
|
|
if iEnd <> -1 then
|
|
pValue[iEnd] := #0;
|
|
Val(pValue, lStatus, lCode);
|
|
if lCode <> 0 then
|
|
break;
|
|
for lHttpStatus := Low(TLHTTPStatus) to High(TLHTTPStatus) do
|
|
if HTTPStatusCodes[lHttpStatus] = lStatus then
|
|
lServerSocket.FResponseInfo.Status := lHttpStatus;
|
|
end else
|
|
if StrIComp(FParsePos, 'Content-Length') = 0 then
|
|
begin
|
|
Val(pValue, lLength, lCode);
|
|
if lCode <> 0 then
|
|
break;
|
|
lServerSocket.FHeaderOut.ContentLength := lLength;
|
|
end else
|
|
if StrIComp(FParsePos, 'Last-Modified') = 0 then
|
|
begin
|
|
if not TryHTTPDateStrToDateTime(pValue,
|
|
lServerSocket.FResponseInfo.LastModified) then
|
|
InternalWrite('WARNING: unable to parse last-modified string from CGI script: ' + pValue);
|
|
end else
|
|
AddExtraHeader;
|
|
FParsePos := pNextLine;
|
|
until false;
|
|
|
|
{ error happened }
|
|
lServerSocket.FResponseInfo.Status := hsInternalError;
|
|
exit(true);
|
|
end;
|
|
|
|
function TCGIOutput.FillBuffer: TWriteBlockStatus;
|
|
begin
|
|
if not FParsingHeaders then
|
|
FReadPos := FBufferPos;
|
|
Result := WriteCGIData;
|
|
if FParsingHeaders then
|
|
begin
|
|
if ParseHeaders then
|
|
begin
|
|
{ error while parsing }
|
|
FEof := true;
|
|
exit(wsDone);
|
|
end;
|
|
end else
|
|
FBufferPos := FReadPos;
|
|
end;
|
|
|
|
procedure TCGIOutput.WriteCGIBlock;
|
|
begin
|
|
{ CGI process has output pending, we can write a block to socket }
|
|
if FParsingHeaders then
|
|
begin
|
|
if (FillBuffer = wsDone) and FParsingHeaders then
|
|
begin
|
|
{ still parsing headers ? something's wrong }
|
|
FParsingHeaders := false;
|
|
CGIOutputError;
|
|
TLHTTPServerSocket(FSocket).StartResponse(Self);
|
|
end;
|
|
end;
|
|
if not FParsingHeaders then
|
|
FSocket.WriteBlock;
|
|
end;
|
|
|
|
{ TSimpleCGIOutput }
|
|
|
|
constructor TSimpleCGIOutput.Create(ASocket: TLHTTPSocket);
|
|
begin
|
|
inherited;
|
|
FProcess := TLProcess.Create(nil);
|
|
FProcess.Options := FProcess.Options + [poUsePipes];
|
|
FProcess.OnNeedInput := @CGIProcNeedInput;
|
|
FProcess.OnHasOutput := @CGIProcHasOutput;
|
|
FProcess.OnHasStderr := @CGIProcHasStderr;
|
|
end;
|
|
|
|
destructor TSimpleCGIOutput.Destroy;
|
|
begin
|
|
inherited;
|
|
FProcess.Free;
|
|
end;
|
|
|
|
function TSimpleCGIOutput.WriteCGIData: TWriteBlockStatus;
|
|
var
|
|
lRead: integer;
|
|
begin
|
|
lRead := FProcess.Output.Read(FBuffer[FReadPos], FBufferSize-FReadPos);
|
|
if lRead = 0 then exit(wsDone);
|
|
Inc(FReadPos, lRead);
|
|
Result := InputBufferEmptyToWriteStatus[lRead = 0];
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.AddEnvironment(const AName, AValue: string);
|
|
begin
|
|
FProcess.Environment.Add(AName+'='+AValue);
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.DoneInput;
|
|
begin
|
|
FProcess.CloseInput;
|
|
end;
|
|
|
|
function TSimpleCGIOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
|
|
begin
|
|
if ASize > 0 then
|
|
Result := FProcess.Input.Write(ABuffer^, ASize)
|
|
else
|
|
Result := 0;
|
|
FProcess.InputEvent.IgnoreWrite := ASize = 0;
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.StartRequest;
|
|
begin
|
|
inherited;
|
|
|
|
FProcess.Eventer := FSocket.Eventer;
|
|
FProcess.Execute;
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.CGIOutputError;
|
|
var
|
|
ServerSocket: TLHTTPServerSocket;
|
|
begin
|
|
ServerSocket := TLHTTPServerSocket(FSocket);
|
|
if FProcess.ExitStatus = 127 then
|
|
ServerSocket.FResponseInfo.Status := hsNotFound
|
|
else
|
|
ServerSocket.FResponseInfo.Status := hsInternalError;
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.CGIProcNeedInput(AHandle: TLHandle);
|
|
begin
|
|
FProcess.InputEvent.IgnoreWrite := true;
|
|
FSocket.ParseBuffer;
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.CGIProcHasOutput(AHandle: TLHandle);
|
|
begin
|
|
WriteCGIBlock;
|
|
end;
|
|
|
|
procedure TSimpleCGIOutput.CGIProcHasStderr(AHandle: TLHandle);
|
|
var
|
|
lBuf: array[0..1023] of char;
|
|
lRead: integer;
|
|
begin
|
|
lRead := FProcess.Stderr.Read(lBuf, sizeof(lBuf)-1);
|
|
lBuf[lRead] := #0;
|
|
write(pchar(@lBuf[0]));
|
|
end;
|
|
|
|
{ TFastCGIOutput }
|
|
|
|
constructor TFastCGIOutput.Create(ASocket: TLHTTPSocket);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
destructor TFastCGIOutput.Destroy;
|
|
begin
|
|
if FRequest <> nil then
|
|
begin
|
|
FRequest.OnInput := nil;
|
|
FRequest.OnOutput := nil;
|
|
FRequest.OnStderr := nil;
|
|
FRequest.OnEndRequest := nil;
|
|
FRequest.AbortRequest;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.AddEnvironment(const AName, AValue: string);
|
|
begin
|
|
FRequest.SendParam(AName, AValue);
|
|
end;
|
|
|
|
procedure TFastCGIOutput.CGIOutputError;
|
|
begin
|
|
TLHTTPServerSocket(FSocket).FResponseInfo.Status := hsInternalError;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.DoneInput;
|
|
begin
|
|
if FRequest <> nil then
|
|
FRequest.DoneInput;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.RequestEnd(ARequest: TLFastCGIRequest);
|
|
begin
|
|
FRequest.OnEndRequest := nil;
|
|
FRequest.OnInput := nil;
|
|
FRequest.OnOutput := nil;
|
|
FRequest := nil;
|
|
{ trigger final write, to flush output to socket }
|
|
WriteCGIBlock;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.RequestNeedInput(ARequest: TLFastCGIRequest);
|
|
begin
|
|
FSocket.ParseBuffer;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.RequestHasOutput(ARequest: TLFastCGIRequest);
|
|
begin
|
|
WriteCGIBlock;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.RequestHasStderr(ARequest: TLFastCGIRequest);
|
|
var
|
|
lBuf: array[0..1023] of char;
|
|
lRead: integer;
|
|
begin
|
|
lRead := ARequest.Get(lBuf, sizeof(lBuf)-1);
|
|
lBuf[lRead] := #0;
|
|
write(pchar(@lBuf[0]));
|
|
end;
|
|
|
|
function TFastCGIOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
|
|
begin
|
|
Result := FRequest.SendInput(ABuffer, ASize);
|
|
end;
|
|
|
|
function TFastCGIOutput.WriteCGIData: TWriteBlockStatus;
|
|
var
|
|
lRead: integer;
|
|
begin
|
|
if FRequest = nil then exit(wsDone);
|
|
if FRequest.OutputDone then exit(wsDone);
|
|
lRead := FRequest.Get(@FBuffer[FReadPos], FBufferSize-FReadPos);
|
|
Inc(FReadPos, lRead);
|
|
Result := InputBufferEmptyToWriteStatus[lRead = 0];
|
|
end;
|
|
|
|
function TFastCGIOutput.WriteBlock: TWriteBlockStatus;
|
|
begin
|
|
if (FRequest <> nil) and FRequest.OutputPending then
|
|
begin
|
|
FRequest.ParseClientBuffer;
|
|
Result := wsWaitingData;
|
|
end else
|
|
Result := inherited;
|
|
end;
|
|
|
|
procedure TFastCGIOutput.StartRequest;
|
|
begin
|
|
FRequest.OnEndRequest := @RequestEnd;
|
|
FRequest.OnInput := @RequestNeedInput;
|
|
FRequest.OnOutput := @RequestHasOutput;
|
|
FRequest.OnStderr := @RequestHasStderr;
|
|
inherited;
|
|
FRequest.DoneParams;
|
|
end;
|
|
|
|
{ TFormOutput }
|
|
|
|
constructor TFormOutput.Create(ASocket: TLHTTPSocket);
|
|
begin
|
|
inherited;
|
|
FRequestVars := TStringList.Create;
|
|
end;
|
|
|
|
destructor TFormOutput.Destroy;
|
|
var
|
|
I: integer;
|
|
tmpObj: TObject;
|
|
begin
|
|
for I := 0 to FRequestVars.Count - 1 do
|
|
begin
|
|
tmpObj := FRequestVars.Objects[I];
|
|
Finalize(string(tmpObj));
|
|
FRequestVars.Objects[I] := nil;
|
|
end;
|
|
FRequestVars.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TFormOutput.AddVariables(Variables: pchar; ASize: integer; SepChar: char): integer;
|
|
var
|
|
varname, sep, next: pchar;
|
|
strName, strValue: string;
|
|
tmpObj: TObject;
|
|
i: integer;
|
|
begin
|
|
if Variables = nil then
|
|
exit(0);
|
|
if ASize = -1 then
|
|
ASize := StrLen(Variables);
|
|
varname := Variables;
|
|
repeat
|
|
sep := varname + IndexChar(varname^, ASize, '=');
|
|
if sep < varname then
|
|
break;
|
|
dec(ASize, sep-varname);
|
|
next := sep + IndexChar(sep^, ASize, SepChar);
|
|
if next < sep then
|
|
begin
|
|
next := sep + ASize;
|
|
ASize := 0;
|
|
end else
|
|
dec(ASize, next+1-sep);
|
|
if sep > varname then
|
|
begin
|
|
setlength(strName, sep-varname);
|
|
move(varname[0], strName[1], sep-varname);
|
|
setlength(strValue, next-sep-1);
|
|
move(sep[1], strValue[1], next-sep-1);
|
|
i := FRequestVars.Add(strName);
|
|
tmpObj := nil;
|
|
string(tmpObj) := strValue;
|
|
FRequestVars.Objects[i] := tmpObj;
|
|
end;
|
|
varname := next+1;
|
|
until false;
|
|
Result := ASize;
|
|
end;
|
|
|
|
procedure TFormOutput.DoneInput;
|
|
begin
|
|
if Assigned(FOnExtraHeaders) then
|
|
FOnExtraHeaders(Self);
|
|
TLHTTPServerSocket(FSocket).StartResponse(Self);
|
|
end;
|
|
|
|
function TFormOutput.HandleInputFormURL(ABuffer: pchar; ASize: integer): integer;
|
|
begin
|
|
Result := ASize-AddVariables(ABuffer, ASize, URIParamSepChar)
|
|
end;
|
|
|
|
procedure TFormOutput.ParseMultipartHeader(ABuffer, ALineEnd: pchar);
|
|
var
|
|
I: TLMultipartParameter;
|
|
len: integer;
|
|
begin
|
|
for I := Low(TLMultipartParameter) to High(TLMultipartParameter) do
|
|
begin
|
|
len := Length(MPParameterStrings[I]);
|
|
if ABuffer+len >= ALineEnd then
|
|
continue;
|
|
if (ABuffer[len] = ':')
|
|
and (StrLIComp(ABuffer, PChar(MPParameterStrings[I]), len) = 0) then
|
|
begin
|
|
Inc(ABuffer, len+2);
|
|
repeat
|
|
if ABuffer = ALineEnd then exit;
|
|
if ABuffer^ <> ' ' then break;
|
|
inc(ABuffer);
|
|
until false;
|
|
FMPParameters[I] := ABuffer;
|
|
if I = mpContentType then
|
|
begin
|
|
repeat
|
|
if ABuffer = ALineEnd then exit;
|
|
if ABuffer = ';' then break;
|
|
inc(ABuffer);
|
|
until false;
|
|
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFormOutput.FindBoundary(ABuffer: pchar): pchar;
|
|
begin
|
|
{$warning TODO}
|
|
Result := nil;
|
|
end;
|
|
|
|
function TFormOutput.HandleInputMultipart(ABuffer: pchar; ASize: integer): integer;
|
|
var
|
|
pos, next, endline: pchar;
|
|
begin
|
|
pos := ABuffer;
|
|
repeat
|
|
case FMPState of
|
|
msStart:
|
|
begin
|
|
{ discard until first boundary }
|
|
next := FindBoundary(pos);
|
|
if next = nil then
|
|
exit(ASize);
|
|
FMPState := msBodypartHeader;
|
|
end;
|
|
msBodypartHeader:
|
|
begin
|
|
endline := pos + IndexChar(pos, ASize, #10);
|
|
if endline < pos then
|
|
exit(pos-ABuffer);
|
|
next := endline+1;
|
|
if (endline > pos) and ((endline-1)^ = #13) then
|
|
dec(endline);
|
|
endline^ := #0;
|
|
if endline > pos then
|
|
ParseMultipartHeader(pos, endline)
|
|
else
|
|
FMPState := msBodypartData;
|
|
end;
|
|
msBodypartData:
|
|
begin
|
|
{ decode based on content-transfer-encoding ? }
|
|
{ CRLF before boundary, belongs to boundary, not data! }
|
|
next := FindBoundary(ABuffer);
|
|
end;
|
|
else
|
|
exit(ASize);
|
|
end;
|
|
dec(ASize, next-pos);
|
|
pos := next;
|
|
until false;
|
|
end;
|
|
|
|
function TFormOutput.HandleInputDiscard(ABuffer: pchar; ASize: integer): integer;
|
|
begin
|
|
Result := ASize;
|
|
end;
|
|
|
|
function TFormOutput.HandleInput(ABuffer: pchar; ASize: integer): integer;
|
|
begin
|
|
Result := FHandleInput(ABuffer, ASize);
|
|
end;
|
|
|
|
function TFormOutput.FillBuffer: TWriteBlockStatus;
|
|
begin
|
|
Result := wsDone;
|
|
if Assigned(FOnFillBuffer) then
|
|
FOnFillBuffer(Self, Result);
|
|
end;
|
|
|
|
procedure TFormOutput.DeleteCookie(const AName: string; const APath: string = '/';
|
|
const ADomain: string = '');
|
|
begin
|
|
{ cookies expire when expires is in the past, duh }
|
|
SetCookie(AName, '', Now - 7.0, APath, ADomain);
|
|
end;
|
|
|
|
procedure TFormOutput.SetCookie(const AName, AValue: string; const AExpires: TDateTime;
|
|
const APath: string = '/'; const ADomain: string = '');
|
|
var
|
|
headers: PStringBuffer;
|
|
begin
|
|
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
|
|
begin
|
|
AppendString(headers^, ';domain=');
|
|
AppendString(headers^, ADomain);
|
|
end;
|
|
AppendString(headers^, #13#10);
|
|
end;
|
|
|
|
{ TFormHandler }
|
|
|
|
procedure TFormHandler.SelectMultipart(AFormOutput: TFormOutput; AContentType: pchar);
|
|
var
|
|
boundary, endquote: pchar;
|
|
begin
|
|
boundary := StrScan(AContentType, '=');
|
|
if boundary <> nil then
|
|
begin
|
|
Inc(boundary);
|
|
if boundary^ = '"' then
|
|
begin
|
|
Inc(boundary);
|
|
endquote := StrScan(boundary, '"');
|
|
if endquote <> nil then
|
|
endquote^ := #0;
|
|
end;
|
|
end;
|
|
|
|
AFormOutput.FBoundary := boundary;
|
|
AFormOutput.FHandleInput := @AFormOutput.HandleInputMultipart;
|
|
end;
|
|
|
|
function TFormHandler.HandleURI(ASocket: TLHTTPServerSocket): TOutputItem;
|
|
var
|
|
newFormOutput: TFormOutput;
|
|
contentType: pchar;
|
|
begin
|
|
if not Assigned(FOnHandleURI) then
|
|
exit(nil);
|
|
|
|
newFormOutput := FOnHandleURI(ASocket);
|
|
if newFormOutput = nil then
|
|
exit(nil);
|
|
|
|
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
|
|
newFormOutput.FHandleInput := @newFormOutput.HandleInputFormURL
|
|
else if StrIComp(contentType, MultipartContentType) = 0 then
|
|
SelectMultipart(newFormOutput, contentType)
|
|
else
|
|
newFormOutput.FHandleInput := @newFormOutput.HandleInputDiscard;
|
|
|
|
Result := newFormOutput;
|
|
end;
|
|
|
|
end.
|