Git Product home page Git Product logo

Comments (4)

ysair avatar ysair commented on June 16, 2024

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;

from mormot.

synopse avatar synopse commented on June 16, 2024

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.

from mormot.

synopse avatar synopse commented on June 16, 2024

A fix was needed for mORMot 2 too.
synopse/mORMot2@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.

from mormot.

ysair avatar ysair commented on June 16, 2024

Great work!

from mormot.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.