synopse / mormot Goto Github PK

Nossa empresa, Sysmo Sistemas, possui um aplicativo de frente de caixa o qual está se fechando após um processo de verificação de integridade da base de dados SQLite em alguns computadores com Windows 10 Pro versão 18363.900.

Código em Deplhi 6:

uses
  mORMot;

[...]

function TRgnSQLiteMaintenance.VerifyDatabaseIntegrity(AServerDatabase: TSQLRestServerDB): Boolean;
var
  oSQLTableJSON: TSQLTableJSON;
begin 
  try
    oSQLTableJSON := AServerDatabase.ExecuteList([], 'PRAGMA integrity_check');
    try
      Result := (oSQLTableJSON <> nil);

      if (Result) then
        Result := (LowerCase(String(oSQLTableJSON.GetS(1,0))) = 'ok');
    finally
      if (oSQLTableJSON <> nil) then
        FreeAndNil(oSQLTableJSON);
    end;
  except
    on E: Exception do
    begin
      Result := False;
      {$IFDEF VER140}
      if (Assigned(LogarErroGeral)) then
        LogarErroGeral('', 'TRgnSQLiteMaintenance.VerifyDatabaseIntegrity: Exception [' + E.Message + ']');
      {$ENDIF}
    end;
  end;
end;

Pelo que foi possível identificar pelos logs a aplicação se fechou quando executou o comando oSQLTableJSON.GetS(1,0).

Suspeitamos que ocorre alguma exceção no processo, mas não é gerada nehuma mensagem de erro e simplesmente fecha a aplicação.

Identificamos em alguns clientes com Windows 10 onde se caso dê alguma exceção no código e o mesmo não é tratado com try except a aplicação é fechada sem apresentar mensagem de erro.
Porém neste caso mesmo com o try except o erro persiste.

Não conseguimos simular internamente, somente em cliente.

Identificamos que em outros computadores com a mesma configuração e versão do Windows não acontece o problema.

Já foram adicionadas permissões de usuário para Controle total e colocado SSD, porém não obteve-se sucesso.

O erro registrado nos eventos do Windows foi:

Nome do Log:   Application
Fonte:         Application Error
Data:          11/06/2020 20:01:34
Identificação do Evento:1000
Categoria da Tarefa:(100)
Nível:         Erro
Palavras-chave:Clássico
Usuário:       N/D
Computador:    caixa01lj5
Descrição:
Nome do aplicativo com falha: pdv10.exe, versão: 3.9.20.3, carimbo de data/hora: 0x2a425e19
Nome do módulo com falha: unknown, versão: 0.0.0.0, carimbo de data/hora: 0x00000000
Código de exceção: 0xc0000005
Deslocamento da falha: 0x00000000
ID do processo com falha: 0xbe0
Hora de início do aplicativo com falha: 0x01d6402ff3dcb7b8
Caminho do aplicativo com falha: c:\pdv\pdv10.exe
Caminho do módulo com falha: unknown
ID do Relatório: 04ede662-fca9-47c6-bcc4-8882091f9ebe
Nome completo do pacote com falha: 
ID do aplicativo relativo ao pacote com falha: 
XML de Evento:
<Event xmlns="http://schemas.microsoft.com/win/2004/08/events/event">
  <System>
    <Provider Name="Application Error" />
    <EventID Qualifiers="0">1000</EventID>
    <Level>2</Level>
    <Task>100</Task>
    <Keywords>0x80000000000000</Keywords>
    <TimeCreated SystemTime="2020-06-11T23:01:34.725905000Z" />
    <EventRecordID>7199</EventRecordID>
    <Channel>Application</Channel>
    <Computer>caixa01lj5</Computer>
    <Security />
  </System>
  <EventData>
    <Data>pdv10.exe</Data>
    <Data>3.9.20.3</Data>
    <Data>2a425e19</Data>
    <Data>unknown</Data>
    <Data>0.0.0.0</Data>
    <Data>00000000</Data>
    <Data>c0000005</Data>
    <Data>00000000</Data>
    <Data>be0</Data>
    <Data>01d6402ff3dcb7b8</Data>
    <Data>c:\pdv\pdv10.exe</Data>
    <Data>unknown</Data>
    <Data>04ede662-fca9-47c6-bcc4-8882091f9ebe</Data>
    <Data>
    </Data>
    <Data>
    </Data>
  </EventData>
</Event>

"SynTable" is missing in "uses" => Undeclared identifier: 'TextColor'

Please roll back the overloaded constructors. Really annoying.

According to the code (shortened for brevity):

   /// get a member from a SQL statement
    // [...]
    // - Execute 'SELECT * FROM TableName WHERE SQLWhere LIMIT 1' SQL Statememt
    // [...]
    function Retrieve(const SQLWhere: RawUTF8; Value: TSQLRecord;
      const aCustomFieldsCSV: RawUTF8=''): boolean; overload; virtual;

In the log files, I observe no "limit" clause. The method still works fine (I get the first record) but I worry a little bit about performance (there may be thousands of matching records).

20201212 15325432 SQL   	mORMotSQLite3.TSQLRestServerDB(0540a4a0) 203us returned 4 rows as 479 B SELECT ID,Sucursal,Terminal,Fecha,Folio,Total,Disponible,TrackId FROM StorageBoleta WHERE Disponible is NULL and Sucursal is NULL and Terminal is NULL

Is this by design?

Going through the documentation it seems that the examples at 4.3.1. TList-like properties has a mistake:

for i := GroupA.Count-1 downto 0 do
    if i and 3=0 then ///!!!!<<<< here it seems that it shoudl be "GroupA[3] = 0" or something similar
      GroupA.Delete(i); // delete integer at index i

the sqlite3.o and sqlite3.obj are old version and have to be manually updated to the latest 3.33

Hello, I have modified some units for Alexendria compatiblity and critical section approch bug.
Here my modification.

• SynCrtSock : i have only move sone part of code to gain access to WinHttp.
• SynCommons : use an Integer instead of boolean for fLocked and correct approch to TSynLocker.TryLock !!!
• Synopse.inc : add support of Delphi 11.

mORMot.zip
.

Hello,

My system is in french language and when a winhttp.dll error is raised in SynCrtSock, I only have the error code but no textual explanation.

May I suggest a slight modification in SynCrtSock ?
The function SysErrorMessagePerModule, could be modified to fall back to the default behaviour (cf. https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-formatmessage) if english langage is not available.
Moreover, it may also be useful to use the FORMAT_MESSAGE_IGNORE_INSERTS flag (cf. https://devblogs.microsoft.com/oldnewthing/20071128-00/?p=24353).

  tmpLen := FormatMessage(
    FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS,
    pointer(GetModuleHandle(ModuleName)),Code,ENGLISH_LANGID,@err,0,nil);
  // if string is empty, it may be because english is not found
  if (tmpLen = 0) then
     tmpLen := FormatMessage(
       FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS,
       pointer(GetModuleHandle(ModuleName)),Code,0,@err,0,nil);

Thank you !

At least on the Delphi side this is more and more considered best practice - and it is a pain to update these manually every time we update mORMot - hopefully this is the norm in mORMot2 - with all the other great "cleanups" :)

Thanks

Shouldn't they be updated to 3.35.5?

The comments say

Using secp256r1 curve from "simple and secure ECDH and ECDSA library"
Copyright (c) 2013, Kenneth MacKay - BSD 2-clause license
https://github.com/esxgx/easy-ecc

but the actual repository seems to be

https://github.com/kmackay/micro-ecc

11.1. Client-Server cheat sheet

https://synopse.info/files/html/Synopse%20mORMot%20Framework%20SAD%201.18.html#TITL_204

Beware ... Security/design flows

should be: flAws not flOws

OK, I'me aware to use Git/TortoiseGit so I send an issue.

There is a problem in criticalsection mamagment so I change SynCommons.pas :

• Replace fLocked to Integer frm boolean (to manage nested calls)
• Correct function TSynLocker.TryLock function to NOT CHECK fLocked !

And I have move declaration and procedure to handle correctly SSL certificate (I create separate unit to do this) in SynCrtSock.pas

mORMot.zip

I use Lazarus 2.0.10 with FPC 3.2.0.
While using mORMot with TQuery, I constat that the function

TQuery.FieldByName('ffield').AsString;
TQuery.FieldByName('ffield').AsWideString;

returns bad when it encounters accent characters ( é, à, è, ... ).
So I have bypassed this problem with the following modifications in the code in SynDB.pas :

function TQueryValue.GetAsWideString: SynUnicode;
begin
  CheckValue;
  with TVarData(fValue) do
  case VType of
    varNull:     result := '';
    varInt64:    result := UTF8ToSynUnicode(Int64ToUtf8(VInt64));
    {$ifdef fpc}
    varString:   result := WideString(RawUTF8(VAny));//UTF8ToSynUnicode(RawUTF8(VAny));
    {$else}
    varString:   result := UTF8ToSynUnicode(RawUTF8(VAny));
    {$endif}
    {$ifdef HASVARUSTRING}
    varUString:  result := UnicodeString(VAny);
    {$endif}
  else Result := SynUnicode(fValue);
  end;
end;  

and :

function TQueryValue.GetString: string;
begin
  CheckValue;
  with TVarData(fValue) do
  case VType of
    varNull:     result := '';
    varInteger:  result := IntToString(VInteger);
    varInt64:    result := IntToString(VInt64);
    varCurrency: result := Curr64ToString(VInt64);
    varDouble:   result := DoubleToString(VDouble);
    varDate:     result := Ansi7ToString(DateTimeToIso8601Text(VDate,' '));
    {$ifdef FPC}
    varString:   result := String(RawUTF8(VAny)); //UTF8ToString(RawUTF8(VAny));
    {$else}
    varString:   result := UTF8ToString(RawUTF8(VAny));
    {$endif}
    {$ifdef HASVARUSTRING}
    varUString:  result := string(UnicodeString(VAny));
    {$endif HASVARUSTRING}
    varOleStr:   result := string(WideString(VAny));
    else result := fValue;
  end;
end;       

So If you find that my corrections are correct, It will be geat to incorporaate them.
Thanks.

PS: github is not formatting code correctelly.

Converting the SQLite3/Samples/12 - SynDB Explorer/DBSynLZ.dpr to Lazarus and building it segfaults due to a endless recursive loop here:

function FileSize(F: THandle): Int64;
var res: Int64Rec absolute result;
begin
  result := 0;
  if PtrInt(F)>0 then
    res.Lo := FileSize(F); { *Converted from GetFileSize* } // from WinAPI or SynKylix/SynFPCLinux
end; 

Changing this line seem to fix the problem:

res.Lo := FileSize(F); { *Converted from GetFileSize* } // from WinAPI or SynKylix/SynFPCLinux

by:

res.Lo := GetFileSize(F, nil); { *Converted from GetFileSize* } // from WinAPI or SynKylix/SynFPCLinux

Hi, I remembered Mormot had a faster Pos function. I was doing really a lot of Pos in some code while bruteforcing some compression code. Changing system.pos for syncommons.pos make it 5x slower. Both string and substring to search are declared as ansistrings.
Is this normal?

Hello,

I have a test server where https port is set to ask for a client certificate (it can be done via command line : netsh http add sslcert ipport=0.0.0.0:443 certhash=XXhashXX appid={XXappidXX} clientcertnegotiation=enable).

When I send an https request with THttpRequest.Request, I should have a 12044 error (ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED), but I have an error 12019 (ERROR_INTERNET_INCORRECT_HANDLE_STATE).
I think there is a problem with the conditions in procedure TWinHTTP.InternalSendRequest. I propose the following modification :

  L := length(aData);
  if not _SendRequest(L) or
     not WinHttpAPI.ReceiveResponse(fRequest,nil) then begin
    **if fHTTPS and IgnoreSSLCertificateErrors and (GetLastError=ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED) then begin**
      if not WinHttpAPI.SetOption(fRequest,WINHTTP_OPTION_SECURITY_FLAGS,
         @SECURITY_FLAT_IGNORE_CERTIFICATES,SizeOf(SECURITY_FLAT_IGNORE_CERTIFICATES)) then
        RaiseLastModuleError(winhttpdll,EWinHTTP);
      if not WinHttpAPI.SetOption(fRequest,WINHTTP_OPTION_CLIENT_CERT_CONTEXT,
         pointer(WINHTTP_NO_CLIENT_CERT_CONTEXT),0) then
        RaiseLastModuleError(winhttpdll,EWinHTTP);
      if not _SendRequest(L) or
         not WinHttpAPI.ReceiveResponse(fRequest,nil) then
        RaiseLastModuleError(winhttpdll,EWinHTTP);
    **end else
       RaiseLastModuleError(winhttpdll,EWinHTTP);**
  end;

Thank you !

in method :

function _PdfDateToDateTime(const AText: TPdfDate): TDateTime;
var Y,M,D, H,MI,SS: cardinal;
begin
if Length(AText)<16 then
EConvertError.CreateRes(@SDateEncodeError);
Y := ord(AText[3])*1000+ord(AText[4])*100+ord(AText[5])*10+ord(AText[6])
-(48+480+4800+48000);
M := ord(AText[7])*10+ord(AText[8])-(48+480);
D := ord(AText[9])*10+ord(AText[10])-(48+480);
result := EncodeDate(Y,M,D);
H := ord(AText[11])*10+ord(AText[12])-(48+480);
MI := ord(AText[13])*10+ord(AText[14])-(48+480);
SS := ord(AText[15])*10+ord(AText[16])-(48+480);
if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
result := result + (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec) / MSecsPerDay else
EConvertError.CreateRes(@SDateEncodeError);
end;

Raise is missing .

correct code:

function _PdfDateToDateTime(const AText: TPdfDate): TDateTime;
var Y,M,D, H,MI,SS: cardinal;
begin
if Length(AText)<16 then
raise EConvertError.CreateRes(@SDateEncodeError);
Y := ord(AText[3])*1000+ord(AText[4])*100+ord(AText[5])*10+ord(AText[6])
-(48+480+4800+48000);
M := ord(AText[7])*10+ord(AText[8])-(48+480);
D := ord(AText[9])*10+ord(AText[10])-(48+480);
result := EncodeDate(Y,M,D);
H := ord(AText[11])*10+ord(AText[12])-(48+480);
MI := ord(AText[13])*10+ord(AText[14])-(48+480);
SS := ord(AText[15])*10+ord(AText[16])-(48+480);
if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
result := result + (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec) / MSecsPerDay else
raise EConvertError.CreateRes(@SDateEncodeError);
end;

Those functions currently contain an infinite loop for some special cases of compressed stream corruption, they have a repeat...until loop which looks like

    repeat
      code := Check(inflate(strm, Z_FINISH),[Z_OK,Z_STREAM_END,Z_BUF_ERROR],'UnCompressStream');
      FlushBuf;
    until code=Z_STREAM_END;

And Check() is thus set to accept Z_BUF_ERROR while the until test does not cover for the case when FlushBuf will not handle it.

To reproduce run the following code on the deflate.bomb file that is inside the attached zip. The issue occurs on both Win32 and Win64.

var
   f : TFileStream;
   buf : TBytes;
   outBuf : ZipString;
begin
   f := TFileStream.Create('c:\temp\deflate.bomb', fmOpenRead);
   SetLength(buf, f.Size);
   f.Read(buf[0], f.Size);
   UnCompressZipString(Pointer(buf), f.Size, outBuf, nil, False, 64*1024);  // never ends
end.

deflate.bomb.zip

After updating to the 07/07/2020 version, an error occurs in the ".CreateMissingTables" method when creating tables with non-lowercase names.
Example:
testtest OK
testTest Error

procedure TForm1.OnDisconnect(const Conn: THttpApiWebSocketConnection;
  aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
begin
  if Assigned(Conn.PrivateData) then
  begin
    //Conn.PrivateData  :=  nil;  //compile error: E2064 Left side cannot be assigned to
    PHttpApiWebSocketConnection(@Conn).PrivateData  :=  nil;
  end;
  TSynLog.Add.Log(sllInfo, '% - disconnect', [Conn.Index]);
end;

Can I change it to

THttpApiWebSocketConnection = record
...
property PrivateData: pointer read fPrivateData write fPrivateData; // write SetPrivateData?

It would be nice to have the option to initiated a RESTFul authentication using POST in addition, instead of just the GET method.

I tried the code:
aConProp:=TSQLDBZEOSConnectionProperties.Create(
TSQLDBZEOSConnectionProperties.URI('OleDB[mssql]', '', ''),
Format(csConStr,[aSQLServer,aDatabase]),aLogin,aPWD);
try
aStmt:=aConProp.NewThreadSafeStatementPrepared(csSQL,True,True);
aStmt.Bind([aUserID]);
aStmt.ExecutePrepared;
if aStmt.Step then
aName:=aStmt.ColumnString(0);
except
On E: Exception do begin
TSynLog.Add.Log(sllServer,'Connect failed :% ',[E.Message]);
raise
end;
end;

It shows AV message instead of "OLEDB Error 80040E4D: SQLState: Login failed for user..." when user login denied.

I noticed when login denied the Stmt instance will be nil but still be referenced in exception block.

I revised TryPrepare procedure exception block like below and then works fine. Hope this can help.

procedure TryPrepare(doraise: boolean);
var Stmt: TSQLDBStatement;
begin
....
except
on E: Exception do begin
StringToUTF8(E.Message,fErrorMessage);
fErrorException := PPointer(E)^;
if assigned(Stmt) then begin
{$ifndef SYNDB_SILENCE}
with SynDBLog.Add do
if [sllSQL,sllDB,sllException,sllError]*Family.Level<>[] then
LogLines(sllSQL,pointer(Stmt.SQLWithInlinedParams),self,'--');
{$endif}
Stmt.Free;
end else
with SynDBLog.Add do
if [sllSQL,sllDB,sllException,sllError]*Family.Level<>[] then
LogLines(sllSQL,pointer(fErrorMessage),self,'--');
result := nil;
if doraise then
raise;
end;

SQLite3 is updated to 3.6, synsqlite3.pas description is still sqlite3 3.35.5

The change in pull request 46 seems to be invalid: synopse/SynPDF#46

Here is the code I used to test this.

The output was:
MS Sans Serif 2
Microsoft Sans Serif 2
Courier New 1
Courier 1

This means that "(ALogFont.lfPitchAndFamily and 3) = FIXED_PITCH" would evaluate for the parameter AIsFixedWidth to

MS Sans Serif 2 => False
Microsoft Sans Serif 2 => False
Courier New 1 => True
Courier 1 => True

This is correct.

@maykon-t can you test on your computer?

// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
program TestFonts;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    System.SysUtils, Windows;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
    FontType: Integer; Data: Pointer): Integer; stdcall;
begin
    WriteLn(string(LogFont.lfFaceName), ' ', LogFont.lfPitchAndFamily and 3);

    Result := 1;
end;

var
    DC: HDC;
    F: LOGFONTW;
begin
    DC := GetDC(0);
    try
        FillChar(F, sizeof(F), 0);
        F.lfCharset := DEFAULT_CHARSET;
        EnumFontFamiliesEx(DC, F, @EnumFontsProc, 0, 0);
    finally
        ReleaseDC(0, DC);
    end;
    ReadLn;
end.

SynCrtSock.pas - not defined USHORT for old delphi

Fix:
PackageNameLength: {+}{$if declared(USHORT)}USHORT{$else}Word{$ifend}{+.};

In case client transfer body in compressed chunked format:

Transfer-Encoding: gzip, chunked

THttpSocket.GetHeader don't recognize neither this is chunked encoding nor chunks is compressed

We can delay this issue since for a while I have not met such requests in the real life..

When did something like this:
TSQLSampleRecord.AutoFree(Rec, Database, '(ID in (1,2) or ID in (3,4))', []);
the sql clause became: 'select ID,Time,Name,Question from SampleRecord where (ID in (1,2) or ID in (3,4)'. I fixed it like this (SynTable.pas, GetWhereExpression):

'n','N': begin
Where.Operator := opIn;
P := GotoNextNotSpace(P+2);
if P^<>'(' then
exit; // incorrect SQL statement
B := P; // get the IN() clause as JSON
inc(P);
while (P^<>')') or (P[1]=':') do // handle :(...): within the clause
if P^=#0 then
exit else
inc(P);
inc(P);
SetString(Where.Value,PAnsiChar(B),P-B);
Where.ValueSQL := B;
Where.ValueSQLLen := P-B;
result := GetWhereValues(Where);
P := GotoNextNotSpace(P);
if (P^=')') and (Where.FunctionName='') then begin
B := P;
repeat
inc(P);
until not (P^ in [#1..' ',')']);
while P[-1]=' ' do dec(P); // trim right space
SetString(Where.ParenthesisAfter,B,P-B);
P := GotoNextNotSpace(P);
end;
exit;
end;

The output of this JSON format with some special characters is incorrect and truncated, but it can be correctly formatted in vscode. This should be a correct JSON：

{"id":{"$oid":"5f51f7fc1a313f6ce3535b77"},"@timestamp" :"2020-09-03T03:16:17.137Z","log" : {"offset" :543391,"file" : {"path" :"C:\Program Files\rempl\Logs\Remediation.011.etl"}},"message" :"CV'#0#2'SetDisableUXWUAccess'#0#1'DoNotConnectToWindowsUpdate'#0#1'NoAutoUpdate'#0#1'AuOptions'#0#1'isRegisteredWithMU'#0#7'isRegisteredWithWU'#0#7'isRegisteredWithWS'#0#7'isRegisteredWithDCAT'#0#7'isRegisteredWithOther'#0#7'2'#0'0'#0'1'#0'8'#0'.'#0'3'#0'C'#0#0#0'�'#2#0#0#0#0#0#0'mnM5lRlFzUSYZhmx.0'#0'K'#0'E'#0'Y'#0''#0'N'#0'O'#0'T'#0''#0'F'#0'O'#0'U'#0'N'#0'D'#0#0#0'K'#0'E'#0'Y'#0''#0'N'#0'O'#0'T'#0''#0'F'#0'O'#0'U'#0'N'#0'D'#0#0#0'K'#0'E'#0'Y'#0''#0'N'#0'O'#0'T'#0''#0'F'#0'O'#0'U'#0'N'#0'D'#0#0#0'K'#0'E'#0'Y'#0''#0'N'#0'O'#0'T'#0'_'#0'F'#0'O'#0'U'#0'N'#0'D'#0#0#0#0#0#0#0#1#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0'eY'#7#$13'�'#1#0#0#0'��'#1#0'��'#1#0'F�'#3'�'#1#0#0#0#$1C'9&tBsKB�C��8m^��7'#0#$B#1#0#0#0#1#0#0#0#0'�'#0#0#4#0#0#0#3#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'@'#0#$C#0#1#0'3'#0'3'#0'Microsoft.Windows.Remediation'#0#$13#0#1#$1A'sPO蠅�G�����'#4'v�'#0#0#0#0#0'�'#3#$B#0#0#0'�'#3'�'#3'","input" : {"type" :"log"},"agent" : {"name" :"XLY-LIURONG","type" :"filebeat","version" :"7.9.0","hostname" :"XLY-LIURONG","ephemeral_id" :"e3a78cca-67a7-4b7f-a7fd-bee382589b49","id" :"f39d3911-acef-44f7-bfff-08c9bd2e2ef8"},"ecs" : {"version" :"1.5.0"},"host" : {"os" : {"platform" :"windows","version" :"10.0","family" :"windows","name" :"Windows 10 Education","kernel" :"10.0.17134.1667 (WinBuild.160101.0800)","build" :"17134.1667"},"id" :"b2789ed2-a7cd-49e9-8a58-4229c1e43034","ip" : ["fe80::2094:8e7e:e734:8fb9","192.168.0.52","fe80::69e5:ad7c:10c1:586a","169.254.88.106","fe80::d5e7:eedf:d448:d6f5","192.168.202.1","fe80::15d5:993:d2d2:54d3","192.168.40.1"],"name" :"XLY-LIURONG","mac" : ["34:97:f6:29:8e:76","0a:00:27:00:00:13","00:50:56:c0:00:01","00:50:56:c0:00:08"],"hostname" :"XLY-LIURONG","architecture" :"x86_64"}}

mORMot master, Delphi 10.2.3, Win 10 LTSC 2019
I'm sorry,I can't reproduce this problem. It seems to only appear in my program. When I copy the JSON into a file and read it from the file, it is properly formatted!

Scenario:
Windows 10, 64 bit Lazarus 2.2.2, 64 bit Freepascal 3.2.2
Sample 14 - Interfaced based services

In Project14ServerHttp.dpr
Change the method 'Add' by inserting an exception:
function TServiceCalculator.Add(n1, n2: integer): integer;
begin
result := n1+n2;
raise Exception.Create('Test'); // <<< insert this exception
end;

In browser type:
http://localhost:8888/root/calculator/add?n1=1&n2=2
The first execution is ok, the exception is showed correctly
but execute again... the server goes down with the message... >>> Fatal error, External Exception: ?

ARM926EJ-S does not support

TDateTimeMS type is supposed to have a millisecond part, when adding to an external database (e.g., PostgreSQL).

It works as expected if the record is added individually using the Add method.

Howerver, when BatchAdd, mORMot will mistakenly strip off the millisecond part of TDateTimeMS field inside method TSQLDBStatementWithParams.BindArray , Line 7891-7896, of SynDB.pas:

if (ParamType=ftDate) and (ChangeFirstChar<>'T') then
    for i := 0 to ValuesCount-1 do // fix e.g. for PostgreSQL
      if (p^.VArray[i]<>'') and (p^.VArray[i][1]='''') then begin
        v.From(PUTF8Char(pointer(p^.VArray[i]))+1,length(p^.VArray[i])-2);
        p^.VArray[i] := v.FullText({expanded=}true,ChangeFirstChar,'''');
      end;

I also checked the mORMot-generated SQL query sent to the database engine., which confirmed the above issue.

Can you please double check? Thanks.

Hello,

If I use SyCrtSock's THttpRequest.Request to make an https request to an url with a machine name only, without the domain information, there is obviously a security error because the CN is invalid.
But the error message contains only the error code and is thus hard to understand : "WinHTTP security error. Status 65536, statusInfo: 16".
Could the procedure WinHTTPSecurityErrorCallback be enhanced to give more explanation, for example :

procedure WinHTTPSecurityErrorCallback(hInternet: HINTERNET; dwContext: PDWORD;
  dwInternetStatus: DWORD; lpvStatusInformation: pointer; dwStatusInformationLength: DWORD); stdcall;
var
   err : String;
   code : DWORD;
begin
  code := pdword(lpvStatusInformation)^;
  err := '';
  if code and $00000001 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_CERT_REV_FAILED | ';
  if code and $00000002 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_INVALID_CERT | ';
  if code and $00000004 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_CERT_REVOKED | ';
  if code and $00000008 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_INVALID_CA | ';
  if code and $00000010 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_CERT_CN_INVALID | ';
  if code and $00000020 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_CERT_DATE_INVALID | ';
  if code and $00000040 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_CERT_WRONG_USAGE | ';
  if code and $80000000 > 0 then err := err + 'WINHTTP_CALLBACK_STATUS_FLAG_SECURITY_CHANNEL_ERROR | ';
  if err <> '' then err := ': ' + Copy(err, 1, Length(err) - 3);
  // in case lpvStatusInformation^=-2147483648 this is attempt to connect to
  // non-https socket wrong port - perhaps must be 443?
  raise EWinHTTP.CreateFmt('WinHTTP security error. Status %d, statusInfo: %d (%s)',
    [dwInternetStatus, code, '$' + IntToHex(code, 8) + err]);
end;

Thank you !

I'm using Delphi 7 and with the following function the attached zip is decompressed as two 0-bytes files (all other zip decompressors correctly decompress them as two non-empty files):

function UnzipFile(sSrcPathName: string; sDestPath: string): boolean;
var zip: TZipRead;
iCont: integer;
begin
result:= false;

zip:= TZipRead.Create(sSrcPathName, 0, 0, {ShowMessageBoxOnError=} true);
try
    for iCont:= 0 to zip.Count-1 do
        if not zip.UnZipFile(iCont, sDestPath, {ForceWriteFlush=} true) then
            exit;
finally
    zip.Free;
end;

result:= true;

end;

Test.zip

SQLite 3.35.0 has been released, bringing many powerful functions

Hi,
While trying to connect to Shutdown RemoteDB server an exception is raised ( witch is normal ) but with memory leak while closing the application.
Try to execute this little application.

I use lazarus-2.0.12 fpc-3.2.2

testExcepCnt.zip

When using with FPC+Win64 SynZip.pas will link static\x86_64-win64sse*.o static libraries, providing access to the accelerated CloudFlare zlib. Can I suggest that the static libraries included with this repository are updated to the latest version of CloudFlare. A recently merged pull request has made the CloudFlare zlib ~33% faster at decompressing files.

Compile package mormot_base 1.18: Exit code 1, Errors: 8, Warnings: 3
SynCommons.pas(7332,23) Warning: Some fields coming after "" were not initialized
SynCommons.pas(13807,42) Warning: Some fields coming after "VType" were not initialized
SynCommons.pas(15370,56) Warning: Some fields coming after "VOptions" were not initialized
SynFPCTypInfo.pas(91,31) Error: Identifier not found "PInterfaceData"
SynFPCTypInfo.pas(91,45) Error: Error in type definition
SynFPCTypInfo.pas(92,32) Error: Identifier not found "PVmtMethodParam"
SynFPCTypInfo.pas(92,47) Error: Error in type definition
SynFPCTypInfo.pas(93,33) Error: Identifier not found "PIntfMethodTable"
SynFPCTypInfo.pas(93,49) Error: Error in type definition
SynFPCTypInfo.pas(94,33) Error: Identifier not found "PIntfMethodEntry"
SynFPCTypInfo.pas(94,49) Error: Error in type definition

installed in xe8,

Hey,
i used the THttpApiServer from current master branch, and attached a OnRequest handler.
I had to notice that a bufferoverread happens for the FullUrl from THttpServerRequest. This is only the case for THttpServerRequest.FullUrl, THttpServerRequest.Url is correct.

Since the nullterminator is correct there, i current work around that by using Split([#0])[0]

SysGdiPlus.pas; line 628ff:

fConvertToEmfPlus: function(graphics, image: THandle; var flag: BOOL;
emftype: TEmfType; description: PWideChar; var out_metafile: integer): TGdipStatus; stdcall;

The out_metafile type must be THandle (or NativeUInt) to be 64 bit save. The current declaration leads to access violations in 64 bit applications. Also the declarion for "EmfPlusImg" in function TGDIPlusFull.ConvertToEmfPlus must be changed to THandle.

this declaration generated error:

  THeapMemoryStream = class(TMemoryStream)
  protected
    function Realloc(var NewCapacity: longint): Pointer; override;
  end;

[dcc64 Error] SynCommons.pas(13427): E2037 Declaration of 'Realloc' differs from previous declaration
longint vs NativeInt. It should be declared as:

THeapMemoryStream = class(TMemoryStream)
protected
  function Realloc(var NewCapacity: NativeInt): Pointer; override;
end;

1. The interface USES section should include SynTable and SynOleDB - these two are missing.
2. Line 287 missing the ; statement terminator
   meta.Restrictions.Values['TABLE_SCHEMA'] := UTF8ToString(UpperCase(Owner))

It won't compile without the above fix.

Current implementation of THttpApiServer always expect Content-Length header to be present - https://github.com/synopse/mORMot/blob/master/SynCrtSock.pas#L9307

In case of Transfer-Encoding: chunked content length not present and we got an empty request body.

Command to reproduce:

curl -H "Transfer-Encoding: chunked" -H "Content-Type: text/xml;charset=UTF-8" -d "chunk of data" http://localhost:8881/anyUri

I use Delphi program to open SQLite database with TSQLRestServerDB. Lockingmode: = lmnormal. The compiler runs on Linux. When the second program is opened, an error is reported: esqlite3exception {"errorcode": 26, "sqlite3errorcode": "secnotadb", "message": "error sqlite_notadb (26) [dbopen] using 3.34.1 with ADB = nil"}.

But it is possible to run on windows.

What is the matter? How should it be solved?

With latest versions, I face some issues when generating code wrappers to access my SOA interfaces.

Some types are missing from methods' signature.

e.g.

function ValidateUserLogin(const inUserName, inUserPassword: String; out outUserInfo: TMyUserInfo): Boolean;

is wrapped as

function ValidateUserLogin(const inUserName, inUserPassword: String; out outUserInfo: ): Boolean;

After narrowing the issue with git bisect, it seems I found the culprit.

in SQLite3/mORMotWrappers.pas, inside TWrapperContext.ContextFromInfo(), around line 948

trimcopy(typName,i+1,maxInt,typName);

the same string is passed as const & out parameter and gets cleared when entering trimcopy.

FYI I'm using delphi 10.1

all the best
Sylvain

Hi! How do you test hundreds of thousands simultaneous connections?

I'm no expert, but it seems that last character '\' should be '/'.
https://sourceforge.net/p/sevenzip/discussion/45797/thread/30a0833bc9/?limit=25#135d
7Zip doesn't handle the \ and replaces it with a unicode dot instead of handling it as a sub-folder.

Hello.
I have the following problem.I compile and run mormot http server on port X using delphi 10.4.1.
When I start accidentally 2 http servers on the same port, mormot allows me to do that.
The exception is raised, but it somehow is ignored.
Is it an intended behaviour? Can I somehow check in my code, that mormot http server was started succefully?

Thank You.