nxtsssltransport.pas

著名的SecureBlackBox控件完整源码

var
  ReplyBuffer: PByteArray;
  ReplyBufferSize: Integer;
  repHeader : TSSLReplyHeader;

begin
  repHeader.MessageID := aMsgID;
  repHeader.ErrorCode := aErrorCode;

  if aMsgID = nxnmSecuredHandshake then
  begin
    // SetLength(FOutBuffer, aReplyDataLen);
    // Move(PChar(aReplyData)^, FOutBuffer[0], aReplyDataLen);
  end
  else
  begin
    SetLength(FOutBuffer, 0);

    ReplyBufferSize := aReplyDataLen + sizeof(TSSLReplyHeader);
    GetMem(ReplyBuffer, ReplyBufferSize);

    Move(repHeader, ReplyBuffer[0], sizeof(TSSLReplyHeader));
    Move(PChar(aReplyData)^, ReplyBuffer[sizeof(TSSLReplyHeader)], aReplyDataLen);

    Inc(FBuffering);
    FServer.SendData(ReplyBuffer, ReplyBufferSize);
    Dec(FBuffering);
    FreeMem(ReplyBuffer);
  end;

  TElServerSSLTransport(aTransport).btInternalReply(FWrapMsgID, DBIERR_NONE, @FOutBuffer[0], Length(FOutBuffer));
end;

procedure TElServerSSLConnectionProxy.bscpProcess(aMsg: PnxDataMessage);
var
  DataMessage: TnxDataMessage;
  Buffer : PByteArray;
  rq : TSSLRequestHeader;
begin
  inherited;
  with aMsg^ do
    case dmMsg of
      nxnmSecuredHandshake:
        begin
          if dmDataLen >= SizeOf(TSSLRequestHeader) then
          begin
            Buffer := PByteArray(dmData);

            SetLength(FInBuffer, dmDataLen);
            Move(Buffer^[0], FInBuffer[0], Length(FInBuffer));

            // pass all data to ElSecureServer
            SetLength(FDataBuffer, 0);
            SetLength(FOutBuffer, 0);

            // pass all data to ElSecureServer
            Inc(FBuffering);
            while (Length(FInBuffer) > 0) and (FErrorCode = 0) do
              FServer.DataAvailable;
            Dec(FBuffering);

            FWrapMsgID := nxnmSecuredHandshake;

            if Length(FOutBuffer) = 0 then
              Reply(nxnmSecuredHandshake, FErrorCode, nil, 0)
            else
              Reply(nxnmSecuredHandshake, FErrorCode, @FOutBuffer[0], Length(FOutBuffer));
          end;
        end;
      nxnmSecuredRequest, nxnmSecuredPost:
        if dmDataLen >= SizeOf(TSSLRequestHeader) then
        begin
          Buffer := PByteArray(dmData);

          // DumpBuffer('c:\request_dst.bin', dmData, dmDataLen);

          SetLength(FInBuffer, dmDataLen);
          Move(Buffer^[0], FInBuffer[0], Length(FInBuffer));

           // pass all data to ElSecureClient
          SetLength(FDataBuffer, 0);
          SetLength(FOutBuffer, 0);

          // pass all data to ElSecureClient
          Inc(FBuffering);
          while (Length(FInBuffer) > 0) and FConnected and (FErrorCode = 0) do
            FServer.DataAvailable;
          Dec(FBuffering);

          if dmDataLen >= SizeOf(TSSLRequestHeader) then
          begin
            Move(FDataBuffer[0], rq, SizeOf(TSSLRequestHeader));

            Move(FDataBuffer[SizeOf(TSSLRequestHeader)], FDatabuffer[0], Length(FDataBuffer) - SizeOf(TSSLRequestHeader));
            SetLength(FDataBuffer, Length(FDataBuffer) - SizeOf(TSSLRequestHeader));

            DataMessage.dmSessionID := bscpSessionID;
            //DataMessage.dmRequestID := 0;
            DataMessage.dmErrorCode := FErrorCode;
            with rq do
            begin
              DataMessage.dmMsg := MessageID;
              DataMessage.dmDataLen := Length(FDataBuffer);
            end;
            if DataMessage.dmDataLen > 0 then
              DataMessage.dmData := @FDataBuffer[0]
            else
              DataMessage.dmData := nil;

            DumpBuffer('c:\request_dst.bin', @FDataBuffer[0], Length(FDataBuffer));


            FWrapMsgID := nxnmSecuredRequest;
            if DataMessage.dmMsg = 0 then
            begin
              if dmMsg = nxnmSecuredRequest then
                bscpProcessLogin(@DataMessage)
            end
            else
              TElServerSSLTransport(bscpTransport).btProcess(@DataMessage);
          end;
        end;
    end;
end;

procedure TElServerSSLConnectionProxy.HandleCloseConnection(Sender: TObject;
  CloseDescription: integer);
begin
  if CloseDescription <> SB_CLOSE_CONNECTION_OK then
    Terminate;

  FConnected := false;
  FErrorCode := ERRCODE_SSL_SERVERSIDE_CLOSE + CloseDescription;
end;

procedure TElServerSSLConnectionProxy.HandleOpenConnection(Sender: TObject);
begin
  FConnected := true;
end;

procedure TElServerSSLConnectionProxy.sscCreateServer;
begin
  FServer := TElSecureServer.Create(nil);
  FServer.CertStorage := TElServerSSLTransport(bscpTransport).CertStorage;
  FServer.ClientCertStorage :=
    TElServerSSLTransport(bscpTransport).ClientCertStorage;

  FServer.OnCertificateValidate :=
    TElServerSSLTransport(bscpTransport).OnCertificateValidate;
  FServer.OnReceive := HandleRecv;
  FServer.OnSend := HandleSend;
  FServer.OnData := HandleData;
  FServer.OnOpenConnection := HandleOpenConnection;
  FServer.OnCloseConnection := HandleCloseConnection;
  //FServer.Enabled := false;
  FServer.Enabled := true;
end;


procedure TElClientSSLConnectionProxy.HandleAbortConnection(Sender: TObject;
  CloseReason: TSBCloseReason);
begin
  if CloseReason = crError then
  begin
    Terminate;
    FErrorCode := DBIERR_NX_SSL_SERVER_CLOSED;
  end;
end;

procedure TElClientSSLConnectionProxy.bscpInitialize;
var ReplyInfo : TSSLClientReplyInfo;
begin
  inherited;
  sscCreateClient;

  // initiate SSL session
  Inc(FBuffering);
  FClient.Open;
  Dec(FBuffering);

  while (not FClient.Active) and (FErrorCode = 0) do
  begin
    ReplyInfo.riConnection := Self;
    ReplyInfo.riReplyCallback := ClientEmptyCallback;
    ReplyInfo.riReplyCookie := 0;
    ReplyInfo.riSessionID := sscSessionID;
    ReplyInfo.riMsgID := nxnmSecuredHandshake;
    ReplyInfo.riTimeout := sscTimeout;
    ReplyInfo.riIsPost := false;

    SendRequestFromBuffer(bscpTransport.Transport, @ReplyInfo);
  end;

  if FErrorCode <> 0 then
    raise EnxSSLTransportException.nxcCreate(bscpTransport, FErrorCode);
end;

procedure TElClientSSLConnectionProxy.bscpInternalPost(aTransport:
    TnxBaseTransport; aSessionID: TnxSessionID;
    aThreadPriority : TnxThreadPriority; aMsgID: TnxMsgID; aRequestData:
    Pointer; aRequestDataLen: TnxWord32; aTimeOut : Integer);
var
  RequestBuffer: PChar;
  RequestBufferSize: Integer;
  ReplyInfo: TSSLClientReplyInfo;
  rqHeader : TSSLRequestHeader;
begin

  if aMsgID = 0 then
    aTransport.Post(0, aSessionID, aThreadPriority, aMsgId,
      aRequestData, aRequestDataLen, aTimeout)
  else
  if FClient.Active then
  begin
    rqHeader.MessageID := aMsgID;
    rqHeader.TimeOut := aTimeout;

    RequestBufferSize := aRequestDataLen + sizeof(TSSLRequestHeader);
    GetMem(RequestBuffer, RequestBufferSize);
    SetLength(FOutBuffer, 0);

    Move(rqHeader, RequestBuffer[0], sizeof(TSSLRequestHeader));
    Move(PChar(aRequestData)^, RequestBuffer[sizeof(TSSLRequestHeader)], aRequestDataLen);

    Inc(FBuffering);

    FClient.SendData(RequestBuffer, RequestBufferSize);

    Dec(FBuffering);

    FreeMem(RequestBuffer);

    if FErrorCode <> 0 then
      raise EnxSSLTransportException.nxcCreate(bscpTransport, FErrorCode);

    ReplyInfo.riConnection := Self;
    ReplyInfo.riReplyCallback := nil;
    ReplyInfo.riReplyCookie := 0;
    ReplyInfo.riMsgID := aMsgID;
    ReplyInfo.riTimeout := aTimeout;
    ReplyInfo.riSessionID := aSessionID;
    ReplyInfo.riIsPost := true;

    SendRequestFromBuffer(aTransport, @ReplyInfo, aThreadPriority);
  end
  else
     raise EnxSSLTransportException.nxcCreate(bscpTransport, TnxResult(DBIERR_NX_SSL_NOT_OPENED));
end;

procedure TElClientSSLConnectionProxy.bscpInternalRequest(aTransport:
  TnxBaseTransport; aSessionID: TnxSessionID; aThreadPriority : TnxThreadPriority;
  aMsgID: TnxMsgID; aTimeOut:
  Integer; aRequestData: Pointer; aRequestDataLen: TnxWord32; aReplyCallback:
  TnxReplyCallback; aReplyCookie: Integer);
var
  RequestBuffer: PByteArray;
  RequestBufferSize: Integer;
  ReplyInfo: TSSLClientReplyInfo;
  rqHeader : TSSLRequestHeader;
begin

  // DumpBuffer('c:\request_src.bin', aRequestData, aRequestDataLen);

  if FClient.Active then
  begin
    rqHeader.MessageID := aMsgID;
    rqHeader.TimeOut := aTimeout;

    RequestBufferSize := aRequestDataLen + sizeof(TSSLRequestHeader);
    GetMem(RequestBuffer, RequestBufferSize);
    SetLength(FOutBuffer, 0);

    Move(rqHeader, RequestBuffer[0], sizeof(TSSLRequestHeader));
    Move(PChar(aRequestData)^, RequestBuffer[sizeof(TSSLRequestHeader)], aRequestDataLen);

    Inc(FBuffering);

    FClient.SendData(RequestBuffer, RequestBufferSize);

    Dec(FBuffering);

    FreeMem(RequestBuffer);

    if FErrorCode <> 0 then
      raise EnxSSLTransportException.nxcCreate(bscpTransport, FErrorCode);

    ReplyInfo.riConnection := Self;
    ReplyInfo.riReplyCallback := aReplyCallback;
    ReplyInfo.riReplyCookie := aReplyCookie;
    ReplyInfo.riMsgID := aMsgID;
    ReplyInfo.riTimeout := aTimeout;
    ReplyInfo.riSessionID := aSessionID;
    ReplyInfo.riIsPost := false;

    // DumpBuffer('c:\request_src.bin', @FOutBuffer[0], Length(FOutBuffer));

    SendRequestFromBuffer(aTransport, @ReplyInfo, aThreadPriority);
  end
  else
     raise EnxSSLTransportException.nxcCreate(bscpTransport, TnxResult(DBIERR_NX_SSL_NOT_OPENED));
end;

procedure TElClientSSLConnectionProxy.SendRequestFromBuffer(aTransport :
    TnxBaseTransport; aReplyInfo: PSSLClientReplyInfo; Priority :
    TnxThreadPriority = 0);
begin
  if not FClient.Active then
    aTransport.Request(0, bscpSessionID, Priority, nxnmSecuredHandshake, aReplyInfo.riTimeout,
      @FOutBuffer[0], Length(FOutBuffer), ClientCallback, Integer(aReplyInfo))
  else
  if aReplyInfo.riIsPost then
    aTransport.Post(0, bscpSessionID, Priority, nxnmSecuredPost, @FOutBuffer[0], Length(FOutBuffer), aReplyInfo.riTimeout)
  else
    aTransport.Request(0, bscpSessionID, Priority, nxnmSecuredRequest, aReplyInfo.riTimeout, @FOutBuffer[0], Length(FOutBuffer), ClientCallback, Integer(aReplyInfo));
end;

procedure TElClientSSLConnectionProxy.sscCreateClient;
begin
  FClient := TElSecureClient.Create(nil);
  FClient.CertStorage := TElClientSSLTransport(bscpTransport).CertStorage;
  FClient.OnSend := HandleSend;
  FClient.OnData := HandleData;
  FClient.OnReceive := Self.HandleRecv;
  FClient.OnCloseConnection := HandleAbortConnection;
  FClient.OnCertificateValidate :=
    TElClientSSLTransport(bscpTransport).OnCertificateValidate;
  FClient.OnCertificateChoose :=
    TElClientSSLTransport(bscpTransport).OnCertificateChoose;
  FClient.OnCertificateNeeded :=
    TElClientSSLTransport(bscpTransport).OnCertificateNeeded;
  FClient.OnCertificateNeededEx :=
    TElClientSSLTransport(bscpTransport).OnCertificateNeededEx;

  //FClient.Enabled := false;
  FClient.Enabled := true;
end;

procedure TElClientSSLConnectionProxy.sscIncomingHandshakeReply;
begin
  // pass all data to ElSecureClient
  SetLength(FDataBuffer, 0);
  SetLength(FOutBuffer, 0);

  // pass all data to ElSecureClient
  Inc(FBuffering);
  while (Length(FInBuffer) > 0) and (FErrorCode = 0) do
    FClient.DataAvailable;
  Dec(FBuffering);
  if FErrorCode <> 0 then
      raise EnxSSLTransportException.nxcCreate(bscpTransport, FErrorCode);
end;

procedure TElClientSSLConnectionProxy.sscIncomingReply(aReplyInfo: Pointer;
    aMsgID: TnxMsgID; aErrorCode: TnxResult; aReplyData : Pointer;
    aReplyDataLen : Integer);
var repHeader : TSSLReplyHeader;
    Buffer : PByteArray;
begin
  if aErrorCode = DBIERR_NONE then
  begin
    if aReplyDataLen < sizeof(TSSLReplyHeader) then
    begin
      aErrorCode := DBIERR_SERVERCOMMLOST;
      aMsgID := 0;
      aReplyData := nil;
      aReplyDataLen := 0;
    end
    else
    begin
      Buffer := PByteArray(aReplyData);
      Move(Buffer[0], repHeader, sizeof(TSSLReplyHeader));
      aReplyData := @Buffer[sizeof(TSSLReplyHeader)];
      aReplyDataLen := aReplyDataLen - sizeof(TSSLReplyHeader);

      aMsgID := repHeader.MessageID;
      aErrorCode := repHeader.ErrorCode;
    end;
  end
  else
  begin
    aMsgID := 0;
    aReplyData := nil;
    aReplyDataLen := 0;
  end;
  with PSSLClientReplyInfo(aReplyInfo)^ do
    riReplyCallback(aMsgID, aErrorCode, aReplyData, aReplyDataLen,
      riReplyCookie);
end;

procedure TElClientSSLConnectionProxy.sscIncomingSecureReply(aReplyInfo:
    Pointer; aMsgID: TnxMsgID; aErrorCode: TnxResult);
begin
  if aErrorCode = DBIERR_NONE then
  begin
    SetLength(FDataBuffer, 0);

    // pass all data to ElSecureClient
    Inc(FBuffering);
    while (Length(FInBuffer) > 0) and (FErrorCode = 0) do
      FClient.DataAvailable;
    Dec(FBuffering);

    if Length(FDataBuffer) = 0 then
      sscIncomingReply(aReplyInfo, aMsgID, FErrorCode, nil, 0)
    else
      sscIncomingReply(aReplyInfo, aMsgID, FErrorCode, @FDataBuffer[0], Length(FDataBuffer));
  end;
end;

constructor TElClientSSLConnectionProxy.CreateSender(aTransport:
  TnxBaseSecuredTransport; const aUserName: string; const aPassword
  : string; aTimeOut: Integer; aClientVersion: Integer; out
  aServerVersion: Integer; out aSessionID: TnxSessionID);
begin
  sscSessionID := aSessionID;
  sscTimeout := aTimeout;
  inherited;
end;

destructor TElClientSSLConnectionProxy.Destroy;
begin
  FClient.Free;
  FClient := nil;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('SecureBlackbox/Add-ons', [TElClientSSLTransport, TElServerSSLTransport]);
end;

end.