Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.08.2013, 16:55   #1
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
Вопрос Реализация TCP+SSL клиент-сервера через Synapse

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

Возникла необходимость написать клиент-сервер по защищенному протоколу 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
Поправьте меня, где неверно сделал. Заранее спасибо!
"ковыряю изнутри" (с)

Последний раз редактировалось 3D Hunter; 27.08.2013 в 17:19.
3D Hunter вне форума Ответить с цитированием
Старый 27.08.2013, 17:29   #2
Lardes
Форумчанин
 
Аватар для Lardes
 
Регистрация: 19.08.2011
Сообщений: 329
По умолчанию

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

Надеюсь, поможет
Lardes вне форума Ответить с цитированием
Старый 28.08.2013, 09:25   #3
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Хорошо, а если мне нужен слущающий порт, отличный от 443? У меня все же TCPS сервер, а не HTTPS-сервер...
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 28.08.2013, 15:18   #4
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Разобрался. Теперь сервер корректно обрабатывает 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; 28.08.2013 в 15:20.
3D Hunter вне форума Ответить с цитированием
Старый 28.08.2013, 16:30   #5
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Поставлю вопрос немного по-другому, может так понятнее будет.
Дело обстоит так: клиент может подключиться к моему серверу вообще без сертификата и получить корректный ответ. Как это исправить? как сделать, чтобы при подключении клиента сервер проверял наличие сертификата и его совпадение с сертификатом на сервере? Сервер должен обрабатывать только подписанных клиентов.
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 28.08.2013, 18:57   #6
Lardes
Форумчанин
 
Аватар для Lardes
 
Регистрация: 19.08.2011
Сообщений: 329
По умолчанию

А проблем с SSL-библиотеками нет?
Lardes вне форума Ответить с цитированием
Старый 28.08.2013, 19:30   #7
Человек_Борща
Старожил
 
Аватар для Человек_Борща
 
Регистрация: 30.12.2009
Сообщений: 11,442
По умолчанию

3D Hunter, попробуйте банально взять сниффер и посмотреть что приходит на ваш сервер от клиента с/без сертификата в момент подключения. На этом и ловите.
Человек_Борща вне форума Ответить с цитированием
Старый 28.08.2013, 21:01   #8
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

не указано чем проверять, сертификат сервера не в счет...
мне кажется нужно заполнить еще
или SSL.CertCA или SSL.TrustCertificate
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 29.08.2013, 12:31   #9
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Порылся на сайте сунапса. 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 не должен проверять мой серверный сертификат.
Версия библиотек рекомендуется автором сунапса и скачана с его сайта.
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 29.08.2013, 13:38   #10
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

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, то проверка считается успешной и клиенту предоставляется доступ до защищенной области.
Для того, чтобы изменения конфигурационного файла веб-сервера вступили в силу необходимо перезапустить веб-сервер
Не стесняемся, плюсуем!

Последний раз редактировалось Slym; 29.08.2013 в 13:48.
Slym вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Synapse. Создание Web-сервера Lardes Работа с сетью в Delphi 2 23.02.2013 00:19
Synapse + SSL + Socks5 = виснут соединения Puhovoi Работа с сетью в Delphi 2 01.12.2012 22:39
Клиент-серверное приложение, создание сервера через MS SQL Server и подключение c ADO (CRM) StuDenT5x3 БД в Delphi 5 14.08.2011 17:12
как создать TCP клиент, TCP сервер ? DreamMaster911 C/C++ Сетевое программирование 1 26.10.2010 15:05
Реализация клиент сервер через delphi и java Horus92 Свободное общение 0 15.10.2010 22:27