Synapse/ru
│
English (en) │
polski (pl) │
русский (ru) │
Synapse предоставляет простой в использовании последовательный порт и синхронную библиотеку TCP/IP.
Обзор
Synapse предлагает последовательный порт и возможность подключения по TCP/IP. Он отличается от других библиотек тем, что вам нужно только добавить в свой код несколько файлов исходного кода Synapse Pascal; нет необходимости устанавливать пакеты и т. д. Единственное исключение - вам понадобится внешняя криптографическая библиотека, если вы хотите использовать шифрование, такое как SSL/TLS/SSH.
См. документацию на официальном сайте (ссылка ниже) для более подробной информации.
Установка
Установка может быть такой же простой, как простое копирование всех файлов в каталог вашего приложения и добавление соответствующих модулей Synapse в ваш раздел uses.
Более элегантный и рекомендуемый способ - это компиляция пакета laz_synapse.lpk, чтобы вы могли использовать одни и те же модули во всех своих проектах.
Страница информации по загрузке/SVN: Страница загрузки Synapse
Поддержка и сообщения об ошибках
У проекта Synapse есть список рассылки, в котором предоставляется поддержка и можно отправлять исправления.
Отчеты об ошибках также можно отправлять по списку рассылки.
См. страницу поддержки Synapse
Поддержка SSL/TLS
Вы можете использовать поддержку OpenSSL, CryptLib, StreamSecII или OpenStreamSecII SSL с Synapse. По умолчанию поддержка SSL не используется.
Поддержка активируется путем помещения выбранного имени модуля в раздел uses вашего проекта. Вы также должны поместить файл двоичной библиотеки в путь к вашему проекту(Windows) или установить его в путях поиска библиотеки (Linux, macOS, FreeBSD).
Synapse загружает файлы библиотеки SSL во время выполнения как динамические библиотеки.
- Для получения подробной информации см. SSL/TLS Plugin Architecture
- Некоторые криптографические библиотеки можно получить здесь
Отсутствущая библиотека
В Linux вам необходимо убедиться, что требуемая динамическая библиотека присутствует/установлена в вашей системе. В случае cryptlib, если библиотека отсутствует в системе, при компоновке появляется сообщение об ошибке:
/usr/bin/ld: cannot find -lcl
Аналогичное сообщение будет отображаться при использовании других динамических библиотек.
Пример веб-сервера
См. примеры Webserver.
Пример запроса сервера QOTD
См. пример запроса сервера Quote of the Day.
Отправка email
Статья Michaël Van Canneyt об отправке электронной почты, включая вложения, с помощью Synapse: http://www.freepascal.org/~michael/articles/lazmail/lazmail-en.pdf
Из сообщения на форуме; работает, например, с Gmail:
{Этот код поддерживает использование шифрования TLS/SSL; при отправке на порт 25 используется простой текстовый SMTP.}
uses
..., smtpsend,ssl_openssl; //вероятно, можно использовать и другие модули SSL.
// MailData - это текст письма.
function SendMail(
User, Password,
MailFrom, MailTo,
SMTPHost, SMTPPort: string;
MailData: string): Boolean;
var
SMTP: TSMTPSend;
sl:TStringList;
begin
Result:=False;
SMTP:=TSMTPSend.Create;
sl:=TStringList.Create;
try
sl.text:=Maildata;
SMTP.UserName:=User;
SMTP.Password:=Password;
SMTP.TargetHost:=SMTPHost;
SMTP.TargetPort:=SMTPPort;
SMTP.AutoTLS:=true;
if Trim(SMTPPort)<>'25' then
SMTP.FullSSL:=true; // при отправке на порт 25 шифрование не используется
if SMTP.Login then
begin
result:=SMTP.MailFrom(MailFrom, Length(MailData)) and
SMTP.MailTo(MailTo) and
SMTP.MailData(sl);
SMTP.Logout;
end;
finally
SMTP.Free;
sl.Free;
end;
end;
Отправка вложений
См. документацию Synapse.
Загрузка файлов
С FTP-сервера
Учитывая URL-адрес и (путь и) имя файла, это загрузит его с FTP-сервера. В основном это обертка кода Synapse, предназначенная для облегчения загрузки при работе с произвольными файлами. Если вы точно знаете, что будете скачивать, простой вызов Synapse:
FtpGetFile
доставит вас очень далеко.
function DownloadFTP(URL, TargetFile: string): boolean;
const
FTPPort=21;
FTPScheme='ftp://'; //Имя схемы URI для URL-адресов FTP
var
Host: string;
Port: integer;
Source: string;
FoundPos: integer;
begin
// Вычеркиваем информацию о схеме:
if LeftStr(URL, length(FTPScheme))=FTPScheme then URL:=Copy(URL, length(FTPScheme)+1, length(URL));
// Грубый парсинг; мог использовать код синтаксического анализа URI в пакетах FPC ...
FoundPos:=pos('/', URL);
Host:=LeftStr(URL, FoundPos-1);
Source:=Copy(URL, FoundPos+1, Length(URL));
//Проверка номера портов:
FoundPos:=pos(':', Host);
Port:=FTPPort;
if FoundPos>0 then
begin
Host:=LeftStr(Host, FoundPos-1);
Port:=StrToIntDef(Copy(Host, FoundPos+1, Length(Host)),21);
end;
Result:=FtpGetFile(Host, IntToStr(Port), Source, TargetFile, 'anonymous', 'fpc@example.com');
if result=false then writeln('DownloadFTP: error downloading '+URL+'. Details: host: '+Host+'; port: '+Inttostr(Port)+'; remote path: '+Source+' to '+TargetFile);
end;
Пример получения списка файлов по заданному пути
//Используем модуль ftpsend
function FtpGetDir(const IP, Port, Path, User, Pass: string; DirList: TStringList): Boolean;
var
i: Integer;
s: string;
begin
Result := False;
with TFTPSend.Create do
try
Username := User;
Password := Pass;
TargetHost := IP;
TargetPort := Port;
if not Login then
Exit;
Result := List(Path, False);
for i := 0 to FtpList.Count -1 do
begin
s := FTPList[i].FileName;
DirList.Add(s);
end;
Logout;
finally
Free;
end;
end;
С HTTP-сервера
Учитывая URL-адрес и (путь и) имя файла, это загрузит его с HTTP-сервера. Обратите внимание, что этот код проверяет код состояния HTTP (например, 200, 404), чтобы узнать, является ли документ, который мы получили обратно с сервера, желаемым файлом или же страницей с ошибкой.
Простая версия
...
uses httpsend,
...
function DownloadHTTP(URL, TargetFile: string): Boolean;
var
HTTPGetResult: Boolean;
HTTPSender: THTTPSend;
begin
Result := False;
HTTPSender := THTTPSend.Create;
try
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
HTTPSender.Document.SaveToFile(TargetFile);
Result := True;
end;
finally
HTTPSender.Free;
end;
end;
Расширенная версия
...
uses httpsend
...
function DownloadHTTP(URL, TargetFile: string): Boolean;
// Грузим файл; при необходимости повторяем попытку.
// Можно использовать Synapse HttpGetBinary, но это не работает
// с кодами результата (т.е. он успешно загружает документ с ошибкой 404)
const
MaxRetries = 3;
var
HTTPGetResult: Boolean;
HTTPSender: THTTPSend;
RetryAttempt: Integer;
begin
Result := False;
RetryAttempt := 1;
HTTPSender := THTTPSend.Create;
try
try
// Пробуем получить файл
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do
begin
Sleep(500 * RetryAttempt);
HTTPSender.Clear;
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
RetryAttempt := RetryAttempt + 1;
end;
// Если у нас есть ответ от сервера, проверяем, не
// был ли файл уже отправлен нам.
case HTTPSender.Resultcode of
100..299:
begin
HTTPSender.Document.SaveToFile(TargetFile);
Result := True;
end; //информирование, успешно
300..399: Result := False; // перенаправление. Не реализовано, но могло бы быть.
400..499: Result := False; // ошибка клиента; 404 не найдено и т.д.
500..599: Result := False; // внутренняя ошибка сервера
else Result := False; // неизвестный код
end;
except
// Нас не интересует причина этой ошибки; загрузка не удалась.
Result := False;
end;
finally
HTTPSender.Free;
end;
end;
Простая версия с показом прогресса загрузки
В следующем примере показано, как получить информацию о ходе загрузки по HTTP, а также размер файла. Размер файла извлекается из информации заголовка.
unit uhttpdownloader;
// Необходимо изменить это. По умолчанию это - {$mode objfpc}{$H+}, и не работает.
{$mode Delphi}
interface
uses
Classes, SysUtils, httpsend, blcksock, typinfo;
type
IProgress = interface
procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
end;
type
{ THttpDownloader }
THttpDownloader = class
public
function DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
private
Bytes : Integer;
MaxBytes : Integer;
HTTPSender: THTTPSend;
ProgressMonitor : IProgress;
procedure Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
function GetSizeFromHeader(Header: String):integer;
end;
implementation
function THttpDownloader.DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
var
HTTPGetResult: Boolean;
begin
Result := False;
Bytes:= 0;
MaxBytes:= -1;
Self.ProgressMonitor:= ProgressMonitor;
HTTPSender := THTTPSend.Create;
try
HTTPSender.Sock.OnStatus:= Status;
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
HTTPSender.Document.SaveToFile(TargetFile);
Result := True;
end;
finally
HTTPSender.Free;
end;
end;
procedure THttpDownloader.Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
var
V, currentHeader: String;
i: integer;
begin
//try to get filesize from headers
if (MaxBytes = -1) then
begin
for i:= 0 to HTTPSender.Headers.Count - 1 do
begin
currentHeader:= HTTPSender.Headers[i];
MaxBytes:= GetSizeFromHeader(currentHeader);
if MaxBytes <> -1 then break;
end;
end;
V := GetEnumName(TypeInfo(THookSocketReason), Integer(Reason)) + ' ' + Value;
if Reason = THookSocketReason.HR_ReadCount then
begin
Bytes:= Bytes + StrToInt(Value);
ProgressMonitor.ProgressNotification(V, Bytes, MaxBytes);
end;
end;
function THttpDownloader.GetSizeFromHeader(Header: String): integer;
var
item : TStringList;
begin
Result:= -1;
if Pos('Content-Length:', Header) <> 0 then
begin
item:= TStringList.Create();
item.Delimiter:= ':';
item.StrictDelimiter:=true;
item.DelimitedText:=Header;
if item.Count = 2 then
begin
Result:= StrToInt(Trim(item[1]));
end;
end;
end;
end.
Что мы здесь делаем?
Прежде всего, мы смотрим на заголовки, чтобы узнать размер файла. Надо подождать и проверить, есть ли заголовок. Первые события не содержат Content-Length: information.
Найдя, мы извлекаем эту информацию. Здесь появляется несколько событий, на которые вы можете реагировать. Но мы проверяем только THookSocketReason.HR_ReadCount в этом примере.
HR_ReadCount предоставляет нам информацию о том, сколько байтов было прочитано с момента последнего события.
Затем прогресс передается в пользовательский интерфейс:
procedure TMainForm.ProgressNotification(Text: String; CurrentProgress: integer; MaxProgress: integer);
begin
if (MaxProgress <> -1) then
begin
ProgressBar.Max:= MaxProgress;
end;
ProgressBar.Position:= CurrentProgress;
memoStatus.Lines.Add(Text);
Application.ProcessMessages;
end;
Итак, окончательно основной модуль будет таким:
unit uMain;
{$mode Delphi}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, httpsend, blcksock, typinfo,
uhttpdownloader;
type
{ TMainForm }
TMainForm = class(TForm, IProgress)
btnStartDownload: TButton;
edtUrl: TEdit;
labelUrl: TLabel;
memoStatus: TMemo;
ProgressBar: TProgressBar;
SaveDialog: TSaveDialog;
procedure btnStartDownloadClick(Sender: TObject);
private
{ private declarations }
function GetFileNameFromURL(url: String):string;
public
{ public declarations }
procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.btnStartDownloadClick(Sender: TObject);
var
fileName: String;
downloader: THttpDownloader;
success: boolean;
begin
fileName:= GetFileNameFromURL(edtUrl.Text);
SaveDialog.FileName:=fileName;
if (SaveDialog.Execute) then
begin
memoStatus.Lines.Clear;
ProgressBar.Position:=0;
downloader:= THttpDownloader.Create();
success:= downloader.DownloadHTTP(edtUrl.Text, SaveDialog.FileName, Self);
ProgressBar.Position:=0;
if Success then
memoStatus.Lines.Add('Download successful')
else
memoStatus.Lines.Add('Error during download');
end;
end;
function TMainForm.GetFileNameFromURL(url: String): string;
var i, l : integer;
fileName, current : String;
begin
fileName:= '';
l:= Length(url);
for i:= l downto 0 do begin
current:= url[i];
if current <> '/' then
begin
fileName:= current + fileName;
end else begin
Result:= fileName;
break;
end;
end;
end;
procedure TMainForm.ProgressNotification(Text: String; CurrentProgress: integer; MaxProgress: integer);
begin
if (MaxProgress <> -1) then ProgressBar.Max:= MaxProgress;
ProgressBar.Position:= CurrentProgress;
memoStatus.Lines.Add(Text);
Application.ProcessMessages;
end;
end.
Ссылка: https://andydunkel.net/2015/09/09/lazarus_synapse_progress/
С HTTP-сервера путем анализа URL-адресов: Sourceforge
См. статью Загрузка с SourceForge для примера загрузки с sourceforge.net.
С HTTPS-сервера
Это похоже на загрузку с HTTP-сервера. Кроме того, вам необходимо активировать поддержку SSL/TLS и получить двоичный файл(ы) для необходимой библиотеки. Затем вы можете использовать ту же функцию DownloadHTTP для загрузки файла с URL-адреса, начинающегося с https://.
Пример программы клиента SSH/Telnet
Ниже вы найдете модуль, который позволяет использовать клиентские функции telnet/SSH, использующий модуль synapse tlntsend.pas
. Пример программы показывает, как это использовать.
Другой, более простой способ проиллюстрирован Leonardo Ramé на [1]. Его пример не может использовать telnet и отправляет только одну команду.
Требования
Помимо исходников Synapse (которых вам понадобится всего пара), если вы хотите использовать функциональность SSH, вам понадобится библиотека шифрования, которую использует Synapse. Если вы используете только Telnet, вам это не нужно.
Есть 2 варианта:
- Библиотека Cryptlib. Преимущество: стабильность. По-видимому, можно использовать закрытые ключи, но они имеют некоторый формат, который широко не поддерживается.
- Библиотека LibSSH2. Привязки Pascal все еще находятся в разработке, но вы можете использовать файл с вашим закрытым ключом (в формате OpenSSH) для аутентификации.
Cryptlib
- В Windows загрузите двоичную версию библиотеки DLL cryptlib (CL32.DLL) и поместите ее в исходный каталог. Если вы компилируете в другой каталог или распространяете свою программу, вам также необходимо будет распространить DLL.
- В Linux и OSX установите cryptlib через диспетчер пакетов/другими способами. При распространении приложения отметьте cryptlib как требование в вашем пакете .deb/.rpm/любой.
Вам также потребуются привязки (cryptlib.pas), присутствующие в исходном дистрибутиве cryptlib.
Версии двоичного файла cryptlib и привязок должны совпадать.
LibSSH2
- В Windows загрузите двоичную версию библиотеки libssh2 (LIBSSH2.DLL) и поместите ее в исходный каталог. Если вы компилируете в другой каталог или распространяете свою программу, вам также необходимо будет распространить DLL.
- В Linux и macOS установите libssh2 через диспетчер пакетов/другими способами. При распространении вашего приложения:
- Linux: отметьте libssh2 как требование в вашем .deb/.rpm/любом пакете.
- macOS: включите libssh2 в каталог ресурсов Application Bundle.
Вам также понадобится ssl_libssh2.pas (см. ниже) и привязки: (libssh2.pas, см. это сообщение на форуме ). Двоичный файл libssh2 и привязки должны совпадать.
Synapse libssh2 SSL plugin
{
ssl_libssh2.pas version 0.2
SSH2 support (draft) plugin for Synapse Library (http://www.ararat.cz/synapse) by LibSSH2 (http://libssh2.org)
Requires: libssh2 pascal interface - http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465 and
libssh2.dll with OpenSSL.
(С) Alexey Suhinin http://x-alexey.narod.ru
}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$H+}
unit ssl_libssh2;
interface
uses
SysUtils,
blcksock, synsock,
libssh2;
type
{:@abstract(class implementing CryptLib SSL/SSH plugin.)
Instance of this class will be created for each @link(TTCPBlockSocket).
You not need to create instance of this class, all is done by Synapse itself!}
TSSLLibSSH2 = class(TCustomSSL)
protected
FSession: PLIBSSH2_SESSION;
FChannel: PLIBSSH2_CHANNEL;
function SSHCheck(Value: integer): Boolean;
function DeInit: Boolean;
public
{:See @inherited}
constructor Create(const Value: TTCPBlockSocket); override;
destructor Destroy; override;
function Connect: boolean; override;
function LibName: String; override;
function Shutdown: boolean; override;
{:See @inherited}
function BiShutdown: boolean; override;
{:See @inherited}
function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
{:See @inherited}
function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
{:See @inherited}
function WaitingData: Integer; override;
{:See @inherited}
function GetSSLVersion: string; override;
published
end;
implementation
{==============================================================================}
function TSSLLibSSH2.SSHCheck(Value: integer): Boolean;
var
PLastError: PAnsiChar;
ErrMsgLen: Integer;
begin
Result := true;
FLastError := 0;
FLastErrorDesc := '';
if Value<0 then
begin
FLastError := libssh2_session_last_error(FSession, PLastError, ErrMsglen, 0);
FLastErrorDesc := PLastError;
Result := false;
end;
end;
function TSSLLibSSH2.DeInit: Boolean;
begin
if Assigned(FChannel) then
begin
libssh2_channel_free(FChannel);
FChannel := nil;
end;
if Assigned(FSession) then
begin
libssh2_session_disconnect(FSession,'Goodbye');
libssh2_session_free(FSession);
FSession := nil;
end;
FSSLEnabled := False;
Result := true;
end;
constructor TSSLLibSSH2.Create(const Value: TTCPBlockSocket);
begin
inherited Create(Value);
FSession := nil;
FChannel := nil;
end;
destructor TSSLLibSSH2.Destroy;
begin
DeInit;
inherited Destroy;
end;
function TSSLLibSSH2.Connect: boolean;
begin
Result := False;
if SSLEnabled then DeInit;
if (FSocket.Socket <> INVALID_SOCKET) and (FSocket.SSL.SSLType = LT_SSHv2) then
begin
FSession := libssh2_session_init();
if not Assigned(FSession) then
begin
FLastError := -999;
FLastErrorDesc := 'Cannot initialize SSH session';
exit;
end;
if not SSHCheck(libssh2_session_startup(FSession, FSocket.Socket)) then
exit;
if (FSocket.SSL.PrivateKeyFile<>'') then
begin
if (not SSHCheck(libssh2_userauth_publickey_fromfile(FSession, PChar(FSocket.SSL.Username), nil, PChar(FSocket.SSL.PrivateKeyFile), PChar(FSocket.SSL.KeyPassword)))) then
exit;
end
else
if (FSocket.SSL.Username<>'') and (FSocket.SSL.Password<>'') then
begin
if (not SSHCheck(libssh2_userauth_password(FSession, PChar(FSocket.SSL.Username), PChar(FSocket.SSL.Password)))) then
exit;
end;
FChannel := libssh2_channel_open_session(FSession);
if not assigned(FChannel) then
begin
SSHCheck(-1); // get error
if FLastError = 0 then
begin
FLastError := -999; // unknown error
FLastErrorDesc := 'Cannot open session';
end;
exit;
end;
if not SSHCheck(libssh2_channel_request_pty(FChannel, 'vanilla')) then
exit;
if not SSHCheck(libssh2_channel_shell(FChannel)) then
exit;
FSSLEnabled := True;
Result := True;
end;
end;
function TSSLLibSSH2.LibName: String;
begin
Result := 'ssl_libssh2';
end;
function TSSLLibSSH2.Shutdown: boolean;
begin
Result := DeInit;
end;
function TSSLLibSSH2.BiShutdown: boolean;
begin
Result := DeInit;
end;
function TSSLLibSSH2.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
begin
Result:=libssh2_channel_write(FChannel, PChar(Buffer), Len);
SSHCheck(Result);
end;
function TSSLLibSSH2.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
begin
result:=libssh2_channel_read(FChannel, PChar(Buffer), Len);
SSHCheck(Result);
end;
function TSSLLibSSH2.WaitingData: Integer;
begin
if libssh2_poll_channel_read(FChannel, Result) <> 1 then Result := 0;
end;
function TSSLLibSSH2.GetSSLVersion: string;
begin
Result:=libssh2_version(0);
end;
initialization
if libssh2_init(0)=0 then
SSLImplementation := TSSLLibSSH2;
finalization
libssh2_exit;
end.
Terminal client class
The telnetsshclient.pas unit below wraps around the Synapse tlntsend.pas unit and abstracts logging in, sending commands and receiving output and logging out.
If you only need a telnet client and can live without SSH support, comment out {$DEFINE HAS_SSH_SUPPORT} below so you don't need to have the libssh2 dll.
This unit has been lightly tested on a Linux ssh/telnet server. Additional tests welcome.
unit telnetsshclient;
{ Wrapper around Synapse libraries and SSL library (libssh2+libssl
is used right now)
Download compiled Windows dll from e.g.
http://alxdm.dyndns-at-work.com:808/files/windll_libssh2.zip
Download FreePascal interface files:
http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465
This unit allows the user to send Telnet or SSH commands and get the output
Thanks to Leonardo Rame
http://leonardorame.blogspot.com/2010/01/synapse-based-ssh-client.html
and Ludo Brands.
Written by Reinier Olislagers 2011.
Modified for libssh2 by Alexey Suhinin 2012.
License of code:
* MIT
* LGPLv2 or later (with FreePascal static linking exception)
* GPLv2 or later
according to your choice.
Free use allowed but please don't sue or blame me.
Uses other libraries/components; different licenses may apply that also can influence the combined/compiled work.
}
{$mode objfpc}{$H+}
{$DEFINE HAS_SSH_SUPPORT} //comment out if only telnet support required
{$DEFINE LIBSSH2}
interface
uses
Classes, SysUtils,
tlntsend
{$IFDEF HAS_SSH_SUPPORT}
{ssl - or actually ssh - libs required by tlntsend}
{$IFDEF LIBSSH2}
ssl_libssh2
{$ELSE}
ssl_cryptlib
{$ENDIF}
{$ENDIF HAS_SSH_SUPPORT} ;
type
TProtocolType = (Telnet, SSH); //Different means of connecting
TServerType = (Unix, Windows); //line endings, mostly
{ TelnetSSHClient }
{ TTelnetSSHClient }
TTelnetSSHClient = class(TTelnetSend)
protected
FConnected: boolean;
FOutputPosition: integer; //Keeps track of position in output stream
FProtocolType: TProtocolType;
FServerLineEnding: string; //depends on FServerType
FServerType: TServerType;
FWelcomeMessage, FTelnetLoginPrompt, FTelnetPasswordPrompt: string;
procedure SetPrivateKeyFile(Value: string);
function GetPrivateKeyFile: string;
{ Based on protocol and servertype, set expected serverside line ending}
procedure DetermineLineEnding;
{ Sets port if no explicit port set. Uses protocol type: SSH or telnet}
procedure DeterminePort;
function GetSessionLog: string;
procedure ProtocolTypeChange(Value: TProtocolType);
function ReceiveData: string; //Can be used to get welcome message etc.
procedure SendData(Data: string);
procedure ServerTypeChange(Value: TServerType);
public
{All output generated during the entire session up to now}
property AllOutput: string read GetSessionLog;
{True if connected to server}
property Connected: boolean read FConnected;
{Name or IP address of host to connect to}
property HostName: string read FTargetHost write FTargetHost;
{Port on host used for connection. If left as 0, it will be determined by protocol type (22 for SSH, 23 for Telnet}
property Port: String read FTargetPort write FTargetPort;
{Location of private key file.}
property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile;
{Telnet login prompt}
property TelnetLoginPrompt: string read FTelnetLoginPrompt write FTelnetLoginPrompt;
{Telnet password prompt}
property TelnetPasswordPrompt: string read FTelnetPasswordPrompt write FTelnetPasswordPrompt;
{Username used when connecting}
property UserName: string read FUserName write FUserName;
{Password used when connecting. Used as passphrase if PrivateKey is used}
property Password: string read FPassword write FPassword;
{Should we talk Telnet or SSH to the server? Defaults to SSH.}
property ProtocolType: TProtocolType read FProtocolType write ProtocolTypeChange;
{Windows or Unix/Linux server? Has effect on line endings. Defaults to Unix. NOTE: untested}
property Servertype: TServerType read FServerType write ServerTypeChange;
{Initial message displayed on logon}
property WelcomeMessage: string read FWelcomeMessage;
{Connect/logon to server. Requires that all authentication, protocol and hostname/port options are correct
Returns descriptive result. You can then use the Connected property.}
function Connect: string;
{If connected, logoff from server}
procedure Disconnect;
{Send command to server and receive result}
function CommandResult(Command: string): string; //Send command and get results
constructor Create;
destructor Destroy; override;
end;
implementation
{ TelnetSSHClient }
procedure TTelnetSSHClient.SetPrivateKeyFile(value: string);
begin
Sock.SSL.PrivateKeyFile := value;
end;
function TTelnetSSHClient.GetPrivateKeyFile: string;
begin
Result := Sock.SSL.PrivateKeyFile;
end;
procedure TTelnetSSHClient.DetermineLineEnding;
begin
case FProtocolType of
SSH:
begin
if FServerType = Unix then
FServerLineEnding := #10 //Unix
else
FServerLineEnding := #13 + #10; //windows
end;
Telnet:
begin
if FServerType = Unix then
FServerLineEnding := #10 //Unix
else
FServerLineEnding := #13 + #10; //windows
end;
else
raise Exception.Create('Unknown protocol type');
end;
end;
procedure Ttelnetsshclient.DeterminePort;
begin
if FTargetPort = '' then
//Set default port for protocol
begin
case FProtocolType of
Telnet: FTargetPort := '23';
SSH: FTargetPort := '22';
else
raise Exception.Create('Unknown protocol type.');
end;
end;
end;
procedure TTelnetSSHClient.ServerTypeChange(Value: Tservertype);
begin
FServerType := Value;
DetermineLineEnding;
end;
function TTelnetSSHClient.Connect: string;
var
Received: string;
begin
result:='Unknown error while connecting';
FOutputPosition := 1; //First character in output stream
FWelcomeMessage := '';
//Just to make sure:
DetermineLineEnding;
DeterminePort;
if FTargetPort='0' then
begin
result:='Port may not be 0.';
exit; //jump out of function
end;
case FProtocolType of
Telnet:
begin
try
if Login then
begin
FConnected := True;
result:='Connected to telnet server.';
end
else
if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);
except
on E: Exception do
begin
FConnected:=false;
result:='Error connecting to telnet server '+FTargetHost+':'+
FTargetPort+' as user ' + FUserName +
'. Technical details: '+E.Message;
end;
end;
end;
SSH:
begin
{$IFNDEF HAS_SSH_SUPPORT}
raise Exception.Create(
'SSH support has not been compiled into the telnetsshclient library.');
{$ENDIF HAS_SSH_SUPPORT}
try
if (PrivateKeyFile <> '') and (FPassword <> '') then
Sock.SSL.KeyPassword:=FPassword;
if SSHLogin then
begin
FConnected := True;
result:='Connected to SSH server.';
end
else
begin
if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);
if Sock.SSL.LastError<0 then raise Exception.Create(Sock.SSL.LastErrorDesc);
end;
except
on E: Exception do
begin
FConnected:=false;
result:='Error connecting to SSH server '+FTargetHost+':'+
FTargetPort+' as user ' + FUserName +
'. Technical details: '+E.Message;
end;
end;
end;
else
raise Exception.Create('Unknown protocol type');
end;
if FConnected = True then
begin
FWelcomeMessage := ReceiveData;
if FProtocolType=Telnet then
begin
//Unfortunately, we'll have to extract login ourselves
//Hope it applies to all server types.
if (AnsiPos(AnsiLowerCase(FTelnetLoginPrompt),AnsiLowerCase(FWelcomeMessage))>0) then
begin
SendData(UserName);
end;
Received:=ReceiveData;
if (AnsiPos(AnsiLowerCase(FTelnetPasswordPrompt),AnsiLowerCase(Received))>0) then
begin
SendData(Password);
end;
//Receive additional welcome message/message of the day
FWelcomeMessage:=FWelcomeMessage+LineEnding+ReceiveData;
end;
end;
end;
procedure TTelnetSSHClient.Disconnect;
begin
Logout;
FConnected := False;
end;
function TTelnetSSHClient.ReceiveData: string;
begin
Result := '';
while Sock.CanRead(1000) or (Sock.WaitingData > 0) do
begin
Sock.RecvPacket(1000);
Result := Result + Copy(SessionLog, FOutputPosition,
Length(SessionLog));
FOutputPosition := Length(SessionLog) + 1;
end;
end;
procedure Ttelnetsshclient.SendData(Data: String);
begin
Data := Data + FServerLineEnding; //Could be linux, could be Windows
Send(Data);
end;
function TTelnetSSHClient.GetSessionLog: string;
begin
// Gets complete output up to now
Result := SessionLog;
end;
procedure TTelnetSSHClient.ProtocolTypeChange(Value: Tprotocoltype);
begin
FProtocolType := Value;
//Auto-determine port and line ending, if necessary
DeterminePort;
DetermineLineEnding;
end;
function TTelnetSSHClient.CommandResult(Command: string): string;
begin
Result := '';
if FConnected then
begin
SendData(Command);
Result := ReceiveData; //gets too much
end
else
begin
//raise exception
Result := '';
raise Exception.Create('Can only run command when connected');
end;
end;
constructor TTelnetSSHClient.Create;
begin
inherited;
FConnected := False;
FProtocolType := SSH; //Could be telnet, too
FServerType := Unix; //Probably a safe default.
FTelnetLoginPrompt := 'login:';
FTelnetPasswordPrompt := 'password:';
DetermineLineEnding;
DeterminePort;
end;
destructor TTelnetSSHClient.Destroy;
begin
if FConnected then
Disconnect;
inherited Destroy;
end;
end.
Example client code
To use the TTelnetSSHClient class we just made, you can use this example application, sshtest.lpr. Note that it needs to be compiled by Lazarus as it needs the LCL components to work with Synapse:
program sshtest;
{Test program for telnetsshclient
Written by Reinier Olislagers 2011.
Modified for libssh2 by Alexey Suhinin 2012.
License of code:
* MIT
* LGPLv2 or later (with FreePascal static linking exception)
* GPLv2 or later
according to your choice.
Free use allowed but please don't sue or blame me.
Uses other libraries/components; different licenses may apply that also can influence the combined/compiled work.
Run: sshtest <serverIPorhostname> [PrivateKeyFile]
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses
telnetsshclient;
var
comm: TTelnetSSHClient;
Command: string;
begin
writeln('Starting.');
comm:=TTelnetSSHClient.Create;
comm.HostName:= ParamStr(1); //First argument on command line
if comm.HostName='' then
begin
writeln('Please specify hostname on command line.');
halt(1);
end;
comm.PrivateKeyFile := ParamStr(2);
comm.TargetPort:='0'; //auto determine based on protocoltype
comm.UserName:='root'; //change to your situation
comm.Password:='password'; //change to your situation
comm.ProtocolType:=SSH; //Telnet or SSH
writeln(comm.Connect); //Show result of connection
if comm.Connected then
begin
writeln('Server: ' + comm.HostName + ':'+comm.TargetPort+', user: '+comm.UserName);
writeln('Welcome message:');
writeln(comm.WelcomeMessage);
Command:='ls -al';
writeln('*** Sending ' + Command);
writeln('*** Begin result****');
writeln(comm.CommandResult(Command));
writeln('*** End result****');
writeln('');
writeln('');
Command:='df -h';
writeln('*** Sending ' + Command);
writeln('*** Begin result****');
writeln(comm.CommandResult(Command));
writeln('*** End result****');
writeln('');
writeln('');
writeln('All output:');
writeln('*** Begin result****');
writeln(comm.AllOutput);
writeln('*** End result****');
comm.Disconnect;
end
else
begin
writeln('Connection to ' +
comm.HostName + ':' +
comm.TargetPort + ' failed.');
end;
comm.Free;
end.
OAuth v1/Twitter/Plurk integration
An OAuth v1 library written in FPC that uses Synapse (and is ready for other network libraries like lnet) is available here. FPCTwit also contains FPC twitter and plurk example client programs and a Lazarus twitter client.
Other Web and Networking Articles
- Web Development Portal
- Networking
- Networking libraries - comparison of various networking libraries
- Brook Framework - The perfect Free Pascal framework for your web applications. It's pure Pascal. You don't need to leave your preferred programming language.
- Sockets - TCP/IP Sockets components
- fcl-net - Networking library supplied with FPC
- lNet - Lightweight Networking Components
- Synapse - Serial port and synchronous TCP/IP Library
- XML Tutorial - XML is often utilized on network communications
- FPC and Apache Modules
- fcl-web - Also known as fpWeb, this is a library to develop web applications which can be deployed as cgi, fastcgi or apache modules.
- Secure Programming
- Internet Tools - A wrapper around Synapse/wininet/Android's http components simplifying https and redirections, and a XPath/XQuery/CSS Selector/JSONiq engine to process the downloaded pages
See also
- Download from SourceForge Example that uses Synapse to download from an HTTP server that redirects.
- Visual Synapse component wrappers for many parts of Synapse serial and networking library (TvsComPort, TvsWebClient, TvsSniffer, TvsHTTPServer, TvsFTPServer, TvsAuthentication, TvsVisualDNS, TvsVisualHTTP, TvsVisualDUP, TvsVisualTCP, TvsVisualICMP, TvsSocksProxyInfo, TvsIPHelper, TvsSendMail and TvsSynPing).
- TCP/IP component based on Synapse + a small demo application