You are not logged in.
Pages: 1
#0 ntdll:RtlInitializeResource+1251 at :0
#1 ntdll:RtlRaiseStatus+1167 at :0
#2 ntdll:RtlEnterCriticalSection+242 at :0
#3 InitThreadNumber(PSynLogThreadInfo($000000000A7EFFD8)) at mormot.core.log.pas:4628
#4 TSynLog.LockAndDisableExceptions(Failed to read data from register) at mormot.core.log.pas:4716
#5 TSynLog.LogInternalFmt(TSynLog($00000000014DCB40), sllTrace, $000000010057AAF8^: 'UnSubscribe(socket=% seq=%) cnt=% %', PVarRec($000000000A307A98), 4, TObject($00000000014E6930)) at mormot.core.log.pas:5782
#6 TSynLog.DoLog(Internal dereference error, Failed to read data from register, Internal dereference error, Failed to read data from register (while calculating location), Failed to read data from register, Failed to read data from register) at mormot.core.log.pas:5261
#7 TWinIocp.Unsubscribe(Failed to read data from register, Internal dereference error) at mormot.net.sock.windows.inc:1947
#8 TPollAsyncSockets.Stop(TPollAsyncSockets($00000000015075B0), TPollAsyncConnection($000000000AB193B0), 'Fatal Error') at mormot.net.async.pas:1751
#9 TPollAsyncSockets.CloseConnection(TPollAsyncSockets($00000000015075B0), nil, 'Fatal Error') at mormot.net.async.pas:2010
windows11 lazarus 4.0
unit mormot.core.log;
procedure InitThreadNumber(nfo: PSynLogThreadInfo);
GlobalThreadLock.Lock; // It seems that the problem lies with this method.
windows11 lazarus 4.0RC
I can't reproduce it - it work as expected at least on fpc 3.2.2.
edit: ... and mormot 2.3.10775
For testing, I downloaded the latest Lazarus 4.0 RC + mORMot ('2.3.11235'), but I still reproduced the error. I'm not sure if it's my issue or if the code itself is designed that way — it seems necessary to explicitly add the freeing code on exit.
I added the freeing code at the end before exiting, and then the problem did not occur.
Steps to reproduce the error:
Create a new form application, call the units from the mvc-blog example and other necessary units
Run the form application and start it
Open https://localhost/blog/default
Close the form
An error dialog pops up, reproducing the error.
uses
MVCModel, MVCViewModel;
var
Form1: TForm1;
aModel: TOrmModel;
aServer: TRestServerDB;
aApplication: TBlogApplication;
aHTTPServer, aHTTPSServer: TRestHttpServer;
LogFamily: TSynLogFamily;
implementation
{$R *.lfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
aModel := CreateModel;
aServer := TRestServerDB.Create(aModel, ChangeFileExt(Executable.ProgramFileName, '.db'));
aServer.DB.Synchronous := smNormal;
aServer.DB.LockingMode := lmExclusive;
aServer.Server.CreateMissingTables;
aApplication := TBlogApplication.Create;
aApplication.Start(aServer);
aHTTPServer := TRestHttpServer.Create('8092', aServer, '+', HTTP_DEFAULT_MODE, nil, 16, secNone, '', '', HTTPSERVER_DEBUG_OPTIONS);
aHTTPSServer := TRestHttpServer.Create([aServer], '443', 32, secTLS, HTTPSERVER_DEBUG_OPTIONS,
'C:\Users\ssl\mycert.pfx',
'C:\Users\ssl\privkey.pem',
'|&SSSv;"f',
'C:\Users\ssl\cert.pem');
aHTTPSServer.RootRedirectToURI('blog/default');
aServer.RootRedirectGet := 'blog/default';
aHTTPServer.RootRedirectToURI('blog/default'); // redirect / to blog/default
aServer.RootRedirectGet := 'blog/default'; // redirect blog to blog/default
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
aHTTPServer.Free;
aHTTPSServer.Free;
aApplication.Free;
aServer.Free;
end;
implementation
{$R *.lfm}
var
aModel: TOrmModel;
aServer: TRestServerDB;
aApplication: TBlogApplication;
aHTTPServer: TRestHttpServer;
aHTTPServer443: TRestHttpServer;
LogFamily: TSynLogFamily;
procedure TForm1.Button1Click(Sender: TObject);
begin
aModel := CreateModel;
aServer := TRestServerDB.Create(
aModel, ChangeFileExt(Executable.ProgramFileName, '.db'));
aServer.DB.Synchronous := smNormal;
aServer.DB.LockingMode := lmExclusive;
aServer.Server.CreateMissingTables;
aApplication := TBlogApplication.Create;
aApplication.Start(aServer);
aHTTPServer443 := TRestHttpServer.Create([aServer], '443', 32, secTLS, HTTPSERVER_DEBUG_OPTIONS,
'C:\Users\aaa\Desktop\ssl\mycert.pfx',
'C:\Users\aaa\Desktop\ssl\privkey.pem',
'|sBcaVv;"f',
'C:\Users\aaa\Desktop\ssl\cert.pem');
aHTTPServer443.RootRedirectToURI('blog/default');
aServer.RootRedirectGet := 'blog/default';
aHTTPServer := TRestHttpServer.Create('8092', aServer, '+',
HTTP_DEFAULT_MODE, nil, 16, secNone, '', '', HTTPSERVER_DEBUG_OPTIONS);
aHTTPServer.RootRedirectToURI('blog/default'); // redirect / to blog/default
//aHTTPServer.RootRedirectToURI('blog/default', True, True);
aServer.RootRedirectGet := 'blog/default'; // redirect blog to blog/default
end;
Convert the mvc-blog example into a program with a form, without making any other changes. Start the program, then open the web page, and then exit the program. At this point, the following error message will appear: "Access violation writing to address $0000000000000024."
I am using Lazarus 3.0.
Of course, you need to access it via https. https://localhost/blog/default
I need to execute the TJsonClient.Request method inside a thread pool task, but I have a problem: how can I pass an array of const parameter?
In such a situation, how would you operate?
I looked at the official code and found that it directly used the addresses of records and classes.However, both records and classes cannot pass an array of const.
procedure TCustomThreadPool.Task(aCaller: TSynThreadPoolWorkThread; aContext: pointer);
begin
TJsonClient.Request(const Method, ActionFmt: RawUtf8;
const ActionArgs, QueryNameValueParams, HeaderNameValueParams: array of const;
var Res; ResInfo: PRttiInfo;
const CustomError: TOnJsonClientError = nil);
end;
There is not enough RTTI on FPC 3.2.2 to define the record fields.
You need to describe your record with a text definition in your code.
This is what is done for example with our OpenAPI generator.
It's done! Thank you.
On which compiler?
lazarus 3.0
FPC 3.2.2
WIN64
I'm not sure if what I wrote is correct. DataRec can't get the data.
type
TDataRec = packed record
userId: integer;
id: integer;
title: RawUtf8;
completed: boolean;
end;
PDataRec = ^TDataRec;
TDataRecArr = array of TDataRec;
procedure TestJsonClient;
implementation
procedure TestJsonClient;
var
JsonClient: TJsonClient;
DataRecArr: TDataRecArr;
DataRec: TDataRec;
begin
FillChar(DataRecArr, SizeOf(DataRecArr), 0);
JsonClient := TJsonClient.Create('https://jsonplaceholder.typicode.com');
JsonClient.Request('GET', 'todos/%', [1], [], [], DataRec, TypeInfo(TDataRec), nil);
end;
The following is the returned data.
https://jsonplaceholder.typicode.com/todos/1
{
"userId": 1,
"id": 1,
"title": "delectus aut autem",
"completed": false
}
This is really a headache-inducing issue. The Mustache official specification should resolve this problem, or we could implement this functionality directly in the Pascal code. Some online Mustache implementations already treat empty strings as true, and I think this doesn't pose any security risk because {{#section}}...{{/section}} and {{^section}}...{{/section}} are paired constructs. At least in general understanding, they are supposed to work that way; otherwise, it would truly cause confusion.
For just this small feature, I really have to write some code to handle it—it’s definitely not convenient.
I used the mvc-blog example and modified the following code in the articlerow.partial file, but the functionality did not meet my expectations:
<h2 class="blog-post-title"><a href=articleView?id={{id}}>{{Title}}</a></h2>
<h2 class="blog-post-title"><a href=articleView?id={{id}}>{{Title}}{{^Title}}000{{/Title}}</a></h2>
I just checked the mvc-blog source code and found that {{^ }} (the inverted section) is always used with Boolean, Array, or null types. It seems it’s not used with strings. Could it be that it doesn’t work with strings?
I also looked up the inverted.json file but it seems there’s no operation for empty strings.
However, if the following code is rendered on the frontend with JavaScript calling Mustache.min.js, it works fine. I guess it works because my code is similar and also rendered on the frontend:
<h2 class="blog-post-title"><a href=articleView?id={{id}}>{{Title}}{{^Title}}000{{/Title}}</a></h2>
I saw the mormot.core.mustache unit’s RenderContext code and it looks like empty strings are not supported:
procedure TSynMustache.RenderContext(Context: TSynMustacheContext;
TagStart, TagEnd: PtrInt);
mtInvertedSection:
// display section for no key, false value, or empty list
if Context.AppendSection(t^.ValueSpace, t^.Value) <> msNothing then
begin
TagStart := t^.SectionOppositeIndex;
continue; // ignore whole section
end;
I haven’t looked deeper into the code yet, and I might have said something wrong.
I don’t know where I went wrong; the code is still not executing as I expected.
The name field in the MongoDB database is of string type and can be empty "".
{{name}} is correct — it shows empty if the value is empty, or if I write a character in the database, it displays correctly.
I am using TMVCApplication, and these templates are all placed in the frontend HTML.
{
"Result": {
"Data": [
{
"Name": ""
"Sex": "Male"
},
{
"Name": "1"
"Sex": "Male"
}
{
"Name": "2"
"Sex": "Male"
}
]
}
}
None of the following work:
{{#if name, "=", ""}}No name{{/if}}
{{#if name =, ""}}No name{{/if}}
{{#if name,"=",""}}No name{{/if}}
{{#if name=""}}No name{{/if}}
{{^name}}No name{{/name}}
{{#Equals name,""}}No name{{/Equals name,""}}
{{#Equals name,""}}No name{{/Equals}}
The link you gave me, I also looked at it, but I still don't understand.
Is it that strings cannot be compared?
I wrote a RegisterExpressionHelpers myself and got it working, but I still want to understand where I went wrong.
Today I checked, and if Name is empty, the code below doesn't work at all.
{{#Result.Data}}
{{^Result.Data.Name}}Unknown{{/Result.Data.Name}}
{{/Result.Data}}
{{#Result.Data}}
{{^Name}}Unknown{{/Name}}
{{/Result.Data}}
Differences between backend Mustache rendering in Mormot and frontend Mustache.min.js rendering:
Backend data:
{
"Result": {
"Data": [
{
"Name": "John"
},
{
"Sex": "Male"
}
]
}
}
Backend Mustache rendering:
{{#Result.Data}}
{{Name}}{{^Result.Data}}Unknown{{/Result.Data}}
{{/Result.Data}}
Frontend Mustache.min.js rendering:
{{#Result.Data}}
{{Name}}{{^Data}}Unknown{{/Data}}
{{/Result.Data}}
One is a relative path, and the other is an absolute path
While writing the code, I found a small issue. I want to share it here so everyone can avoid spending hours troubleshooting the same problem.
Mustache.min.js is the official code I downloaded; my testing is not rigorous enough
procedure TMvcApplication.DoText(const Value: variant; out Result: variant);
var
D: double = 0;
B: Boolean;
begin
// "D" does not receive a valid result, but integers do
B := VariantToDouble(Value, D);
end;
procedure TMvcApplication.Start(aRestModel: TRest; aInterface: PRttiInfo);
begin
(TMvcRunOnRestServer(fMainRunner).Views as TMvcViewsMustache).
RegisterExpressionHelpers(['DoText'], [@DoText]);
end;
// Frontend template snippet
{{DoText 20.6170212765957}}
Sorry, I don't get what is going on in your code, and what "abnormal" is?
It's not an error, but the data cannot be retrieved if the value is in a format like 20.6170212765957. This is because MongoDB's Double type stores numbers with such long decimal precision.
This is a method I defined using RegisterExpressionHelpers.
(TMvcRunOnRestServer(fMainRunner).Views as TMvcViewsMustache).
RegisterExpressionHelpers(['RatingConvert'], [@RatingConvert]);
procedure TMvcApplication.RatingConvert(const Value: variant; out Result: variant);
var
D: double = 0;
B: boolean;
begin
SetVariantNull(Result);
// Normal
OutputDebugString(PChar(VariantToString(Value)));
VariantToDouble(variant(20.6170212765957), D);
D := Value;
// Abnormal
B := VariantToDouble(Value, D);
end;
Value := 20.6170212765957
I don't know if it's my problem or someone else's problem
TWebServerHsts = (
wshOff,
wshOn,
wshIncludeSubDomains,
wshIncludeSubDomainsPreload);
In TMVCApplication, how to use `TWebServerHsts`?
I created pull request to fix minor ACME client bug:
https://github.com/synopse/mORMot2/pull/367
First of all, thank you very much for sharing
I have reviewed your code and noticed that you associate tmvcapplication and acme through reading and writing local certificate files, rather than linking them directly in the code. Could this cause any issues, such as file access conflicts?
Also, it seems you did not use the RegisterAndWaitFolder CompleteDomainRegistration method. Have you tested your code to ensure it runs completely without any problems?
Sorry, I forgot to check before sending the content.
procedure ACMEStart;
var
F: TFileName;
ES: TAcmeLetsEncryptServer;
I: integer;
Status: TAcmeStatus;
Cert, PrivateKey: RawUtf8;
begin
RegisterOpenSsl;
F := IncludeTrailingPathDelimiter(GetCurrentDir) + 'sslFolder';
ES := TAcmeLetsEncryptServer.Create(TSynLog, F,
ACME_LETSENCRYPT_DEBUG_URL,
'x509-es256', 'jf93v83');
try
ES.LoadFromKeyStoreFolder;
for I := Low(ES.Client) to High(ES.Client) do
with ES.Client[I] do
begin
RegisterAndWaitFolder(F, F, F, 'jf93v83', 3);
repeat
Status := CheckChallengesStatus;
Sleep(1000);
until Status <> asPending;
if Status = asValid then
begin
Status := ES.Client[I].CompleteDomainRegistration(Cert, PrivateKey, 'jf93v83');
end;
end;
ES.CheckCertificatesBackground;
ES.Redirect('xxx.com', 'https://xxx.com');
ES.Redirect('www.xxx.com', 'https://www.xxx.com');
finally
ES.Free;
end;
end;
Below is the JSON file, to be used by the LoadFromKeyStoreFolder method.
{
"contact": "mailto:admin@xxx.com",
"subjects": [
"xxx.com"
"www.com"
]
}
1.Since I don't have a domain name or a public IP, I cannot perform testing. I’m not sure if what I wrote is correct. Is there anything else I should pay attention to?
2.How does ACME integrate with TMvcApplication? Should I directly call RegisterAndWaitFolder to save the certificate files, or how should it be handled?
HttpServer := TRestHttpServer.Create([RestServerDB], '443', 32, secTLS, HTTPSERVER_DEFAULT_OPTIONS,
'C:\Users\FBI\Desktop\BOOK\1\ssl\mycert.pfx',
'C:\Users\FBI\Desktop\BOOK\1\ssl\privkey.pem',
'|&VwVx;2S',
'C:\Users\FBI\Desktop\BOOK\1\ssl\cert.pem'
);
FRestHttpServer.DomainHostRedirect('xxx.com', 'root');
FRestHttpServer.RootRedirectToURI('xxx.com', 'blog/default', true, true);
Thank you very much.
The problem lies in the code below
aHTTPServer.RootRedirectToURI('blog/default', true, true)
// This is fine; HTTP://127.0.0.1 can be accessed.
HttpServer := TRestHttpServer.Create('80', RestServerDB, '+',
HTTP_DEFAULT_MODE, nil, 32, secNone, '', '', HTTPSERVER_DEFAULT_OPTIONS);
// This has a problem; HTTPS://127.0.0.1 cannot be accessed
HttpServer := TRestHttpServer.Create([RestServerDB], '443', 32, secTLS, HTTPSERVER_DEFAULT_OPTIONS,
'C:\Users\FBI\Desktop\BOOK\1\ssl\mycert.pfx', // openssl pkcs12 -inkey privkey.pem -in cert.pem -export -out mycert.pfx
'C:\Users\FBI\Desktop\BOOK\1\ssl\privkey.pem', // openssl genpkey -algorithm RSA -out privkey.pem -pkeyopt rsa_keygen_bits:2048 -aes256
'|&VwVx;2S',
'C:\Users\FBI\Desktop\BOOK\1\ssl\cert.pem' // openssl req -new -x509 -key privkey.pem -out cert.pem -days 3650
);
FRestHttpServer.DomainHostRedirect('127.0.0.1', 'root');
Question 1: Does HTTPS require a public IP address to be effective?
https://127.0.0.1
The following error still occurs
Exception class "ESChannel" at $0000000100357C80 with message "<>: HandshakeStep returned 80090327 [SEC_E_CERT_UNKNOWN], System Error 87 [ERROR_INVALID_PARAMETER]"
Question 2: Is there any problem with the self-signed certificate I generated?
Question 3: Are there any issues with the fields filled in the OpenSSL command, aside from the Common Name? I left all other fields empty.
openssl req -new -x509 -key privkey.pem -out cert.pem -days 3650
Country Name (2 letter code) [AU]:
State or Province Name (full name) [Some-State]:
Locality Name (eg, city) []:
Organization Name (eg, company) [Internet Widgits Pty Ltd]:
Organizational Unit Name (eg, section) []:
Common Name (e.g. server FQDN or YOUR name) []:127.0.0.1
Email Address []:
Question 1:
I am accessing HTTPS://127.0.0.1:443 with a browser, and the server is also running on the same machine. When debugging the program, the compilation shows the following error message. Is it correct that I must use a client with IgnoreCertificateErrors := True; set, otherwise it will report an error? Is my understanding correct?
Exception class "ESChannel" at $0000000100352960 with message "<>: HandshakeStep returned 80090327 [SEC_E_CERT_UNKNOWN], System Error 87 [ERROR_INVALID_PARAMETER]"
Question 2:
If I set secTLS, whether using OpenSSL or Let’s Encrypt, I only need to specify the certificate inside mORMot, and there is no need to specify the certificate inside Windows. Is my understanding correct?
Or, in other words, can I choose to set the certificate either in Windows or in mORMot, and either one will work?
Question 1:
// Exception class "ESChannel" at $0000000100352960 with message "<>: HandshakeStep returned 80090327 [SEC_E_CERT_UNKNOWN], System Error 87 [ERROR_INVALID_PARAMETER]"
Server := TRestHttpServer.Create([RestServer], '8888', 16, secTLSSelfSigned);
According to the instructions here:
https/blog.synopse.info/?post/2022/07/09/Included-TLS-Support-for-mORMot-REST-or-WebSockets
Even after following these, the error persists.
I looked into the code, and during runtime it calls InitNetTlsContextSelfSignedServer → InitNetTlsContext.
I’m not sure if this is due to my setup or some other reason.
Question 2:
Server := TRestHttpServer.Create([RestServer], '8888', 16, secTLSSelfSigned, HTTPSERVER_DEFAULT_OPTIONS, 'CertificateFile', 'PrivateKeyFile', 'PrivateKeyPassword', 'CACertificatesFile');
Is it necessary to reference a self-signed certificate file?
Question 3:
If I set secTLS, do I only need to configure the key files in the Windows system, or do I also need to specify certificate files within mORMot?
Thank you very much for your efforts, thank you.
On delphi? seem a potential tricky lifetime or reference issue.. variable V forces the compiler to go through its standard for variant assignment whereas in direct assignment to 'var result' might become invalid if docVariantArray is modified or freed prematurely.
Maybe try `SetVariantByValue(TDocVariantData(docVariantArray).Values[0], Result);`
class procedure TDocVariant.GetSingleOrDefault(const docVariantArray, default: variant; var Result: variant);
var
vt: cardinal;
V: variant;
begin
vt := TVarData(docVariantArray).VType;
if vt = varVariantByRef then
GetSingleOrDefault(PVariant(TVarData(docVariantArray).VPointer)^, default, Result)
else
if (vt <> DocVariantVType) or (TDocVariantData(docVariantArray).Count <> 1) or not TDocVariantData(docVariantArray).IsArray then
Result := default
else
begin
// Commented out the official code because it cannot get the data
// Result := TDocVariantData(docVariantArray).Values[0];
// This also cannot get the data
// SetVariantByValue(TDocVariantData(docVariantArray).Values[0], Result);
// This works fine
// Result := default;
// The following also works fine
V := TDocVariantData(docVariantArray).Values[0];
Result := V;
end;
end;
Actually, I use AggregateDoc to query the database, and after tracking all the way here, I found the problem. I'm not sure if it's my issue or something else.
class procedure TDocVariant.GetSingleOrDefault(const docVariantArray, default: variant; var Result: variant);
var
vt: cardinal;
V: variant;
begin
vt := TVarData(docVariantArray).VType;
if vt = varVariantByRef then
GetSingleOrDefault(PVariant(TVarData(docVariantArray).VPointer)^, default, Result)
else
if (vt <> DocVariantVType) or (TDocVariantData(docVariantArray).Count <> 1) or not TDocVariantData(docVariantArray).IsArray then
Result := default
else
begin
//This cannot return data
//Result := TDocVariantData(docVariantArray).Values[0];
// But this one can return data
V := TDocVariantData(docVariantArray).Values[0];
Result := V;
end;
end;
Why does this happen? Please help. Thank you.
Pages: 1