/*
  ICS SSL FTP Server - C++Builder translation of the Delphi demo OverbyteIcsSslFtpServ1.pas
  (demos-delphi-vcl), ICS V9.8.

  Two TSslFtpServer components share one TSslContext: SslFtpServer1 accepts AUTH TLS/SSL on the
  normal FTP port, SslFtpServer2 is an implicit-SSL server (port 990 by default). Accounts come
  from ftpaccounts-default.ini (or ftpaccounts-<host>.ini after a HOST command). It also shows a
  virtual directory C:\VIRTUAL\, files built on the fly, and a worker thread that delays the
  download of any *.ZZZ file by 10 seconds without blocking other clients.
  Warning: as written, every user gets access to every file the computer can reach.

  How this C++ version differs from the Delphi original, apart from syntax:
  - The unused BigConsole helper, the empty OpenSslVer1Click and the empty OnChangeDirectory
    handler (its body is IFDEF NEVER) are not translated; the .dfm bindings of the last are removed.
  - A client that disconnects while its worker thread runs clears the thread's OnTerminate in its
    destructor, so the thread never starts a transfer on a freed client.
  - While a client's *.ZZZ worker thread runs, every command from it except ABOR and QUIT is
    refused in OnClientCommand, so the pending download's state is not overwritten and each client
    has at most one thread, whose OnTerminate is cleared when the client is freed.
  - Delphi demo bugs are fixed here; each fix has a one-line comment.
*/

#include <vcl.h>
#pragma hdrstop

#include <initializer_list>
#include <memory>

#include "OverbyteIcsSslFtpServ1.h"
#include "OverbyteIcsIniFiles.hpp"
#include "OverbyteIcsUtils.hpp"

#pragma package(smart_init)
#pragma resource "*.dfm"

TSslFtpServerForm *SslFtpServerForm;

namespace {

const wchar_t *const AppCopyRight = L" SslFtpServ" IcsVerLitCopyright;

// Ini file layout
const wchar_t *const SectionData       = L"Data";
const wchar_t *const KeyPort           = L"Port";
const wchar_t *const SectionWindow     = L"Window";
const wchar_t *const KeyTop            = L"Top";
const wchar_t *const KeyLeft           = L"Left";
const wchar_t *const KeyWidth          = L"Width";
const wchar_t *const KeyHeight         = L"Height";
const wchar_t *const KeyMinim          = L"RunMinimized";
const wchar_t *const KeyCertFile       = L"CertFile";
const wchar_t *const KeyPassPhrase     = L"PassPhrase";
const wchar_t *const KeyPrivKeyFile    = L"PrivKeyFile";
const wchar_t *const KeyVerifyPeer     = L"VerifyPeer";
const wchar_t *const KeyCAFile         = L"CAFile";
const wchar_t *const KeyCAPath         = L"CAPath";
const wchar_t *const KeySslConnPort    = L"SslConnPort";
const wchar_t *const KeyRenegInterval  = L"RenegotiationInterval";
const wchar_t *const KeyDisplaySslInfo = L"DisplaySslInfo";
const wchar_t *const KeyServIpAddr     = L"ServIpAddr";

// Account ini file layout
const wchar_t *const KeyPassword         = L"Password";
const wchar_t *const KeyHomeDir          = L"HomeDir";
const wchar_t *const KeyOtpMethod        = L"OtpMethod";
const wchar_t *const KeyForceHomeDir     = L"ForceHomeDir";
const wchar_t *const KeyHidePhysicalPath = L"HidePhysicalPath";
const wchar_t *const KeyReadOnly         = L"ReadOnly";
const wchar_t *const KeyForceSsl         = L"ForceSsl";

// Writes a String to a stream as UTF-8 bytes.
void WriteUtf8(TStream *Stream, const String &S)
{
    const UTF8String Bytes(S);
    Stream->Write(Bytes.c_str(), Bytes.Length());
}

}

/* ---- Client and worker thread ---- */

__fastcall TMyClient::~TMyClient()
{
    // The thread is still alive here (it frees itself only after OnTerminate has run on this
    // main thread), so clearing OnTerminate stops it from starting a transfer on this client.
    if (FWorkerThread)
        FWorkerThread->OnTerminate = nullptr;
}

// Stands for some lengthy processing before a download; other clients are not blocked.
void __fastcall TGetProcessingThread::Execute()
{
    Sleep(10000);
}

/* ---- Form ---- */

__fastcall TSslFtpServerForm::TSslFtpServerForm(TComponent *Owner)
    : TForm(Owner)
{
}

__fastcall TSslFtpServerForm::~TSslFtpServerForm()
{
    // Free the servers (whose events log to the form) while the form's C++ members still exist.
    DestroyComponents();
}

void __fastcall TSslFtpServerForm::FormCreate(TObject *Sender)
{
    Caption = Caption + IcsVerLitSample;   // common ICS sample caption: version and date
    FIniFileName = GetIcsIniFileName();
    // The account files are in the Delphi demo folder, three levels up from Win64x\<config>.
    // Delphi looks in the exe folder (bin\<platform>\<config>), where they are not.
    FAccountDir = IcsAbsolutisePath(ExtractFilePath(Application->ExeName) + "..\\..\\..\\demos-delphi-vcl\\");
    InfoMemo->Clear();
    GreenImage->Visible = false;
    RedImage->Visible = true;
    RedImage->Top = GreenImage->Top;
    RedImage->Left = GreenImage->Left;
}

void __fastcall TSslFtpServerForm::FormShow(TObject *Sender)
{
    if (FInitialized)
        return;
    FInitialized = true;
    Left = -Width;   // keep the form off screen until WMAppStartup places it
    ReportMemoryLeaksOnShutdown = (DebugHook != 0);

    int Minim = 0;
    {
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
        FXTop = IniFile->ReadInteger(SectionWindow, KeyTop, Top);
        FXLeft = IniFile->ReadInteger(SectionWindow, KeyLeft, Left);
        FXWidth = IniFile->ReadInteger(SectionWindow, KeyWidth, Width);
        FXHeight = IniFile->ReadInteger(SectionWindow, KeyHeight, Height);
        Minim = IniFile->ReadInteger(SectionWindow, KeyMinim, 0);
    }

    LoadConfig();
    SaveConfig();   // create the ini file keys if they don't exist

    // Always keep the window visible, with a reasonable width and height.
    if (FXLeft < 0)
        FXLeft = 0;
    if (FXTop < 0)
        FXTop = 0;
    if (FXWidth < 341)
        FXWidth = 341;
    if (FXHeight < 683)   // Delphi tests "<= 6831", so the saved height is never restored
        FXHeight = 683;
    if (FXLeft + FXWidth > Screen->Width)
        FXLeft = Screen->Width - FXWidth;
    if (FXTop + FXHeight > Screen->Height)
        FXTop = Screen->Height - FXHeight;

    StartMinimizedCheckBox->Checked = (Minim != 0);

    // Finish initializing from the message loop, once the form is visible.
    PostMessage(Handle, WM_APPSTARTUP, 0, 0);
}

void __fastcall TSslFtpServerForm::FormClose(TObject *Sender, TCloseAction &Action)
{
    try {
        StopServer();
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
        IniFile->WriteInteger(SectionWindow, KeyTop, Top);
        IniFile->WriteInteger(SectionWindow, KeyLeft, Left);
        IniFile->WriteInteger(SectionWindow, KeyWidth, Width);
        IniFile->WriteInteger(SectionWindow, KeyHeight, Height);
        IniFile->WriteInteger(SectionWindow, KeyMinim, StartMinimizedCheckBox->Checked ? 1 : 0);
        IniFile->WriteString(SectionData, KeyPort, FPort);
        IniFile->WriteString(SectionData, KeyCertFile, CertFileEdit->Text);
        IniFile->WriteString(SectionData, KeyPrivKeyFile, PrivKeyFileEdit->Text);
        IniFile->WriteString(SectionData, KeyPassPhrase, PassPhraseEdit->Text);
        IniFile->WriteString(SectionData, KeyCAFile, CAFileEdit->Text);
        IniFile->WriteString(SectionData, KeyCAPath, CAPathEdit->Text);
        IniFile->WriteInteger(SectionData, KeyVerifyPeer, VerifyPeerCheckBox->Checked ? 1 : 0);
        IniFile->WriteString(SectionData, KeySslConnPort, SslTypeConnPortEdit->Text);
        IniFile->WriteInteger(SectionData, KeyDisplaySslInfo, DisplaySslInfoCheckBox->Checked ? 1 : 0);
        IniFile->WriteInteger(SectionData, KeyRenegInterval, static_cast<int>(FSslRenegotiationInterval));
        IniFile->WriteString(SectionData, KeyServIpAddr, ServIpAddr->Text);
        IniFile->UpdateFile();
    }
    catch (Exception &) {
        // Ignore any exception while closing, as Delphi does.
    }
}

void TSslFtpServerForm::LoadConfig()
{
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
    FPort = IniFile->ReadString(SectionData, KeyPort, "ftp");
    CertFileEdit->Text = IniFile->ReadString(SectionData, KeyCertFile, "01cert.pem");
    PrivKeyFileEdit->Text = IniFile->ReadString(SectionData, KeyPrivKeyFile, "01key.pem");
    PassPhraseEdit->Text = IniFile->ReadString(SectionData, KeyPassPhrase, "password");
    CAFileEdit->Text = IniFile->ReadString(SectionData, KeyCAFile, "cacert.pem");
    CAPathEdit->Text = IniFile->ReadString(SectionData, KeyCAPath, "");
    VerifyPeerCheckBox->Checked = (IniFile->ReadInteger(SectionData, KeyVerifyPeer, 0) != 0);
    SslTypeConnPortEdit->Text = IniFile->ReadString(SectionData, KeySslConnPort, "990");
    ServIpAddr->Text = IniFile->ReadString(SectionData, KeyServIpAddr, "0.0.0.0");
    FSslRenegotiationInterval = static_cast<unsigned>(IniFile->ReadInteger(SectionData, KeyRenegInterval, 0));
    DisplaySslInfoCheckBox->Checked = (IniFile->ReadInteger(SectionData, KeyDisplaySslInfo, 0) != 0);
    IniFile.reset();
    RenegotiationIntervalEdit->Text = IntToStr(static_cast<int>(FSslRenegotiationInterval / 1000));
}

void TSslFtpServerForm::SaveConfig()
{
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
    IniFile->WriteString(SectionData, KeyPort, FPort);
    IniFile->WriteString(SectionData, KeyCertFile, CertFileEdit->Text);
    IniFile->WriteString(SectionData, KeyPrivKeyFile, PrivKeyFileEdit->Text);
    IniFile->WriteString(SectionData, KeyPassPhrase, PassPhraseEdit->Text);
    IniFile->WriteString(SectionData, KeyCAFile, CAFileEdit->Text);
    IniFile->WriteString(SectionData, KeyCAPath, CAPathEdit->Text);
    IniFile->WriteInteger(SectionData, KeyVerifyPeer, VerifyPeerCheckBox->Checked ? 1 : 0);
    IniFile->WriteString(SectionData, KeySslConnPort, SslTypeConnPortEdit->Text);
    IniFile->WriteInteger(SectionData, KeyRenegInterval, static_cast<int>(FSslRenegotiationInterval));
    IniFile->WriteString(SectionData, KeyServIpAddr, ServIpAddr->Text);
    IniFile->UpdateFile();
}

// Posted by FormShow: runs once the form is on screen.
void __fastcall TSslFtpServerForm::WMAppStartup(TMessage &Msg)
{
    if (StartMinimizedCheckBox->Checked)
        Application->Minimize();
    Top = FXTop;
    Left = FXLeft;
    Width = FXWidth;
    Height = FXHeight;
    Update();   // show the form completely
    UpdateClientCount();
}

void TSslFtpServerForm::Display(const String &Msg)
{
    InfoMemo->Lines->Add(Msg);
}

void TSslFtpServerForm::StartServer()
{
    GreenImage->Visible = false;
    RedImage->Visible = true;
    Update();

    // Version information for the program and the components it uses.
    const TWSAData wsi = WinsockInfo();
    Display(Trim(String(AppCopyRight)));
    Display("Using:");
    Display("   " + Overbyteicswsocket::CopyRight);
    Display("   " + Overbyteicsftpsrv::CopyRight);
    Display("    Winsock:");
    // Delphi prints "(wHighVersion shr 8).(wHighVersion and 15)", which is minor.major.
    Display("        Version " + IntToStr(static_cast<int>(LOBYTE(wsi.wHighVersion))) + "." +
            IntToStr(static_cast<int>(HIBYTE(wsi.wHighVersion))));
    Display("        " + String(IcsStrPas(wsi.szDescription)));
    Display("        " + String(IcsStrPas(wsi.szSystemStatus)));
    if (wsi.lpVendorInfo)
        Display("        " + String(IcsStrPas(wsi.lpVendorInfo)));

    // SSL settings, with OpenSSL's internal session caching.
    SslContext1->SslMinVersion = sslVerTLS1_2;
    SslContext1->SslMaxVersion = sslVerMax;
    SslContext1->SslCipherList = sslCiphersMozillaSrvTLS12;
    SslContext1->SslSessionCacheModes = TSslSessCacheModes() << sslSESS_CACHE_SERVER;
    SslContext1->SslSessionTimeout = 300;   // seconds
    SslContext1->SslDefaultSessionIDContext = "AnyStringForSessionCaching";

    SslContext1->SslCertFile = CertFileEdit->Text;
    SslContext1->SslPassPhrase = PassPhraseEdit->Text;
    SslContext1->SslPrivKeyFile = PrivKeyFileEdit->Text;
    SslContext1->SslCAFile = CAFileEdit->Text;
    SslContext1->SslCAPath = CAPathEdit->Text;
    SslContext1->SslVerifyPeer = VerifyPeerCheckBox->Checked;
    SslFtpServer1->FtpSslTypes = TFtpSslTypes() << ftpAuthTls << ftpAuthSsl;
    SslFtpServer2->FtpSslTypes = TFtpSslTypes() << ftpImplicitSsl;

    SslFtpServer1->ClientClass = __classid(TMyClient);   // the servers create our client class
    SslFtpServer2->ClientClass = __classid(TMyClient);
    // A custom multi-line banner.
    SslFtpServer1->Banner = "220-Welcome to my Server\r\n"
                            "220-\r\n"
                            "220 ICS FTP Server ready.";
    SslFtpServer1->Addr = ServIpAddr->Text;
    SslFtpServer2->Addr = ServIpAddr->Text;
    SslFtpServer1->Port = FPort;
    SslFtpServer2->Port = SslTypeConnPortEdit->Text;
    SslFtpServer1->WSDebugOptions = DefWSDebugServer;   // what to log to the OnDisplay event
    SslFtpServer2->WSDebugOptions = DefWSDebugServer;
    SslFtpServer1->Start();
    SslFtpServer2->Start();
}

void TSslFtpServerForm::StopServer()
{
    SslFtpServer1->Stop();
    SslFtpServer1->DisconnectAll();
    SslFtpServer2->Stop();
    SslFtpServer2->DisconnectAll();
}

void __fastcall TSslFtpServerForm::MnuQuitClick(TObject *Sender)
{
    Close();
}

void __fastcall TSslFtpServerForm::MnuStopServerClick(TObject *Sender)
{
    StopServer();
}

void __fastcall TSslFtpServerForm::MnuStartServerClick(TObject *Sender)
{
    StartServer();
}

void __fastcall TSslFtpServerForm::ImagesDblClick(TObject *Sender)
{
    if (SslFtpServer1->Active)
        StopServer();
    else
        StartServer();
}

// Leaving is the number of clients still in the lists that are being disconnected.
void TSslFtpServerForm::UpdateClientCount(int Leaving)
{
    const int Count = SslFtpServer1->ClientCount + SslFtpServer2->ClientCount - Leaving;
    if (Count <= 0)
        ClientCountLabel->Caption = "No user";
    else
        ClientCountLabel->Caption = IntToStr(Count) + " users";
}

// The default accounts file; a HOST command may select another one.
void TSslFtpServerForm::SetDefaultAccount(TFtpCtrlSocket *Client)
{
    Client->AccountIniName = FAccountDir + "ftpaccounts-default.ini";
    Client->AccountReadOnly = true;
    Client->AccountPassword = "";
}

void __fastcall TSslFtpServerForm::SslFtpServer1ClientConnect(TObject *Sender, TFtpCtrlSocket *Client,
                                                              System::Word AError)
{
    // How to refuse a client.
    if (Client->GetPeerAddr() == "193.121.12.25") {
        Client->SendStr(RawByteString("421 Connection not allowed.\r\n"));
        Client->Close();
        return;
    }
    Client->RcvSize = 64 * 1024;   // some speed tuning
    Display("! " + Client->GetPeerAddr() + " connected");
    SetDefaultAccount(Client);
    UpdateClientCount();
}

void __fastcall TSslFtpServerForm::SslFtpServer1ClientDisconnect(TObject *Sender, TFtpCtrlSocket *Client,
                                                                 System::Word AError)
{
    Display("! " + Client->GetPeerAddr() + " disconnected");
    UpdateClientCount(1);   // the client is still in the server's list here; Delphi counts it
}

// Client may be null for server messages.
void __fastcall TSslFtpServerForm::SslFtpServer1Display(TObject *Sender, TFtpCtrlSocket *Client, TFtpString Msg)
{
    Display(Msg);
}

void __fastcall TSslFtpServerForm::SslFtpServer1Start(TObject *Sender)
{
    GreenImage->Visible = true;
    RedImage->Visible = false;
    Display("! " + static_cast<TComponent *>(Sender)->Name + " started");
}

void __fastcall TSslFtpServerForm::SslFtpServer1Stop(TObject *Sender)
{
    GreenImage->Visible = false;
    RedImage->Visible = true;
    Display("! " + static_cast<TComponent *>(Sender)->Name + " stopped");
}

void __fastcall TSslFtpServerForm::SslFtpServer1StorSessionConnected(TObject *Sender, TFtpCtrlSocket *Client,
                                                                     TWSocket *Data, System::Word AError)
{
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data session failed to open. Error #" + IntToStr(AError));
}

void __fastcall TSslFtpServerForm::SslFtpServer1ValidateDele(TObject *Sender, TFtpCtrlSocket *Client,
                                                             TFtpString &FilePath, bool &Allowed)
{
    Allowed = !Client->AccountReadOnly;
}

void __fastcall TSslFtpServerForm::SslFtpServer1ValidatePut(TObject *Sender, TFtpCtrlSocket *Client,
                                                            TFtpString &FilePath, bool &Allowed)
{
    Allowed = !Client->AccountReadOnly;
}

void __fastcall TSslFtpServerForm::SslFtpServer1ValidateRnFr(TObject *Sender, TFtpCtrlSocket *Client,
                                                             TFtpString &FilePath, bool &Allowed)
{
    Allowed = !Client->AccountReadOnly;
}

void __fastcall TSslFtpServerForm::SslFtpServer1StorSessionClosed(TObject *Sender, TFtpCtrlSocket *Client,
                                                                  TWSocket *Data, System::Word AError)
{
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data session closed. Error #" + IntToStr(AError));
}

void __fastcall TSslFtpServerForm::SslFtpServer1RetrDataSent(TObject *Sender, TFtpCtrlSocket *Client,
                                                             TWSocket *Data, System::Word AError)
{
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data sent. Error #" + IntToStr(AError));
}

/* Called when the data session for a download has opened: the place to build a file or stream
   when the data is not already a file. Here a file under C:\VIRTUAL\ is built in memory; any other
   file is sent from disk as usual. Throwing an exception here aborts the transfer. To simply
   forbid some files or directories, use OnValidateGet or OnValidatePut instead. */
void __fastcall TSslFtpServerForm::SslFtpServer1RetrSessionConnected(TObject *Sender, TFtpCtrlSocket *Client,
                                                                     TWSocket *Data, System::Word AError)
{
    const String Path = UpperCase(Client->FilePath);
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data session connected. Error #" + IntToStr(AError));
    else if (Path.SubString(1, 19) == "C:\\VIRTUAL\\FORBIDEN")
        throw Exception("Access prohibed !");
    else if (Path.SubString(1, 11) == "C:\\VIRTUAL\\") {
        Display("! VIRTUAL FILE");
        Client->UserData = 1;   // remember that we created the stream
        delete Client->DataStream;
        Client->DataStream = new TMemoryStream();
        // Delphi writes Length(Buf) bytes of a UTF-16 string, so only half the text is sent.
        WriteUtf8(Client->DataStream,
                  "This is a file created on the fly by the FTP server\r\n"
                  "It could result of a query to a database or anything else.\r\n"
                  "The request was: '" + Client->FilePath + "'\r\n");
        Client->DataStream->Position = 0;
    }
}

void __fastcall TSslFtpServerForm::SslFtpServer1RetrSessionClosed(TObject *Sender, TFtpCtrlSocket *Client,
                                                                  TWSocket *Data, System::Word AError)
{
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data session closed. Error #" + IntToStr(AError));
    if (Client->UserData == 1) {
        // We created a stream for a virtual file or directory: free it.
        delete Client->DataStream;
        Client->DataStream = nullptr;
        Client->UserData = 0;
    }
}

/* Called when the server needs a directory listing. Returning without doing anything lets the
   server list the disk; here C:\VIRTUAL\ gets a listing built in memory. */
void __fastcall TSslFtpServerForm::SslFtpServer1BuildDirectory(TObject *Sender, TFtpCtrlSocket *Client,
                                                               TFtpString &Directory, bool Detailed)
{
    if (UpperCase(Client->Directory) != "C:\\VIRTUAL\\")
        return;
    Display("! VIRTUAL DIR");
    Client->UserData = 1;   // remember that we created the stream
    delete Client->DataStream;
    Client->DataStream = new TMemoryStream();
    if (Detailed)   // Unix-style listing lines
        WriteUtf8(Client->DataStream,
                  "-rwxrwxrwx   1 ftp      ftp            0 Apr 30 19:00 FORBIDEN\r\n"
                  "-rwxrwxrwx   1 ftp      ftp            0 Apr 30 19:00 TEST\r\n"
                  "drwxrwxrwx   1 ftp      ftp            0 Apr 30 19:00 SOME DIR\r\n");
    else
        WriteUtf8(Client->DataStream, "FORBIDEN\r\nTEST\r\n");
    Client->DataStream->Position = 0;
}

// Called once the server has built a listing: adds the virtual directory to the C:\ listing.
void __fastcall TSslFtpServerForm::SslFtpServer1AlterDirectory(TObject *Sender, TFtpCtrlSocket *Client,
                                                               TFtpString &Directory, bool Detailed)
{
    if (UpperCase(Client->Directory) != "C:\\")
        return;
    if (Detailed)
        WriteUtf8(Client->DataStream, "drwxrwxrwx   1 ftp      ftp            0 Apr 30 19:00 VIRTUAL\r\n");
}

void __fastcall TSslFtpServerForm::SslFtpServer1ClientCommand(TObject *Sender, TFtpCtrlSocket *Client,
                                                              TFtpString &Keyword, TFtpString &Params,
                                                              TFtpString &Answer)
{
    Display("< " + Client->GetPeerAddr() + " " + Keyword + " " + Params);
    // While a *.ZZZ worker runs, the client holds that RETR's file and data-channel state, and
    // every command ICS runs overwrites part of it (at least CurCmdType, which a passive data
    // connection is wired by). A non-empty Answer is sent instead of running the command.
    // ABOR and QUIT run normally and cancel the pending download.
    TMyClient *MyClient = static_cast<TMyClient *>(Client);
    if (MyClient->FWorkerThread) {
        if (Keyword != "ABOR" && Keyword != "QUIT") {
            Answer = "503 Previous download still being prepared";
            return;
        }
        MyClient->FWorkerCancelled = true;
    }
    if (Keyword != "CCC" && Keyword != "AUTH" && Keyword != "QUIT")
        CheckRenegotiation(MyClient, false);
}

void __fastcall TSslFtpServerForm::SslFtpServer1AnswerToClient(TObject *Sender, TFtpCtrlSocket *Client,
                                                               TFtpString &Answer)
{
    Display("> " + Client->GetPeerAddr() + " " + Answer);
}

void __fastcall TSslFtpServerForm::SslFtpServer1Authenticate(TObject *Sender, TFtpCtrlSocket *Client,
                                                             TFtpString UserName, TFtpString Password,
                                                             bool &Authenticated)
{
    if (Client->OtpMethod > OtpKeyNone) {
        // One Time Passwords: keep the sequence and seed for the next login.
        if (!Authenticated)
            return;
        Display("! " + Client->SessIdInfo + " is One Time Password authenticated");
        FOtpSequence = Client->OtpSequence;
        FOtpSeed = Client->OtpSeed;
    }
    else {
        // Check the user here and set Authenticated to false to refuse; also the place to set
        // Client->HomeDir. Client->UserData can hold per-client data. The account was read
        // from the ini file in the OnOtpMethod event; "*" is an anonymous logon.
        if (Client->UserName == UserName && !Password.IsEmpty() &&
            (Client->AccountPassword == Password || Client->AccountPassword == "*"))
            Display("! " + Client->SessIdInfo + " is authenticated");
        else {
            Display("! " + Client->SessIdInfo + " failed authentication");
            Authenticated = false;
        }
        if (Password == "bad")
            Authenticated = false;
    }
    if (!Authenticated)
        return;
    Display("! " + Client->SessIdInfo + " Home Directory: " + Client->HomeDir);
}

void __fastcall TSslFtpServerForm::Cleardisplay1Click(TObject *Sender)
{
    InfoMemo->Clear();
}

void __fastcall TSslFtpServerForm::MnuListClientsClick(TObject *Sender)
{
    // Delphi lists only SslFtpServer1's clients; this lists both servers.
    if (SslFtpServer1->ClientCount + SslFtpServer2->ClientCount <= 0) {
        Display("No client");
        return;
    }
    int Nr = 0;
    for (TSslFtpServer *Server : {SslFtpServer1, SslFtpServer2}) {
        for (int I = 0; I < Server->ClientCount; I++) {
            TFtpCtrlSocket *Client = Server->Client[I];
            Display("Client " + IntToStr(++Nr) + ": " + Client->GetPeerAddr() + "/" + Client->GetPeerPort());
        }
    }
}

void __fastcall TSslFtpServerForm::DisconnectAllMnuClick(TObject *Sender)
{
    SslFtpServer1->DisconnectAll();
    SslFtpServer2->DisconnectAll();
}

// A *.ZZZ download first runs a thread (here it just sleeps 10 seconds) to show that other
// clients are not blocked; the transfer starts when the thread ends.
void __fastcall TSslFtpServerForm::SslFtpServer1GetProcessing(TObject *Sender, TFtpCtrlSocket *Client,
                                                              bool &DelayedSend)
{
    TMyClient *MyClient = static_cast<TMyClient *>(Client);
    if (UpperCase(ExtractFileExt(MyClient->FileName)) != ".ZZZ")
        return;
    TGetProcessingThread *Thread = new TGetProcessingThread();   // frees itself when done
    Thread->Server = static_cast<TFtpServer *>(Sender);
    Thread->Client = MyClient;
    Thread->FreeOnTerminate = true;
    Thread->OnTerminate = WorkerThreadTerminated;
    Thread->Start();
    // Set only after Start succeeds; OnTerminate is synchronized onto this thread, so it cannot
    // run before these lines. If Start raises, the suspended thread is leaked, not deleted:
    // deleting it would wait in TThread::ShutdownThread for a thread that never runs.
    MyClient->FWorkerThread = Thread;
    MyClient->FWorkerCancelled = false;
    DelayedSend = true;   // WorkerThreadTerminated starts the transfer
}

// Runs on the main thread (TThread synchronizes OnTerminate).
void __fastcall TSslFtpServerForm::WorkerThreadTerminated(TObject *Sender)
{
    TGetProcessingThread *Thread = static_cast<TGetProcessingThread *>(Sender);
    TMyClient *Client = Thread->Client;
    if (Client->FWorkerThread == Thread)
        Client->FWorkerThread = nullptr;
    if (Client->FWorkerCancelled) {   // ABOR or QUIT arrived during the delay
        Client->FWorkerCancelled = false;
        return;
    }
    // Client dropped during the delay; its close is already queued (as ICS ClientProcessingThreadTerminate).
    if (Client->State != wsConnected)
        return;
    TFtpString Answer;
    Thread->Server->DoStartSendData(Thread->Client, Answer);
}

void __fastcall TSslFtpServerForm::SslFtpServer1Host(TObject *Sender, TFtpCtrlSocket *Client, TFtpString Host,
                                                     bool &Allowed)
{
    // HOST might be ftp.domain.com or [123.123.123.123].
    const String FileName = FAccountDir + "ftpaccounts-" + LowerCase(Host) + ".ini";
    if (!FileExists(FileName)) {
        Display("! Could not find Accounts File: " + FileName);
        Allowed = false;
        return;
    }
    Client->AccountIniName = FileName;
    Allowed = true;
}

void __fastcall TSslFtpServerForm::SslFtpServer1Rein(TObject *Sender, TFtpCtrlSocket *Client, bool &Allowed)
{
    Allowed = true;
    Display("! Reinitialise client accepted");
    Client->SessIdInfo = Client->GetPeerAddr() + "=(Not Logged On)";
    Display("! " + Client->SessIdInfo + " connected");
    SetDefaultAccount(Client);
}

void __fastcall TSslFtpServerForm::SslFtpServer1MakeDirectory(TObject *Sender, TFtpCtrlSocket *Client,
                                                              TFtpString Directory, bool &Allowed)
{
    Allowed = !Client->AccountReadOnly;
}

void __fastcall TSslFtpServerForm::SslFtpServer1OtpGetPassword(TObject *Sender, TFtpCtrlSocket *Client,
                                                               TFtpString UserName, String &UserPassword)
{
    UserPassword = Client->AccountPassword;   // the expected password, used to build the OTP
}

// Looks up the account: One Time Password method, home directory and so on. A blank password
// means there is no such account.
void __fastcall TSslFtpServerForm::SslFtpServer1OtpMethod(TObject *Sender, TFtpCtrlSocket *Client,
                                                          TFtpString UserName, TOtpMethod &OtpMethod)
{
    if (!FileExists(Client->AccountIniName)) {
        Display("! Could not find Accounts File: " + Client->AccountIniName);
        return;
    }
    Display("! Opening Accounts File: " + Client->AccountIniName);
    String Method;
    {
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(Client->AccountIniName, true));
        Client->AccountPassword = IniFile->ReadString(UserName, KeyPassword, "");   // checked later
        Method = IniFile->ReadString(UserName, KeyOtpMethod, "none");
        Client->AccountReadOnly = (IniFile->ReadString(UserName, KeyReadOnly, "true") == "true");
        Client->HomeDir = IniFile->ReadString(UserName, KeyHomeDir, "c:\\temp");
        Client->Directory = Client->HomeDir;
        if (IniFile->ReadString(UserName, KeyForceHomeDir, "true") == "true")
            Client->Options = Client->Options << ftpCdupHome;
        if (IniFile->ReadString(UserName, KeyHidePhysicalPath, "true") == "true")
            Client->Options = Client->Options << ftpHidePhysicalPath;
        if (IniFile->ReadString(UserName, KeyForceSsl, "false") == "true" && !Client->SslEnable)
            Client->AccountPassword = "";   // SSL required but not in use: the login fails
    }

    OtpMethod = OtpGetMethod(Method);
    Client->OtpSequence = FOtpSequence;
    Client->OtpSeed = FOtpSeed;

    // This could be account information, an SQL id or anything else.
    Client->SessIdInfo = Client->GetPeerAddr() + "=" + UserName;
}

void __fastcall TSslFtpServerForm::SslFtpServer1SslVerifyPeer(TObject *Sender, int &Ok, TX509Base *Cert)
{
    if (DisplaySslInfoCheckBox->Checked)
        Display("Received certificate\r\nSubject: " + Cert->SubjectOneLine + "\r\nIssuer: " + Cert->IssuerOneLine);
    if (Ok != 1) {
        if (DisplaySslInfoCheckBox->Checked)
            Display("Error msg: " + Cert->VerifyErrMsg + "\r\nIn this example we accept any cert");
        Ok = 1;   // this example accepts any client
    }
}

// Fired for the control socket (a TMyClient) and for each data socket (owned by the client).
void __fastcall TSslFtpServerForm::SslFtpServer1SslHandshakeDone(TObject *Sender, System::Word ErrCode,
                                                                 TX509Base *PeerCert, bool &Disconnect)
{
    TWSocket *Sock = static_cast<TWSocket *>(Sender);
    String Str;
    if (TMyClient *Client = dynamic_cast<TMyClient *>(Sender)) {
        Client->LastSslHandshake = GetTickCount64();
        Str = "CtrlSocket ";
    }
    else
        Str = "DataSocket ";
    if (!DisplaySslInfoCheckBox->Checked)
        return;
    if (ErrCode == 0)
        Display("! " + Sock->GetPeerAddr() + " " + Str + Sock->SslHandshakeRespMsg +
                ", SessionReused " + IntToStr(Sock->SslSessionReused() ? 1 : 0));
    else
        Display("! " + Sock->GetPeerAddr() + " " + Str + " SslHandshake failed - " + Sock->SslHandshakeRespMsg);
}

// Asks for an SSL renegotiation once the interval has passed since the last handshake.
void TSslFtpServerForm::CheckRenegotiation(TMyClient *Client, bool IsData)
{
    if (!Client->SslEnable || !Client->SSL || FSslRenegotiationInterval == 0)
        return;
    // 64-bit ticks: Delphi's 32-bit GetTickCount sum wraps after 49.7 days.
    if (Client->LastSslHandshake + FSslRenegotiationInterval >= GetTickCount64())
        return;
    TWSocket *Socket = IsData ? Client->DataSocket : static_cast<TWSocket *>(Client);
    const String Str = IsData ? "DataSocket" : "CtrlSocket";
    if (!Socket->SslStartRenegotiation()) {
        if (DisplaySslInfoCheckBox->Checked)
            Display("! " + Socket->GetPeerAddr() + " " + Str + " SslStartRenegotiation failed.");
    }
    else if (DisplaySslInfoCheckBox->Checked)
        Display("! " + Client->GetPeerAddr() + " " + Str + " SSL renegotiation started.");
}

void __fastcall TSslFtpServerForm::RenegotiationIntervalEditChange(TObject *Sender)
{
    // Seconds in the edit box, milliseconds internally. Anything that is not a positive number
    // disables it (Delphi turns a negative number into a huge unsigned interval).
    int Seconds = 0;
    if (TryStrToInt(static_cast<TEdit *>(Sender)->Text, Seconds) && Seconds > 0)
        FSslRenegotiationInterval = static_cast<unsigned>(Seconds) * 1000;
    else
        FSslRenegotiationInterval = 0;
}
