/*
  ICS Web Application Server pages - C++Builder translation of the Delphi unit
  OverbyteIcsWebAppServerPages.pas (demos-delphi-vcl), ICS V9.8.

  The URL handlers (dynamic pages) of the OverbyteIcsWebAppServer demo: login and session
  pages, a hit counter image, a configuration form with a logo upload, a HEAD request test,
  an email form sent with TSmtpCli, and a Hello World page. Most pages are templates from the
  server's TemplateDir.

  How this C++ version differs from the Delphi original, apart from syntax:
  - TWebAppSrvDataModule is a plain C++ class instead of a TComponent created in the unit's
    initialization section and never freed: the server form owns the instance and points
    WebAppSrvDataModule at it. TAppSrvSessionData is registered by RegisterWebAppClasses,
    which the form calls (Delphi: RegisterClass in the initialization section).
  - Only the VCL counter image (JPEG) is translated, not the {$IFDEF FMX} PNG one.
  - Components and objects the handlers create (socket, timer, SMTP and HTTP clients,
    decoders, streams, string lists) have no Owner and are held in std::unique_ptr.
  - AnswerPage's UserData is passed as a typed null: a bare nullptr is ambiguous between
    its TObject* (template file) and PWideChar (resource type) overloads.
  - Delphi demo bugs are fixed here, as in OverbyteIcsSslMultiWebPages.cpp where the code is
    the same; each fix has a one-line comment.
*/

#include <vcl.h>
#pragma hdrstop

#include <Vcl.Graphics.hpp>
#include <Vcl.Imaging.jpeg.hpp>
#include <algorithm>
#include <cstring>

#include "OverbyteIcsWebAppServerPages.h"
#include "OverbyteIcsIniFiles.hpp"
#include "OverbyteIcsUtils.hpp"
#include "OverbyteIcsFormDataDecoder.hpp"
#include "OverbyteIcsUrl.hpp"
#include "OverbyteIcsMD5.hpp"
#include "OverbyteIcsHtmlUtils.hpp"

#pragma package(smart_init)

const wchar_t *const UrlLogin                   = L"/login/loginform.html";
const wchar_t *const UrlDoLoginSecure           = L"/DoLoginSecure.Html";
const wchar_t *const UrlHomePage                = L"/HomePage.html";
const wchar_t *const UrlCounter                 = L"/Counter.jpg";
const wchar_t *const UrlConfigForm              = L"/ConfigForm.html";
const wchar_t *const UrlDoConfigHtml            = L"/DoConfig.html";
const wchar_t *const UrlConfigLogoPng           = L"/ConfigLogo.png";
const wchar_t *const UrlDoConfigConfirmSaveHtml = L"/ConfigConfirmSave.html";
const wchar_t *const UrlCounterViewHtml         = L"/CounterView.html";
const wchar_t *const UrlJavascriptErrorHtml     = L"/JavascriptError.html";
const wchar_t *const UrlAjaxFetchCounter        = L"/Ajax/FetchCounter";
const wchar_t *const UrlHeadForm                = L"/HeadForm.html";

TWebAppSrvDataModule *WebAppSrvDataModule = nullptr;

namespace {

const wchar_t *const CounterSection = L"Counter";
const wchar_t *const SectionConfig  = L"Config";
const wchar_t *const KeyPort        = L"Port";
const wchar_t *const DftPort        = L"20105";

/* The email host is deliberately hardcoded in this form, to prevent it being supplied
   as a form parameter, which is how spammers abuse email forms. The account may be
   passed as a parameter with the form, but sending the form will fail unless it's
   another valid account at ftptest.org. */
const wchar_t *const DefaultEmailDomain  = L"@ftptest.org";
const wchar_t *const DefaultEmailAccount = L"testing";

// The magsys SMTP servers host the ftptest.org domain and may be used to test this form.
// You won't be able to read that mailbox, but you get a CC of the email.
const wchar_t *const SmtpServerList[] = {L"mail.magsys.co.uk", L"mail3.magsys.co.uk"};
const int SmtpServerCount = sizeof(SmtpServerList) / sizeof(SmtpServerList[0]);

const wchar_t *const PleaseSelect = L"Please select";

// Typed null for AnswerPage's UserData, see the file header.
TObject *const NoUserData = nullptr;

// True when the first L characters of S are digits (fewer if S is shorter).
bool IsNumeric(const String &S, int L)
{
    for (int I = 1; I <= L && I <= S.Length(); I++) {
        if (S[I] < L'0' || S[I] > L'9')
            return false;
    }
    return true;
}

String GetTempLastMod(THttpAppSrvConnection *Client, const String &FName)
{
    TDateTime FileDT;
    __int64 FSize;
    if (IcsGetUAgeSizeFile(Client->TemplateDir + "/" + FName, FileDT, FSize))
        return FormatDateTime("dd mmm yyyy", FileDT);
    return "Page not found";
}

// Does a string contain any common HTML tags; spammers use HTML in email bodies.
bool IsHtmlTags(const String &S)
{
    const String S2 = LowerCase(S);
    for (const wchar_t *Tag : {L"<a", L"</a", L"href", L"<img", L"[/url]"}) {
        if (S2.Pos(Tag) > 0)
            return true;
    }
    return false;
}

bool IsValidEmail(const String &Value)
{
    // Only letters, digits, '_', '-' and '.' are accepted in either part.
    auto CheckAllowed = [](const String &S) {
        for (int I = 1; I <= S.Length(); I++) {
            const wchar_t C = S[I];
            if (!((C >= L'a' && C <= L'z') || (C >= L'A' && C <= L'Z') ||
                  (C >= L'0' && C <= L'9') || C == L'_' || C == L'-' || C == L'.'))
                return false;
        }
        return true;
    };

    const int At = Value.Pos("@");
    if (At == 0)
        return false;
    const String NamePart = Value.SubString(1, At - 1);
    const String ServerPart = Value.SubString(At + 1, MaxInt);
    if (NamePart.IsEmpty() || ServerPart.Length() < 5)
        return false;
    const int Dot = ServerPart.Pos(".");
    if (Dot == 0 || Dot > ServerPart.Length() - 2)
        return false;
    return CheckAllowed(NamePart) && CheckAllowed(ServerPart);
}

// True when S is usable as one file or directory name: no path delimiters, drive separator,
// wildcards or control characters, and no trailing '.' or space (so not "." or "..").
bool IsPlainFileName(const String &S)
{
    if (S.IsEmpty() || S[S.Length()] == L'.' || S[S.Length()] == L' ')
        return false;
    for (int I = 1; I <= S.Length(); I++) {
        const wchar_t C = S[I];
        if (C < L' ' || wcschr(L"<>:\"/\\|?*", C) != nullptr)
            return false;
    }
    return true;
}

// True when S can be written as an INI value: no line breaks or other control characters.
bool IsIniValueSafe(const String &S)
{
    for (int I = 1; I <= S.Length(); I++)
        if (S[I] < L' ')
            return false;
    return true;
}

// True when a counter name survives a round trip as an INI key: not empty, no leading or
// trailing spaces (the reader trims them), no leading ';' (read back as a comment), no '='
// (the key/value separator), and no line breaks or other control characters.
bool IsValidCounterName(const String &S)
{
    if (S.IsEmpty() || S != Trim(S) || S[1] == L';')
        return false;
    for (int I = 1; I <= S.Length(); I++) {
        const wchar_t C = S[I];
        if (C < L' ' || C == L'=')
            return false;
    }
    return true;
}

} // namespace

/* ---- TWebAppSrvDataModule: settings shared between the form and the pages ---- */

// Both counter functions refuse a name that is not a valid INI key, whichever page passed it.
int TWebAppSrvDataModule::CounterValue(const String &CounterName, int DefaultValue) const
{
    if (!IsValidCounterName(CounterName))
        return DefaultValue;
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FCounterFileName, true));
    return IniFile->ReadInteger(CounterSection, CounterName, DefaultValue);
}

int TWebAppSrvDataModule::CounterIncrement(const String &CounterRef) const
{
    if (!IsValidCounterName(CounterRef))
        return 0;
    // The ini file is created if it doesn't exist.
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(FCounterFileName, true));
    const int Result = IniFile->ReadInteger(CounterSection, CounterRef, 0) + 1;
    IniFile->WriteInteger(CounterSection, CounterRef, Result);
    IniFile->UpdateFile();
    return Result;
}

void TWebAppSrvDataModule::Display(const String &Msg) const
{
    if (OnDisplay)
        OnDisplay(nullptr, Msg);   // Delphi passes the data module as Sender; it is no TObject here
}

void TWebAppSrvDataModule::LoadConfig()
{
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(IniFileName, true));
    Port = IniFile->ReadString(SectionConfig, KeyPort, DftPort);
}

void TWebAppSrvDataModule::SaveConfig() const
{
    std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(IniFileName, true));
    IniFile->WriteString(SectionConfig, KeyPort, Port);
    IniFile->UpdateFile();
}

void TWebAppSrvDataModule::SetDataDir(const String &Value)
{
    FDataDir = Value;
    FCounterFileName = FDataDir + PathDelim + "Counters.ini";
}

/* ---- Session data, saved to and loaded from the sessions file by name ---- */

__fastcall TAppSrvSessionData::TAppSrvSessionData(TComponent *AOwner)
    : TWebSessionData(AOwner)
{
}

/* ---- Base class for pages that need a logged-in session ---- */

// Answers the "not logged" page when there is no valid session; the handler is then finished.
bool TUrlHandlerBase::NotLogged()
{
    const bool Result = !ValidateSession();
    if (Result) {
        AnswerPage("", NO_CACHE, "NotLogged.html", NoUserData,
                   ARRAYOFCONST((L"LOGIN", UrlLogin)));
        Finish();
    }
    return Result;
}

TAppSrvSessionData *TUrlHandlerBase::SessionData()
{
    return WSession ? dynamic_cast<TAppSrvSessionData *>(WSession->SessionData) : nullptr;
}

void TUrlHandlerBase::Relocate(const String &Location)
{
    AnswerPage("302 moved", "Location: " + Location + "\r\n" + NO_CACHE, "Moved.html",
               NoUserData, ARRAYOFCONST((L"LOCATION", Location)));
}

/* ---- Helpers for the temporary configuration directories ---- */

// Deletes a directory, all the files it contains and all its subdirectories.
void ForceRemoveDir(const String &Dir)
{
    TSearchRec F;
    int Status = FindFirst(IncludeTrailingPathDelimiter(Dir) + "*.*", faAnyFile, F);
    while (Status == 0) {
        if ((F.Attr & faDirectory) != 0) {
            if (F.Name != "." && F.Name != "..")
                ForceRemoveDir(Dir + PathDelim + F.Name);
        }
        else
            DeleteFile(Dir + PathDelim + F.Name);
        Status = FindNext(F);
    }
    FindClose(F);
    RemoveDir(Dir);
}

// Removes the subdirectories of Dir whose name starts with a YYYYMMDDHHNNSS time stamp
// that is now in the past.
void CleanupTimeStampedDir(const String &Dir)
{
    // An empty Dir would mean the drive root (IncludeTrailingPathDelimiter gives "\"); Delphi scans it.
    if (Dir.IsEmpty())
        return;
    const String NowStamp = FormatDateTime("YYYYMMDDHHNNSS", Now());
    TSearchRec F;
    int Status = FindFirst(IncludeTrailingPathDelimiter(Dir) + "*.*", faAnyFile, F);
    while (Status == 0) {
        if ((F.Attr & faDirectory) != 0 && F.Name != "." && F.Name != ".." &&
            F.Name.Length() >= 14 && IsNumeric(F.Name, 14) &&
            F.Name.SubString(1, 14) <= NowStamp)
            ForceRemoveDir(Dir + PathDelim + F.Name);
        Status = FindNext(F);
    }
    FindClose(F);
}

/* ---- /mailer.html: email form, sent with TSmtpCli to a hardcoded host ---- */

void __fastcall TUrlHandlerMailer::Execute()
{
    FWSocket.reset(new TWSocket(nullptr));
    FWSocket->OnDnsLookupDone = DoneDnsLookup;
    FWSocket->OnBgException = HandleBackgroundExceptions;
    FAbortTimer.reset(new TIcsTimer(nullptr));   // Delphi makes the socket the timer's Owner
    FAbortTimer->OnTimer = TimerAbortTimer;
    FAbortTimer->Interval = 5000;                // five second timeout for DNS
    try {
        // Get the user's IP address and look up the host name.
        sIPAddr = Client->GetPeerAddr();
        sUserIPHost = "";
        FWSocket->ReverseDnsLookup(sIPAddr);
        FAbortTimer->Enabled = true;
    }
    catch (Exception &E) {
        Display("Exception Looking up DNS - " + IcsGetExceptMess(&E));
        DoneDnsLookup(this, 999);   // continue to use the form
    }
}

void __fastcall TUrlHandlerMailer::HandleBackgroundExceptions(TObject *Sender, Exception *E, bool &CanClose)
{
    Display("Exception processing page - " + E->ClassName() + ": " + E->Message);
    CanClose = true;
}

__fastcall TUrlHandlerMailer::~TUrlHandlerMailer()
{
    if (FAbortTimer)
        FAbortTimer->Enabled = false;
}

// Answers the form page (or maildone.html) once; later SMTP events find the page answered.
void TUrlHandlerMailer::AnswerMailer(const String &Page)
{
    FAnswered = true;
    if (Page == "maildone.html")
        AnswerPage("", NO_CACHE, Page, NoUserData, nullptr, -1);
    else
        AnswerPage("", NO_CACHE, Page, NoUserData,
                   ARRAYOFCONST((L"PageLastMod", GetTempLastMod(Client, Page),
                                 L"sPageUrl", sPageUrl, L"sMailTo", sMailTo, L"sMailName", sMailName,
                                 L"sUserIPHost", sUserIPHost, L"sMailFrom", sMailFrom,
                                 L"sMailBody", sMailBody, L"errorMsg", errorMsg)));
    Finish();
}

void __fastcall TUrlHandlerMailer::TimerAbortTimer(TObject *Sender)
{
    FAbortTimer->Enabled = false;
    if (sUserIPHost.IsEmpty()) {
        Display("DNS Lookup Timed Out");
        FWSocket->CancelDnsLookup();
    }
    else {
        Display("SMTP Send Timed Out");
        FSmtpClient->Quit();
    }
}

void __fastcall TUrlHandlerMailer::DoneDnsLookup(TObject *Sender, System::Word Error)
{
    FAbortTimer->Enabled = false;
    FAbortTimer->Interval = 60000;   // 60 second timeout for SMTP
    if (Error == 0) {
        // The results are read from the handler's own socket: after an exception Execute calls this
        // with the handler itself, not the socket, as Sender (Delphi then fails its "Sender as TWSocket").
        String sTemp;
        if (FWSocket->DnsResultList->Count != 0) {
            for (int I = 0; I < FWSocket->DnsResultList->Count; I++) {
                if (I != 0)
                    sTemp += ", ";
                sTemp += FWSocket->DnsResultList->Strings[I];
            }
        }
        else
            sTemp = FWSocket->DnsResult;
        sUserIPHost = sTemp + " (" + sIPAddr + ")";
    }
    else {
        Display("DNS Lookup Failed - " + WSocketErrorDesc(Error));
        sUserIPHost = sIPAddr;
    }
    sPageUrl = "http://" + Client->RequestHost + Client->Path;   // used for the POST URL
    errorMsg = "";

    // A GET may pass the email account (no domain) as the query.
    if (Client->Method == "GET")
        sMailTo = Params;

    // The page POSTs to itself to send the email.
    if (Client->Method == "POST") {
        const String Posted = Client->PostedDataStr;
        ExtractURLEncodedValue(Posted, "MailZBody", sMailBody);
        if (IsHtmlTags(sMailBody)) {
            errorMsg = "Please specify valid content";   // spammers use HTML tags in the body
            Display("Email validation error: " + errorMsg + " - " + sMailBody);
        }
        else if (sMailBody.Length() < 40) {
            errorMsg = "Please specify your full message";
            Display("Email validation error: " + errorMsg + " - " + sMailBody);
        }
        ExtractURLEncodedValue(Posted, "MailZFrom", sMailFrom);
        ExtractURLEncodedValue(Posted, "MailZName", sMailName);
        ExtractURLEncodedValue(Posted, "MailZTo", sMailTo);
        if (sMailTo.Length() < 4)
            sMailTo = DefaultEmailAccount;   // no account passed, use the default
        if (!IsValidEmail(sMailFrom)) {
            errorMsg = "Please specify a valid email address";
            Display("Email validation error: " + errorMsg + " - " + sMailFrom);
        }
        // Stops spammers POSTing this page without a GET first: they must know the IP and host name.
        String sTemp;
        ExtractURLEncodedValue(Posted, "MailZIp", sTemp);
        if (sUserIPHost != sTemp) {
            errorMsg = "Please specify your message again, internal error";
            Display("Email validation error: " + errorMsg + " - IP Address " + sTemp);
        }
        if (sMailName.Length() < 5)
            errorMsg = "Please specify your full name";
        else if (!IsUsAscii(sMailName))
            errorMsg = "Your full name can not contain punctuation";

        // Build the form email and send it to the hardcoded host.
        if (errorMsg.IsEmpty()) {
            try {
                const String sMagEmail = sMailTo + DefaultEmailDomain;
                const String sTempFrom = "\"" + sMailName + "\" <" + sMailFrom + ">";
                if (!FEmailBody)
                    FEmailBody.reset(new TStringList());
                if (!FSmtpClient)
                    FSmtpClient.reset(new TSmtpCli(nullptr));   // Delphi: Create(Self)
                FSmtpClient->OnBgException = HandleBackgroundExceptions;
                FSmtpClient->OnDisplay = SmtpClientDisplay;
                FSmtpClient->OnGetData = SmtpClientGetData;
                FSmtpClient->OnRequestDone = SmtpClientRequestDone;
                FEmailBody->Text = RemoveHtmlSpecialChars(sMailBody) + "\r\n\r\n" +
                    "User Address: " + sUserIPHost + "\r\n" +
                    "Email Sent from Web Site Response Form: " + sPageUrl + "\r\n";
                if (!Client->AuthUserName.IsEmpty())
                    FEmailBody->Add("User Account: " + Client->AuthUserName);
                Display("Sending Email Form to " + sMagEmail + " from " + sTempFrom);
                FSmtpClient->RcptName->Clear();
                FSmtpClient->RcptName->Add(sMagEmail);
                FSmtpClient->RcptName->Add(sMailFrom);
                FSmtpClient->FromName = sMailFrom;
                FSmtpClient->HdrTo = sMagEmail;
                FSmtpClient->HdrFrom = sTempFrom;
                FSmtpClient->HdrReplyTo = sTempFrom;
                FSmtpClient->HdrCc = sTempFrom;
                FSmtpClient->HdrSubject = "ICS Demo Web Site Email Form - " + sMailTo;
                FSmtpClient->Host = SmtpServerList[0];
                FCurSmtpServer = 0;
                FSmtpClient->Open();   // connect, then HELO
                FAbortTimer->Enabled = true;
                return;   // the SMTP events send the response
            }
            catch (Exception &E) {
                errorMsg = "Failed to Start Sending Email Form: " + IcsGetExceptMess(&E);
                Display(errorMsg);
            }
        }
    }
    AnswerMailer("mailer.html");
}

// Supplies the email body to TSmtpCli one line at a time.
void __fastcall TUrlHandlerMailer::SmtpClientGetData(TObject *Sender, int LineNum, void *MsgLine, int MaxLen, bool &More)
{
    if (!FEmailBody || LineNum > FEmailBody->Count || MaxLen <= 0) {
        More = false;
        return;
    }
    // Truncated to MaxLen - 1 bytes plus the terminating nul (Delphi copies the line unbounded).
    const AnsiString Line = FEmailBody->Strings[LineNum - 1];
    const int Len = std::min(Line.Length(), MaxLen - 1);
    char *Dest = static_cast<char *>(MsgLine);
    if (Len > 0)
        std::memcpy(Dest, Line.c_str(), Len);
    Dest[Len] = '\0';
}

void __fastcall TUrlHandlerMailer::SmtpClientRequestDone(TObject *Sender, TSmtpRequest RqType, System::Word ErrorCode)
{
    if (!Client) {
        // The client is gone: abort everything.
        FSmtpClient->Abort();
        Finish();
        return;
    }
    // The page is answered only once: the Quit that follows an answer still reports here (Delphi answers again).
    if (FAnswered)
        return;

    FAbortTimer->Enabled = false;
    try {
        if (RqType == smtpOpen) {
            if (ErrorCode == 0) {
                Display("Connected to SMTP Server: " + FSmtpClient->Host);
                FSmtpClient->Mail();   // headers, then data
                FAbortTimer->Enabled = true;
                return;
            }
            errorMsg = "Failed to Send Email Form, SMTP Server: " + FSmtpClient->Host +
                       ", Open Error - " + FSmtpClient->ErrorMessage;
            Display(errorMsg);

            // Try the next server, if any.
            FCurSmtpServer++;
            if (FCurSmtpServer < SmtpServerCount) {
                Display("Trying Alternate SMTP Server");
                FSmtpClient->Host = SmtpServerList[FCurSmtpServer];
                FSmtpClient->Open();
                FAbortTimer->Enabled = true;
                return;
            }
            FSmtpClient->Quit();
            if (FAnswered)
                return;   // Quit reported (and answered) before returning
        }
        else if (RqType == smtpQuit)
            errorMsg = "Quit Send Email Form - " + FSmtpClient->ErrorMessage;
        else if (RqType == smtpMail) {
            if (ErrorCode == 0) {
                Display("Sent Email Form OK");
                AnswerMailer("maildone.html");
                FSmtpClient->Quit();   // Delphi quits before answering; then the Quit could answer first
                return;
            }
            errorMsg = "Failed to Send Email Form, Mail Error - " + FSmtpClient->ErrorMessage;
            FSmtpClient->Quit();
            if (FAnswered)
                return;
        }
        else {
            FSmtpClient->Quit();
            if (FAnswered)
                return;
            errorMsg = "Unexpected Email Form Request Done: " + IntToStr(static_cast<int>(RqType));
        }
    }
    catch (Exception &E) {
        errorMsg = "!! Error Sending Email - " + IcsGetExceptMess(&E) + " - " + FSmtpClient->ErrorMessage;
    }
    Display(errorMsg);
    AnswerMailer("mailer.html");
}

void __fastcall TUrlHandlerMailer::SmtpClientDisplay(TObject *Sender, String Msg)
{
    Display("Smtp:" + Msg);
}

/* ---- Login pages ---- */

void __fastcall TUrlHandlerLoginFormHtml::Execute()
{
    TAppSrvSessionData *MySessionData;
    String Headers;
    if (!ValidateSession()) {
        // The session takes ownership of its data.
        MySessionData = new TAppSrvSessionData(nullptr);
        MySessionData->AssignName();
        Headers = NO_CACHE + CreateSession("", 0, MySessionData);
    }
    else {
        MySessionData = SessionData();
        Headers = NO_CACHE;
    }

    MySessionData->LastRequest = Now();
    MySessionData->RequestCount = MySessionData->RequestCount + 1;
    MySessionData->LoginChallenge = StrMD5(IntToHex(static_cast<int>(GetTickCount()), 8));
    AnswerPage("", Headers, "LoginForm.html", NoUserData,
               ARRAYOFCONST((L"Challenge", MySessionData->LoginChallenge,
                             L"DoLoginSecure", UrlDoLoginSecure,
                             L"COUNTER", UrlCounter)));
    Finish();
}

void __fastcall TUrlHandlerDoLoginSecureHtml::Execute()
{
    if (NotLogged())
        return;

    const String Challenge = SessionData()->LoginChallenge;
    String PasswordHash, UserCode;
    ExtractURLEncodedValue(Params, "PasswordHash", PasswordHash);
    ExtractURLEncodedValue(Params, "UserCode", UserCode);
    // This demo uses a hardcoded password. A real application would look up the user
    // code, password and permissions in a database.
    const String Password = "admin";

    if (UserCode.IsEmpty() ||
        !SameText(PasswordHash, StrMD5(Challenge + Trim(UpperCase(Password))))) {
        WebAppSrvDataModule->CounterIncrement("LoginInvalid");
        DeleteSession();
        NotLogged();
        return;
    }

    WebAppSrvDataModule->CounterIncrement("LoginOK");
    SessionData()->LogonTime = Now();
    SessionData()->UserCode = UserCode;
    Relocate(UrlHomePage);
    Finish();
}

void __fastcall TUrlHandlerJavascriptErrorHtml::Execute()
{
    AnswerPage("", "", "JavascriptError.html", NoUserData,
               ARRAYOFCONST((L"COUNTER", UrlCounter)));
    Finish();
}

void __fastcall TUrlHandlerDefaultDoc::Execute()
{
    if (NotLogged())
        return;
    Relocate(UrlHomePage);
    Finish();   // Delphi never finishes this handler, so each request leaves it alive
}

void __fastcall TUrlHandlerHomePageHtml::Execute()
{
    if (NotLogged())
        return;
    AnswerPage("", NO_CACHE, "HomePage.html", NoUserData,
               ARRAYOFCONST((L"LOGIN", UrlLogin,
                             L"COUNTER", UrlCounter,
                             L"CONFIG", UrlConfigForm,
                             L"COUNTERVIEW", UrlCounterViewHtml,
                             L"USERCODE", SessionData()->UserCode,
                             L"LOGINTIME", DateToStr(SessionData()->LogonTime))));
    Finish();
}

void __fastcall TUrlHandlerHelloWorld::Execute()
{
    AnswerString("", "", "", "<HTML><BODY>Hello World !</BODY></HTML>");
    Finish();
}

/* ---- /HeadForm.html: sends a HEAD request to a URL once a sum is answered ---- */

namespace {
const wchar_t *const sDefaultUrl         = L"http://ipv6.google.com";
const wchar_t *const sDoCalc             = L"Please try to calculate the correct value";
const wchar_t *const sHeadUrl            = L"HeadUrl";
const wchar_t *const sEquals             = L"Equals";
const wchar_t *const sResponse           = L"Response";
const wchar_t *const sAnswerThisQuestion = L"Please answer this question: <br>";

// Calls the handler's Finish when the scope ends, however it ends (Delphi: try/finally),
// unless Release was called because an async request will finish it later.
class TFinishOnExit
{
public:
    explicit TFinishOnExit(TUrlHandler *Handler) : FHandler(Handler) {}
    ~TFinishOnExit() { if (FHandler) FHandler->Finish(); }
    void Release() { FHandler = nullptr; }
    TFinishOnExit(const TFinishOnExit &) = delete;
    TFinishOnExit &operator=(const TFinishOnExit &) = delete;
private:
    TUrlHandler *FHandler;
};
}

// Url is HTML-encoded here; Response is HTML already, its user and server text encoded by the callers.
// Delphi puts the URL and the received headers into the page raw.
void TUrlHandlerHead::AnswerHeadForm(const String &Url, const String &Response)
{
    AnswerPage("", NO_CACHE, UrlHeadForm, NoUserData,
               ARRAYOFCONST((sHeadUrl, TextToHtmlText(Url), sEquals, GenerateMath(), sResponse, Response)));
}

void __fastcall TUrlHandlerHead::HeadRequestDone(TObject *Sender, THttpRequest RqType, System::Word ErrCode)
{
    TFinishOnExit FinishGuard(this);
    if (FCli->RcvdHeader->Count > 0) {
        if (!FAllHdrs)
            FResponse += TextToHtmlText(FCli->RcvdHeader->Strings[0]);
        else {
            for (int I = 0; I < FCli->RcvdHeader->Count; I++)
                FResponse += TextToHtmlText(FCli->RcvdHeader->Strings[I]) + "<br>\r\n";
        }
    }
    else if (ErrCode != 0)
        FResponse += "error #" + IntToStr(ErrCode);
    else
        FResponse += "Unknown error";
    AnswerHeadForm(sDefaultUrl, FResponse);
}

void __fastcall TUrlHandlerHead::HeadRequestTimeout(TObject *Sender, TTimeoutReason Reason)
{
    TFinishOnExit FinishGuard(this);
    FCli->OnRequestDone = nullptr;
    FCli->Abort();
    FResponse += " Request timeout";
    AnswerHeadForm(sDefaultUrl, FResponse);
}

void __fastcall TUrlHandlerHead::Execute()
{
    if (NotLogged())   // also finishes this handler
        return;
    TFinishOnExit FinishGuard(this);
    String Equals, S;
    FResponse = "";
    ExtractURLEncodedValue(Params, sHeadUrl, FUrl);
    ExtractURLEncodedValue(Params, sEquals, Equals);
    ExtractURLEncodedValue(Params, "Submit", S);
    const bool ButtonPressed = !S.IsEmpty();
    ExtractURLEncodedValue(Params, "AllHeaders", S);
    FAllHdrs = !S.IsEmpty();
    if (FUrl.IsEmpty())
        FUrl = sDefaultUrl;
    if (SessionData()->TempVar >= 0 && ButtonPressed && !Equals.IsEmpty()) {
        if (!VerifyMath(Equals))
            AnswerHeadForm(FUrl, sDoCalc);
        else {
            try {
                FCli.reset(new TSslHttpRest(nullptr));   // Delphi: Create(Self)
                FResponse = "Response from \"" + TextToHtmlText(FUrl) + "\":<br>";
                FCli->SocketFamily = sfAnyIPv4;          // IPv6 and IPv4, prefer IPv4
                FCli->RequestVer = "1.1";
                FCli->CtrlSocket->TimeoutConnect = 5 * 1000;
                FCli->CtrlSocket->TimeoutIdle = 10 * 1000;
                FCli->CtrlSocket->OnTimeout = HeadRequestTimeout;
                FCli->OnRequestDone = HeadRequestDone;
                if (FCli->RestRequest(httpHEAD, FUrl, true, "") >= 0) {
                    FinishGuard.Release();   // the request events finish this handler
                    return;
                }
                // -1: the request never started (e.g. a non-HTTP URL), so no event will come; Delphi never answers.
                FResponse += " Request not started: " + TextToHtmlText(FCli->ReasonPhrase);
            }
            catch (Exception &) {
                FResponse += " Internal server error";
            }
            AnswerHeadForm(sDefaultUrl, FResponse);
        }
    }
    else {
        if (ButtonPressed && Equals.IsEmpty())
            FResponse = sDoCalc;
        AnswerHeadForm(FUrl, FResponse);
    }
}

String TUrlHandlerHead::GenerateMath()
{
    TAppSrvSessionData *Session = SessionData();
    if (!Session)
        return "";
    const int N1 = Random(10);
    const int N2 = Random(10);
    if (Random(2) == 0) {
        Session->TempVar = N1 + N2;
        return String(sAnswerThisQuestion) + IntToStr(N1) + " + " + IntToStr(N2) + " equals ?";
    }
    const int Hi = std::max(N1, N2);
    const int Lo = std::min(N1, N2);
    Session->TempVar = Hi - Lo;
    return String(sAnswerThisQuestion) + IntToStr(Hi) + " - " + IntToStr(Lo) + " equals ?";
}

bool TUrlHandlerHead::VerifyMath(const String &S)
{
    return SessionData() && StrToIntDef(S, 0) == SessionData()->TempVar;
}

/* ---- /CounterView.html and its Ajax counter fetch ---- */

void __fastcall TUrlHandlerCounterViewHtml::Execute()
{
    if (NotLogged())
        return;

    std::unique_ptr<TStringList> Names(new TStringList());
    ExtractURLEncodedParamList(Params, Names.get());

    std::unique_ptr<TArrayOfConstBuilder> Tags(new TArrayOfConstBuilder());
    Tags->Add("LOGIN", UrlLogin);
    Tags->Add("COUNTER", UrlCounter);
    Tags->Add("USERCODE", SessionData()->UserCode);
    Tags->Add("LOGINTIME", DateToStr(SessionData()->LogonTime));
    for (int I = 0; I < Names->Count; I++) {
        String CounterName;
        ExtractURLEncodedValue(Params, Names->Strings[I], CounterName);
        FCountersSelected->Add(CounterName);
        Tags->Add("CounterValue" + IntToStr(I + 1), WebAppSrvDataModule->CounterValue(CounterName, 0));
    }

    ArrayOfTVarRec TagArray = Tags->Value;   // holds a reference to the builder's array
    OnGetRowData = GetRowData;
    AnswerPage("", NO_CACHE, "/CounterView.html", NoUserData, &TagArray[0], TagArray.High);
    OnGetRowData = nullptr;
    Finish();
}

// Fills the two counter drop-downs (tables 1 and 2): row 1 is "Please select", then
// one row per counter in Counters.ini.
void __fastcall TUrlHandlerCounterViewHtml::GetRowData(TObject *Sender, const String TableName, int Row,
                                                      TStringIndex *TagData, bool &More, TObject *UserData)
{
    const int NoTable = StrToIntDef(TableName, 0);
    if (Row == 1) {
        std::unique_ptr<TIcsIniFile> IniFile(new TIcsIniFile(WebAppSrvDataModule->CounterFileName(), true));
        FCounters->Clear();
        IniFile->ReadSection(CounterSection, FCounters.get());
        FCounters->Sort();
        TagData->Add("CounterItem", PleaseSelect);
        if (FCountersSelected->Count == 0)
            TagData->Add("CounterSelected", "SELECTED");
        More = true;
        return;
    }

    More = Row <= FCounters->Count + 1;   // counter N is row N + 1 (Delphi stops one short and drops the last)
    if (More) {
        TagData->Add("CounterItem", FCounters->Strings[Row - 2]);
        if (NoTable >= 1 && NoTable <= FCountersSelected->Count &&   // NoTable >= 1: a non-numeric table name is no index
            SameText(FCountersSelected->Strings[NoTable - 1], FCounters->Strings[Row - 2]))
            TagData->Add("CounterSelected", "SELECTED");
    }
}

void __fastcall TUrlHandlerAjaxFetchCounter::Execute()
{
    if (!ValidateSession()) {
        AnswerString("500", "text/plain", NO_CACHE, "Invalid login");
        Finish();
        return;   // Delphi carries on and answers a second time
    }

    String CounterName;
    ExtractURLEncodedValue(Params, "counter", CounterName);
    CounterName = Trim(CounterName);
    const int CounterValue = (CounterName == PleaseSelect || CounterName.IsEmpty())
        ? 0 : WebAppSrvDataModule->CounterValue(CounterName, 0);
    AnswerString("", "text/plain", NO_CACHE, IntToStr(CounterValue));
    Finish();
}

/* ---- /Counter.jpg: a hit counter drawn as a JPEG image ---- */

void __fastcall TUrlHandlerCounterJpg::Execute()
{
    String CounterRef;
    ExtractURLEncodedValue(Params, "Ref", CounterRef);
    if (CounterRef.IsEmpty())
        CounterRef = "Counter";
    // Delphi writes any name as an INI key, so a CR/LF in it can inject lines into Counters.ini.
    if (!IsValidCounterName(CounterRef)) {
        AnswerString("400", "text/plain", NO_CACHE, "Invalid counter name");
        Finish();
        return;
    }
    // Separate counter for access without a login.
    if (!ValidateSession())
        CounterRef = "NotLogged_" + CounterRef;

    const String CounterString = IntToStr(WebAppSrvDataModule->CounterIncrement(CounterRef));

    delete DocStream;
    DocStream = new TMemoryStream();   // the connection owns and frees the document stream
    std::unique_ptr<TJPEGImage> JpegImg(new TJPEGImage());
    std::unique_ptr<Vcl::Graphics::TBitmap> BitMapImg(new Vcl::Graphics::TBitmap());
    BitMapImg->Width = 64;
    BitMapImg->Height = 32;
    TCanvas *Canvas = BitMapImg->Canvas;
    Canvas->Pen->Color = clBlack;
    Canvas->Brush->Color = clGray;
    Canvas->RoundRect(0, 0, BitMapImg->Width - 1, BitMapImg->Height - 1, 16, 16);
    Canvas->Font->Name = "arial";
    Canvas->Font->Size = 14;
    Canvas->Font->Color = clWhite;
    Canvas->TextOut((BitMapImg->Width - Canvas->TextWidth(CounterString)) / 2 - 1,
                    (BitMapImg->Height - Canvas->TextHeight(CounterString)) / 2 - 1,
                    CounterString);
    JpegImg->Assign(BitMapImg.get());
    JpegImg->SaveToStream(DocStream);
    AnswerStream("", "image/jpeg", NO_CACHE);
    Finish();
}

/* ---- Configuration: form, posted changes with a logo upload, confirmation ---- */

void __fastcall TUrlHandlerConfigFormHtml::Execute()
{
    if (NotLogged())
        return;
    AnswerPage("", NO_CACHE, "Config.html", NoUserData,
               ARRAYOFCONST((L"LOGIN", UrlLogin,
                             L"COUNTER", UrlCounter,
                             L"USERCODE", SessionData()->UserCode,
                             L"DOCONFIG", UrlDoConfigHtml,
                             L"PORT", WebAppSrvDataModule->Port,
                             L"LOGINTIME", DateToStr(SessionData()->LogonTime))));
    Finish();
}

void __fastcall TUrlHandlerDoConfigHtml::Execute()
{
    if (NotLogged())
        return;
    String ErrMsg;
    TAppSrvSessionData *Session = SessionData();
    Session->ConfigPort = "";
    Session->ConfigTempDir = "";

    std::unique_ptr<TMemoryStream> Stream(new TMemoryStream());
    Stream->WriteBuffer(Client->PostedData, Client->PostedDataLen);
    Stream->Seek(static_cast<__int64>(0), soBeginning);
    std::unique_ptr<TFormDataAnalyser> Decoder(new TFormDataAnalyser(nullptr));
    Decoder->DecodeStream(Stream.get());

    // Missing form parts are treated as empty (Delphi dereferences the nil part).
    if (!SameText(Decoder->PartData(String("submit")), "Save"))
        ErrMsg = "canceled";
    else {
        // Port: a minimal check. A port is a positive 16 bit decimal number or a well
        // known service name such as "http".
        TFormDataItem *Field = Decoder->Part("port");
        if (Field && Field->DataLength > 0 && Field->DataLength < 100) {
            // Delphi checks only the length, so a CR/LF inside the value can inject lines into the INI file.
            const String Port = Trim(Field->AsString());
            if (IsIniValueSafe(Port))
                Session->ConfigPort = Port;
            else
                ErrMsg = "Invalid port";
        }

        // Logo image file: a minimal validity check.
        Field = Decoder->Part("logo");
        const String FileName = Field ? ExtractFileName(Field->ContentFileName()) : String();
        Session->ConfigHasLogo = !FileName.IsEmpty();
        if (Session->ConfigHasLogo) {
            const String FileExt = ExtractFileExt(FileName);
            if (!SameText(FileExt, ".png") ||
                !(SameText(Field->ContentType(), "image/png") || SameText(Field->ContentType(), "image/x-png")))
                ErrMsg = "Only PNG file accepted for logo";
            else if (Field->DataLength > 50 * 1024)
                ErrMsg = "Logo image file must be < 50KB";
            // The user code becomes a folder name, so "..\" or a path would escape the data folder.
            else if (!IsPlainFileName(Session->UserCode))
                ErrMsg = "User code cannot be used as a folder name";
            else {
                // A temporary directory; the server deletes it once the time in its name has passed.
                Session->ConfigTempDir = String(PathDelim) +
                    FormatDateTime("YYYYMMDDHHNNSSZZZ", Now() + EncodeTime(0, 15, 0, 0));
                const String TempDir = Session->ConfigTempDir + PathDelim + Session->UserCode;
                ForceDirectories(WebAppSrvDataModule->DataDir() + TempDir);
                // Never use the original file name.
                Field->SaveToFile(WebAppSrvDataModule->DataDir() + TempDir + PathDelim + "Logo.png");
            }
        }
    }

    if (!ErrMsg.IsEmpty())
        AnswerString("", "", "", "<html><body><a href=\"" + String(UrlConfigForm) + "\">" +
                                 ErrMsg + "</a></body></html>");
    else
        AnswerPage("", NO_CACHE, "ConfigConfirm.html", NoUserData,
                   ARRAYOFCONST((L"PORT", Session->ConfigPort, L"LOGO", L"ConfigLogo.png",
                                 L"ACTION", UrlDoConfigConfirmSaveHtml)));
    Finish();
}

void __fastcall TUrlHandlerConfigLogoPng::Execute()
{
    if (NotLogged())
        return;
    TAppSrvSessionData *Session = SessionData();
    // The user code is checked again here and at confirm, because sessions are restored from Sessions.dat.
    const String FileName = (Session->ConfigHasLogo && IsPlainFileName(Session->UserCode))
        ? WebAppSrvDataModule->DataDir() + Session->ConfigTempDir + PathDelim + Session->UserCode + PathDelim + "Logo.png"
        : WebAppSrvDataModule->ImagesDir + PathDelim + "Logo.png";

    delete DocStream;
    DocStream = new TFileStream(FileName, fmOpenRead);
    AnswerStream("", "image/png", NO_CACHE);
    Finish();
}

void __fastcall TUrlHandlerDoConfigConfirmSaveHtml::Execute()
{
    if (NotLogged())
        return;
    TAppSrvSessionData *Session = SessionData();
    String Submit;
    ExtractURLEncodedValue(Params, "submit", Submit);
    if (SameText(Submit, "OK")) {
        // A new configuration has been confirmed.
        if (!Session->ConfigPort.IsEmpty() && IsIniValueSafe(Session->ConfigPort)) {
            WebAppSrvDataModule->Port = Session->ConfigPort;
            WebAppSrvDataModule->SaveConfig();
        }
        if (Session->ConfigHasLogo && IsPlainFileName(Session->UserCode)) {
            const String FileName = WebAppSrvDataModule->DataDir() + Session->ConfigTempDir +
                                    PathDelim + Session->UserCode + PathDelim + "Logo.png";
            if (!Session->ConfigTempDir.IsEmpty() && FileExists(FileName)) {
                // Replace the existing logo image with the new one.
                const String Logo = WebAppSrvDataModule->ImagesDir + PathDelim + "Logo.png";
                // One call replaces the logo, so a failure keeps the old one (Delphi deletes it before
                // the rename, so a failed rename leaves none).
                if (MoveFileEx(FileName.c_str(), Logo.c_str(), MOVEFILE_REPLACE_EXISTING | MOVEFILE_COPY_ALLOWED))
                    ForceRemoveDir(WebAppSrvDataModule->DataDir() + Session->ConfigTempDir);
                else
                    Display("Failed to replace logo - " + SysErrorMessage(GetLastError()));
            }
        }
    }
    Relocate("/");
    Finish();
}

// The sessions file names its session data class, so it must be registered before the
// file is loaded (Delphi: RegisterClass in this unit's initialization section).
void RegisterWebAppClasses()
{
    RegisterClass(__classid(TAppSrvSessionData));
}