synopse / mormot Goto Github PK
View Code? Open in Web Editor NEWSynopse mORMot 1 ORM/SOA/MVC framework - Please upgrade to mORMot 2 !
Home Page: https://synopse.info
Synopse mORMot 1 ORM/SOA/MVC framework - Please upgrade to mORMot 2 !
Home Page: https://synopse.info
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..
Line 1010 in 34bf46e
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.
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]
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?
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
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 !
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>
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
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 !
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
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
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;
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.
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
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
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.
SynCrtSock.pas - not defined USHORT for old delphi
Fix:
PackageNameLength: {+}{$if declared(USHORT)}USHORT{$else}Word{$ifend}{+.};
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 :
And I have move declaration and procedure to handle correctly SSL certificate (I create separate unit to do this) in SynCrtSock.pas
Hi! How do you test hundreds of thousands simultaneous connections?
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;
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;
It won't compile without the above fix.
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!
Shouldn't they be updated to 3.35.5?
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?
It would be nice to have the option to initiated a RESTFul authentication using POST in addition, instead of just the GET method.
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.
SQLite 3.35.0 has been released, bringing many powerful functions
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.
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
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
the sqlite3.o and sqlite3.obj are old version and have to be manually updated to the latest 3.33
"SynTable" is missing in "uses" => Undeclared identifier: 'TextColor'
ARM926EJ-S does not support
SQLite3 is updated to 3.6, synsqlite3.pas description is still sqlite3 3.35.5
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?
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;
installed in xe8,
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 !
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
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.
Please roll back the overloaded constructors. Really annoying.
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?
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: ?
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
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.
Hello, I have modified some units for Alexendria compatiblity and critical section approch bug.
Here my modification.
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.
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;
A declarative, efficient, and flexible JavaScript library for building user interfaces.
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
An Open Source Machine Learning Framework for Everyone
The Web framework for perfectionists with deadlines.
A PHP framework for web artisans
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
Some thing interesting about web. New door for the world.
A server is a program made to process requests and deliver data to clients.
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Some thing interesting about visualization, use data art
Some thing interesting about game, make everyone happy.
We are working to build community through open source technology. NB: members must have two-factor auth.
Open source projects and samples from Microsoft.
Google ❤️ Open Source for everyone.
Alibaba Open Source for everyone
Data-Driven Documents codes.
China tencent open source team.