Closed ysair closed 1 year ago
My fix:
type
...
{$ifdef MSWINDOWS}
PInt64Rec = ^Int64Rec; //*** fileSize function
{$ENDIF}
...
THttpSocket = class(TCrtSocket)
protected
...
procedure CompressDataAndWriteHeaders(const OutContentType: SockString;
var OutContent: SockString; const OutContentLength : Integer = -1); //*** add param
...
implementation
...
procedure THttpServer.Process(ClientSock: THttpServerSocket;
ConnectionID: THttpServerConnectionID; ConnectionThread: TSynThread);
...
//*** from SynCommons.pas
function FileSize(const FileName: TFileName): Int64;
{$ifdef MSWINDOWS}
var FA: WIN32_FILE_ATTRIBUTE_DATA;
begin // 5 times faster than CreateFile, GetFileSizeEx, CloseHandle
if GetFileAttributesEx(pointer(FileName),GetFileExInfoStandard,@FA) then begin
PInt64Rec(@result)^.Lo := FA.nFileSizeLow;
PInt64Rec(@result)^.Hi := FA.nFileSizeHigh;
end else
result := 0;
end;
{$else}
var f: THandle;
res: Int64Rec absolute result;
begin
result := 0;
f := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
if PtrInt(f)>0 then begin
res.Lo := GetFileSize(f,@res.Hi); // from SynKylix/SynFPCLinux
FileClose(f);
end;
end;
{$endif MSWINDOWS}
function SendResponse: boolean;
var
fs: TFileStream;
fn: TFileName;
outContentLength : Integer; //add
begin
result := not Terminated; // true=success
if not result then
exit;
{$ifdef SYNCRTDEBUGLOW}
TSynLog.Add.Log(sllCustom2, 'SendResponse respsent=% code=%', [respsent,code], self);
{$endif}
respsent := true;
outContentLength := -1; //*** initialize length
// handle case of direct sending of static file (as with http.sys)
if (ctxt.OutContent<>'') and (ctxt.OutContentType=HTTP_RESP_STATICFILE) then
try
ExtractNameValue(ctxt.fOutCustomHeaders,'CONTENT-TYPE:',ctxt.fOutContentType);
fn := {$ifdef UNICODE}UTF8ToUnicodeString{$else}Utf8ToAnsi{$endif}(ctxt.OutContent);
if not Assigned(fOnSendFile) or not fOnSendFile(ctxt,fn) then begin
if ctxt.Method = 'GET' then begin //*** read file only at GET
fs := TFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
try
SetString(ctxt.fOutContent,nil,fs.Size);
fs.Read(Pointer(ctxt.fOutContent)^,length(ctxt.fOutContent));
finally
fs.Free;
end;
end else
outContentLength := FileSize(fn);
end; //*** end
except
on E: Exception do begin // error reading or sending file
ErrorMsg := E.ClassName+': '+E.Message;
Code := STATUS_NOTFOUND;
result := false; // fatal error
end;
end;
...
// 2.2. generic headers
ClientSock.SockSend([
{$ifndef NOXPOWEREDNAME}XPOWEREDNAME+': '+XPOWEREDVALUE+#13#10+{$endif}
'Server: ',fServerName]);
ClientSock.CompressDataAndWriteHeaders(ctxt.OutContentType,ctxt.fOutContent,outContentLength); //*** add length param
if ClientSock.KeepAliveClient then begin
...
procedure THttpSocket.CompressDataAndWriteHeaders(const OutContentType: SockString;
var OutContent: SockString; const OutContentLength : Integer); //*** add param
var OutContentEncoding: SockString;
begin
if integer(fCompressAcceptHeader)<>0 then begin
OutContentEncoding := CompressDataAndGetHeaders(fCompressAcceptHeader,fCompress,
OutContentType,OutContent);
if OutContentEncoding<>'' then
SockSend(['Content-Encoding: ',OutContentEncoding]);
end;
if OutContentLength < 0 then //*** check param
SockSend(['Content-Length: ',length(OutContent)]) // needed even 0
else
SockSend(['Content-Length: ',OutContentLength]); //*** end
if (OutContentType<>'') and (OutContentType<>HTTP_RESP_STATICFILE) then
SockSend(['Content-Type: ',OutContentType]);
end;
Nice!
Only caveat: the file response could come from a POST, not only a GET. So in my fix, I check for 'HEAD' - and use TFileStream.Size which is good enough for our purpose.
A fix was needed for mORMot 2 too. https://github.com/synopse/mORMot2/commit/0a92cb0e
We can see that the new code was easier to fix, because better organized. A single fix is done for both THttpServer and THttpAsyncServer, which share the same HTTP response logic.
Great work!
Performance will be affected when the file is large, e.g. HEAD http://localhost/bigfile.json
HTTP/1.0 200 OK X-Powered-By: mORMot 1.18 synopse.info Server: mORMot (Windows) Content-Length: 28373948