indy Indy FTP Server with TLS/SSL

shineworld · September 29, 2023

Hi all,

sorry in advance for very newbie in TLS/SSL things.

I'm trying to create a secure FTP Server (with TLS/SSL) using the latest Indy sources from the GitHub repository.
I've created required certificates with OpenSSL and used openssl-1.0.2u-x64_86-win64 DLL's always from a GitHub repository (info from Embarcadero Delphi manual).

This is an extract of dummy code to test an early connection using Filezilla FTP Client:

unit osFTPServer;

interface

uses
  IdContext,
  IdFTPList,
  IdFTPServer,
  IdFTPListOutput,

  IdSSLOpenSSL;

type
  TFTPServer = class
  private
    FFTPServer: TIdFTPServer;
    FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL;
  private
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
    procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd : String; const ASwitches : String);

  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  IdSSLOpenSSLHeaders,

  osSysUtils;

{ TFTPServer }

constructor TFTPServer.Create;
begin
  inherited;

  // inits default members values
  FFTPServer := nil;
  FIOHandlerSSLOpenSLL := nil;

  // starts
  IdOpenSSLSetLibPath('D:\x\develop\qem\rosetta_cnc_1\openssl.64');

  FFTPServer := TIdFTPServer.Create;
  FFTPServer.DefaultPort := 21;

  FFTPServer.OnConnect := ServerConnect;
  FFTPServer.OnDisconnect := ServerDisconnect;
  FFTPServer.OnUserLogin := ServerUserLogin;
  FFTPServer.OnListDirectory := ServerListDirectory;

  FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
  FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
  FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvTLSv1_2;
  FIOHandlerSSLOpenSLL.SSLOptions.CertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-cert.pem';
  FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-key.pem';
  FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := '';

  FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;

  FFTPServer.Active := True;
end;

destructor TFTPServer.Destroy;
begin
  //### does jobs to deactivate server before to free it!!!

  // frees objects
  SafeFreeAndNil(FFTPServer);
  SafeFreeAndNil(FIOHandlerSSLOpenSLL);

  inherited;
end;

procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  //###
end;

procedure TFTPServer.ServerDisconnect(AContext: TIdContext);
begin
  //###
end;

procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: String);
begin
  //###
end;

procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
begin
  //###
  VAuthenticated := True;
end;

end.

When I try to connect with FileZilla it say:
image.png.31a6102fcea2812d59664a1be756db9b.png

Status:   Connecting to 192.168.0.27:21...
Status:   Connection established, waiting for welcome message...
Status:   Insecure server, it does not support FTP over TLS.
Status:   Logged in
Status:   Retrieving directory listing...
Status:   Directory listing of "/" successful

What am I doing wrong?
Thanks in advance for any suggestions.

shineworld · September 29, 2023

Certificates are OK because I've tried to do the same thing with Python using them:

# require pip install pyOpenSSL
# require pip install pyftpdlib

from pyftpdlib.authorizers import DummyAuthorizer
from pyftpdlib.handlers import FTPHandler, TLS_FTPHandler
from pyftpdlib.servers import FTPServer

def create_server():
    # Crea un'autorizzazione e aggiungi un utente
    authorizer = DummyAuthorizer()
    authorizer.add_user("user", "12345", "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates", perm="elradfmw")

    # Inizializza l'handler del server FTP e assegna l'autorizzatore
    handler = TLS_FTPHandler
    handler.authorizer = authorizer

    # Specifica i percorsi per i certificati SSL
    handler.certfile = "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates\\ftpserver\\server-cert.pem"  # Sostituisci con il percorso corretto del certificato
    handler.keyfile = "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates\\ftpserver\\server-key.pem"  # Sostituisci con il percorso corretto della chiave privata

    # Abilita TLS sull'handler
    handler.tls_control_required = True
    handler.tls_data_required = True

    # Configura altre opzioni dell'handler
    handler.passive_ports = range(60000, 65535)

    # Crea il server FTP e lo avvia
    server = FTPServer(("127.0.0.1", 21), handler)
    server.serve_forever()

if __name__ == "__main__":
    create_server()

and Filezilla open now a TLS/SSL connection...

Happy for a solution with Delphi 🙂

DelphiUdIT · September 29, 2023

In the server connect event you must add:

procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  If AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := (UseTLS = utNoTLSSupport); //This function must be set to false for it to handle SSL/TLS functionality.
end;

shineworld · September 29, 2023

Being really ignorant of security I put a few breakpoints in the sources and followed step by step changing the options from way to way.

Something seems to be working now...

unit osFTPServer;

interface

uses
  IdCTypes,
  IdContext,
  IdComponent,

  IdFTPList,
  IdFTPServer,
  IdFTPListOutput,

  IdSSLOpenSSL,
  IdSSLOpenSSLHeaders;

type
  TFTPServer = class
  private
    FFTPServer: TIdFTPServer;
    FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL;
  private
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
    procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd : String; const ASwitches : String);

    procedure SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure SSLStatusInfo(const AMsg: String);
    procedure SSLStatusInfoEx(ASender : TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg : String);
    procedure SSLGetPassword(var Password: String);
    procedure SSLGetPasswordEx(ASender : TObject; var VPassword: String; const AIsWrite : Boolean);


  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
//IdSSL,
  IdExplicitTLSClientServerBase,

  osSysUtils;

{ TFTPServer }

constructor TFTPServer.Create;
begin
  inherited;

  // inits default members values
  FFTPServer := nil;
  FIOHandlerSSLOpenSLL := nil;

  // creates, sets and start FTP server
  IdOpenSSLSetLibPath('D:\x\develop\qem\rosetta_cnc_1\openssl.64');

  FFTPServer := TIdFTPServer.Create;
  FFTPServer.DefaultPort := 21;

  FFTPServer.OnConnect := ServerConnect;
  FFTPServer.OnDisconnect := ServerDisconnect;
  FFTPServer.OnUserLogin := ServerUserLogin;
  FFTPServer.OnListDirectory := ServerListDirectory;

  FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
  FIOHandlerSSLOpenSLL.OnStatus := SSLStatus;
  FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo;
  FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx;
  FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword;
  FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx;

  FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
  FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvSSLv23; // sslvTLSv1_2;
  FIOHandlerSSLOpenSLL.SSLOptions.CertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-cert.pem';
  FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-key.pem';
  FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\root-cert.pem';
  FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := '';

  FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
  FFTPServer.UseTLS := utUseRequireTLS;

  FFTPServer.Active := True;
end;

destructor TFTPServer.Destroy;
begin
  //### does jobs to deactivate server before to free it!!!

  // frees objects
  SafeFreeAndNil(FFTPServer);
  SafeFreeAndNil(FIOHandlerSSLOpenSLL);

  inherited;
end;

procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  //###
{
  If AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False; //This function must be set to false for it to handle SSL/TLS functionality.
}
end;

procedure TFTPServer.ServerDisconnect(AContext: TIdContext);
begin
  //###
end;

procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: String);
begin
  //###
end;

procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
begin
  //###
  VAuthenticated := True;
end;

procedure TFTPServer.SSLGetPassword(var Password: String);
begin
  //###
end;

procedure TFTPServer.SSLGetPasswordEx(ASender: TObject; var VPassword: String; const AIsWrite: Boolean);
begin
  //###
end;

procedure TFTPServer.SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfo(const AMsg: String);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: String);
begin
  //###
end;

end.

Filezilla reply:

Status:   Connecting to 192.168.0.27:21...
Status:   Connection established, waiting for welcome message...
Status:   Initializing TLS...
Status:   TLS connection established.
Status:   Logged in
Status:   Retrieving directory listing...
Status:   Directory listing of "/" successful

Log is very close to what happens with Python code:
Status:   Connecting to 127.0.0.1:21...
Status:   Connection established, waiting for welcome message...
Status:   Initializing TLS...
Status:   TLS connection established.
Status:   Logged in
Status:   Retrieving directory listing...
Status:   Directory listing of "/" successful

DelphiUdIT · September 29, 2023

You use

sslvSSLv23;

Instead try to stay on sslvTLSv1_2.

If you want to use the sslmServer way, you'd better set the "chiperlist" to a way like this (it's for better security and to avoid known bugs):

//THIS BEFORE SERVER ACTIVATION
FIOHandlerSSLOpenSLL.SSLOptions.CipherList := '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA'+
                      ':ECDHE-RSA-AES128-GCM-SHA256'+
                      ':ECDHE-RSA-AES256-GCM-SHA384'+
                      ':ECDHE-RSA-CHACHA20-POLY1305'+
                      //to use this two you must create a dhparam.pem file with openssl in this way
                      //openssl dhparam -out dhparam.pem 4096
                      //':DHE-RSA-AES128-GCM-SHA256'+
                      //':DHE-RSA-AES256-GCM-SHA384'+
                      '';
  ////This is to use DHE encoding (see above)
  //DHParamsFile := '.\dhparam.pem';

Then, if you use openssl 1.02, and you want the "client" to attempt connection according to your chiperlist you should also set the context with a general command:

//THIS AFTER SERVER ACTIVATION (EVERY TIME YOU DISABLE AND ENABLE THE SERVER)
type
   TMyIdSSLContext = class(TIdSSLContext)
  end;
var FSSLContext1: TMyIdSSLContext;
FSSLContext1 := TMyIdSSLContext(FIOHandlerSSLOpenSLL.SSLContext);
SSL_CTX_set_ecdh_auto(FSSLContext1.fContext, 1);
SSL_CTX_set_options(FSSLContext1.fContext, SSL_OP_CIPHER_SERVER_PREFERENCE);

You can check also OPENSSL REF PAGE: https://www.openssl.org/docs/man1.1.1/man1/ciphers.html

Edited September 29, 2023 by DelphiUdIT

DelphiUdIT · September 29, 2023

If you want to play with security, build a Https server (from Indy demo with a little effort). After that you can test it with https://www.ssllabs.com/ssltest/ or with https://testtls.com/

To test, the servers should be public available (firewall NAT is enough).

You can play with the project attached, old demo (is ready to compile and run with cert and SSL dll 32 bit (1.02u)).

This is the partial result with test, with default (no chiperlist).

https-server.zip

shineworld · September 30, 2023

I've tried to move from sslvSSLv23 to sslvTLSv1_2 as in the test code below but FileZilla says:

2023-09-30 10:39:20 11520 1 Status: Connecting to 127.0.0.1:21...
2023-09-30 10:39:20 11520 1 Status: Connection established, waiting for welcome message...

and

> openssl s_client -starttls ftp -connect 192.168.0.27:21

says:
P:\>openssl s_client -starttls ftp -connect 192.168.0.27:21
CONNECTED(00000178)
... infinite wait without do nothing..

{**
 *  TAKE CARE
 *  =========
 *  This unit is purely for study purposes in which to learn the basics about building and testing an FTP server with
 *  various levels of security. Server activation is in class constructor, and server properties manually placed before
 *  its activation. On final class will be implemented a Start & Stop method to control it, with a property to get the
 *  current state. The server settings will be placed in properties to be set before to activate the server.
 *
 **}
unit osFTPServer;

interface

uses
  System.Classes,

  IdCTypes,
  IdContext,
  IdComponent,

  IdFTPList,
  IdFTPServer,
  IdFTPListOutput,

  IdSSLOpenSSL,
  IdSSLOpenSSLHeaders;

type
  TFTPServerSecurityPolicy =
  (
    fssp_None,
    fssp_sslvSSLv23,
    fssp_sslvTLSv1_2
  );

  TFTPServer = class
  private
    FCertificatesPath: string;
    FFTPServer: TIdFTPServer;
    FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL;
    FOpenSSLDLLPath: string;
    FPassword: string;
    FRootPath: string;
    FSecurityPolicy: TFTPServerSecurityPolicy;
    FUsername: string;
  private
    procedure ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd: string; const ASwitches: string);
    procedure ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
    procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
    procedure SSLGetPassword(var Password: string);
    procedure SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean);
    procedure SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure SSLStatusInfo(const AMsg: string);
    procedure SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string);
  private
    function FixPath(const APath: string): string;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  System.IOUtils,
  System.SysUtils,

  IdSSL,
  IdExplicitTLSClientServerBase;

function FixTailPathDelimiter(const S: string): string;
begin
  Result := IncludeTrailingPathDelimiter(ExcludeTrailingPathDelimiter(S));
end;

procedure SafeFreeAndNil(var Obj);
var
  Temp: TObject;
begin
  try
    Temp := TObject(Obj);
    if Temp <> nil then
    begin
      Pointer(Obj) := nil;
      Temp.Free;
    end;
  except
  end;
end;

{ TFTPServer }

constructor TFTPServer.Create;
begin
  inherited;

  // inits default members values
  FCertificatesPath := '';
  FFTPServer := nil;
  FIOHandlerSSLOpenSLL := nil;
  FOpenSSLDLLPath := '';
  FPassword := '';
  FRootPath := '';
  FSecurityPolicy := fssp_None;
  FUsername := '';

  // TEMPORARY: manually set FTP settings (WILL BE PLACED ON PROPERTIES)
  FCertificatesPath := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\';
  FOpenSSLDLLPath := 'D:\x\develop\qem\rosetta_cnc_1\openssl.64';
  FPassword := '12345';
  FRootPath := 'D:\x\develop\qem\rosetta_cnc_1\certificates\';
//FSecurityPolicy := fssp_sslvSSLv23;
  FSecurityPolicy := fssp_sslvTLSv1_2;
  FUsername := 'user';

  // TEMPORARY: creates, sets and start FTP server
  IdOpenSSLSetLibPath(FOpenSSLDLLPath);

  FFTPServer := TIdFTPServer.Create;
  FFTPServer.DefaultPort := 21;
  FFTPServer.OnChangeDirectory := ServerChangeDirectory;
  FFTPServer.OnConnect := ServerConnect;
  FFTPServer.OnDeleteFile := ServerDeleteFile;
  FFTPServer.OnDisconnect := ServerDisconnect;
  FFTPServer.OnListDirectory := ServerListDirectory;
  FFTPServer.OnMakeDirectory := ServerMakeDirectory;
  FFTPServer.OnRemoveDirectory := ServerRemoveDirectory;
  FFTPServer.OnStoreFile := ServerStoreFile;
  FFTPServer.OnUserLogin := ServerUserLogin;

  case FSecurityPolicy of
    fssp_None: ;

    fssp_sslvSSLv23:
    begin
      FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
      FIOHandlerSSLOpenSLL.OnStatus := SSLStatus;
      FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo;
      FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx;
      FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword;
      FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx;

      FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
      FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvSSLv23;
      FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'server-cert.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'server-key.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'root-cert.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := '';
      FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FFTPServer.UseTLS := utUseRequireTLS;
    end;

    fssp_sslvTLSv1_2:
    begin
{.DEFINE USES_DHPARAM}    // NOTE: to use this create a dhparam.pem file with openssl in this way openssl dhparam -out dhparam.pem 4096
      FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
      FIOHandlerSSLOpenSLL.OnStatus := SSLStatus;
      FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo;
      FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx;
      FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword;
      FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx;

      FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
      FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvTLSv1_2;
{$IFDEF USES_DHPARAM}
      FIOHandlerSSLOpenSLL.SSLOptions.CipherList :=
      (
        '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' +
        ':ECDHE-RSA-AES128-GCM-SHA256' +
        ':ECDHE-RSA-AES256-GCM-SHA384' +
        ':ECDHE-RSA-CHACHA20-POLY1305' +
        ':DHE-RSA-AES128-GCM-SHA256' +
        ':DHE-RSA-AES256-GCM-SHA384' +
        ''
      );
      FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := FCertificatesPath + 'dhparam.pem';
{$ELSE}
      FIOHandlerSSLOpenSLL.SSLOptions.CipherList :=
      (
        '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' +
        ':ECDHE-RSA-AES128-GCM-SHA256' +
        ':ECDHE-RSA-AES256-GCM-SHA384' +
        ':ECDHE-RSA-CHACHA20-POLY1305'
      );
      FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := '';
{$ENDIF}
      FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'server-cert.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'server-key.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'root-cert.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := '';
      FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FFTPServer.UseTLS := utUseRequireTLS;
    end;
  end;

  // sets passive boundary ports range to permit more than one file operation (eg: client multiple copy file to server)
  FFTPServer.PASVBoundPortMin := 60000;
  FFTPServer.PASVBoundPortMax := 65535;
  FFTPServer.Active := True;
end;

destructor TFTPServer.Destroy;
begin
  //### does jobs to deactivate server before to free it!!!

  // frees objects
  SafeFreeAndNil(FFTPServer);
  SafeFreeAndNil(FIOHandlerSSLOpenSLL);

  inherited;
end;

function TFTPServer.FixPath(const APath: string): string;
begin
  Result := StringReplace(APath, '/', '\', [rfReplaceAll]);
  Result := StringReplace(Result, '\\', '\', [rfReplaceAll]);
end;

procedure TFTPServer.ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  //###
end;

procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  case FSecurityPolicy of
    fssp_None:
      ;

    fssp_sslvSSLv23:
      ;

    fssp_sslvTLSv1_2:
    begin
      // PassThroung must be set to False for it to handle SSL/TLS functionality
      if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
        TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
    end;
  end;
end;

procedure TFTPServer.ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName);
begin
  DeleteFile(FixPath(FRootPath + ASender.CurrentDir + '\' + APathname));
end;

procedure TFTPServer.ServerDisconnect(AContext: TIdContext);
begin
  //###
end;

procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: string);
var
  Status: Integer;
  SearchRec: TSearchRec;
  Item: TIdFTPListOutputItem;
begin
  try
    ADirectoryListing.DirFormat := doWin32;
    ADirectoryListing.Switches := ASwitches;
    {$WARN SYMBOL_PLATFORM OFF}
    Status := FindFirst(FixPath(FRootPath + FixTailPathDelimiter(APath) + '*.*'), faAnyFile - faHidden - faSysFile, SearchRec);
    {$WARN SYMBOL_PLATFORM ON}
    try
      while Status = 0 do
      begin
        Item := ADirectoryListing.Add;
        if SearchRec.Attr and faDirectory = 0 then
          Item.ItemType := ditFile
        else
          Item.ItemType := ditDirectory;
        Item.FileName := SearchRec.Name;
        Item.Size := SearchRec.Size;
        Item.ModifiedDate := SearchRec.TimeStamp;
        Status := FindNext(SearchRec);
      end;
    finally
      FindClose(SearchRec);
    end;
  except
  end;
end;

procedure TFTPServer.ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  try
    ForceDirectories(FixPath(FRootPath + VDirectory));
  except
  end;
end;

procedure TFTPServer.ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  try
    TDirectory.Delete(FixPath(FRootPath + VDirectory), True);
  except
  end;
end;

procedure TFTPServer.ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
var
  Path: string;
begin
  // extracts path and forces creation if does not exits
  Path := ExtractFilePath(FixPath(FRootPath + AFilename));
  if not DirectoryExists(Path) then
    ForceDirectories(Path);

  // opens a file stream for cration or append
  if not AAppend then
    VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmCreate)
  else
    VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmOpenWrite)
end;

procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
begin
  // checks user and password validity
  case FSecurityPolicy of
    fssp_None:
    begin
      VAuthenticated := True;
    end;

    fssp_sslvSSLv23:
    begin
      VAuthenticated :=
      (
        (FUsername = Trim(AUserName)) and
        (FPassword = Trim(APassword))
      );
    end;

    fssp_sslvTLSv1_2:
    begin
      VAuthenticated :=
      (
        (FUsername = Trim(AUserName)) and
        (FPassword = Trim(APassword))
      );
    end;
  end;
end;

procedure TFTPServer.SSLGetPassword(var Password: string);
begin
  //###
  Password := FPassword;
end;

procedure TFTPServer.SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean);
begin
  //###
end;

procedure TFTPServer.SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfo(const AMsg: string);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string);
begin
  //###
end;

end.

Have you any suggestions?
Thanks in advance for any suggestions.

Edited September 30, 2023 by shineworld

DelphiUdIT · September 30, 2023

Some little changes ... take care of port use ... in Indy too (better to use bindings with explicit port).

Some methods included, some excluded (the password ask in the SSLIoHandler is for the "certificate key file", not for user).

I use to assign the SSLIoHandler to TFTPServer immediately.

{**
 *  TAKE CARE
 *  =========
 *  This unit is purely for study purposes in which to learn the basics about building and testing an FTP server with
 *  various levels of security. Server activation is in class constructor, and server properties manually placed before
 *  its activation. On final class will be implemented a Start & Stop method to control it, with a property to get the
 *  current state. The server settings will be placed in properties to be set before to activate the server.
 *
 **}
unit osFTPServer;

interface

uses
  System.Classes,

  IdCTypes,
  IdContext,
  IdComponent,

  IdFTPList,
  IdFTPServer,
  IdFTPListOutput,

  IdSSLOpenSSL,
  IdSSLOpenSSLHeaders;

type
   TMyIdSSLContext = class(TIdSSLContext)
  end;

type
  TFTPServerSecurityPolicy =
  (
    fssp_None,
    fssp_sslvSSLv23,
    fssp_sslvTLSv1_2
  );

  TFTPServer = class
  private
    FCertificatesPath: string;
    FFTPServer: TIdFTPServer;
    FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL;
    FOpenSSLDLLPath: string;
    FPassword: string;
    FRootPath: string;
    FSecurityPolicy: TFTPServerSecurityPolicy;
    FUsername: string;
    FSSLContext1: TMyIdSSLContext;
  private
    procedure IdFTPServer1QuerySSLPort(APort: Word; var VUseSSL: Boolean);
    procedure IdFTPServer1UserAccount(ASender: TIdFTPServerContext;
              const AUsername, APassword, AAcount: string; var AAuthenticated: Boolean);
    procedure ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd: string; const ASwitches: string);
    procedure ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
    procedure ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
    procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
    procedure SSLGetPassword(var Password: string);
    procedure SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean);
    procedure SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure SSLStatusInfo(const AMsg: string);
    procedure SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string);
  private
    function FixPath(const APath: string): string;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  System.IOUtils,
  System.SysUtils,
  IdSSL,
  IdExplicitTLSClientServerBase;

function FixTailPathDelimiter(const S: string): string;
begin
  Result := IncludeTrailingPathDelimiter(ExcludeTrailingPathDelimiter(S));
end;

procedure SafeFreeAndNil(var Obj);
var
  Temp: TObject;
begin
  try
    Temp := TObject(Obj);
    if Temp <> nil then
    begin
      Pointer(Obj) := nil;
      Temp.Free;
    end;
  except
  end;
end;

{ TFTPServer }

constructor TFTPServer.Create;
begin
  inherited;

  // inits default members values
  FCertificatesPath := '';
  FFTPServer := nil;
  FIOHandlerSSLOpenSLL := nil;
  FOpenSSLDLLPath := '';
  FPassword := '';
  FRootPath := '';
  FSecurityPolicy := fssp_None;
  FUsername := '';

  // TEMPORARY: manually set FTP settings (WILL BE PLACED ON PROPERTIES)
  FCertificatesPath := '.\';
  FOpenSSLDLLPath := '.\';
  FPassword := '12345';
  FRootPath := '.\';
//FSecurityPolicy := fssp_sslvSSLv23;
  FSecurityPolicy := fssp_sslvTLSv1_2;
  FUsername := 'user';

  // TEMPORARY: creates, sets and start FTP server
  IdOpenSSLSetLibPath(FOpenSSLDLLPath);

  FFTPServer := TIdFTPServer.Create;
  FFTPServer.DefaultPort := 21;
  FFTPServer.OnChangeDirectory := ServerChangeDirectory;
  FFTPServer.OnConnect := ServerConnect;
  FFTPServer.OnDeleteFile := ServerDeleteFile;
  FFTPServer.OnDisconnect := ServerDisconnect;
  FFTPServer.OnListDirectory := ServerListDirectory;
  FFTPServer.OnMakeDirectory := ServerMakeDirectory;
  FFTPServer.OnRemoveDirectory := ServerRemoveDirectory;
  FFTPServer.OnStoreFile := ServerStoreFile;
  FFTPServer.OnUserLogin := ServerUserLogin;
  FFTPServer.OnQuerySSLPort := IdFTPServer1QuerySSLPort;
  FFTPServer.OnUserAccount := IdFTPServer1UserAccount;

  case FSecurityPolicy of
    fssp_None: ;

    fssp_sslvSSLv23:
    begin
      FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
      FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FIOHandlerSSLOpenSLL.OnStatus := SSLStatus;
      FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo;
      FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx;
      //FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword;
      //FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx;

      FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
      FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvSSLv23;
      FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'certonly.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'privatekey.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'lets-encrypt-r3.pem';
      //FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FFTPServer.UseTLS := utUseRequireTLS;
    end;

    fssp_sslvTLSv1_2:
    begin
      {$DEFINE USES_DHPARAM}    // NOTE: to use this create a dhparam.pem file with openssl in this way openssl dhparam -out dhparam.pem 4096
      FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil);
      FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FIOHandlerSSLOpenSLL.OnStatus := SSLStatus;
      FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo;
      FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx;
      //FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword;
      //FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx;

      FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer;
      FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvTLSv1_2;
{$IFDEF USES_DHPARAM}
      FIOHandlerSSLOpenSLL.SSLOptions.CipherList :=
      (
        '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' +
        ':ECDHE-RSA-AES128-GCM-SHA256' +
        ':ECDHE-RSA-AES256-GCM-SHA384' +
        ':ECDHE-RSA-CHACHA20-POLY1305' +
        ':DHE-RSA-AES128-GCM-SHA256' +
        ':DHE-RSA-AES256-GCM-SHA384' +
        ''
      );
      FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := FCertificatesPath + 'dhparam.pem';
{$ELSE}
      FIOHandlerSSLOpenSLL.SSLOptions.CipherList :=
      (
        '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' +
        ':ECDHE-RSA-AES128-GCM-SHA256' +
        ':ECDHE-RSA-AES256-GCM-SHA384' +
        ':ECDHE-RSA-CHACHA20-POLY1305'
      );
      FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := '';
{$ENDIF}
      FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'certonly.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'privatekey.pem';
      FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'lets-encrypt-r3.pem';
      //FFTPServer.IOHandler := FIOHandlerSSLOpenSLL;
      FFTPServer.UseTLS := utUseExplicitTLS;
    end;
  end;

  // sets passive boundary ports range to permit more than one file operation (eg: client multiple copy file to server)
  FFTPServer.PASVBoundPortMin := 60000;
  FFTPServer.PASVBoundPortMax := 65535;
  FFTPServer.Active := True;

  //After activation
  FSSLContext1 := TMyIdSSLContext(FIOHandlerSSLOpenSLL.SSLContext);
  SSL_CTX_set_ecdh_auto(FSSLContext1.fContext, 1);
  SSL_CTX_set_options(FSSLContext1.fContext, SSL_OP_CIPHER_SERVER_PREFERENCE);
end;

destructor TFTPServer.Destroy;
begin
  //### does jobs to deactivate server before to free it!!!

  // frees objects
  SafeFreeAndNil(FFTPServer);
  SafeFreeAndNil(FIOHandlerSSLOpenSLL);

  inherited;
end;

function TFTPServer.FixPath(const APath: string): string;
begin
  Result := StringReplace(APath, '/', '\', [rfReplaceAll]);
  Result := StringReplace(Result, '\\', '\', [rfReplaceAll]);
end;

procedure TFTPServer.ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  //###
end;

procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  case FSecurityPolicy of
    fssp_None:
      begin
        // PassThroung must be set to False for it to handle SSL/TLS functionality
        if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
          TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := True;
      end;
    fssp_sslvSSLv23:
      begin
        // PassThroung must be set to False for it to handle SSL/TLS functionality
        if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
          TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
      end;
    fssp_sslvTLSv1_2:
      begin
        // PassThroung must be set to False for it to handle SSL/TLS functionality
        if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
          TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False;
      end;
  end;
end;

procedure TFTPServer.ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName);
begin
  DeleteFile(FixPath(FRootPath + ASender.CurrentDir + '\' + APathname));
end;

procedure TFTPServer.ServerDisconnect(AContext: TIdContext);
begin
  //###
end;

procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: string);
var
  Status: Integer;
  SearchRec: TSearchRec;
  Item: TIdFTPListOutputItem;
begin
  try
    ADirectoryListing.DirFormat := doWin32;
    ADirectoryListing.Switches := ASwitches;
    {$WARN SYMBOL_PLATFORM OFF}
    Status := FindFirst(FixPath(FRootPath + FixTailPathDelimiter(APath) + '*.*'), faAnyFile - faHidden - faSysFile, SearchRec);
    {$WARN SYMBOL_PLATFORM ON}
    try
      while Status = 0 do
      begin
        Item := ADirectoryListing.Add;
        if SearchRec.Attr and faDirectory = 0 then
          Item.ItemType := ditFile
        else
          Item.ItemType := ditDirectory;
        Item.FileName := SearchRec.Name;
        Item.Size := SearchRec.Size;
        Item.ModifiedDate := SearchRec.TimeStamp;
        Status := FindNext(SearchRec);
      end;
    finally
      FindClose(SearchRec);
    end;
  except
  end;
end;

procedure TFTPServer.ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  try
    ForceDirectories(FixPath(FRootPath + VDirectory));
  except
  end;
end;

procedure TFTPServer.ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName);
begin
  try
    TDirectory.Delete(FixPath(FRootPath + VDirectory), True);
  except
  end;
end;

procedure TFTPServer.ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream);
var
  Path: string;
begin
  // extracts path and forces creation if does not exits
  Path := ExtractFilePath(FixPath(FRootPath + AFilename));
  if not DirectoryExists(Path) then
    ForceDirectories(Path);

  // opens a file stream for cration or append
  if not AAppend then
    VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmCreate)
  else
    VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmOpenWrite)
end;

procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean);
begin
  // checks user and password validity
  case FSecurityPolicy of
    fssp_None:
    begin
      VAuthenticated := True;
    end;

    fssp_sslvSSLv23:
    begin
      VAuthenticated :=
      (
        (FUsername = Trim(AUserName)) and
        (FPassword = Trim(APassword))
      );
    end;

    fssp_sslvTLSv1_2:
    begin
      VAuthenticated :=
      (
        (FUsername = Trim(AUserName)) and
        (FPassword = Trim(APassword))
      );
    end;
  end;
end;

procedure TFTPServer.IdFTPServer1UserAccount(ASender: TIdFTPServerContext;
  const AUsername, APassword, AAcount: string; var AAuthenticated: Boolean);
begin
  AAuthenticated := True;
end;

procedure TFTPServer.SSLGetPassword(var Password: string);
begin
  //###
  //THIS IS THE PASSWROD FOR THE KEY CERTIFICATION FILE
  //Password := FPassword;
end;

procedure TFTPServer.SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean);
begin
  //###
end;

procedure TFTPServer.SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfo(const AMsg: string);
begin
  //###
end;

procedure TFTPServer.SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string);
begin
  //###
end;

procedure TFTPServer.IdFTPServer1QuerySSLPort(APort: Word; var VUseSSL: Boolean);
begin
  VUseSSL := (APort = 21);
end;

end.

Bye

Edited September 30, 2023 by DelphiUdIT

Remy Lebeau · September 30, 2023

On 9/29/2023 at 3:51 AM, DelphiUdIT said:

In the server connect event you must add:


procedure TFTPServer.ServerConnect(AContext: TIdContext);
begin
  If AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := (UseTLS = utNoTLSSupport); //This function must be set to false for it to handle SSL/TLS functionality.
end;

This approach is incorrect. This forces ALL connections to use SSL/TLS implicitly at connect-time. But clients may want to use SSL/TLS explicitly instead, ie via an AUTH or CCC command.

The CORRECT way to handle the PassThrough is to let TIdFTPServer manage it for you. You should not be setting it manually yourself at all.

If TIdFTPServer.UseTLS is set to utNoTLSSupport then TIdFTPServer will not touch PassThrough at all, and neither should you.

If TIdFTPServer.UseTLS is set to utUseRequireTLS or utUseExplicitTLS then TIdFTPServer will set PassThrough according to client commands. You don't need to do anything extra for this. The difference between them is that utUseExplicitTLS allows the client to decide whether SSL/TLS is used, whereas utUseRequireTLS will reject various operations if the client doesn't use SSL/TLS.

If TIdFTPServer.UseTLS is set to utUseImplicitTLS than you need to use the TIdFTPServer.OnQuerySSLPort event to tell the server which port(s) are to use SSL/TLS implicitly (ie, to set PassThrough at connect-time),

Edited September 30, 2023 by Remy Lebeau

Sign In

indy Indy FTP Server with TLS/SSL

Recommended Posts

shineworld 68

Share this post

Link to post

shineworld 68

Share this post

Link to post

DelphiUdIT 132

Share this post

Link to post

shineworld 68

Share this post

Link to post

DelphiUdIT 132

Share this post

Link to post

DelphiUdIT 132

Share this post

Link to post

shineworld 68

Share this post

Link to post

DelphiUdIT 132

Share this post

Link to post

Remy Lebeau 1263

Share this post

Link to post

Create an account or sign in to comment

Create an account

Sign in

Browse

Activity