mORMot Open Source

Hello,

I have run in Delphi 10.3 update 3 the project ..\SQLite3\Samples\ThirdPartyDemos\George\REST-tester\mORMotRESTsrv.dpr and an exception is raised when I set the port 80 and click on the "Start server" Button.

I have seen the problem and is the following :

In RestServerUnit.pas this code is executed :

  fHTTPServer := TSQLHttpServer.Create(AnsiString(fServerSettings.Port), [fRestServer], '+', useBidirSocket);

After this, in SynCrtSock.pas, the fSock is created in the THttpServer constructor :

  constructor THttpServer.Create
  begin
      .....
      fSock := TCrtSocket.Bind(aPort); // BIND + LISTEN
      ....
  end;

But the line fSock := TCrtSocket.Bind(aPort) raises in the TCrtSocket.OpenBind this exception :

  raise ECrtSocket.CreateFmt('OpenBind(%s:%s,%s) failed: %s', [aServer,fPort,BINDTXT[doBind],BINDMSG[doBind]],-1);

So, when the destructor of the THttpServer occurs, an access violation is raised because fSock has a nil value, concretly here :

   destructor THttpServer.Destroy;
   begin
      ....
      if not fExecuteFinished then begin
        Sock.Close; // shutdown the socket to unlock Accept() in Execute   
        DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1)); // <--------------- WANING, Sock could be nil
      end;
      .............
   end;

I have applied a correction to this code :

   destructor THttpServer.Destroy;
   begin
      ....
      if not fExecuteFinished then begin
        Sock.Close; // shutdown the socket to unlock Accept() in Execute   
        if Sock <> nil then                                                               // <--------------- avoid to use Sock when it is nil
          DirectShutdown(CallServer('127.0.0.1',Sock.Port,false,cslTCP,1));
      end;
      .............
   end;

Thank you.

Hello,

I have seen an issue using TRawByteStringStream.Write.

I did write a integer value, after, several string values, and finally I set the TRawByteStringStream Position to 0 and did write a new integer value  to the beginning of the stream. My surprise was that the TRawByteStringStream Size was cutted.

I think that there is a problem with the SetLength in this method :

function TRawByteStringStream.Write(const Buffer; Count: Integer): Longint;
begin
  if Count<=0 then
    Result := 0 else begin
    Result := Count;
    SetLength(fDataString,fPosition+Result);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Buffer,PByteArray(fDataString)[fPosition],Result);
    inc(FPosition,Result);
  end;
end;

The SetLength is set although the fPosition+Result not be greater than the length of fDataString.

Is it done thinking in performance?.

Would not be more correct this? :

function TRawByteStringStream.Write(const Buffer; Count: Longint): Longint;
begin
  if Count<=0 then
    Result := 0
  else begin
    Result := Count;
    if fPosition+Result > Length(fDataString) then
      SetLength(fDataString,fPosition+Result);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Buffer,PByteArray(fDataString)[fPosition],Result);
    inc(FPosition,Result);
  end;
end;

Thank you.

Hello Administrator,

I have done a modification to SynCrtSock.pas in order to allow customize the block size of the data that is read in TWinHttpAPI.InternalRetrieveAnswer.

The changes has been the following ( I have remarked the changes with the word "changed" )  :

  TWinHttpAPI = class(THttpRequest)
  protected
    ...
    fBlockSize : cardinal; // <------------------------- changed
    ...
  public
    ...
    /// hoy many bytes should be retrieved for each InternalRead in InternalRetrieveAnswer
    property BlockSize : cardinal
      read fBlockSize write fBlockSize; // <---------------------------- changed
  end;

...

function TWinHttpAPI.InternalRetrieveAnswer(
  var Header, Encoding, AcceptEncoding, Data: SockString): integer;
var Bytes, ContentLength, Read: DWORD;
    tmp: SockString;
begin // HTTP_QUERY* and WINHTTP_QUERY* do match -> common to TWinINet + TWinHTTP
    result := InternalGetInfo32(HTTP_QUERY_STATUS_CODE);
    Header := InternalGetInfo(HTTP_QUERY_RAW_HEADERS_CRLF);
    Encoding := InternalGetInfo(HTTP_QUERY_CONTENT_ENCODING);
    AcceptEncoding := InternalGetInfo(HTTP_QUERY_ACCEPT_ENCODING);
    // retrieve received content (if any)
    Read := 0;
    ContentLength := InternalGetInfo32(HTTP_QUERY_CONTENT_LENGTH);
    if Assigned(fOnDownload) then begin
      // download per-chunk using calback event
      Bytes := fOnDownloadChunkSize;
      if Bytes<=0 then
        Bytes := 65536; // 64KB seems fair enough by default
      SetLength(tmp,Bytes);
      repeat
        Bytes := InternalReadData(tmp,0);
        if Bytes=0 then
          break;
        inc(Read,Bytes);
        if not fOnDownload(self,Read,ContentLength,Bytes,pointer(tmp)^) then
          break; // returned false = aborted
        if Assigned(fOnProgress) then
          fOnProgress(self,Read,ContentLength);
      until false;
    end else
    if ContentLength<>0 then begin
      // optimized version reading "Content-Length: xxx" bytes
      if fBlockSize <= 0 then // <------------------------------------------ changed
        SetLength(Data,ContentLength);
      repeat
        // ------------------ changed start
        if fBlockSize > 0 then
        begin
          if Read + fBlockSize > ContentLength then
            Bytes := ContentLength - Read
          else
            Bytes := fBlockSize;
          SetLength( Data, Read + Bytes );
        end;
        // ------------------ changed end
        Bytes := InternalReadData(Data,Read);
        if Bytes=0 then begin
          SetLength(Data,Read); // truncated content
          break;
        end;
        inc(Read,Bytes);
        if Assigned(fOnProgress) then
          fOnProgress(self,Read,ContentLength);
      until Read=ContentLength;
    end else begin
      // Content-Length not set: read response in blocks of HTTP_RESP_BLOCK_SIZE or fBlockSize <------------------- changed
      repeat
        if fBlockSize <= 0 then // <------------------------------- changed
          SetLength(Data,Read+HTTP_RESP_BLOCK_SIZE)
        else
          SetLength(Data,Read+fBlockSize); // <------------------------------- changed
        Bytes := InternalReadData(Data,Read);
        if Bytes=0 then
          break;
        inc(Read,Bytes);
        if Assigned(fOnProgress) then
          fOnProgress(self,Read,ContentLength);
      until false;
      SetLength(Data,Read);
    end;
end;

These changes are very useful when I use a TSQLHttpClient to allow to consume a function of a interface based services server that returns a RawByteString that is very large, and I need that the client application show a progress during the "download" of this data. Without my modification, the OnProgress is only shown once, but If I set the new BlockSize property to 65535 for example, the progress is shown every 65535 bytes received and the user interface is updated showing a responsive progressbar.

Can you tell me if this is usefull for the synopse framework?.

Thank you and best regards.

I have created a vcl form application and created an instance of THttpApiServer class. In the OnRequest event I would like to set the version of the response to set it as HTTP/1.0 instead of HTTP/1.1.

For example, when I receive a request in this format : GET /../jpg/image.cgi HTTP/1.1 .....
I would like to response with : HTTP/1.0 200 OK .... Content-Type: image/jpeg ....

Thank you and best regards.