ssl_cryptlib.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
        st := CRYPT_SESSION_SSL;
      LT_SSHv2:
        st := CRYPT_SESSION_SSH;
    else
      Exit;
    end;
  if not SSLCheck(cryptCreateSession(FcryptSession, CRYPT_UNUSED, st)) then
    Exit;
  x := -1;
  case FSSLType of
    LT_SSLv3:
      x := 0;
    LT_TLSv1:
      x := 1;
    LT_TLSv1_1:
      x := 2;
  end;
  if x >= 0 then
    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then
      Exit;
  if FUsername <> '' then
  begin
    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME,
      Pointer(FUsername), Length(FUsername));
    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD,
      Pointer(FPassword), Length(FPassword));
  end;
  if FSSLType = LT_SSHv2 then
    if FSSHChannelType <> '' then
    begin
      cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL, CRYPT_UNUSED);
      cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_TYPE,
        Pointer(FSSHChannelType), Length(FSSHChannelType));
      if FSSHChannelArg1 <> '' then
        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG1,
          Pointer(FSSHChannelArg1), Length(FSSHChannelArg1));
      if FSSHChannelArg2 <> '' then
        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG2,
          Pointer(FSSHChannelArg2), Length(FSSHChannelArg2));
    end;


  if server and (FPrivatekeyFile = '') then
  begin
    if FPrivatekeyLabel = '' then
      FPrivatekeyLabel := 'synapse';
    if FkeyPassword = '' then
      FkeyPassword := 'synapse';
    CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
  end;

  if (FPrivatekeyLabel <> '') and (FPrivatekeyFile <> '') then
  begin
    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
      PChar(FPrivatekeyFile), CRYPT_KEYOPT_READONLY)) then
      Exit;
    try
    if not SSLCheck(cryptGetPrivateKey(KeySetObj, cryptcontext, CRYPT_KEYID_NAME,
      PChar(FPrivatekeyLabel), PChar(FKeyPassword))) then
      Exit;
    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_PRIVATEKEY,
      cryptcontext)) then
      Exit;
    finally
      cryptKeysetClose(keySetObj);
      cryptDestroyContext(cryptcontext);
    end;
  end;
  if server and FVerifyCert then
  begin
    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
      PChar(FCertCAFile), CRYPT_KEYOPT_READONLY)) then
      Exit;
    try
    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_KEYSET,
      keySetObj)) then
      Exit;
    finally
      cryptKeysetClose(keySetObj);
    end;
  end;
  Result := true;
end;

function TSSLCryptLib.DeInit: Boolean;
begin
  Result := True;
  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
    CryptDestroySession(FcryptSession);
  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
  FSSLEnabled := False;
  if FDelCert then
    Deletefile(FPrivatekeyFile);
end;

function TSSLCryptLib.Prepare(server:Boolean): Boolean;
begin
  Result := false;
  DeInit;
  if Init(server) then
    Result := true
  else
    DeInit;
end;

function TSSLCryptLib.Connect: boolean;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(false) then
  begin
    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
      Exit;
    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
      Exit;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLCryptLib.Accept: boolean;
begin
  Result := False;
  if FSocket.Socket = INVALID_SOCKET then
    Exit;
  if Prepare(true) then
  begin
    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
      Exit;
    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
      Exit;
    FSSLEnabled := True;
    Result := True;
  end;
end;

function TSSLCryptLib.Shutdown: boolean;
begin
  Result := BiShutdown;
end;

function TSSLCryptLib.BiShutdown: boolean;
begin
  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
    cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
  DeInit;
  Result := True;
end;

function TSSLCryptLib.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  l: integer;
begin
  FLastError := 0;
  FLastErrorDesc := '';
  SSLCheck(cryptPushData(FCryptSession, Buffer, Len, L));
  cryptFlushData(FcryptSession);
  Result := l;
end;

function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
var
  l: integer;
begin
  FLastError := 0;
  FLastErrorDesc := '';
  SSLCheck(cryptPopData(FCryptSession, Buffer, Len, L));
  Result := l;
end;

function TSSLCryptLib.WaitingData: Integer;
begin
  Result := 0;
end;

function TSSLCryptLib.GetSSLVersion: string;
var
  x: integer;
begin
  Result := '';
  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
    Exit;
  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x);
  if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then
    case x of
      0:
        Result := 'SSLv3';
      1:
        Result := 'TLSv1';
      2:
        Result := 'TLSv1.1';
    end;
  if FSSLType in [LT_SSHv2] then
    case x of
      0:
        Result := 'SSHv1';
      1:
        Result := 'SSHv2';
    end;
end;

function TSSLCryptLib.GetPeerSubject: string;
var
  cert: CRYPT_CERTIFICATE;
begin
  Result := '';
  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
    Exit;
  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
  cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTNAME, CRYPT_UNUSED);
  Result := GetString(cert, CRYPT_CERTINFO_DN);
  cryptDestroyCert(cert);
end;

function TSSLCryptLib.GetPeerName: string;
var
  cert: CRYPT_CERTIFICATE;
begin
  Result := '';
  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
    Exit;
  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
  Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME);
  cryptDestroyCert(cert);
end;

function TSSLCryptLib.GetPeerIssuer: string;
var
  cert: CRYPT_CERTIFICATE;
begin
  Result := '';
  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
    Exit;
  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
  Result := GetString(cert, CRYPT_CERTINFO_DN);
  cryptDestroyCert(cert);
end;

function TSSLCryptLib.GetPeerFingerprint: string;
var
  cert: CRYPT_CERTIFICATE;
begin
  Result := '';
  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
    Exit;
  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
  Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT);
  Result := MD5(Result);
  cryptDestroyCert(cert);
end;

{==============================================================================}

initialization
  if cryptInit = CRYPT_OK then
    SSLImplementation := TSSLCryptLib;
  cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL);

finalization
  cryptEnd;

end.