THttpServer : Executing the HEAD request will read the entire file

[ysair]

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

procedure THttpServer.Process(ClientSock: THttpServerSocket;
  ConnectionID: THttpServerConnectionID; ConnectionThread: TSynThread);

...

    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
          fs := TFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
          try
            SetString(ctxt.fOutContent,nil,fs.Size);
            fs.Read(Pointer(ctxt.fOutContent)^,length(ctxt.fOutContent));  //reading file content is slow
         finally
            fs.Free;
          end;
         end;

[ysair]

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;

[synopse]

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.

[synopse]

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.

[ysair]

Great work!