/// FastCGI HTTP/1.1 Server implementation for mORMot // - this unit is a part of the freeware Synopse mORMot framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit mORMotFastCgiServer; { This file is part of Synopse mORMot framework. Synopse mORMot framework. Copyright (C) 2020 Arnaud Bouchez Synopse Informatique - https://synopse.info *** BEGIN LICENSE BLOCK ***** Version: MPL 1.1/GPL 2.0/LGPL 2.1 The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is Synopse mORMot framework. The Initial Developer of the Original Code is Arnaud Bouchez. Portions created by the Initial Developer are Copyright (C) 2020 the Initial Developer. All Rights Reserved. Contributor(s): Alternatively, the contents of this file may be used under the terms of either the GNU General Public License Version 2 or later (the "GPL"), or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which case the provisions of the GPL or the LGPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of either the GPL or the LGPL, and not to allow others to use your version of this file under the terms of the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL or the LGPL. If you do not delete the provisions above, a recipient may use your version of this file under the terms of any one of the MPL, the GPL or the LGPL. ***** END LICENSE BLOCK ***** fastcgi configuration example for lighttpd under linux: - http://localhost/test will ask TSQLRestServer from the content - we use only one process and one thread, which is OK for our framework - the socket is created by lighttpd, and used by the executable - the target executable (located at /var/bin/test) must call the mORMotFastCGIMainProc() procedure - default implementation under linux use the libfcgi.so library: you'll need to exec e.g. apt-get install libfcgi0ldbl fastcgi.server = ( "/test/" => (( "socket" => "/tmp/test-socket", "bin-path" => "/var/bin/test", "min-procs" => 1, "max-procs" => 1, # "max-load-per-proc" => 1, # never used if max-procs=1 "kill-signal" => 10 # libfcgi need to be killed with SIGUSR1(10) )) ) ------------------------------------------------------------------------ TODO: to be changed so that it uses THttpServerRequest, and would be directly defined as THttpFastCGIServer = class(THttpServerGeneric) ------------------------------------------------------------------------ } {.$define USELIBFCGI} // if defined, the standard client library (libfcgi.dll or libfcgi.so) is // used, instead of the 100% pascal FastCGI client {$ifndef MSWINDOWS} {$define USELIBFCGI} // pure pascal FastCGI client only available under Windows yet {$endif} interface uses {$ifdef MSWINDOWS} Windows, SynWinSock, {$else} Types, LibC, {$endif} {$ifndef USELIBFCGI} SynCrtSock, // the pascal version use our Synopse socket {$endif} SysUtils, Classes, SynCommons, mORMot; /// publishes a HTTP/1.1 RESTFUL JSON mORMot Server, using FASTCGI // - will raise an exception if the executable was not used as a FastCGI // process, but a normal CGI process // - call this procedure in your main block of your program: it is up to // the HTTP server to implement the request handling procedure mORMotFastCGIMainProc(Server: TSQLRestServer); {$ifdef USELIBFCGI} (* FastCGI access through the libfcgi library only needed libfcgi functions were defined see http://www.fastcgi.com for additional documentation *) const /// Unsupported Version FastCGI error code FCGX_UNSUPPORTED_VERSION = -2; /// Protocol related FastCGI error code FCGX_PROTOCOL_ERROR = -3; /// Parameters related FastCGI error code FCGX_PARAMS_ERROR = -4; /// Calling Sequence FastCGI error code FCGX_CALL_SEQ_ERROR = -5; /// Useful FCGX_Request flag // - Setting FCGI_FAIL_ACCEPT_ON_INTR prevents FCGX_Accept() from // restarting upon being interrupted FCGI_FAIL_ACCEPT_ON_INTR = 1; /// name of the dll we use to import all FastCGI low-level functions from // - 'libfcgi.so.0' is Ubuntu/Debian Linux standard library name: check // your distribution {$IFDEF Win32} dllname = 'libfcgi.dll'; {$ELSE} dllname = 'libfcgi.so.0'; {$ENDIF} type /// defines the state of a FastCGI stream // - The state of a stream is private and should only be accessed // as an 'opaque' pointer PFCGX_Stream = pointer; /// An environment (as defined by environ(7)) // - A nil-terminated array of strings, each string having the form name=value FCGX_ParamArrayType = PPAnsiChar; /// returns TRUE if this process appears to be a CGI process // - in such case, you should not use the FastCGI implementation // - caller should raise an exception in such case function FCGX_IsCGI: boolean; cdecl; external dllname; {{ accept a new request (NOT multi-thread safe) - return 0 for successful call, -1 for error - Finishes the request accepted by (and frees any storage allocated by) the previous call to FCGX_Accept. Creates input, output, and error streams and assigns them to *in, *out, and *err respectively. Creates a parameters data structure to be accessed via getenv(3) (if assigned to environ) or by FCGX_GetParam and assigns it to *envp. - DO NOT retain pointers to the envp array or any strings contained in it (e.g. to the result of calling FCGX_GetParam), since these will be freed by the next call to FCGX_Finish or FCGX_Accept } function FCGX_Accept(var _in, _out, _err: PFCGX_Stream; var params: FCGX_ParamArrayType): integer; cdecl; external dllname; {{ read a line from the server socket - Reads up to n-1 consecutive bytes from the input stream into the character array str. - Stops before n-1 bytes have been read if '\n' or EOF is read. - The terminating '\n' is copied to str. After copying the last byte into str, stores a '\0' terminator. - returns NULL if EOF is the first thing read from the input stream } function FCGX_GetLine(str: PAnsiChar; n: integer; stream: PFCGX_Stream): PAnsiChar; cdecl; external dllname; {{ read some data from the server socket - reads up to n consecutive bytes from the input stream into the character array str. Performs no interpretation of the input bytes. - returns number of bytes read. If result is smaller than n, the end of input has been reached } function FCGX_GetStr(str: PAnsiChar; n: integer; stream: PFCGX_Stream): integer; cdecl; external dllname; {{ write some data to the server socket - writes n consecutive bytes from the character array str into the output stream. - performs no interpretation of the output bytes. - returns the number of bytes written (n) for normal return, EOF (-1) if an error occurred } function FCGX_PutStr(str: PAnsiChar; n: integer; stream: PFCGX_Stream): integer; cdecl; external dllname; {{ obtain value of FCGI parameter in environment - returns the value bound to name, NULL if name not present in the environment envp - caller must not mutate the result or retain it past the end of this request - see @http://hoohoo.ncsa.illinois.edu/cgi/env.html for a Environment Variables list } function FCGX_GetParam(name: PUTF8Char; envp: FCGX_ParamArrayType): PUTF8Char; cdecl; external dllname; {$else} (* NATIVE Pascal FastCGI client implementation implemented under Windows only by now *) type /// FastCGI record types, i.e. the general function that the record performs TFCGIRecType = ( rtBeginRequest = 1, rtAbortRequest, rtEndRequest, rtParams, rtStdIn, rtStdOut, rtStdErr, rtData, rtGetValues, rtGetValuesResult, rtUnknown); /// FastCGI roles, only Responder role is supported in this unit version TFCGIRole = ( rUnknown, rResponder, rAuthorizer, rFilter); PFCGIHeader = ^TFCGIHeader; /// FastCGI header TFCGIHeader = packed record /// FastCGI protocol version, ever constant 1 Version: byte; /// FastCGI record type RecType: TFCGIRecType; /// identifies the FastCGI request to which the record belongs // - equals zero for a management request request // - non zero for an application record // Used also to determine if the session is being multiplexed ID: word; /// FastCGI record length // - will send up to 64 KB of data per block Len: word; /// Pad length to complete 8 bytes alignment boundary in FastCGI protocol PadLen: byte; /// Pad field Filler: byte; end; PFCGIBeginRequest = ^TFCGIBeginRequest; /// rtBeginRequest record TFCGIBeginRequest = packed record /// FastCGI header Header: TFCGIHeader; /// Pad field Filler: byte; /// FastCGI role Role: TFCGIRole; /// Keep connection KeepConn: boolean; /// Pad field Filler2: array[1..5] of byte; end; /// FastCGI level status (and error) code for END_REQUEST record TFCGIProtocolStatus = ( psRequestComplete, psCantMultiplexConnections, psOverloaded, psUnknownRole); /// FastCGI connection modes TFCGIListenType = (ltUnused, {ltFileSync, ltFileASync,} ltSocketSync=2, {ltSocketASync,} ltPipeSync{, ltPipeASync}); { ltSocketSync=2 so no RTTI } /// handle Fast CGI // - implements the official Fast CGI Specification available at // @http://www.fastcgi.com/devkit/doc/fcgi-spec.html // - this base type has virtual public methods ReadPacked and SendPacket, // implementing the named pipe or socket defined by the single file // descriptor sent by the web server which can be overridden by its children // for proper socket/pipe handling TFastCGIServer = class protected fServer: TSQLRestServer; fRequestHeaders: RawUTF8; fRequestMethod: RawUTF8; fRequestURL: RawUTF8; fRequestBody: RawUTF8; // FastCGI role for the current request fRequestRole: TFCGIRole; // current FastCGI request ID fRequestID: word; fResponseHeaders: RawUTF8; fResponseContent: RawByteString; // global 64 KB buffer, used for chunking data to be sent fTempResponse: RawUTF8; fTempNamedPipe: RawUTF8; fListenType: TFCGIListenType; fhListen: THandle; fConnectionOpened: boolean; fSocket: TCrtSocket; // send a response back to the server // - the content is chuncked in 64 KB buffers, if necessary // - call SendPacket() virtual method // - if sent in rtStdOut, the fResponseHeaders are sent with the content; in // this case, if no 'content-type:' exists in fResponseHeaders, use default // 'text/html' function SendResponse(Content: RawUTF8; aRecType: TFCGIRecType): boolean; // send an end request, with the specified protocol status function SendEndRequest(Status: TFCGIProtocolStatus): boolean; // reset all fRequest* parameters procedure ResetRequest; property hListen: THandle read fhListen; property listenType: TFCGIListenType read fListenType; property ConnectionOpened: boolean read fConnectionOpened; public /// virtual method used to read a packet from the remote server // - must return '' on error // - by default, use the single file descriptor sent by the web server, // and expect to read data from the corresponding named pipe or // TCP/IP socket function ReadPacked: RawUTF8; virtual; /// virtual method used to send a packed to the remote server // - must return FALSE on error // - by default, use the single file descriptor sent by the web server, // and expect to write data to the corresponding named pipe or // TCP/IP socket function SendPacket(Buffer: pointer; BufferLen: integer): boolean; virtual; /// method triggered when the Web server wants to abort the request // - do nothing by default - only to be implemented for Multiplex connection // which are not enabled with this class procedure LogOut; virtual; /// method triggered to calculate the response // - expect fRequestHeaders, fRequestMethod, fRequestBody and fRequestURL // properties as input // - update fResponseHeaders and fResponseContent properties as output procedure ProcessRequest; virtual; public /// create the object instance to run with the specified RESTful Server constructor Create(aServer: TSQLRestServer); /// release the associated memory and handles destructor Destroy; override; /// the main loop of the FastCGI application // - loop until application is terminated // - use the associated RESTful Server to calculate the answer // - call the virtual methods ReadPacked and SendPacket to handle the response // - the FastCGI server must have been successfully connected before calling it // - return true if communication was made successfully function Run: boolean; virtual; /// associated RESTful Server property Server: TSQLRestServer read fServer; end; {$endif} implementation {$ifdef USELIBFCGI} procedure mORMotFastCGIMainProc(Server: TSQLRestServer); var _in, _out, _err: PFCGX_Stream; envp: FCGX_ParamArrayType; {function ReadString: RawUTF8; var tmp: array[0..1023] of AnsiChar; // 1KB should be enough for HTTP headers L: integer; begin if FCGX_GetLine(tmp,sizeof(tmp),_in)=nil then // EOF reached? result := '' else begin // get line content L := StrLen(tmp); while (L>0) and (tmp[L-1]<=' ') do dec(L); // in-place trimright SetString(result,tmp,L); end; end; function RemoteIP: RawUTF8; begin result := FCGX_GetParam('REMOTE_ADDR',envp); end;} var call: TSQLRestURIParams; ContentLength,len: integer; param: PPUtf8CharArray; name: string[200]; ID: cardinal; P: PUTF8Char; begin if FCGX_IsCGI then raise ECommunicationException.Create('Server not called as a FastCGI process'); ID := 0; fillchar(call,sizeof(call),0); if Server<>nil then while FCGX_Accept(_in,_out,_err,envp)>=0 do begin // get headers ContentLength := 0; call.Url := ''; AppendBuffersToRawUTF8(call.Url, [FCGX_GetParam('REQUEST_URI',envp),'?',FCGX_GetParam('QUERY_STRING',envp)]); call.Method := ''; inc(ID); call.InHead := 'ConnectionID: '+CardinalToHex(ID)+#13#10; param := pointer(envp); while param[0]<>nil do begin len := StrLen(param[0]); if len>200 then continue; // invalid request SetString(name,PAnsiChar(param[0]),len); if name='CONTENT_LENGTH' then ContentLength := GetCardinal(param[1]) else if name='REQUEST_METHOD' then call.Method := RawUTF8(param[1]) else if name='REMOTE_ADDR' then AppendBuffersToRawUTF8(call.InHead,['RemoteIP: ',param[1],#13#10]); AppendBuffersToRawUTF8(call.InHead,[param[0],': ',param[1],#13#10]); param := @param[2]; end; // get content call.InBody := ''; if ContentLength>0 then begin SetLength(call.InBody,ContentLength); if FCGX_GetStr(pointer(call.InBody),ContentLength,_in)<>ContentLength then continue; // invalid request end; call.RestAccessRights := @SUPERVISOR_ACCESS_RIGHTS; // process the request in the internal TSQLRestServer instance Server.URI(call); ContentLength := length(call.OutBody); call.OutHead := trim(call.OutHead); if call.OutHead<>'' then call.OutHead := call.OutHead+#13#10; call.OutHead := FormatUTF8( '%Status: %'#13#10'Server-InternalState: %'#13#10+ 'X-Powered-By: mORMotFastCGIServer https://synopse.info'#13#10+ 'Content-Length: %'#13#10, [call.OutHead,call.OutStatus,call.OutInternalState,ContentLength]); // send the answer back to the HTTP server if FCGX_PutStr(pointer(call.OutHead),length(call.OutHead),_out)=length(call.OutHead) then if call.OutBody<>'' then FCGX_PutStr(pointer(call.OutBody),ContentLength,_out); end; end; {$else} /// retrieve one Name:Value pair length, as encoded by the FastCGI server // - must be called twice, first for the Name length, then for the Value length function ReadRequestLen(PB: PByteArray; out PNew: PByteArray): integer; begin if PB[0]>127 then begin result := (PB[0] and $7f)shl 24 + PB[1] shl 16 + PB[2] shl 8 + PB[3]; PNew := PByteArray(PtrInt(PB)+4); end else begin result := PB[0]; PNew := PByteArray(PtrInt(PB)+1); end; end; /// retrieve headers as encoded by the FastCGI server // - return the headers as Name:Value pairs by line, ready to be // searched with FindIniNameValue() function function ReadRequestHeader(Buffer: pointer; BufferLen: integer): RawUTF8; var Len0,Len1: integer; PB: PByteArray absolute Buffer; PC: PAnsiChar absolute Buffer; PEnd: PAnsiChar; PResult: PAnsiChar; begin result := ''; if (Buffer=nil) or (BufferLen<=0) then exit; PEnd := PC+BufferLen; repeat Len0 := ReadRequestLen(PB,PB); Len1 := ReadRequestLen(PB,PB); SetLength(result,length(result)+Len0+Len1+4); // 'Name: Value'#13#10 PResult := pointer(result); move(PC^,PResult^,Len0); inc(PC,Len0); inc(PResult,Len0); PResult^ := ':'; inc(PResult); PResult^ := ' '; inc(PResult); move(PC^,PResult^,Len1); inc(PC,Len1); PWord(PResult+Len1)^ := ord(13)+ord(10)shl 8; until PC>=PEnd; end; /// returns TRUE if UpperName is inside the provided headers, as encoded by the // FastCGI server function HasRequestHeader(Buffer: pointer; BufferLen: integer; UpperName: PAnsiChar): boolean; var Len: integer; PB: PByteArray absolute Buffer; PC: PUTF8Char absolute Buffer; PEnd: PUTF8Char; begin result := false; if (Buffer=nil) or (BufferLen<=0) then exit; PEnd := PC+BufferLen; repeat Len := ReadRequestLen(PB,PB)+ReadRequestLen(PB,PB); if IdemPChar(PC,UpperName) then begin result := true; exit; end; inc(PC,Len); until PC>=PEnd; end; /// add a Name:Value parameter, encoded as expected by the FastCGI server procedure AddParam(var Result: RawUTF8; const Name,Value: RawUTF8); var Len: array[0..1] of cardinal; i: integer; P: PUTF8Char; L: cardinal; begin Len[0] := length(Name); Len[1] := length(Value); L := length(Result); if Len[0]>127 then inc(L,4) else inc(L); if Len[1]>127 then inc(L,4) else inc(L); SetLength(result,L+Len[0]+Len[1]); P := pointer(result); for i := 0 to 1 do if Len[i]>127 then begin PCardinal(P)^ := Len[i] shr 24 + 128 + ((Len[i] shr 16) and 255)shl 8+ ((Len[i] shr 8) and 255)shl 16+ (Len[i] and 255)shl 24; inc(P,4); end else begin P^ := AnsiChar(Len[i]); inc(P); end; move(pointer(Name)^,P^,Len[0]); inc(P,Len[0]); move(pointer(Value)^,P^,Len[1]); end; procedure mORMotFastCGIMainProc(Server: TSQLRestServer); var FastCGI: TFastCGIServer; begin FastCGI := TFastCGIServer.Create(Server); try FastCGI.Run; finally FastCGI.Free; end; end; { TFastCGIServer } const MAX_BUFFER = 65536; constructor TFastCGIServer.Create(aServer: TSQLRestServer); {$ifdef MSWINDOWS} var oldStdIn: THandle; pipeMode: cardinal; {$endif} begin inherited Create; fServer := aServer; SetLength(fTempResponse,MAX_BUFFER+8); // enough place SetLength(fTempNamedPipe,MAX_BUFFER); {$ifdef MSWINDOWS} // guess the type (named pipe or socket) of the file descriptor // sent by the server, in order to use it in ReadPacked and SendPacket oldStdIn := GetStdHandle(STD_INPUT_HANDLE); if (GetStdHandle(STD_OUTPUT_HANDLE)=INVALID_HANDLE_VALUE) and (GetStdHandle(STD_ERROR_HANDLE)=INVALID_HANDLE_VALUE) and (oldStdIn<>INVALID_HANDLE_VALUE) and // FastCGI call: only STDIN // Move the handle to a "low" number DuplicateHandle(GetCurrentProcess, oldStdIn, GetCurrentProcess, @hListen, 0, true, DUPLICATE_SAME_ACCESS) and SetStdHandle(STD_INPUT_HANDLE, hListen) then begin CloseHandle(oldStdIn); // Set the pipe handle state so that it operates in wait mode pipeMode := PIPE_READMODE_BYTE or PIPE_WAIT; if SetNamedPipeHandleState(hListen,pipeMode,nil,nil) then flistenType := ltPipeSync else begin flistenType := ltSocketSync; fSocket := TCrtSocket.Create(5000); end; exit; end; // if we reached here, exe was not called as a FastCGI process raise ESynException.CreateUTF8('%.Create: % not called as a FastCGI process', [Self,ExeVersion.ProgramFileName]); {$else} not implemented yet: please use libfcgi.so version, which seems stable & fast under Linux {$endif} end; destructor TFastCGIServer.Destroy; begin {$ifdef MSWINDOWS} if listenType=ltPipeSync then DisconnectNamedPipe(hListen); {$endif} inherited; end; procedure TFastCGIServer.LogOut; begin ; // do nothing by default end; procedure TFastCGIServer.ProcessRequest; var call: TSQLRestURIParams; begin if Server=nil then begin ResetRequest; exit; end; fillchar(call,sizeof(call),0); with call do begin LowLevelConnectionID := PtrInt(self); Url := fRequestURL; Method := fRequestMethod; InHead := 'ConnectionID: '+CardinalToHex(fRequestID); InBody := fRequestBody; RestAccessRights := @SUPERVISOR_ACCESS_RIGHTS; Server.URI(call); fResponseContent := OutBody; fResponseHeaders := FormatUTF8( 'Status: %'#13#10'Server-InternalState: %'#13#10+ 'X-Powered-By: mORMot https://synopse.info'#13#10+ JSON_CONTENT_TYPE_HEADER+#13#10+ 'Content-Length: %'#13#10+ '%', // a void line will be appened in SendResponse() method [OutStatus,OutInternalState,length(OutBody),OutHead]); end; end; function TFastCGIServer.ReadPacked: RawUTF8; {$ifdef MSWINDOWS} var L: integer; {$endif} begin result := ''; if (self=nil) or not ConnectionOpened then exit; {$ifdef MSWINDOWS} case listenType of ltSocketSync: result := fSocket.SockReceiveString; ltPipeSync: repeat L := FileRead(hListen,pointer(fTempNamedPipe)^,length(fTempNamedPipe)); if L<0 then exit; AppendBufferToRawUTF8(result,pointer(fTempNamedPipe),L); until (L''); else exit; end; {$endif} end; procedure TFastCGIServer.ResetRequest; begin fRequestHeaders := ''; fRequestMethod := ''; fRequestURL := ''; fRequestBody := ''; fResponseHeaders := ''; fResponseContent := ''; end; function TFastCGIServer.Run: boolean; var Packet: RawUTF8; PC, PEnd: PUTF8Char; PHead: PFCGIHeader; ValuesResult: RawUTF8; Sin: TVarSin; begin result := false; {$ifdef MSWINDOWS} if not ConnectionOpened then case listenType of ltPipeSync: if not ConnectNamedPipe(hListen,nil) then // allow client connected after CreateNamedPipe but before ConnectNamedPipe if GetLastError<>ERROR_PIPE_CONNECTED then exit; ltSocketSync: begin fSocket.OpenBind('','',false, accept(hListen,Sin)); Assert(False,'if fSocket.SockCanRead(1000)=0 then exit;'); if fSocket.Sock<0 then exit; // invalid socket end; else exit; end; {$else} exit; {$endif} result := true; fConnectionOpened := true; fRequestID := 0; if Server<>nil then repeat Packet := ReadPacked; if Packet='' then break; PC := pointer(Packet); PEnd := PC+length(Packet); repeat PHead := pointer(PC); if PHead^.Version<>1 then begin SendResponse('Version',rtUnknown); break; end; inc(PC,sizeof(TFCGIHeader)); if (fRequestID<>0) and (PHead^.ID<>0) and (PHead^.ID<>fRequestID) then SendEndRequest(psCantMultiplexConnections) else begin case PHead^.RecType of rtBeginRequest: with PFCGIBeginRequest(PHead)^ do if Role in [rResponder..rFilter] then begin fRequestID := Header.ID; fRequestRole := Role; ResetRequest; fRequestHeaders := 'FCGI_ROLE:'+PTypeInfo(TypeInfo(TFCGIRole))^. EnumBaseType^.GetEnumNameTrimed(Role)+#13#10; end else SendEndRequest(psUnknownRole); rtAbortRequest: begin LogOut; // do nothing by default ResetRequest; end; rtGetValues: begin ValuesResult := ''; if HasRequestHeader(PC,PHead^.Len,'FCGI_MAX_CONNS:') then AddParam(ValuesResult,'FCGI_MAX_CONNS','1'); if HasRequestHeader(PC,PHead^.Len,'FCGI_MAX_REQS:') then AddParam(ValuesResult,'FCGI_MAX_REQS','1'); if HasRequestHeader(PC,PHead^.Len,'FCGI_MPXS_CONNS:') then AddParam(ValuesResult,'FCGI_MPXS_CONNS','0'); SendResponse(ValuesResult,rtGetValuesResult); end; rtParams, rtStdIn, rtData: // stream records if PHead^.Len=0 then begin // end of stream is marked by an empty record if PHead^.RecType=rtParams then begin // read Name-Value pair headers stream fRequestHeaders := ReadRequestHeader( pointer(fRequestBody),length(fRequestBody)); fRequestURL := FindIniNameValue(pointer(fRequestHeaders),'REQUEST_URI:')+'?'+ FindIniNameValue(pointer(fRequestHeaders),'QUERY_STRING:'); fRequestMethod := FindIniNameValue(pointer(fRequestHeaders),'REQUEST_METHOD:'); // 'GET' end else begin // handle byte streams: stdin, data -> process in Server.URL ProcessRequest; if (fResponseContent<>'') or SameTextU(fRequestMethod,'GET') or SameTextU(fRequestMethod,'HEAD') then SendResponse(fResponseContent,rtStdOut); SendEndRequest(psRequestComplete); end; fRequestBody := ''; end else // append stream records AppendBufferToRawUTF8(fRequestBody,PC,PHead^.Len); else begin // UNKNOWN_TYPE record SendResponse(RawUTF8(AnsiChar(PHead^.RecType)+#0#0#0#0#0#0#0), rtUnknown); break; end; end; // end case PHead^.RecType end; inc(PC,PHead^.Len+PHead^.PadLen); until PC>=PEnd; until false; end; function TFastCGIServer.SendEndRequest(Status: TFCGIProtocolStatus): boolean; var EndBlock: packed record Head: TFCGIHeader; // inline SendResponse() logic appStatus: integer; protocolStatus: TFCGIProtocolStatus; reserved: array[1..3] of byte; // padding for 8 bytes block length end; begin assert(sizeof(EndBlock)-sizeof(EndBlock.Head)=8); if Status<>psRequestComplete then // on error, send back the English error message as text/html SendResponse(UnCamelCase(PTypeInfo(TypeInfo(TFCGIProtocolStatus))^. EnumBaseType^.GetEnumNameTrimed(Status)),rtStdOut); fillchar(EndBlock,sizeof(EndBlock),0); EndBlock.Head.Version := 1; EndBlock.Head.RecType := rtEndRequest; EndBlock.Head.ID := fRequestID; EndBlock.Head.Len := sizeof(EndBlock)-sizeof(EndBlock.Head); EndBlock.protocolStatus := Status; result := SendPacket(@EndBlock,sizeof(EndBlock)); end; function TFastCGIServer.SendPacket(Buffer: pointer; BufferLen: integer): boolean; {$ifdef MSWINDOWS} var L: integer; {$endif} begin result := false; if (self=nil) or not ConnectionOpened or (BufferLen=0) then exit; {$ifdef MSWINDOWS} case listenType of ltSocketSync: result := fSocket.TrySndLow(Buffer,BufferLen); ltPipeSync: begin repeat L := FileWrite(hListen,Buffer^,BufferLen); if L<0 then exit; dec(BufferLen,L); inc(PtrInt(Buffer),L); until BufferLen<=0; result := true; end; else exit; end; {$endif} end; function TFastCGIServer.SendResponse(Content: RawUTF8; aRecType: TFCGIRecType): boolean; var P: PUTF8Char; PLen: integer; begin if (self=nil) or (fTempResponse='') then begin result := false; exit; // avoid GPF end; if aRecType=rtStdOut then begin // add headers to beginning of content if IdemPChar(pointer(fRequestMethod),'HEAD') then Content := ''; // force no content if only Header was asked for if (fResponseHeaders<>'') and (fResponseHeaders[length(fResponseHeaders)]<>#10) then fResponseHeaders := fResponseHeaders+#13#10; if not ExistsIniName(pointer(fResponseHeaders),HEADER_CONTENT_TYPE_UPPER) then fResponseHeaders := fResponseHeaders+HTML_CONTENT_TYPE_HEADER+#13#10; Content := fResponseHeaders+#13#10+Content; fResponseHeaders := ''; end; with PFCGIHeader(pointer(fTempResponse))^ do begin // use a temporary buffer PInteger(@Version)^ := 1; // will force ID := 0 RecType := aRecType; if not (aRecType in [rtGetValuesResult, rtUnknown]) then ID := fRequestID; P := pointer(Content); PLen := length(Content); repeat // send in 64 KB max chunks Len := PLen-(P-pointer(Content)); if Len>MAX_BUFFER-sizeof(TFCGIHeader) then Len := MAX_BUFFER-sizeof(TFCGIHeader); PadLen := 7 - ((Len + 7) and 7); move(P^,PByteArray(pointer(fTempResponse))^[sizeof(TFCGIHeader)],Len); result := SendPacket(pointer(fTempResponse),sizeof(TFCGIHeader)+Len+PadLen); inc(P,Len); until not Result or (P-pointer(Content)>=PLen); end; end; {$endif} end.