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

  An SSL FTP server with no real GUI; it is designed to become a Windows service. All settings
  come from an ini file (copied from the Delphi demo folder to the ICS ini directory on first
  run, and that copy is the one to edit). IcsHosts gives several hosts on several addresses and
  ports, each with its own SSL certificate; certificates can be ordered automatically (Let's
  Encrypt and others) or are self-signed when missing, and status and errors can be emailed to
  an administrator. The server starts when the form opens. The accounts come from the same
  ftpaccounts-default.ini file as the SslFtpServ demo.

  How this C++ version differs from the Delphi original, apart from syntax:
  - The default ini file and the account files are found relative to this demo's Win64x\<config>
    output folder: both are read from ..\demos-delphi-vcl.
  - The unit globals are members of the form; the unused ones (ProgDirectory, StatSrvSslCertWeb,
    WebLogHdrMask) are not translated, nor are the empty FormShow, OnBuildFilePath and OnOAAuthUrl
    handlers, whose .dfm bindings are removed.
  - The diagnostic log is held in a std::unique_ptr and only flushed when it exists.
  - 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 <System.TypInfo.hpp>

#include "OverbyteIcsSslMultiFtpServ1.h"
#include "OverbyteIcsIniFiles.hpp"
#include "OverbyteIcsUtils.hpp"
#include "OverbyteIcsTicks64.hpp"
#include "OverbyteIcsSmtpProt.hpp"

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

TFtpServerForm *FtpServerForm;

namespace {

const wchar_t *const SrvCopyRight = L" OverbyteIcsSslMultiFtpServ" IcsVerLitCopyright;
const int MaxWinChars = 800000;
const wchar_t *const LogNameMask = L"\"ftpsrv-\"yyyymmdd\".log\"";

const wchar_t *const SectionGeneral  = L"General";
const wchar_t *const KeyServLogDir   = L"ServLogDir";
const wchar_t *const KeyAdminEmailTo = L"AdminEmailTo";

// 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 TFtpServerForm::TFtpServerForm(TComponent *Owner)
    : TForm(Owner)
{
}

__fastcall TFtpServerForm::~TFtpServerForm()
{
    // Free the server and the other components (whose events log to the form) while the
    // form's C++ members still exist.
    DestroyComponents();
}

// Lines are buffered here and added to the log window once a second by the timer.
void TFtpServerForm::Display(String Msg)
{
    // Hide the password in a "-login" line: up to 11 characters, from the second after the '+'.
    const int J = Msg.Pos("-login");
    if (J > 10) {
        int K = Msg.SubString(J, 99).Pos("+");
        if (K > 4) {
            K += J;
            for (int I = K; I <= K + 10 && I <= Msg.Length(); I++)
                Msg[I] = L'#';
        }
    }

    FWinLinesBuff += Msg + "\r\n";
    if (FDiagLogBuffer) {
        try {
            FDiagLogBuffer->WriteLine(Msg);
        }
        catch (Exception &) {
            // Delphi ignores a failed write too; there is nowhere else to report it.
        }
    }
}

// Delphi calls DiagLogBuffer.FlushFile directly, which fails when no ServLogDir is set.
void TFtpServerForm::FlushDiagLog()
{
    if (FDiagLogBuffer)
        FDiagLogBuffer->FlushFile(true);
}

void __fastcall TFtpServerForm::Timer1Timer(TObject *Sender)
{
    // Check the SSL certificates every two hours; may order expired certificates.
    if (IcsTestTrgTick64(FCertCheckTrigger)) {
        FCertCheckTrigger = IcsGetTrgMins64(120);
        try {
            Display("Regular Server Recheck for New SSL Certificates Starting");
            FlushDiagLog();
            String S1;
            // Don't stop on the first error, no exceptions.
            const bool NewFlag = SslFtpServer1->RecheckSslCerts(S1, false, true);
            if (NewFlag || !S1.IsEmpty()) {
                if (NewFlag)
                    Display("Server Recheck Loaded New SSL Certificate(s)");
                Display("Server Recheck SSL Certificate Errors:\r\n" + S1);
                if (!S1.IsEmpty() && FLastErrorEmail != S1)   // tell someone
                    SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server Recheck SSL Certificate Errors", S1);
                FLastErrorEmail = S1;
                ReportHosts();   // report everything again
                Display("Listen Bindings:\r\n" + SslFtpServer1->ListenStates());
            }
            else
                Display("Server Recheck SSL Certificate Nothing New");
        }
        catch (Exception &E) {
            Display("Server Recheck SSL Certificate Failed - " + E.Message);
        }
    }

    // At midnight: start a new log file, recheck SSL certificates, log the configuration again.
    if (FLogDate != static_cast<int>(Date())) {
        FLogDate = static_cast<int>(Date());
        try {
            FlushDiagLog();   // with the old date's file name
        }
        catch (Exception &) {
        }
        Display("Nightly Server Recheck Starting");
        ReportHosts();
        Display("Listen Bindings:\r\n" + SslFtpServer1->ListenStates());
        FCertCheckTrigger = Overbyteicstypes::Trigger64Immediate;
        FlushDiagLog();
    }

    // Add the buffered lines to the log window, trimming it when it grows too large.
    const int DispLen = FWinLinesBuff.Length();
    if (DispLen > 0) {
        try {
            if (FWinDispCur + DispLen > MaxWinChars) {
                String S1 = DisplayMemo->Lines->Text;
                const int RemoveLen = MaxWinChars - DispLen - 20000;
                if (RemoveLen > 20000) {
                    S1 = S1.SubString(RemoveLen, MaxInt);
                    const int NewStart = S1.Pos("\r");   // start of the next line
                    DisplayMemo->Text = S1.SubString(NewStart, MaxInt) + FWinLinesBuff;
                    FWinDispCur = S1.Length() - NewStart + DispLen;
                }
                else {
                    DisplayMemo->Lines->Text = FWinLinesBuff;
                    FWinDispCur = DispLen;
                }
            }
            else {
                DisplayMemo->Lines->Add(FWinLinesBuff.SubString(1, DispLen - 2));   // without the last CRLF
                FWinDispCur += DispLen;
                SendMessage(DisplayMemo->Handle, WM_VSCROLL, SB_BOTTOM, 0);
            }
        }
        catch (Exception &) {
        }
        FWinLinesBuff = "";
    }

    // Housekeeping every five minutes (nothing to do yet).
    if (IcsTestTrgTick64(FHouseKeepingTrg))
        FHouseKeepingTrg = IcsGetTrgMSecs64(300);
}

void __fastcall TFtpServerForm::ApplicationEventsException(TObject *Sender, Exception *E)
{
    Display("!!! Application Exception Event - " + IcsGetExceptMess(E));
}

void __fastcall TFtpServerForm::FormCreate(TObject *Sender)
{
    Caption = Caption + IcsVerLitSample;   // common ICS sample caption: version and date
    ReportMemoryLeaksOnShutdown = (DebugHook != 0);
    FIniFileName = GetIcsIniFileName();
    // The account files are in the Delphi demo folder, three levels up from Win64x\<config>.
    FAccountPath = IcsAbsolutisePath(ExtractFilePath(ParamStr(0)) + "..\\..\\..\\demos-delphi-vcl\\");
    GSSLEAY_LOAD_LEGACY = true;   // OpenSSL 3 legacy provider for old algorithms
    Application->OnException = ApplicationEventsException;
    GSSL_SignTest_Check = true;
    GSSL_SignTest_Certificate = true;
    FLogDate = static_cast<int>(Date());
    FSrvCompName = IcsGetCompName();

    // Use the ini file in the ICS ini directory (usually C:\Users\(me)\AppData\Local\ICS);
    // if it is missing, copy the default one from the Delphi demo folder.
    if (!FileExists(FIniFileName)) {
        const String DefaultIni = FAccountPath + ChangeFileExt(ExtractFileName(ParamStr(0)), ".ini");
        if (FileExists(DefaultIni)) {
            try {
                std::unique_ptr<TStringList> List(new TStringList());   // Delphi leaks it on success
                List->LoadFromFile(DefaultIni);
                List->SaveToFile(FIniFileName);
                Display("Copied default INI file to: " + FIniFileName + ", where it should be edited");
            }
            catch (Exception &) {
                // Ignored, as in Delphi; the ini file then gives no settings.
            }
        }
    }
    String LogDir;
    {
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
        LogDir = IniFile->ReadString(SectionGeneral, KeyServLogDir, "");
        FAdminEmailTo = IniFile->ReadString(SectionGeneral, KeyAdminEmailTo, "");
        IcsLoadMailQuFromIni(IniFile.get(), IcsMailQueue, "MailQueue");
        IcsLoadRestEmailFromIni(IniFile.get(), IcsRestEmail, "RestEmail");   // OAuth2 secrets and token
        FOldRefrToken = IcsRestEmail->RefrToken;                             // to see if it changes
    }
    FCertCheckTrigger = Overbyteicstypes::Trigger64Disabled;
    FHouseKeepingTrg = Overbyteicstypes::Trigger64Disabled;
    Timer1->Enabled = true;   // so the log window updates
    if (!LogDir.IsEmpty()) {
        ForceDirectories(ExtractFileDir(LogDir));
        // The file name is a mask that adds the date.
        const String NameMask = "\"" + IncludeTrailingPathDelimiter(LogDir) + "\"" + LogNameMask;
        const String Header = "\"" + String(SrvCopyRight) + "\r\n" +
            "Log File Created: \"dd mmm yyyy hh:mm:ss\"\r\n" +
            "Computer: " + FSrvCompName + "\"\r\n";
        FDiagLogBuffer.reset(new TIcsBuffLogStream(nullptr, NameMask, Header, FileCPUtf8));
        Display("Log File: " + FDiagLogBuffer->FullName);
    }
    Display("INI file: " + FIniFileName);
    Display("FTP Accounts Path: " + FAccountPath);
    FlushDiagLog();

    // Tell them who we are.
    IcsSslRootCAStore->Initialise();      // loads OpenSSL and the internal root CAs if needed
    IcsSslLoadProviders(true, false);     // the legacy provider is needed
    Display(String(SrvCopyRight) + "\r\nSSL/TLS " + IcsReportOpenSSLVer(true));
    PostMessage(Handle, WM_STARTUP, 0, 0);
}

void __fastcall TFtpServerForm::RecheckCertsButtonClick(TObject *Sender)
{
    FCertCheckTrigger = Overbyteicstypes::Trigger64Immediate;
}

void __fastcall TFtpServerForm::FormClose(TObject *Sender, TCloseAction &Action)
{
    if (FFinalized)
        return;   // only once
    FFinalized = true;
    FCertCheckTrigger = Overbyteicstypes::Trigger64Disabled;
    FHouseKeepingTrg = Overbyteicstypes::Trigger64Disabled;
    StopButtonClick(this);
    StopQueueMail();
    FDiagLogBuffer.reset();
    Timer1->Enabled = false;
}

void __fastcall TFtpServerForm::WMStartup(TMessage &Msg)
{
    StartButtonClick(this);
}

// Expands the escapes of the ini file's banner: \n CRLF, \c CR, \l LF, \\ backslash, \d date
// and time, \o ISO date and time, \t time, \p computer name, \h first host name, \v this
// program's copyright, \s the FTP server's copyright. Unknown escapes are kept as they are.
String TFtpServerForm::UnEscapeStr(const String &Buffer)
{
    String Result;
    if (Buffer.IsEmpty())
        return Result;
    const TDateTime CurDT = Now();
    int I = 1;
    while (I <= Buffer.Length()) {
        wchar_t Ch = Buffer[I++];
        if (Ch != L'\\') {
            Result += Ch;
            continue;
        }
        if (I > Buffer.Length())
            break;
        Ch = Buffer[I++];   // the escaped character
        switch (Ch) {
        case L'n': Result += "\r\n"; break;
        case L'c': Result += L'\r'; break;
        case L'l': Result += L'\n'; break;
        case L'\\': Result += L'\\'; break;
        case L'd': Result += DateToStr(CurDT) + " " + TimeToStr(CurDT); break;
        case L'o': Result += FormatDateTime(ISODateTimeMask, CurDT); break;
        case L't': Result += TimeToStr(CurDT); break;
        case L'p': Result += FSrvCompName; break;
        case L'h':
            // Delphi indexes IcsHosts[0].HostNames[0] without checking that they exist.
            if (SslFtpServer1->IcsHosts->Count > 0 && SslFtpServer1->IcsHosts->Items[0]->HostNames->Count > 0)
                Result += SslFtpServer1->IcsHosts->Items[0]->HostNames->Strings[0];
            break;
        case L'v': Result += SrvCopyRight; break;
        case L's': Result += Overbyteicsftpsrv::CopyRight; break;
        default:
            Result += L'\\';   // unknown escape: keep both characters
            Result += Ch;
        }
    }
    return Result;
}

void TFtpServerForm::ReportHosts()
{
    FStatSrvSslCert = "";
    TIcsHostCollection *Hosts = SslFtpServer1->IcsHosts;
    Display("Total server hosts " + IntToStr(Hosts->Count));
    for (int I = 0; I < Hosts->Count; I++) {
        TIcsHost *Host = Hosts->Items[I];
        if (Host->CertValRes == chainFail)
            Display("Server SSL Certificate Errors - " + Host->DisplayName);   // might want to stop and warn here

        // Site info for the log.
        FStatSrvSslCert += "Site Host " + IntToStr(I) + " [" + Host->DisplayName + "] " +
                           Host->HostNames->CommaText + "\r\n" +
                           "Bindings: " + Host->BindInfo + "\r\n" +
                           "SSL Security Level: " +
                           GetEnumName(__delphirtti(TSslSrvSecurity), static_cast<int>(Host->SslSrvSecurity)) + "\r\n" +
                           "SSL Certificate: " + Host->CertErrs + "\r\n" + Host->CertInfo + "\r\n\r\n";
    }
    Display(FStatSrvSslCert);
}

void __fastcall TFtpServerForm::StartButtonClick(TObject *Sender)
{
    try {
        // Main server settings from the ini file. The ini file is freed on every path (Delphi
        // leaks it when there are no hosts or on an exception).
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FIniFileName, true));
        IcsLoadFtpServerFromIni(IniFile.get(), SslFtpServer1, "FtpServer");

        // Ordering X509 certificates may need a proxy server.
        IcsSslX509Certs->ProxyURL = IniFile->ReadString("FtpServer", "X509ProxyURL", "");

        // The server hosts; checks the SSL files exist.
        IcsLoadIcsHostsFromIni(IniFile.get(), SslFtpServer1->IcsHosts, "Host", SslFtpServer1->ServSocket);
        if (SslFtpServer1->IcsHosts->Count <= 0) {
            Display("Can Not Start Server - No Server Hosts Configured");
            return;
        }
        Display("Number of Hosts Configured: " + IntToStr(SslFtpServer1->IcsHosts->Count));
    }
    catch (Exception &E) {
        Display("Failed to Get FTP server settings - " + E.Message);
        return;
    }

    // Validate the hosts and keep the site certificate information.
    String Errs;
    try {
        Errs = SslFtpServer1->ValidateHosts(false, true);   // don't stop on the first error, no exceptions
        if (!Errs.IsEmpty()) {
            Display("Server Validation Errors:\r\n" + Errs);
            if (!FAdminEmailTo.IsEmpty())
                SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server Validation Errors", Errs);
        }
        ReportHosts();
        Display("Required Listen Bindings:\r\n" + SslFtpServer1->ListenStates());
    }
    catch (Exception &E) {
        Display("Host Validation Failed, Server Stopped - " + E.Message);
        return;
    }

    // Server defaults; most were set by IcsLoadFtpServerFromIni.
    try {
        SslFtpServer1->ClientClass = __classid(TMyClient);   // the server creates our client class
        SslFtpServer1->SocketErrs = wsErrFriendly;
        SslFtpServer1->ExclusiveAddr = true;
        if (SslFtpServer1->TimeoutSecsIdle < 30)
            SslFtpServer1->TimeoutSecsIdle = 30;   // sanity check
        if (SslFtpServer1->Banner.Pos("\\n") > 0)
            SslFtpServer1->Banner = UnEscapeStr(SslFtpServer1->Banner);
        if (SslFtpServer1->Banner.IsEmpty())
            SslFtpServer1->Banner = "220 ICS FTP Server";
        if (SslFtpServer1->BandwidthLimit > 0)
            Display("Bandwidth Limited to " + IntToKbyte(SslFtpServer1->BandwidthLimit));
        TFtpsOptions Options = SslFtpServer1->Options;
        Display("Server options: " +
                IcsSetToStr(__delphirtti(TFtpsOption), &Options, static_cast<int>(sizeof(Options))));
        SslFtpServer1->WSDebugOptions = TWSDebugOptions() << wsdlogConnWS << wsdlogListen << wsdlogAccept
            << wsdlogInfo << wsdlogSsl << wsdlogHdr << wsdlogCerts << wsdlogErrs << wsdlogDns;
        SslFtpServer1->Start();
        String S = SslFtpServer1->ListenAllOK() ? "Started OK, " : "Failed to Start, ";
        S += "Listen Bindings:\r\n" + SslFtpServer1->ListenStates();
        Display(S);
        FCertCheckTrigger = IcsGetTrgSecs64(15);   // the first check is early, to order new certificates
        if (!FAdminEmailTo.IsEmpty())
            SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server Started",
                           "ICS Multi FTP Server\r\n\r\n" + S + "\r\n" + Errs);
        FlushDiagLog();
        StopButton->Enabled = true;
        StartButton->Enabled = false;
    }
    catch (Exception &E) {
        Display("Failed to start FTP server - " + E.Message);
    }
}

void __fastcall TFtpServerForm::StopButtonClick(TObject *Sender)
{
    if (!StopButton->Enabled)
        return;
    IcsSslX509Certs->CloseAccount();
    FCertCheckTrigger = Overbyteicstypes::Trigger64Disabled;
    StartButton->Enabled = true;
    StopButton->Enabled = false;
    FlushDiagLog();
    SslFtpServer1->Stop();
    if (!FAdminEmailTo.IsEmpty())
        SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server Stopped", "ICS Multi FTP Server Stopped\r\n");
    Display("Server stopped");
    FlushDiagLog();
}

void TFtpServerForm::StartQueueMail()
{
    try {
        if (!IcsMailQueue->Active &&
            (IcsMailQueue->MailQuDir.IsEmpty() || !ForceDirectories(IcsMailQueue->MailQuDir))) {
            Display("!! Failed to Start Mail Queue, No Directory");
            return;
        }
        if (IcsMailQueue->MailServers->Count == 0) {
            Display("!! Failed to Start Mail Queue, No Mail Servers");
            return;
        }
        // The account passwords should be stored encrypted and decrypted here.
        String S;
        for (int I = 0; I < IcsMailQueue->MailServers->Count; I++)
            S += IcsMailQueue->MailServers->Items[I]->Host + ", ";
        IcsMailQueue->Active = true;
        if (IcsMailQueue->Active)
            Display("Started Mail Queue OK, Servers: " + S);
    }
    catch (Exception &E) {
        Display("!! Failed to Start Mail Queue - " + IcsGetExceptMess(&E));
    }
}

void TFtpServerForm::StopQueueMail()
{
    if (!IcsMailQueue->Active)
        return;
    if (IcsMailQueue->MailImmItems > 0)
        Display("Waiting up to 30 seconds to send Queued Mail Items");
    IcsMailQueue->WaitSendandStop(30);
}

void TFtpServerForm::SendAdminEmail(const String &EmailTo, const String &Subject, const String &Body)
{
    if (EmailTo.IsEmpty())
        return;
    if (!IcsMailQueue->Active)
        StartQueueMail();   // restart if not running
    if (!IcsMailQueue->Active)
        Display("Error Starting Mail Queue");
    try {
        THtmlSmtpCli *Smtp = IcsMailQueue->QuHtmlSmtp;
        const String TempFrom = "\"" + FSrvCompName + "\" <" + FSrvCompName + "@magsys.co.uk>";
        Smtp->EmailFiles->Clear();
        Smtp->RcptName->Clear();
        Smtp->Allow8bitChars = true;
        Smtp->ContentType = smtpPlainText;
        Smtp->WrapMessageText = false;
        Smtp->WrapMsgMaxLineLen = 76;
        Smtp->PlainText->Clear();
        Smtp->PlainText->Text = String(SrvCopyRight) + "\r\n\r\n" + Body;
        Display("Queuing Email to " + EmailTo + " from " + TempFrom);
        Smtp->RcptName->Add(EmailTo);
        Smtp->FromName = TempFrom;
        Smtp->HdrCc = "";
        Smtp->HdrTo = EmailTo;
        Smtp->HdrFrom = TempFrom;
        Smtp->HdrReplyTo = TempFrom;
        Smtp->HdrSubject = Subject;
        Smtp->XMailer = "";
        if (IcsMailQueue->QueueMail() > 0)
            Display("Email Form Queued OK");
        else
            Display("Failed to Queue Email: " + Smtp->ErrorMessage);
    }
    catch (Exception &E) {
        Display("Failed to Queue Email: " + IcsGetExceptMess(&E));
    }
}

/* ---- FTP server events ---- */

// Called once the server has built a listing: adds the virtual directory to the C:\ listing.
void __fastcall TFtpServerForm::SslFtpServer1AlterDirectory(TObject *Sender, TFtpCtrlSocket *Client,
                                                            TFtpString &Directory, bool Detailed)
{
    if (UpperCase(Client->Directory) != "C:\\")
        return;
    // Delphi writes Length(Buf) bytes of a UTF-16 string, so only half the text is sent.
    if (Detailed)
        WriteUtf8(Client->DataStream, "drwxrwxrwx   1 ftp      ftp            0 Apr 30 19:00 VIRTUAL\r\n");
}

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

void __fastcall TFtpServerForm::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;
    }
    FlushDiagLog();
    if (!Authenticated)
        return;
    Display("! " + Client->SessIdInfo + " Home Directory: " + Client->HomeDir);
}

void __fastcall TFtpServerForm::SslFtpServer1BgException(TObject *Sender, Exception *E, bool &CanClose)
{
    Display("! Server BgException: " + IcsGetExceptMess(E));
}

/* 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 TFtpServerForm::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;   // Delphi leaves it at the end; the server only rewinds its own streams
}

// The place to check whether a user may enter a directory: here only ROOT may use C:\.
void __fastcall TFtpServerForm::SslFtpServer1ChangeDirectory(TObject *Sender, TFtpCtrlSocket *Client,
                                                             TFtpString Directory, bool &Allowed)
{
    if (UpperCase(Client->UserName) != "ROOT" && UpperCase(Client->Directory) == "C:\\")
        Allowed = false;
}

void __fastcall TFtpServerForm::SslFtpServer1ClientCommand(TObject *Sender, TFtpCtrlSocket *Client,
                                                           TFtpString &Keyword, TFtpString &Params,
                                                           TFtpString &Answer)
{
    String S = String(StringToUtf8(Params));
    if (Keyword == "PASS")
        S = "####";
    Display("< " + Client->GetPeerAddr() + " " + Keyword + " " + S);
    // 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 == "QUIT")
        FlushDiagLog();
}

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

void __fastcall TFtpServerForm::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;
    }
    Display("! " + Client->GetPeerAddr() + " connected");
    SetDefaultAccount(Client);
    FlushDiagLog();
}

void __fastcall TFtpServerForm::SslFtpServer1ClientDisconnect(TObject *Sender, TFtpCtrlSocket *Client,
                                                              System::Word AError)
{
    Display("! " + Client->GetPeerAddr() + " disconnected");
    FlushDiagLog();
}

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

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

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

void __fastcall TFtpServerForm::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 TFtpServerForm::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 TFtpServerForm::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);
}

// The Retr/Stor handlers test AError; Delphi tests Error, which is the Windows constant ERROR
// (0), so data session errors are never shown.
void __fastcall TFtpServerForm::SslFtpServer1RetrDataSent(TObject *Sender, TFtpCtrlSocket *Client,
                                                          TWSocket *Data, System::Word AError)
{
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data sent. Error #" + IntToStr(AError));
}

void __fastcall TFtpServerForm::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 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 TFtpServerForm::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();
        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;
    }
}

// Fired for the control socket (a TMyClient) and for each data socket (owned by the client).
void __fastcall TFtpServerForm::SslFtpServer1SslHandshakeDone(TObject *Sender, System::Word ErrCode,
                                                              TX509Base *PeerCert, bool &Disconnect)
{
    TWSocket *Sock = static_cast<TWSocket *>(Sender);
    TFtpCtrlSocket *Client = dynamic_cast<TFtpCtrlSocket *>(Sender);
    String Str = "Ctrl Socket: ";
    if (!Client) {
        Client = static_cast<TFtpCtrlSocket *>(Sock->Owner);
        Str = "Data Socket: ";
    }
    Display("SSL Client Hello from " + Client->CPeerAddr + "\r\n" + Trim(WSocketGetCliHelloStr(Client->CliHelloData)));
    if (ErrCode == 0) {
        Display(Client->SessIdInfo + " " + Str + Sock->SslHandshakeRespMsg);
        Display("SSL Handshake done, IcsHost #" + IntToStr(Client->IcsHostIdx) + " - " + Client->HostTag);
    }
    else
        Display(Client->SessIdInfo + "SSL Handshake Failed - " + Str + Sock->SslHandshakeRespMsg);
}

void __fastcall TFtpServerForm::SslFtpServer1SslServerName(TObject *Sender, TSslContext *&Ctx, TTlsExtError &ErrCode)
{
    ErrCode = teeOk;
}

// A client sending an SSL certificate is rare; it is reported once per session and accepted.
void __fastcall TFtpServerForm::SslFtpServer1SslVerifyPeer(TObject *Sender, int &Ok, TX509Base *Cert)
{
    TMyClient *Client = dynamic_cast<TMyClient *>(Sender);
    if (!Client)
        Client = static_cast<TMyClient *>(static_cast<TWSocket *>(Sender)->Owner);   // a data socket
    if (Client->ReportSslCert) {
        Ok = 1;
        return;
    }
    Client->ReportSslCert = true;
    Display(Client->SessIdInfo + "Received SSL certificate\r\n" +
            "Subject: " + Cert->SubjectOneLine + "\r\n" +
            "Common Name: " + Cert->SubjectCName + "\r\n" +
            "Issuer: " + Cert->IssuerOneLine);
    if (Ok != 1) {
        Display(Client->SessIdInfo + "SSL Certificate Error: " + Cert->VerifyErrMsg + " (but error ignored)");
        Ok = 1;   // this example accepts any client
    }
}

void __fastcall TFtpServerForm::SslFtpServer1Start(TObject *Sender)
{
    Display("! " + static_cast<TComponent *>(Sender)->Name + " started");
}

void __fastcall TFtpServerForm::SslFtpServer1Stop(TObject *Sender)
{
    Display("! " + static_cast<TComponent *>(Sender)->Name + " stopped");
}

void __fastcall TFtpServerForm::SslFtpServer1StorSessionConnected(TObject *Sender, TFtpCtrlSocket *Client,
                                                                  TWSocket *Data, System::Word AError)
{
    // Delphi's message here reads "Data session closed".
    if (AError != 0)
        Display("! " + Client->GetPeerAddr() + " Data session failed to open. Error #" + IntToStr(AError));
}

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

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

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

/* ---- Mail queue, OAuth2 and certificate ordering events ---- */

void __fastcall TFtpServerForm::IcsMailQueueLogEvent(TMailLogLevel LogLevel, const String Info)
{
    Display(Info);
}

void __fastcall TFtpServerForm::IcsMailQueueOATokenEvent(int ServNr, String &Token, String &TokAccount,
                                                         TDateTime &TokExpireDT)
{
    Display("Starting to get OAuth2 Bearer Token");
    // Allows interaction: waits for a browser window. A real service must not, since it has
    // no desktop for the browser.
    if (!IcsRestEmail->GetNewToken(true))
        Display("Failed to get OAuth2 Bearer Token");
    else {
        // The access token lives a few hours and can be refreshed, so it is not saved.
        Token = IcsRestEmail->AccToken;
        TokExpireDT = IcsRestEmail->AccExpireDT;
        TokAccount = IcsRestEmail->NewAccEmail;
    }
}

// The refresh token only comes after a login window, so it should be saved.
void __fastcall TFtpServerForm::IcsRestEmailEmailNewToken(TObject *Sender)
{
    if (!IcsRestEmail->RefrToken.IsEmpty() && IcsRestEmail->RefrToken != FOldRefrToken) {
        const String Info = "New OAuth2 Refresh Token for Account: " + IcsRestEmail->NewAccEmail +
                            ", Should be Saved in INI File: " + FIniFileName + "\r\n" +
                            "RefrToken=" + IcsRestEmail->RefrToken;
        Display(Info);
        if (!FAdminEmailTo.IsEmpty())
            SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server New OAuth2 Refresh Token",
                           "FTP server New OAuth2 Refresh Token.\r\n\r\n" + Info);
    }
}

void __fastcall TFtpServerForm::IcsRestEmailEmailProg(TObject *Sender, TLogOption LogOption, const String Msg)
{
    Display(Msg);
}

void __fastcall TFtpServerForm::IcsSslX509CertsCertProg(TObject *Sender, TLogOption LogOption, const String Msg)
{
    Display(Msg);
}

// DNS challenges would update a DNS server with the TXT record; not done here.
void __fastcall TFtpServerForm::IcsSslX509CertsChallengeDNS(TObject *Sender, const TChallengeItem &ChallengeItem,
                                                            bool &ChlgOK)
{
    ChlgOK = false;
}

void __fastcall TFtpServerForm::IcsSslX509CertsChallgRefresh(TObject *Sender)
{
    TSslX509Certs *Certs = static_cast<TSslX509Certs *>(Sender);
    if (Certs->IssueState > IssStateNone)
        Display("X509 Certificate Order State Change: " + Certs->CertCommonName + " - New State: " +
                IssueStateLits[Certs->IssueState]);
}

void __fastcall TFtpServerForm::IcsSslX509CertsNewCert(TObject *Sender)
{
    FCertCheckTrigger = Overbyteicstypes::Trigger64Immediate;   // load the new certificates
    Display("Trigger Recheck Certificates");
    Display("FTP server ordered new SSL cerrtificate.\r\n" + IcsSslX509Certs->GetOrderResult());
    if (!FAdminEmailTo.IsEmpty())
        SendAdminEmail(FAdminEmailTo, "ICS Multi FTP Server SSL Certificate Order Completed",
                       "FTP server ordered new SSL cerrtificate.\r\n\r\n" + IcsSslX509Certs->GetOrderResult() + "\r\n");
}