Реализация TCP+SSL клиент-сервера через Synapse

[3D Hunter]

Доброго времени суток!

Возникла необходимость написать клиент-сервер по защищенному протоколу TCP с использованием SSL. Говорю сразу, перед тем как создавать тему, прошарил поиском здесь и ничего не нашел толкового (единственно http://forum.vingrad.ru/forum/s/6e3b...ic-274886.html), только HTTPSend+SSL, который мне не нужен.
По кускам из интернета попробовал следующее:
Поток сервера:

uses
  Windows, SysUtils, Classes, synautil, synachar,
  blcksock, ssl_openssl, UConfig, USimpleLog;

...

constructor TTcpServer.Create(const AConfig:TTcpStruct);
begin
  inherited Create(True);
  FreeOnTerminate:=False;
  InitializeCriticalSection(FRTL);
  FConfig:=AConfig;
  FSock:=TTCPBlockSocket.Create;
  with FSock.SSL do
  begin
    SSLType:=LT_all;
    PrivateKeyFile:=ExtractFilePath(ParamStr(0))+'priv.key';
    CertificateFile:=ExtractFilePath(ParamStr(0))+'cert.crt';
    VerifyCert:=True;
  end;
  FClientList:=TList.Create;
end;

...

procedure TTcpServer.Execute;
var
  LSocket:Integer;
  LListened:Boolean;

  procedure ListenSocket;
  begin
    FSock.CloseSocket;
    FSock.Bind('0.0.0.0',FConfig.Port);
    FSock.Listen;
    if (FSock.LastError<>0) then raise Exception.Create(FSock.LastErrorDesc);
    LListened:=True;
  end;

begin
  LListened:=False;
  while (not Terminated) do
  try
    if (not LListened) then ListenSocket;
    gLog.Log(ltEvent,'Listen thread has started normally');
    while (not Terminated) do
      if FSock.CanRead(1000) then
      begin
        LSocket:=FSock.Accept;
        FSock.SSLAcceptConnection;
        LListened:=FSock.LastError=0;
        if (LListened) then
        begin
          with TTcpClient.Create(Self,LSocket) do Start;
          Sleep(100);
        end
        else Break;
      end;
  except
    on E:Exception do
    begin
      gLog.Log(ltError,'TTcpServer.Execute: '+E.Message);
      Sleep(10000);
    end;
  end;
end;

В OnClick кнопки, кинутой на пустую форму, написал:

procedure TForm1.Button1Click(Sender: TObject);
var
  LSock:TTCPBlockSocket;
begin
  try
    LSock:=TTCPBlockSocket.Create;
    with LSock.SSL do
    begin
      SSLType:=LT_all;
      CertificateFile:=ExtractFilePath(ParamStr(0))+'cert.crt';
    end;
    LSock.Connect('localhost','9050');
    LSock.SSLDoConnect;//тут форма виснет!
    if LSock.LastError<>0 then Edit1.Text:=LSock.LastErrorDesc;
  finally
    LSock.Free;
  end;
end;

Версии библиотек ssl: 0.9.8.4d
Поправьте меня, где неверно сделал. Заранее спасибо!

[Lardes]

Посмотрите пример в папке ...\source\demo\httpsserv и для тестирования библиотек SSL ...\source\demo\FreePascal\testssl. pas. И почитайте оф. документацию по https.

Надеюсь, поможет

[3D Hunter]

Хорошо, а если мне нужен слущающий порт, отличный от 443? У меня все же TCPS сервер, а не HTTPS-сервер...

[3D Hunter]

Разобрался. Теперь сервер корректно обрабатывает SSL-подключения и принимает данные от клиента.
Встал вопрос валидации клиента при подключении (аналогичная проблема рассматривалась на http://forum.vingrad.ru/forum/s/6e3b...ic-274886.html). Есть приватный ключ и публичный сертификат. Подключаться к серверу должны только подписанные этим сертификатом клиенты. При подключении логгирует ошибку. привожу рабочий код сюда (кому-то может пригодится):

Код серверного потока:

{ TTcpServer }

//PRIVATE
procedure TTcpServer.Execute;
var
  LSocket:Integer;
  LListened:Boolean;

  procedure ListenSocket;
  begin
    FSock.CloseSocket;
    FSock.Bind('0.0.0.0',FConfig.Port);
    FSock.Listen;
    if (FSock.LastError<>0) then raise Exception.Create(FSock.LastErrorDesc);
    LListened:=True;
  end;

begin
  LListened:=False;
  while (not Terminated) do
  try
    if (not LListened) then ListenSocket;
    gLog.Log(ltEvent,'Listen thread has started normally');
    while (not Terminated) do
      if FSock.CanRead(1000) then
      begin
        LSocket:=FSock.Accept;
        LListened:=FSock.LastError=0;
        if (LListened) then
        begin
          with TTcpClient.Create(Self,LSocket) do Start;
          Sleep(100);
        end
        else Break;
      end;
  except
    on E:Exception do
    begin
      gLog.Log(ltError,'TTcpServer.Execute: '+E.Message);
      Sleep(10000);
    end;
  end;
end;

Код клиентского потока:

{ TTcpClient }

//PRIVATE
procedure TTcpClient.Execute;
var
  LqError:Boolean;//дескриптор выхода из цикла
  LErrMsg:AnsiString;//описание ошибки
begin
  //установка SSL-канала
  if (not InitSSL) then Exit;

  //цикл обработки
  while (not FOwner.Terminated) do
  try
    gLog.Log(ltEvent,FSock.RecvPacket(1000));
    Break;//просто проверка на факт приема данных - в except не заходим
  except
    on E:Exception do
    begin
      LErrMsg:=Format('TTcpClient.Execute: [%s:%d] - %s',
                      [FSock.GetRemoteSinIP,FSock.GetRemoteSinPort,E.Message]);
      gLog.Log(ltError,LErrMsg);
      if LqError then Break;
    end;
  end
end;

function TTcpClient.InitSSL:Boolean;
var
  LErrMsg:AnsiString;//описание ошибки
begin
  Result:=True;
  try
    with FSock.SSL do
    begin
      SSLType:=LT_all;
      PrivateKeyFile:=ExtractFilePath(ParamStr(0))+'priv.key';
      CertificateFile:=ExtractFilePath(ParamStr(0))+'cert.crt';
      KeyPassword:='';
      VerifyCert:=True;
      if (not FSock.SSLAcceptConnection) then raise Exception.Create(LastErrorDesc);
      if (GetCertInfo='') then raise Exception.Create('Certificate information is empty');
    end;
  except
    on E:Exception do
    begin
      LErrMsg:=Format('TTcpClient.InitSSL: [%s:%d] - %s',
                      [FSock.GetRemoteSinIP,FSock.GetRemoteSinPort,E.Message]);
      gLog.Log(ltError,LErrMsg);
      Result:=False;
    end;
  end;
end;

Код клиента:

procedure TForm1.Button1Click(Sender: TObject);
var
  LSock:TTCPBlockSocket;
begin
  try
    LSock:=TTCPBlockSocket.Create;
    LSock.SSL.CertificateFile:=ExtractFilePath(ParamStr(0))+'cert.crt';
    LSock.SSL.VerifyCert:=True;
    LSock.Connect('localhost','9050');
    LSock.SSLDoConnect;
    LSock.SendString('123');
    if LSock.LastError<>0 then Edit1.Text:=LSock.LastErrorDesc;
  finally
    LSock.Free;
  end;
end;

[3D Hunter]

Поставлю вопрос немного по-другому, может так понятнее будет.
Дело обстоит так: клиент может подключиться к моему серверу вообще без сертификата и получить корректный ответ. Как это исправить? как сделать, чтобы при подключении клиента сервер проверял наличие сертификата и его совпадение с сертификатом на сервере? Сервер должен обрабатывать только подписанных клиентов.

[Lardes]

А проблем с SSL-библиотеками нет?

[Человек_Борща]

3D Hunter, попробуйте банально взять сниффер и посмотреть что приходит на ваш сервер от клиента с/без сертификата в момент подключения. На этом и ловите.

[Slym]

не указано чем проверять, сертификат сервера не в счет...
мне кажется нужно заполнить еще
или SSL.CertCA или SSL.TrustCertificate

[3D Hunter]

Порылся на сайте сунапса. Lukas Gebauer пишет по этому поводу следующее:

CertCAFile is for root certificates. Because self-signed certificate has
no root certificate (you are sign it by self), then you not need it.
keyPassword you need, when you are using encrypted private key. But my
procedure does not crypt private key. So, you not need it too.

Полный текст здесь.
Т.е. CertCAFile нужен в случае корневого сертификата, но у меня его нет и он в принципе не требуется, ибо никакой вышестоящий CA не должен проверять мой серверный сертификат.
Версия библиотек рекомендуется автором сунапса и скачана с его сайта.

[Slym]

1. CA - само подписанный (иногда подписан вышестоящим CA) используется только для выдачи сертификатов и RevocationList
2. ServerCert - подписан чем угодно, обычно подписан CA.
3. ClientCert - подписан CA.
Итого нужно минимум 3 сертификата и ключи к ним.

Server доверяет себе и сертификатам выданным CA
т.е. чтоб проверить клиента ему нужен сертификат CA
http://saintist.ru/2009/04/29/svoy-ssl-sertifikat/

3.2. Запрос и проверка клиентских сертификатов.

Найдите в конфигурационном файле веб-сервера httpd.conf секцию , соответсвующую вашему сайту и добавьте в неё следующие директивы:

SSLCACertificateFile /path/to/ca.crt

SSLVerifyClient require

Описание директив:

SSLCACertificateFile /path/to/ca.crt
Абсолютный путь до доверенного сертификата (см. $1.). Также в качестве значения директивы SSLCACertificateFile может быть указан файл, содержащий несколько доверенных сертификатов (формируется путем обычной конкатенации файлов сертификатов), тогда все они будут считаться доверенными сертификатами.
SSLVerifyClient require
При наличии этой директивы веб-сервер будет запрашивать сертификат у клиента в обязательном порядке. Если клиент не предоставляет сертификат, тогда сервер отклоняет запрос. Если клиент предоставляет сертификат, то веб-сервер проверяет его срок действия и поставщика сертификата (сертификат которым он подписан), если сертификат поставщика присутсвует в файле SSLCACertificateFile, то проверка считается успешной и клиенту предоставляется доступ до защищенной области.
Для того, чтобы изменения конфигурационного файла веб-сервера вступили в силу необходимо перезапустить веб-сервер