使用 Indy OpenSSL 和 MySql 时出现访问冲突
Access Violation When Using Indy OpenSSL and MySql
使用MySql 8.0.16、Delphi 10.3 Rio，以及附带的标准版Indy。
我正在使用 TIdServerIOHandlerSSLOpenSSL 的实例和 TIdHttpServer 的实例，使用从 Fulgan 下载的 OpenSSL 1.0.2s。我所有的 Indy 组件都是在运行时用代码创建的。
在我关闭应用程序并从 IdSSLOpenSSL.pas 文件的 finalization 部分调用 IdSSLOpenSSLHeaders.Unload() 中出现访问冲突之前，一切似乎都正常。
Project rasied exception class $C0000005 with message 'c0000005 ACCESS_VIOLATION'
堆栈跟踪如下：
IdSSLOpenSSLHeaders.Unload
IdSSLOpenSSL.UnloadOpenSSLLibrary
IdSSLOpenSSL.Finalization
System.FinalizeUnits
System._Halt()
MayApp.MayApp
:0000000076DC556D; C:\Windows\system32\kernel.dll
:0000000076F2385D; ntdll.dll
崩溃在这里：
if Assigned(ERR_remove_thread_state) then begin
ERR_remove_thread_state(nil); <-- Access Violation here
end
我目前正在释放 TIdHTTPServer，然后是 IOHandler。
当我连接到 MySql 数据库时出现问题。看起来 libmysql 也使用主线程的错误队列，它还通过调用 ERR_remove_thread_state() 释放队列。重现的最少代码在这里：
program OpenSSLIssue;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, IdServerIOHandler, IdSSL, IdGlobal,
IdSSLOpenSSL, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer, IdContext,
IdCoderMIME, IdSSLOpenSSLHeaders, FireDac.Comp.Client, FireDac.Phys.MySQL,
FireDAC.Stan.Def;
type
TEndPoint = class
protected
{ Protected declarations }
FIP: String;
FPort: WORD;
FProtocol: String;
FServer: TIdHttpServer;
FIOHandler: TIdServerIOHandlerSSLOpenSSL;
procedure QuerySSLPort(APort: Word; var AUseSSL: Boolean);
function SSLVerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
public
{ Public declarations }
constructor Create(AIP: String; APort: WORD; AProtocol: String);
destructor Destroy; override;
function Start: Boolean;
procedure Stop;
end;
constructor TEndPoint.Create(AIP: String; APort: WORD; AProtocol: String);
begin
var LPath := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
IdOpenSSLSetLibPath(LPath);
FIP := AIP;
FPort := APort;
FProtocol := AProtocol.ToUpper;
FServer := TIdHttpServer.Create(nil);
FServer.DefaultPort := APort;
FServer.OnQuerySSLPort := QuerySSLPort;
if 'HTTPS' = FProtocol then
begin
FIOHandler := TIdServerIOHandlerSSLOpenSSL.Create(nil);
FIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
FIOHandler.SSLOptions.Method := sslvTLSv1_2;
FIOHandler.SSLOptions.CertFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'device.crt';
FIOHandler.SSLOptions.KeyFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'myDevice.key';
FIOHandler.SSLOptions.RootCertFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'myRootCA.pem';
FIOHandler.OnVerifyPeer := SSLVerifyPeer;
FServer.IOHandler := FIOHandler;
end;
var LBinding := FServer.Bindings.Add;
LBinding.IP := AIP;
LBinding.Port := APort;
end;
destructor TEndPoint.Destroy;
begin
FServer.Free;
if nil <> FIOHandler then
FIOHandler.Free;
inherited Destroy;
end;
procedure TEndPoint.QuerySSLPort(APort: Word; var AUseSSL: Boolean);
begin
AUseSSL := 'HTTPS' = FProtocol;
end;
function TEndPoint.SSLVerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
begin
Result := AOK;
end;
function TEndPoint.Start: Boolean;
begin
Result := FALSE;
try
FServer.Active := TRUE;
Result := TRUE;
except
end;
end;
procedure TEndPoint.Stop;
begin
try
FServer.Active := FALSE;
except
//Suppress any exceptions as sockets are closed off
end;
end;
function GetConnection(ADatabaseName, AUserName, APAssword, ADatabase, AHost: String): TFDConnection;
begin
var LConnectionDef := FDManager.ConnectionDefs.FindConnectionDef(ADatabaseName + '_Connection');
if nil = LConnectionDef then
begin
var LParams := TStringList.Create;
LParams.Add('User_Name=' + AUserName);
LParams.Add('Password=' + APassword);
LParams.Add('Server=' + AHost);
LParams.Add('Database=' + ADatabase);
FDManager.AddConnectionDef(ADatabaseName + '_Connection', 'MYSQL', LParams);
end else
begin
var LIndex := LConnectionDef.Params.IndexOfName('Server');
LConnectionDef.Params[LIndex] := AHost;
LConnectionDef.Params.UserName := AUserName;
LConnectionDef.Params.Password := APassword;
LConnectionDef.Params.Database := ADatabase;
end;
Result := TFDConnection.Create(nil);
Result.LoginPrompt := FALSE;
Result.DriverName := 'MYSQL';
Result.ConnectionDefName := ADatabaseName + '_Connection';
end;
(* Create the DQL in MySql Workbeanch with the following:
CREATE DATABASE IF NOT EXISTS `MyTestDB`;
USE MyTestDB;
CREATE TABLE IF NOT EXISTS `TestTable`(
`VersionID` int NOT NULL,
`VerMajor` int NOT NULL,
`VerMinor` int NOT NULL,
`VerRelease` int NOT NULL,
PRIMARY KEY (`VersionID`)
);
*)
begin
var DriverLink := TFDPhysMYSQLDriverLink.Create(nil);
DriverLink.VendorLib := String.Format('%s\libmysql.dll',[ExcludeTrailingPathDelimiter(ExtractFileDir( ParamStr(0) ))]);
try
var FEndpoint := TEndPoint.Create('127.0.0.1', 8200, 'https');
try
FEndpoint.Start;
var LConn := GetConnection('MyTestDB', 'root', 'rootPasswd', 'MyTestDB', 'localhost');
try
LConn.Open;
WriteLn('Connection Open');
Sleep(1000);
LConn.Close;
finally
LConn.Free;
end;
FEndpoint.Stop;
finally
FEndpoint.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
DriverLink.Free;
end.
这是因为单元的定稿部分的顺序 运行。这是由单位在使用条款中出现的顺序决定的。初始化部分按照它们在使用中出现的顺序 运行。定稿部分 运行 反向 顺序。
按此顺序，IdSSLOpenSSL.pas 的最终确定部分将是 运行 在 libmysql.dll 被 FireDAC 卸载后，将导致 AcessViolation当 Indy 尝试清理和卸载 OpenSSL 时：
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, FireDAC.Stan.Def, FireDac.Phys.MySQL,
IdServerIOHandler, IdSSL, IdGlobal, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer,
IdContext, IdCoderMIME, IdSSLOpenSSLHeaders,
//finlaize section of IdSSLOpenSSL will be run after
//libmysql.dll is unloaded byFireDAC
IdSSLOpenSSL,
FireDac.Comp.Client;
按此顺序，IdSSLOpenSSL.pas 的最终确定部分将在 运行 之前 libmysql.dll 被 FireDAC 卸载并且不会有错误:
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, FireDAC.Stan.Def, FireDac.Phys.MySQL,
IdServerIOHandler, IdSSL, IdGlobal, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer,
IdContext, IdCoderMIME, IdSSLOpenSSLHeaders,
//finlaize section of IdSSLOpenSSL will be run before
//libmysql.dll is unloaded byFireDAC
FireDac.Comp.Client,
IdSSLOpenSSL;
使用MySql 8.0.16、Delphi 10.3 Rio，以及附带的标准版Indy。
我正在使用 TIdServerIOHandlerSSLOpenSSL 的实例和 TIdHttpServer 的实例，使用从 Fulgan 下载的 OpenSSL 1.0.2s。我所有的 Indy 组件都是在运行时用代码创建的。
在我关闭应用程序并从 IdSSLOpenSSL.pas 文件的 finalization 部分调用 IdSSLOpenSSLHeaders.Unload() 中出现访问冲突之前，一切似乎都正常。
Project rasied exception class $C0000005 with message 'c0000005 ACCESS_VIOLATION'
堆栈跟踪如下：
IdSSLOpenSSLHeaders.Unload
IdSSLOpenSSL.UnloadOpenSSLLibrary
IdSSLOpenSSL.Finalization
System.FinalizeUnits
System._Halt()
MayApp.MayApp
:0000000076DC556D; C:\Windows\system32\kernel.dll
:0000000076F2385D; ntdll.dll
崩溃在这里：
if Assigned(ERR_remove_thread_state) then begin
ERR_remove_thread_state(nil); <-- Access Violation here
end
我目前正在释放 TIdHTTPServer，然后是 IOHandler。
当我连接到 MySql 数据库时出现问题。看起来 libmysql 也使用主线程的错误队列，它还通过调用 ERR_remove_thread_state() 释放队列。重现的最少代码在这里：
program OpenSSLIssue;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, IdServerIOHandler, IdSSL, IdGlobal,
IdSSLOpenSSL, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer, IdContext,
IdCoderMIME, IdSSLOpenSSLHeaders, FireDac.Comp.Client, FireDac.Phys.MySQL,
FireDAC.Stan.Def;
type
TEndPoint = class
protected
{ Protected declarations }
FIP: String;
FPort: WORD;
FProtocol: String;
FServer: TIdHttpServer;
FIOHandler: TIdServerIOHandlerSSLOpenSSL;
procedure QuerySSLPort(APort: Word; var AUseSSL: Boolean);
function SSLVerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
public
{ Public declarations }
constructor Create(AIP: String; APort: WORD; AProtocol: String);
destructor Destroy; override;
function Start: Boolean;
procedure Stop;
end;
constructor TEndPoint.Create(AIP: String; APort: WORD; AProtocol: String);
begin
var LPath := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
IdOpenSSLSetLibPath(LPath);
FIP := AIP;
FPort := APort;
FProtocol := AProtocol.ToUpper;
FServer := TIdHttpServer.Create(nil);
FServer.DefaultPort := APort;
FServer.OnQuerySSLPort := QuerySSLPort;
if 'HTTPS' = FProtocol then
begin
FIOHandler := TIdServerIOHandlerSSLOpenSSL.Create(nil);
FIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2];
FIOHandler.SSLOptions.Method := sslvTLSv1_2;
FIOHandler.SSLOptions.CertFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'device.crt';
FIOHandler.SSLOptions.KeyFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'myDevice.key';
FIOHandler.SSLOptions.RootCertFile := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+ 'myRootCA.pem';
FIOHandler.OnVerifyPeer := SSLVerifyPeer;
FServer.IOHandler := FIOHandler;
end;
var LBinding := FServer.Bindings.Add;
LBinding.IP := AIP;
LBinding.Port := APort;
end;
destructor TEndPoint.Destroy;
begin
FServer.Free;
if nil <> FIOHandler then
FIOHandler.Free;
inherited Destroy;
end;
procedure TEndPoint.QuerySSLPort(APort: Word; var AUseSSL: Boolean);
begin
AUseSSL := 'HTTPS' = FProtocol;
end;
function TEndPoint.SSLVerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
begin
Result := AOK;
end;
function TEndPoint.Start: Boolean;
begin
Result := FALSE;
try
FServer.Active := TRUE;
Result := TRUE;
except
end;
end;
procedure TEndPoint.Stop;
begin
try
FServer.Active := FALSE;
except
//Suppress any exceptions as sockets are closed off
end;
end;
function GetConnection(ADatabaseName, AUserName, APAssword, ADatabase, AHost: String): TFDConnection;
begin
var LConnectionDef := FDManager.ConnectionDefs.FindConnectionDef(ADatabaseName + '_Connection');
if nil = LConnectionDef then
begin
var LParams := TStringList.Create;
LParams.Add('User_Name=' + AUserName);
LParams.Add('Password=' + APassword);
LParams.Add('Server=' + AHost);
LParams.Add('Database=' + ADatabase);
FDManager.AddConnectionDef(ADatabaseName + '_Connection', 'MYSQL', LParams);
end else
begin
var LIndex := LConnectionDef.Params.IndexOfName('Server');
LConnectionDef.Params[LIndex] := AHost;
LConnectionDef.Params.UserName := AUserName;
LConnectionDef.Params.Password := APassword;
LConnectionDef.Params.Database := ADatabase;
end;
Result := TFDConnection.Create(nil);
Result.LoginPrompt := FALSE;
Result.DriverName := 'MYSQL';
Result.ConnectionDefName := ADatabaseName + '_Connection';
end;
(* Create the DQL in MySql Workbeanch with the following:
CREATE DATABASE IF NOT EXISTS `MyTestDB`;
USE MyTestDB;
CREATE TABLE IF NOT EXISTS `TestTable`(
`VersionID` int NOT NULL,
`VerMajor` int NOT NULL,
`VerMinor` int NOT NULL,
`VerRelease` int NOT NULL,
PRIMARY KEY (`VersionID`)
);
*)
begin
var DriverLink := TFDPhysMYSQLDriverLink.Create(nil);
DriverLink.VendorLib := String.Format('%s\libmysql.dll',[ExcludeTrailingPathDelimiter(ExtractFileDir( ParamStr(0) ))]);
try
var FEndpoint := TEndPoint.Create('127.0.0.1', 8200, 'https');
try
FEndpoint.Start;
var LConn := GetConnection('MyTestDB', 'root', 'rootPasswd', 'MyTestDB', 'localhost');
try
LConn.Open;
WriteLn('Connection Open');
Sleep(1000);
LConn.Close;
finally
LConn.Free;
end;
FEndpoint.Stop;
finally
FEndpoint.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
DriverLink.Free;
end.
这是因为单元的定稿部分的顺序 运行。这是由单位在使用条款中出现的顺序决定的。初始化部分按照它们在使用中出现的顺序 运行。定稿部分 运行 反向 顺序。
按此顺序，IdSSLOpenSSL.pas 的最终确定部分将是 运行 在 libmysql.dll 被 FireDAC 卸载后，将导致 AcessViolation当 Indy 尝试清理和卸载 OpenSSL 时：
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, FireDAC.Stan.Def, FireDac.Phys.MySQL,
IdServerIOHandler, IdSSL, IdGlobal, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer,
IdContext, IdCoderMIME, IdSSLOpenSSLHeaders,
//finlaize section of IdSSLOpenSSL will be run after
//libmysql.dll is unloaded byFireDAC
IdSSLOpenSSL,
FireDac.Comp.Client;
按此顺序，IdSSLOpenSSL.pas 的最终确定部分将在 运行 之前 libmysql.dll 被 FireDAC 卸载并且不会有错误:
uses
System.Classes, System.SysUtils, System.IoUtils, System.JSON, WinApi.Windows,
WinApi.Messages, System.Generics.Collections, FireDAC.Stan.Def, FireDac.Phys.MySQL,
IdServerIOHandler, IdSSL, IdGlobal, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdUDPBase, IdUDPServer,IdSocketHandle, IdCustomHTTPServer, IdHTTPServer,
IdContext, IdCoderMIME, IdSSLOpenSSLHeaders,
//finlaize section of IdSSLOpenSSL will be run before
//libmysql.dll is unloaded byFireDAC
FireDac.Comp.Client,
IdSSLOpenSSL;