Synapse

From Lazarus wiki
Revision as of 15:00, 24 March 2012 by Vincent (talk | contribs) (Text replace - "delphi>" to "syntaxhighlight>")
Jump to navigationJump to search

Synapse provides an easy to use serial port and synchronous TCP/IP library.

Other Web and Networking Articles

Overview

Synapse offers serial port and TCP/IP connectivity. It differs from other libraries that you only require to add some Synapse Pascal source code files to your code; no need for installing packages etc. The only exception is that you will need an external crypto library if you want to use encryption such as SSL/TLS/SSH. See the documentation on the official site (link below) for more details.

Linux

Unit cryptlib and the SSL part of Synapse require a crypto library, e.g. the cryptlib library. If the library is not present on the system, an error message appears during linking:

/usr/bin/ld: cannot find -lcl

Note: it may very well be possible to use OpenSSL libraries for the SSL part of Synapse. You will then need to specify the Synapse openssl_* units in your uses clause.

Downloading files

Downloading files from an FTP server

Given an URL and a (path and) file name, this will download it from an FTP server. It's mostly a wrapper around the Synapse code meant to make downloading easier when handling arbitrary files. If you know exactly what you're going to download where, just a call to Synapse

FtpGetFile

will get you very far.

function DownloadFTP(URL, TargetFile: string): boolean;
const
  FTPPort=21;
  FTPScheme='ftp://'; //URI scheme name for FTP URLs
var
  Host: string;
  Port: integer;
  Source: string;
  FoundPos: integer;
begin
  // Strip out scheme info:
  if LeftStr(URL, length(FTPScheme))=FTPScheme then URL:=Copy(URL, length(FTPScheme)+1, length(URL));

  // Crude parsing; could have used URI parsing code in FPC packages...
  FoundPos:=pos('/', URL);
  Host:=LeftStr(URL, FoundPos-1);
  Source:=Copy(URL, FoundPos+1, Length(URL));

  //Check for port numbers:
  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;

Downloading files from an HTTP server

Given an URL and a (path and) file name, this will download it from an HTTP server. Note that this code checks the HTTP status code (like 200, 404) to see if the document we got back from the server is the desired file or an error page.

With thanks to Ocye on the forum.

...
uses httpsend
...
function DownloadHTTP(URL, TargetFile: string): boolean;
// Download file; retry if necessary.
// Deals with SourceForge download links
// Could use Synapse HttpGetBinary, but that doesn't deal
// with result codes (i.e. it happily downloads a 404 error document)
const
  MaxRetries=3;
var
  HTTPGetResult: boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: integer;
begin
  result:=false;
  RetryAttempt:=1;
  //Optional: mangling of Sourceforge file download URLs; see below.
  //URL:=SourceForgeURL(URL); //Deal with sourceforge URLs
  HTTPSender:=THTTPSend.Create;
  try
    try
      // Try to get the file
      HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult=false) and (RetryAttempt<MaxRetries) do
      begin
        sleep(500*RetryAttempt);
        HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt:=RetryAttempt+1;
      end;
      // If we have an answer from the server, check if the file
      // was sent to us.
      case HTTPSender.Resultcode of
        100..299:
          begin
            with TFileStream.Create(TargetFile,fmCreate or fmOpenWrite) do
            try
              Seek(0, soFromBeginning);
              CopyFrom(HTTPSender.Document, 0);
            finally
              Free;
            end;
            result:=true;
          end; //informational, success
        300..399: result:=false; //redirection. Not implemented, but could be.
        400..499: result:=false; //client error; 404 not found etc
        500..599: result:=false; //internal server error
        else result:=false; //unknown code
      end;
    except
      // We don't care for the reason for this error; the download failed.
      result:=false;
    end;
  finally
    HTTPSender.Free;
  end;
end;

Dealing with Sourceforge HTTP download mirrors

If you're downloading files from Sourceforge.net projects, the code above won't work for you as Sourceforge redirect you. With thanks to ludob & Ocye:

function SourceForgeURL(URL: string): string;
// Detects sourceforge download and tries to deal with
// redirection, and extracting direct download link.
// Thanks to
// Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575
const
  SFProjectPart = '//sourceforge.net/projects/';
  SFFilesPart = '/files/';
  SFDownloadPart ='/download';
var
  HTTPSender: THTTPSend;
  i, j: integer;
  FoundCorrectURL: boolean;
  SFDirectory: string; //Sourceforge directory
  SFDirectoryBegin: integer;
  SFFileBegin: integer;
  SFFilename: string; //Sourceforge name of file
  SFProject: string;
  SFProjectBegin: integer;
begin
  // Detect SourceForge download; e.g. from URL
  //          1         2         3         4         5         6         7         8         9
  // 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890
  // http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download
  //                                 ^^^project^^^       ^^^directory............^^^ ^^^file^^^
  FoundCorrectURL:=true; //Assume not a SF download
  i:=Pos(SFProjectPart, URL);
  if i>0 then
  begin
    // Possibly found project; now extract project, directory and filename parts.
    SFProjectBegin:=i+Length(SFProjectPart);
    j := PosEx(SFFilesPart, URL, SFProjectBegin);
    if (j>0) then
    begin
      SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
      SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
      if SFDirectoryBegin>0 then
      begin
        // Find file
        // URL might have trailing arguments... so: search for first
        // /download coming up from the right, but it should be after
        // /files/
        i:=RPos(SFDownloadPart, URL);
        // Now look for previous / so we can make out the file
        // This might perhaps be the trailing / in /files/
        SFFileBegin:=RPosEx('/',URL,i-1)+1;

        if SFFileBegin>0 then
        begin
          SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
          //Include trailing /
          SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
          FoundCorrectURL:=false;
        end;
      end;
    end;
  end;

  if not FoundCorrectURL then
  begin
    try
      // Rewrite URL if needed for Sourceforge download redirection
      // Detect direct link in HTML body and get URL from that
      HTTPSender := THTTPSend.Create;
      //Who knows, this might help:
      HTTPSender.UserAgent:='curl/7.21.0 (i686-pc-linux-gnu) libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18';
      while not FoundCorrectURL do
      begin
        HTTPSender.HTTPMethod('GET', URL);
        case HTTPSender.Resultcode of
          301, 302, 307:
            begin
              for i := 0 to HTTPSender.Headers.Count - 1 do
                if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or
                  (Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then
                begin
                  j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]);
                  if j > 0 then
                    URL :=
                      'http://' + RightStr(HTTPSender.Headers.Strings[i],
                      length(HTTPSender.Headers.Strings[i]) - j - 10) +
                      '.dl.sourceforge.net/project/' +
                      SFProject + '/' + SFDirectory + SFFilename
                  else
                    URL:=StringReplace(
                      HTTPSender.Headers.Strings[i], 'Location: ', '', []);
                  HTTPSender.Clear;//httpsend
                  FoundCorrectURL:=true;
                  break; //out of rewriting loop
              end;
            end;
          100..200:
            begin
              //Could be a sourceforge timer/direct link page, but...
              if AnsiPos('Content-Type: text/html', HTTPSender.Headers.Text)>0 then
              begin
                // find out... it's at least not a binary
                URL:=SFDirectLinkURL(URL, HTTPSender.Document);
              end;
              FoundCorrectURL:=true; //We're done by now
            end;
          500: raise Exception.Create('No internet connection available');
            //Internal Server Error ('+aURL+')');
          else
            raise Exception.Create('Download failed with error code ' +
              IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')');
        end;//case
      end;//while
    finally
      HTTPSender.Free;
    end;
  end;
  result:=URL;
end;

SSH/Telnet client sample program

Below you will find a unit that allows you to use telnet/SSH client functionality that uses the synapse tlntsend.pas unit. An example program shows how to use this. A different, simpler way is illustrated by Leonardo Ramé at [1]. His example cannot use telnet and only sends one command, though.

Requirements

Apart from the Synapse sources (of which you only need a couple), if you want to use SSH functionality, you will need the cryptlib library. If you only use Telnet, you don't need cryptlib.

Suggestion:

  • On Windows, download a binary version of the cryptlib DLL (CL32.DLL) and put it in your source directory. If you compile to a different directory or distribute your program, you will need to distribute the DLL as well.
  • On Linux and OSX, install cryptlib via your package manager/other means. When distributing your application, mark cryptlib as a requirement in your .deb/.rpm/whatever package.

You will also need the bindings (cryptlib.pas), present in the source distribution of cryptlib.

The cryptlib binary and the bindings must match.

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 cryptlib 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 (cryptlib is used right now)
Download compiled Windows dll from e.g.
http://dl.free.fr/izHgBttba
Click on "Télécharger ce fichier"

This unit allows the user to send Telnet or SSH commands and get the output
Thanks to Leonardo Ramé
http://leonardorame.blogspot.com/2010/01/synapse-based-ssh-client.html
and Ludo Brands.

Written by Reinier Olislagers 2011. License of my 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

interface

uses
  Classes, SysUtils,
  tlntsend
  {$IFDEF HAS_SSH_SUPPORT}
  {ssl - or actually ssh - libs required by tlntsend}
  , ssl_cryptlib {Please include cryptlib dll in executable directory/install cryptlib .so/.dylib}
  {$ENDIF HAS_SSH_SUPPORT}  ;

type
  TProtocolType = (Telnet, SSH); //Different means of connecting
  TServerType = (Unix, Windows); //line endings, mostly
  { TelnetSSHClient }

  { TTelnetSSHClient }

  TTelnetSSHClient = class(TObject)
  protected
    FTelnetSend: TTelnetSend;
    FConnected: boolean;
    FHostName: string;
    FOutputPosition: integer; //Keeps track of position in output stream
    FPort: integer;
    FPrivateKey: string;
    FPassword: string;
    FProtocolType: TProtocolType;
    FServerLineEnding: string; //depends on FServerType
    FServerType: TServerType;
    FUserName: string;
    FWelcomeMessage: 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 FHostName write FHostName;
    {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: integer read FPort write FPort;
    {Location of private key file. NOTE: not supported yet}
    property PrivateKey: string read FPrivateKey write FPrivateKey;
    {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.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 Port = 0 then
    //Set default port for protocol
  begin
    case ProtocolType of
      Telnet: Port := 23;
      SSH: Port := 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;
const
  TelnetLoginPrompt='login:'; //Must be lower case
  TelnetPasswordPrompt='password:'; //Must be lower case
var
  Received: string;
begin
  result:='Unknown error while connecting';
  FOutputPosition := 1; //First character in output stream
  FWelcomeMessage := '';
  //Just to make sure:
  DetermineLineEnding;
  DeterminePort;
  if Port=0 then
  begin
   result:='Port may not be 0.';
   exit; //jump out of function
  end;
  FTelnetSend.TargetHost := HostName;
  FTelnetSend.TargetPort := IntToStr(Port);
  FTelnetSend.UserName := UserName;
  if PrivateKey <> '' then
  begin
    result:='Private key use not supported.';
    if Password <> '' then
    begin
      //Assume the password is the passphrase for the private key
      //todo: implement this.
    end;
  end
  else
  begin
    FTelnetSend.Password := Password;
  end;
  case FProtocolType of
    Telnet:
    begin
      try
        if FTelnetSend.Login then
        begin
          FConnected := True;
          result:='Connected to telnet server.';
        end;
      except
        on E: Exception do
        begin
          FConnected:=false;
          result:='Error connecting to telnet server '+HostName+':'+
          inttostr(Port)+' as user ' + UserName +
          '. 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 FTelnetSend.SSHLogin then
        begin
          FConnected := True;
          result:='Connected to SSH server.';
        end;
      except
        on E: Exception do
        begin
          FConnected:=false;
          result:='Error connecting to SSH server '+HostName+':'+
          inttostr(Port)+' as user ' + UserName +
          '. Technical details: '+E.Message;
        end;
      end;
      case FTelnetSend.Sock.SSL.LastError of
        -1:
        begin
          FConnected := False;
          raise Exception.Create(
            'Cannot find cryptlib library or invalid version. Technical error description: ' +
            FTelnetSend.Sock.SSL.LastErrorDesc);
        end;
        0:
        begin
        end;//everything hunky-dory.
        else
        begin
        end; //unknown error, let's continue for now.;
      end;
    end;
    else
      raise Exception.Create('Unknown protocol type');
  end;
  if FConnected = True then
  begin
    FWelcomeMessage := ReceiveData;
    if ProtocolType=Telnet then
    begin
      //Unfortunately, we'll have to extract login ourselves
      //Hope it applies to all server types.
      if (AnsiPos(TelnetLoginPrompt,AnsiLowerCase(FWelcomeMessage))>0) then
      begin
        SendData(UserName);
      end;
      Received:=ReceiveData;
      if (AnsiPos(TelnetPasswordPrompt,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
  FTelnetSend.Logout;
  FConnected := False;
end;

function TTelnetSSHClient.ReceiveData: string;
begin
  Result := '';
  while FTelnetSend.Sock.CanRead(1000) or (FTelnetSend.Sock.WaitingData > 0) do
  begin
    FTelnetSend.Sock.RecvPacket(1000);
    Result := Result + Copy(FTelnetSend.SessionLog, FOutputPosition,
      Length(FTelnetSend.SessionLog));
    FOutputPosition := Length(FTelnetSend.SessionLog) + 1;
  end;
end;

procedure Ttelnetsshclient.SendData(Data: String);
begin
  Data := Data + FServerLineEnding; //Could be linux, could be Windows
  FTelnetSend.Send(Data);
end;

function TTelnetSSHClient.GetSessionLog: string;
begin
  // Gets complete output up to now
  Result := FTelnetSend.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 Connected 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
  FConnected := False;
  HostName := '127.0.0.1';  //Maybe we've got a local ssh server running ;)
  Port := 0; //if 0, gets automatically switched depending on terminal type
  UserName := 'root'; //default value
  Password := 'password'; //default value
  PrivateKey := '';
  ProtocolType := SSH; //Could be telnet, too
  ServerType := Unix; //Probably a safe default.
  DetermineLineEnding;
  DeterminePort;
  FTelnetSend := TTelnetSend.Create();
end;

destructor TTelnetSSHClient.Destroy;
begin
  if FConnected then
    Disconnect;
  FTelnetSend.Free;
  inherited Destroy;
end;

end.

Example program

To use the 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. License of my 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>
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, Interfaces, // this includes the LCL widgetset
  SysUtils,
  Forms,
  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.Port:=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 + ':'+inttostr(comm.Port)+', 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 + ':' +
      inttostr(comm.Port) + ' failed.');
  end;
  comm.Free;
end.

External links