delphi 使用Indy OpenSSL和MySql时的访问冲突

wfveoks0  于 2023-10-18  发布在  Mysql
关注(0)|答案(1)|浏览(127)

使用MySql 8.0.16、 Delphi 10.3 Rio和标准版的Indy。
我正在使用一个TIdServerIOHandlerSSLOpenSSL示例和一个TIdHttpServer示例,使用从Fulgan下载的OpenSSL 1.0.2。我的所有Indy组件都是在运行时在代码中创建的。
一切似乎都正常,直到我关闭应用程序并在IdSSLOpenSSL.pas文件的finalization部分调用的IdSSLOpenSSLHeaders.Unload()中获得访问冲突。
项目引发异常类$C0000005,消息为“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.
ivqmmu1c

ivqmmu1c1#

其原因是单元的终结部分的运行顺序。这是由单元在uses子句中出现的顺序决定的。初始化部分按照它们在使用中出现的顺序运行。完成部分以 reverse 顺序运行。
按照这个顺序,IdSSLOpenSSL.pas的finalize部分将在 * libmysql.dll被FireDAC卸载后 * 运行,并在Indy尝试清理和卸载OpenSSL时导致AcessViolation:

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的finalize部分将在FireDAC卸载 * libmysql.dll之前 * 运行,并且不会出现错误:

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;

相关问题