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

  A test SMTP server using TSslSmtpServer on two ports: 25 (STARTTLS) and 587. It accepts mail for the
  listed local accounts (and aliases) and saves each message as an .eml file in the spool directory.
  The authentication handlers accept the password "password" for any user name.

  How this C++ version differs from the Delphi original, apart from syntax:
  - The log lines that share the "time  client id  text" layout go through one helper, LogClient.
  - The two IcsHosts entries differ only in port, so one loop configures both.
  - The empty MailFrom and RcptTo handlers are not translated (and so not assigned).
  - The unit-level variables FIniFileName, FInitialized and FSmtpServer are form members.
  - The component is owned by the form, which frees it; FormDestroy only stops the server.
*/

#include <vcl.h>
#pragma hdrstop

#include <memory>
#include <System.SysUtils.hpp>

#include "OverbyteIcsSslSmtpServ1.h"
#include "OverbyteIcsIniFiles.hpp"
#include "OverbyteIcsStreams.hpp"
#include "OverbyteIcsUtils.hpp"

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

TSmtpSslSrvForm *SmtpSslSrvForm;

namespace {
const wchar_t *const SectionData = L"Data";
const wchar_t *const KeyDnsServer = L"DnsServer";
const wchar_t *const KeyEmailAccs = L"EmailAccs";
const wchar_t *const KeySpoolDir = L"SpoolDir";
const wchar_t *const KeyAddRecvHdrs = L"AddRecvHdrs";
const wchar_t *const KeyAddEnvHdrs = L"AddEnvHdrs";
const wchar_t *const KeyAddReplayHdrs = L"AddReplayHdrs";
const wchar_t *const KeyAllowRelay = L"AddAllowRelay";
const wchar_t *const KeyAuthTls = L"AuthTls";
const wchar_t *const KeyAliasAccs = L"AddAliasAccs";
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 KeyServIpAddr = L"ServIpAddr";
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";

String NowStamp()
{
    return FormatDateTime("hh:nn:ss", Time());
}
}

__fastcall TSmtpSslSrvForm::TSmtpSslSrvForm(TComponent *Owner)
    : TForm(Owner), FInitialized(false), FSmtpServer(nullptr)
{
}

// Logs "time  client id (8 hex digits)  text".
void __fastcall TSmtpSslSrvForm::LogClient(TSmtpSrvCli *Cli, const String &Text)
{
    Log->Lines->Add(NowStamp() + "  " + IntToHex(static_cast<int>(Cli->ID), 8) + "  " + Text);
}

void __fastcall TSmtpSslSrvForm::FormClose(TObject *Sender, TCloseAction &Action)
{
    std::unique_ptr<TIcsIniFile> ini(new TIcsIniFile(FIniFileName, true));
    ini->WriteString(SectionData, KeyDnsServer, PrefDnsServer->Text);
    ini->WriteString(SectionData, KeyEmailAccs, PrefEmailAccs->Lines->CommaText);
    ini->WriteString(SectionData, KeyAliasAccs, PrefAliasAccs->Lines->CommaText);
    ini->WriteString(SectionData, KeySpoolDir, PrefSpoolDir->Text);
    ini->WriteBool(SectionData, KeyAddRecvHdrs, PrefAddRecvHdrs->Checked);
    ini->WriteBool(SectionData, KeyAddEnvHdrs, PrefAddEnvHdrs->Checked);
    ini->WriteBool(SectionData, KeyAddReplayHdrs, PrefAddReplayHdrs->Checked);
    ini->WriteBool(SectionData, KeyAllowRelay, PrefAllowRelay->Checked);
    ini->WriteBool(SectionData, KeyAuthTls, PrefAuthTls->Checked);
    ini->WriteString(SectionData, KeyCertFile, CertFileEdit->Text);
    ini->WriteString(SectionData, KeyPrivKeyFile, PrivKeyFileEdit->Text);
    ini->WriteString(SectionData, KeyPassPhrase, PassPhraseEdit->Text);
    ini->WriteString(SectionData, KeyServIpAddr, ServIpAddr->Text);

    ini->WriteInteger(SectionWindow, KeyTop, Top);
    ini->WriteInteger(SectionWindow, KeyLeft, Left);
    ini->WriteInteger(SectionWindow, KeyWidth, Width);
    ini->WriteInteger(SectionWindow, KeyHeight, Height);
    ini->UpdateFile();
}

void __fastcall TSmtpSslSrvForm::FormCreate(TObject *Sender)
{
    Caption = Caption + IcsVerLitSample;   // common ICS sample caption: version and date
    Log->Clear();
    FIniFileName = GetIcsIniFileName();

    FSmtpServer = new TSslSmtpServer(this);   // owned by the form, which frees it
    FSmtpServer->OnException = SmtpServer1Exception;
    FSmtpServer->OnServerStarted = SmtpServer1ServerStarted;
    FSmtpServer->OnServerStopped = SmtpServer1ServerStopped;
    FSmtpServer->OnConnect = SmtpServer1Connect;
    FSmtpServer->OnDisconnect = SmtpServer1Disconnect;
    FSmtpServer->OnCommand = SmtpServer1Command;
    FSmtpServer->OnResponse = SmtpServer1Response;
    FSmtpServer->OnAuth = SmtpServer1Auth;
    FSmtpServer->OnAuthPW = SmtpServer1AuthPW;
    FSmtpServer->OnDataStart = SmtpServer1DataStart;
    FSmtpServer->OnDataEnd = SmtpServer1DataEnd;
    FSmtpServer->WSDebugOptions = TWSDebugOptions();
    FSmtpServer->OnDisplay = SmtpServer1Display;
    FSmtpServer->OnSslVerifyPeer = SmtpServer1SslVerifyPeer;
    FSmtpServer->OnSslHandshakeDone = SmtpServer1SslHandshakeDone;
}

void __fastcall TSmtpSslSrvForm::FormDestroy(TObject *Sender)
{
    FSmtpServer->Stop();
}

void __fastcall TSmtpSslSrvForm::FormShow(TObject *Sender)
{
    if (FInitialized)
        return;
    FInitialized = true;

    std::unique_ptr<TIcsIniFile> ini(new TIcsIniFile(FIniFileName, true));
    PrefDnsServer->Text = ini->ReadString(SectionData, KeyDnsServer, "8.8.8.8");   // Google DNS
    PrefEmailAccs->Lines->CommaText = ini->ReadString(SectionData, KeyEmailAccs, "account@domain.com");
    PrefAliasAccs->Lines->CommaText = ini->ReadString(SectionData, KeyAliasAccs, "*@domain.com=account@domain.com");
    PrefSpoolDir->Text = ini->ReadString(SectionData, KeySpoolDir, "c:\\mailspool\\");
    PrefAddRecvHdrs->Checked = ini->ReadBool(SectionData, KeyAddRecvHdrs, true);
    PrefAddEnvHdrs->Checked = ini->ReadBool(SectionData, KeyAddEnvHdrs, false);
    PrefAddReplayHdrs->Checked = ini->ReadBool(SectionData, KeyAddReplayHdrs, false);
    PrefAllowRelay->Checked = ini->ReadBool(SectionData, KeyAllowRelay, true);
    PrefAuthTls->Checked = ini->ReadBool(SectionData, KeyAuthTls, true);
    CertFileEdit->Text = ini->ReadString(SectionData, KeyCertFile,
        "C:\\ProgramData\\ICS-OpenSSL\\ICS-Certs\\localhost-bundle.pem");
    PrivKeyFileEdit->Text = ini->ReadString(SectionData, KeyPrivKeyFile, "");
    PassPhraseEdit->Text = ini->ReadString(SectionData, KeyPassPhrase, "password");
    ServIpAddr->Text = ini->ReadString(SectionData, KeyServIpAddr, "127.0.0.1");
    Top = ini->ReadInteger(SectionWindow, KeyTop, (Screen->Height - Height) / 2);
    Left = ini->ReadInteger(SectionWindow, KeyLeft, (Screen->Width - Width) / 2);
    Width = ini->ReadInteger(SectionWindow, KeyWidth, Width);
    Height = ini->ReadInteger(SectionWindow, KeyHeight, Height);
}

void __fastcall TSmtpSslSrvForm::doStartClick(TObject *Sender)
{
    if (PrefSpoolDir->Text == "") {
        Log->Lines->Add("Must specify a spool directory to receive email");
        return;
    }
    if (!ForceDirectories(PrefSpoolDir->Text)) {
        Log->Lines->Add("Failed to create spool directory: " + PrefSpoolDir->Text);
        return;
    }

    TSslSmtpServer *srv = FSmtpServer;
    srv->WSDebugOptions = DefWSDebugServer;
    srv->ServerHost = WSocketResolveIp(ServIpAddr->Text);   // should be the mail exchange domain name
    srv->SocketFamily = sfIPv4;
    srv->CertExpireDays = 7;
    srv->SslCertAutoOrder = false;
    srv->IcsHosts->Clear();

    // Port 25 (STARTTLS) and port 587, both bound to the server address with the same certificate.
    const int ports[] = {25, 587};
    for (int port : ports) {
        TIcsHost *host = static_cast<TIcsHost*>(srv->IcsHosts->Add());
        host->HostEnabled = true;
        host->BindIpAddr = ServIpAddr->Text;
        host->BindNonPort = port;
        host->HostTag = "SmtpServer";
        host->Descr = host->HostTag;
        host->CertSupplierProto = SuppProtoNone;
        if (FileExists(CertFileEdit->Text)) {
            host->HostNames->Text = srv->ServerHost;
            host->SslCert = IcsTrim(CertFileEdit->Text);
            if (FileExists(PrivKeyFileEdit->Text))
                host->SslKey = IcsTrim(PrivKeyFileEdit->Text);
            host->SslPassword = IcsTrim(PassPhraseEdit->Text);
        }
    }

    srv->DnsAddress = PrefDnsServer->Text;
    srv->ClientTimeout = 5 * 60;
    srv->MaxMessageSize = 25 * 1000000;

    // Set << adds an element and Set >> removes it, in place; the local copy is assigned back once.
    TSmtpsOptions opts = srv->Options;
    auto setOption = [&opts](TSmtpsOption option, bool on) {
        if (on)
            opts << option;
        else
            opts >> option;
    };
    setOption(smtpsAddRecvHeaders, PrefAddRecvHdrs->Checked);
    setOption(smtpsParseHeaders, true);
    setOption(smtpsAddEnvHeaders, PrefAddEnvHdrs->Checked);
    setOption(smtpsAddReplayHdrs, PrefAddReplayHdrs->Checked);
    setOption(smtpsAllowOpenRelay, PrefAllowRelay->Checked);
    setOption(smtpsAllowAuthRelay, PrefAllowRelay->Checked);
    setOption(smtpsAuthNoTls, PrefAuthTls->Checked);   // despite its name, set means AUTH is only offered after TLS
    setOption(smtpsAllowTls, true);
    srv->Options = opts;
    srv->LocalAccounts = PrefEmailAccs->Lines;
    srv->AliasAccounts = PrefAliasAccs->Lines;   // must be assigned after the local accounts, since it is checked against them

    // Pre-load the OpenSSL DLLs.
    try {
        IcsSslRootCAStore->Initialise();
        Log->Lines->Add("SSL Version: " + IcsReportOpenSSLVer(true));
    }
    catch (Exception &E) {
        Log->Lines->Add("Failed to Initialise SSL - " + E.Message);
    }
    try {
        srv->Start();
        doStart->Enabled = false;
        doExit->Enabled = false;
        doStop->Enabled = true;
    }
    catch (Exception &E) {
        Log->Lines->Add("Failed to Start SMTP Server: " + E.Message);
    }
}

void __fastcall TSmtpSslSrvForm::doStopClick(TObject *Sender)
{
    FSmtpServer->Stop();
}

void __fastcall TSmtpSslSrvForm::doExitClick(TObject *Sender)
{
    FSmtpServer->Stop();
    Close();
}

void __fastcall TSmtpSslSrvForm::SmtpServer1ServerStarted(TObject *Sender)
{
    TSmtpServer *srv = static_cast<TSmtpServer*>(Sender);
    Log->Lines->Add(NowStamp() + "  SMTP Server Started");
    Log->Lines->Add("Socket 1 State: " + String(SocketStateNames[srv->WSocketServer->State]) + " " +
        SocketFamilyNames[srv->SocketFamily] + " on " +
        FormatIpAddrPort(srv->WSocketServer->GetXAddr(), srv->WSocketServer->Port));
}

void __fastcall TSmtpSslSrvForm::SmtpServer1ServerStopped(TObject *Sender)
{
    TSmtpServer *srv = static_cast<TSmtpServer*>(Sender);
    Log->Lines->Add(NowStamp() + "  SMTP Server Socket " +
        IntToHex(srv->WSocketServer->MultiListenIndex + 2, 1) + " Stopped");
    doStart->Enabled = true;
    doExit->Enabled = true;
    doStop->Enabled = false;
}

void __fastcall TSmtpSslSrvForm::SmtpServer1SslHandshakeDone(TObject *Sender, WORD ErrCode, TX509Base *PeerCert, bool &Disconnect)
{
    TSmtpSrvCli *cli = static_cast<TSmtpSrvCli*>(Sender);
    if (ErrCode == 0)
        LogClient(cli, cli->SslHandshakeRespMsg);
    else   // Delphi formats the failure time with 'hh:nn:aa', not 'hh:nn:ss'; LogClient always prints seconds
        LogClient(cli, "SslHandshake Failed - " + cli->SslHandshakeRespMsg);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1SslVerifyPeer(TObject *Sender, int &Ok, TX509Base *Cert)
{
    Log->Lines->Add("Received certificate\r\nSubject: " + Cert->SubjectOneLine + "\r\nIssuer: " + Cert->IssuerOneLine);
    if (Ok != 1) {
        Log->Lines->Add("Error msg: " + Cert->VerifyErrMsg + "\r\nIn this example we accept any cert");
        Ok = 1;   // in this example we accept any client
    }
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Connect(TObject *Sender, TObject *Client, const String IpAddr, TSmtpMailAction &Action, String &Reason)
{
    // Action could be set to wsmtpSysUnavail, wsmtpNetError or wsmtpCongested to refuse a client.
    TSmtpSrvCli *cli = static_cast<TSmtpSrvCli*>(Client);
    LogClient(cli, "Client connected from " + IpAddr + " [" + cli->ClientRDNS + " MX=" + cli->ClientMX + "]");
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Disconnect(TObject *Sender, TObject *Client, WORD Error)
{
    LogClient(static_cast<TSmtpSrvCli*>(Client), "Connection terminated");
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Display(TObject *Sender, const String Msg)
{
    Log->Lines->Add(Msg);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Exception(TObject *Sender, Exception *E)
{
    Log->Lines->Add("Exception: " + E->Message);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Auth(TObject *Sender, TObject *Client, const String UserName, String &Password, TSmtpMailAction &Action, String &Reason)
{
    // A blank user name means CRAM-MD5/SHA1 was already checked by the server.
    TSmtpSrvCli *cli = static_cast<TSmtpSrvCli*>(Client);
    if (UserName == "")
        Action = wsmtpAuthRequired;
    else if (Password != "") {
        Action = wsmtpAuthPermFail;
        if (Password == "password")
            Action = wsmtpOK;
    }
    if (Action == wsmtpOK)
        LogClient(cli, "Authentication OK: UserName=" + UserName + " Password=" + Password);
    else
        LogClient(cli, "Authentication failed: UserName=" + UserName + " Password=" + Password);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1AuthPW(TObject *Sender, TObject *Client, const String UserName, String &Password, TSmtpMailAction &Action, String &Reason)
{
    // Supplies the password the server tests CRAM-MD5/SHA1 against.
    Password = "password";
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Command(TObject *Sender, TObject *Client, const String Command)
{
    LogClient(static_cast<TSmtpSrvCli*>(Client), "< " + Command);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1Response(TObject *Sender, TObject *Client, const String Response)
{
    LogClient(static_cast<TSmtpSrvCli*>(Client), "> " + Response);
}

void __fastcall TSmtpSslSrvForm::SmtpServer1DataStart(TObject *Sender, TObject *Client, TSmtpMailAction &Action, String &Reason)
{
    // All envelope commands are in; open the file that receives the message. Mail for a local account is
    // saved in a folder named after the first account, other mail (to relay) goes straight to the spool.
    TSmtpSrvCli *cli = static_cast<TSmtpSrvCli*>(Client);
    // Delphi appends the file name to the edit text as typed; a missing trailing backslash gave a wrong path.
    String spool = IncludeTrailingPathDelimiter(PrefSpoolDir->Text);
    try {
        cli->DataFileName = spool + cli->MessageID + ".eml";
        if (cli->ToAccounts->Count > 0) {
            cli->DataFileName = spool + cli->ToAccounts->Strings[0] + "\\";
            if (!ForceDirectories(cli->DataFileName)) {
                Log->Lines->Add("Failed to create spool directory: " + cli->DataFileName);
                Action = wsmtpSysUnavail;
                Reason = "Mail spool unavailable";
                return;
            }
            cli->DataFileName = cli->DataFileName + cli->MessageID + ".eml";
        }
        cli->DataStream = new TIcsBufferedFileStream(cli->DataFileName, fmCreate, MAX_BUFSIZE);
    }
    catch (Exception &E) {
        LogClient(cli, "Failed to create mail spool file " + cli->DataFileName);
        Action = wsmtpSysUnavail;
        Reason = "Mail spool unavailable";
    }
}

void __fastcall TSmtpSslSrvForm::SmtpServer1DataEnd(TObject *Sender, TObject *Client, TSmtpMailAction &Action, String &Reason)
{
    // A complete message has been received; Action could be wsmtpMsgTooLarge, wsmtpMailboxFull or wsmtpSysUnavail.
    TSmtpSrvCli *cli = static_cast<TSmtpSrvCli*>(Client);
    if (cli->DataStream) {
        LogClient(cli, "Saved mail to spool file " + cli->DataFileName + ", size " + IntToStr(cli->DataStream->Size));
        delete cli->DataStream;   // closing the stream saves the file to disk
        cli->DataStream = nullptr;
    }
}