-- smtp.lua -- sending mail, as a script.
--
-- The same shape as examples/httpd.lua and for the same reason: the systems primitives are in C
-- (tcp*, tcpStartTls, crypto*) and the protocol lives here, where it can be read and patched. It
-- needs an engine with binary-safe strings.
--
--     local smtp = load(fsRead("examples/smtp.lua"))()
--     smtp.send({
--         host = "smtp.example.com", port = 587, tls = "starttls",
--         user = "apikey", password = "...",
--         from = "Singe <no-reply@example.com>",
--         to   = "player@example.com",              -- or a list of addresses
--         subject = "Verify your account",
--         text = "Open this link ...",
--     })
--
-- Returns true, or nil plus a message. Nothing here retries: a caller that must not lose a message
-- keeps it in a queue and calls again, because "did it send" is a question only the caller's own
-- durable state can answer.

local smtp = {}

local CRLF        = "\r\n"
local LINE_MAX    = 998          -- RFC 5322's limit, excluding the CRLF
local B64_WRAP    = 76           -- RFC 2045's limit for base64 body lines
local RECV_CHUNK  = 4096
local REPLY_MAX   = 65536        -- a server that will not finish a reply is not a server


-- Every address and header value the caller supplies is checked for CR and LF before it goes near
-- the wire. Without this, a display name or an address out of a database could carry "\r\nBcc: ..."
-- and add headers, or "\r\n.\r\n" and end the message early. This is the single most important
-- function in the file.
local function guard(what, value)
    value = tostring(value or "")
    if value:find("[\r\n]") then
        return nil, what .. " must not contain a line break"
    end
    return value
end


-- The address inside "Display Name <box@example.com>", or the whole string when it is bare. The
-- envelope wants only the address; the header keeps whatever the caller wrote.
local function addressOf(value)
    local inner = value:match("<([^>]*)>")
    return inner or value
end


local function isAscii(value)
    return not value:find("[\128-\255]")
end


-- A header value that is not plain ASCII becomes an RFC 2047 encoded word, so a subject with an
-- accent or an emoji survives instead of arriving as mojibake.
local function encodeHeader(value)
    if isAscii(value) then
        return value
    end
    return "=?UTF-8?B?" .. cryptoBase64Encode(value) .. "?="
end


-- Days since the epoch to a civil date (Howard Hinnant's algorithm, shifted so the era starts in
-- March and leap day lands at the end of it).
local function civilFromDays(days)
    local z   = days + 719468
    local era = math.floor(z / 146097)
    local doe = z - era * 146097
    local yoe = math.floor((doe - math.floor(doe / 1460) + math.floor(doe / 36524) - math.floor(doe / 146096)) / 365)
    local y   = yoe + era * 400
    local doy = doe - (365 * yoe + math.floor(yoe / 4) - math.floor(yoe / 100))
    local mp  = math.floor((5 * doy + 2) / 153)
    local d   = doy - math.floor((153 * mp + 2) / 5) + 1
    local m   = mp + (mp < 10 and 3 or -9)
    if m <= 2 then
        y = y + 1
    end
    return y, m, d
end


-- An RFC 5322 date in UTC. The zone is written "-0000" rather than "+0000" because that is the
-- form meaning "UTC, and the sender's own zone is not being disclosed", which is the truth here.
local function rfc5322Date(epoch)
    local DAY_NAMES   = { "Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed" }   -- epoch day 0 was a Thursday
    local MONTH_NAMES = { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
    local seconds     = math.floor(epoch)
    local days        = math.floor(seconds / 86400)
    local rest        = seconds - days * 86400
    local year, month, day = civilFromDays(days)

    return string.format("%s, %02d %s %04d %02d:%02d:%02d -0000",
        DAY_NAMES[(days % 7) + 1], day, MONTH_NAMES[month], year,
        math.floor(rest / 3600), math.floor((rest % 3600) / 60), rest % 60)
end


-- A reader over one connection. tcpRecv hands back whatever has arrived, which is not the same
-- shape as a line, so what is left over is kept for the next call.
local function reader(conn)
    return { conn = conn, buffer = "" }
end


local function readLine(r)
    while true do
        local at = r.buffer:find(CRLF, 1, true)
        if at then
            local line = r.buffer:sub(1, at - 1)
            r.buffer = r.buffer:sub(at + 2)
            return line
        end
        if #r.buffer > REPLY_MAX then
            return nil, "the server sent an unreasonably long reply"
        end
        local chunk = tcpRecv(r.conn, RECV_CHUNK)
        if not chunk or #chunk == 0 then
            return nil, "the server closed the connection"
        end
        r.buffer = r.buffer .. chunk
    end
end


-- An SMTP reply is one or more lines; every line but the last has a hyphen after its code
-- ("250-STARTTLS" then "250 HELP"). Returns the code and the joined text.
local function readReply(r)
    local lines = {}
    while true do
        local line, err = readLine(r)
        if not line then
            return nil, err
        end
        local code, sep, text = line:match("^(%d%d%d)([ -]?)(.*)$")
        if not code then
            return nil, "malformed reply: " .. line
        end
        lines[#lines + 1] = text
        if sep ~= "-" then
            return tonumber(code), table.concat(lines, "\n")
        end
    end
end


local function say(conn, text)
    return tcpSend(conn, text .. CRLF)
end


-- Send a command and require one of the expected codes, so every step fails at the step that
-- actually went wrong rather than three steps later.
local function expect(conn, r, command, ok, what)
    if command then
        say(conn, command)
    end
    local code, text = readReply(r)
    if not code then
        return nil, what .. ": " .. tostring(text)
    end
    for _, wanted in ipairs(ok) do
        if code == wanted then
            return code, text
        end
    end
    return nil, string.format("%s: server said %d %s", what, code, (text or ""):gsub("\n.*", ""))
end


local function wrapBase64(text)
    local out = {}
    for i = 1, #text, B64_WRAP do
        out[#out + 1] = text:sub(i, i + B64_WRAP - 1)
    end
    return table.concat(out, CRLF)
end


-- The message itself. The body is always base64: it makes the message binary-safe and 8-bit clean,
-- and it cannot produce a line starting with "." or one longer than the limit, so neither
-- dot-stuffing nor folding has to be got right separately.
local function buildMessage(opts, recipients)
    local headers = {}
    local body    = tostring(opts.text or "")

    headers[#headers + 1] = "From: " .. encodeHeader(opts.from)
    headers[#headers + 1] = "To: " .. encodeHeader(table.concat(recipients, ", "))
    headers[#headers + 1] = "Subject: " .. encodeHeader(opts.subject or "")
    headers[#headers + 1] = "Date: " .. rfc5322Date(timeNow())
    headers[#headers + 1] = "Message-ID: <" .. cryptoUuid() .. "@" .. (opts.messageIdDomain or addressOf(opts.from):match("@(.+)") or "localhost") .. ">"
    headers[#headers + 1] = "MIME-Version: 1.0"
    headers[#headers + 1] = "Content-Type: text/plain; charset=utf-8"
    headers[#headers + 1] = "Content-Transfer-Encoding: base64"
    for _, extra in ipairs(opts.headers or {}) do
        headers[#headers + 1] = extra
    end
    return table.concat(headers, CRLF) .. CRLF .. CRLF .. wrapBase64(cryptoBase64Encode(body))
end


local function authenticate(conn, r, opts, extensions)
    if not opts.user then
        return true
    end
    local mechanisms = extensions:match("AUTH ([^\n]*)") or ""
    if mechanisms:find("PLAIN") then
        local token = cryptoBase64Encode("\0" .. opts.user .. "\0" .. opts.password)
        return expect(conn, r, "AUTH PLAIN " .. token, { 235 }, "authentication")
    end
    if mechanisms:find("LOGIN") then
        local ok, err = expect(conn, r, "AUTH LOGIN", { 334 }, "authentication")
        if not ok then
            return nil, err
        end
        ok, err = expect(conn, r, cryptoBase64Encode(opts.user), { 334 }, "authentication (user)")
        if not ok then
            return nil, err
        end
        return expect(conn, r, cryptoBase64Encode(opts.password), { 235 }, "authentication (password)")
    end
    return nil, "the relay offers no authentication mechanism this understands (saw: " .. mechanisms .. ")"
end


-- Send one message. opts.tls is "starttls" (default), "implicit", or "none"; "none" also needs
-- allowPlain, because sending a password or a recovery link over a plain connection should take
-- more than a typo.
function smtp.send(opts)
    local mode       = opts.tls or "starttls"
    local port       = opts.port or (mode == "implicit" and 465 or 587)
    local ehloName   = opts.ehlo or "localhost"
    local recipients = type(opts.to) == "table" and opts.to or { opts.to }
    local envelope   = {}

    if mode == "none" and not opts.allowPlain then
        return nil, "refusing to send over a plain connection: set tls, or allowPlain if the relay is reached some other safe way"
    end
    for _, field in ipairs({ "host", "from", "subject" }) do
        local value, err = guard(field, opts[field])
        if not value then
            return nil, err
        end
    end
    for index, address in ipairs(recipients) do
        local value, err = guard("recipient", address)
        if not value then
            return nil, err
        end
        recipients[index] = value
        envelope[index]   = addressOf(value)
    end
    if #recipients == 0 then
        return nil, "no recipient"
    end

    local conn = tcpConnect(opts.host, port)
    if not conn then
        return nil, "could not reach " .. opts.host .. ":" .. port
    end

    local function fail(message)
        tcpClose(conn)
        return nil, message
    end

    -- An implicit-TLS relay expects the handshake before it says anything at all.
    if mode == "implicit" then
        local ok, err = pcall(tcpStartTls, conn, opts.host, { insecure = opts.insecure })
        if not ok then
            return fail("TLS: " .. tostring(err))
        end
    end

    local r = reader(conn)
    local code, text = expect(conn, r, nil, { 220 }, "greeting")
    if not code then
        return fail(text)
    end
    code, text = expect(conn, r, "EHLO " .. ehloName, { 250 }, "EHLO")
    if not code then
        return fail(text)
    end

    if mode == "starttls" then
        if not text:find("STARTTLS") then
            return fail("the relay does not offer STARTTLS, and downgrading is not on offer here")
        end
        code, text = expect(conn, r, "STARTTLS", { 220 }, "STARTTLS")
        if not code then
            return fail(text)
        end
        local ok, err = pcall(tcpStartTls, conn, opts.host, { insecure = opts.insecure })
        if not ok then
            return fail("TLS: " .. tostring(err))
        end
        -- The extension list from before the upgrade is not to be trusted, and AUTH is usually only
        -- advertised afterwards, so EHLO is asked again over the protected connection.
        code, text = expect(conn, r, "EHLO " .. ehloName, { 250 }, "EHLO after STARTTLS")
        if not code then
            return fail(text)
        end
    end

    if opts.user and mode == "none" then
        return fail("refusing to send credentials over a plain connection")
    end
    local authed, authErr = authenticate(conn, r, opts, text)
    if not authed then
        return fail(authErr)
    end

    code, text = expect(conn, r, "MAIL FROM:<" .. addressOf(opts.from) .. ">", { 250 }, "MAIL FROM")
    if not code then
        return fail(text)
    end
    for _, address in ipairs(envelope) do
        code, text = expect(conn, r, "RCPT TO:<" .. address .. ">", { 250, 251 }, "RCPT TO " .. address)
        if not code then
            return fail(text)
        end
    end
    code, text = expect(conn, r, "DATA", { 354 }, "DATA")
    if not code then
        return fail(text)
    end
    tcpSend(conn, buildMessage(opts, recipients) .. CRLF .. "." .. CRLF)
    code, text = expect(conn, r, nil, { 250 }, "message body")
    if not code then
        return fail(text)
    end
    say(conn, "QUIT")
    tcpClose(conn)
    return true
end


-- Exposed for testing:  the pieces above are pure functions of their arguments and are worth
-- checking without a relay in the loop.
smtp.internal = {
    addressOf    = addressOf,
    encodeHeader = encodeHeader,
    guard        = guard,
    rfc5322Date  = rfc5322Date,
    buildMessage = buildMessage,
}

return smtp