使用Indy OpenSSL和MySql时发生访问冲突

时间:2019-07-16 13:29:49

标签: delphi indy

使用MySql 8.0.16,Delphi 10.3 Rio和随附的标准版本的Indy。

我正在使用TIdServerIOHandlerSSLOpenSSL的实例和TIdHttpServer的实例,并使用从Fulgan下载的OpenSSL 1.0.2s。我所有的Indy组件都是在运行时用代码创建的。

在我关闭应用程序并在IdSSLOpenSSLHeaders.Unload()中获得访问冲突之前,一切似乎都可以正常工作,该访问冲突是从finalization文件的IdSSLOpenSSL.pas部分调用的。

  

带有消息'c0000005 ACCESS_VIOLATION'的项目已异常项目$ C0000005

堆栈跟踪如下:

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.

1 个答案:

答案 0 :(得分:1)

其原因是这些单元的完成部分运行的顺序。这由“单位”在“ uses”子句中出现的顺序决定。初始化部分按照它们在使用中出现的顺序运行。终结部分按反向顺序运行。

以此顺序IdSSLOpenSSL.pas的finalize部分将在 之后运行。由FireDAC卸载libmysql.dll,并在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;

以此顺序,IdFireOpenSSL.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;