smtp.bend source
smtp.bend on the hub · documented module
# SMTP client (RFC 5321), with STARTTLS (RFC 3207), implicit TLS (RFC# 8314), SIZE (RFC 1870), SMTPUTF8 (RFC 6531) and AUTH PLAIN, LOGIN,# CRAM-MD5, XOAUTH2 and OAUTHBEARER (RFC 4954, 4616, 2195, 7628). One# connection, then one transaction per message:## S: 220 greeting (implicit TLS: after the handshake)# C: EHLO name S: 250 (a 5xx: HELO name, no extensions)# C: STARTTLS S: 220 (STARTTLS mode; then the handshake# and EHLO again, RFC 3207 4.2)# C: AUTH ... S: 235 (with a user; only under TLS)# C: MAIL FROM:<from> S: 250# C: RCPT TO:<to> S: 250 (once per To, Cc and Bcc address; a# refused one is reported, not fatal)# C: DATA S: 354# C: the message, then "." S: 250# (MAIL again for the next message; RSET first if one stopped midway)# C: QUIT S: 221## A refusal before the first MAIL ends the talk with QUIT; one inside a# message ends that message only. This file is the IO: it threads the# socket and the read buffer through continuations. What to say, and# what a reply means, is in core.bend (the message, the options, the# commands, the plan), which is pure and is what the laws are about.## import ./core.bend as C# import ./smtp.bend as S# S.Smtp.send_mail(C.Opts.login(C.Opts.new("smtp.example.com"), user, pass),# C.Mail.new("Me <me@example.com>", "Ana <ana@x.com>", "Hi", "text"))import Baseimport ./text.bend as Timport ./reply.bend as Rimport ./mime.bend as Mimport ./net.bend as Nimport ./idna.bend as Iimport ./addr.bend as Aimport ./md5.bend as Dimport ./dkim.bend as Qimport ./core.bend as C# The connection is broken: close it and report.def Smtp.drop(s: Socket, code: U32, msg: String) -> IO(C.Out()): do IO<C.Out()>: N.Net.close(s) IO.pure(C.Out(), C.Smtp.fail(code, msg))def Smtp.bye.got(m: Socket & Result<&1, &1, U32 & String, Maybe<&1, String>>, r: C.Out()) -> IO(C.Out()): (s, _) = m do IO<C.Out()>: N.Net.close(s) IO.pure(C.Out(), r)def Smtp.bye.sent(m: Socket & Result<&1, &1, U32 & String, Unit>, r: C.Out()) -> IO(C.Out()): (s, _) = m do IO<C.Out()>: p : Socket & Result<&1, &1, U32 & String, Maybe<&1, String>> <- N.Net.poll(s, 4096, 10000) Smtp.bye.got(p, r)# QUIT, a wait for the server's answer (up to 10 s), the close; then r,# whatever the server said.def Smtp.quit(s: Socket, r: C.Out()) -> IO(C.Out()): do IO<C.Out()>: m : Socket & Result<&1, &1, U32 & String, Unit> <- N.Net.send(s, "QUIT\r\n") Smtp.bye.sent(m, r)# A poll's answer: more bytes on the buffer, or the end of the talk.def Smtp.got( m: Socket & Result<&1, &1, U32 & String, Maybe<&1, String>>, buf: String, more: Socket -> String -> IO(C.Out())) -> IO(C.Out()): (s, r) = m match r: case Fail{e}: (code, msg) = e Smtp.drop(s, code, "recv: " ++ msg) case Done{None{}}: Smtp.drop(s, 0, "timed out waiting for the server") case Done{Some{SNil{}}}: Smtp.drop(s, 0, "the server closed the connection") case Done{Some{SCon{h, t}}}: more(s, buf ++ SCon{h, t})# The next reply: from the buffer if it holds one, else after a poll of# up to ms.def Smtp.read( fuel: Nat, sp: R.Split, s: Socket, +ms: U32, k: Socket -> String -> R.Reply -> IO(C.Out())) -> IO(C.Out()): match fuel sp: case _ R.Got{r, rest}: k(s, rest, r) case 0n R.More{_}: Smtp.drop(s, 0, "no complete reply") case 1n+p R.More{buf}: do IO<C.Out()>: m : Socket & Result<&1, &1, U32 & String, Maybe<&1, String>> <- N.Net.poll(s, 4096, ms) Smtp.got(m, buf, s2 => b2 => Smtp.read(p, R.Reply.split(b2), s2, ms, k))def Smtp.check(ok: Bool, r: R.Reply, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match ok: case True{}: k(s, buf) case False{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, text))# Go on if the reply's class is the one wanted, else QUIT with it.def Smtp.expect(+r: R.Reply, +want: U32, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): Smtp.check(U32.is_eq(R.Reply.class(r), want), r, s, buf, k)def Smtp.sent(m: Socket & Result<&1, &1, U32 & String, Unit>, k: Socket -> IO(C.Out())) -> IO(C.Out()): (s, r) = m match r: case Done{_}: k(s) case Fail{e}: (code, msg) = e Smtp.drop(s, code, "send: " ++ msg)def Smtp.send(s: Socket, line: String, k: Socket -> IO(C.Out())) -> IO(C.Out()): do IO<C.Out()>: m : Socket & Result<&1, &1, U32 & String, Unit> <- N.Net.send(s, line) Smtp.sent(m, k)# Send a line, read the reply (up to ms), go on if its class is `want`.def Smtp.talk(s: Socket, buf: String, line: String, want: U32, ms: U32, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): Smtp.send(s, line, s2 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s2, ms, s3 => b3 => r => Smtp.expect(r, want, s3, b3, k)))# Hello# -----def Smtp.helo.go(name: String, s: Socket, buf: String, next: C.Caps -> Socket -> String -> IO(C.Out())) -> IO(C.Out()): Smtp.talk(s, buf, C.Smtp.helo(name), 2, C.Smtp.wait(), s2 => b2 => next(C.Caps.none(), s2, b2))# HELO takes a domain, never an address literal (RFC 5321 4.1.1.1): a# literal EHLO name gives way to the host's own name.def Smtp.helo.named(literal: Bool, name: String, s: Socket, buf: String, next: C.Caps -> Socket -> String -> IO(C.Out())) -> IO(C.Out()): match literal: case True{}: do IO<C.Out()>: host : String <- N.Net.hostname() Smtp.helo.go(host, s, buf, next) case False{}: Smtp.helo.go(name, s, buf, next)def Smtp.hello.got(ok: Bool, old: Bool, r: R.Reply, s: Socket, buf: String, +name: String, next: C.Caps -> Socket -> String -> IO(C.Out())) -> IO(C.Out()): match ok old: case True{} _: R.Reply{_, text} = r next(C.Caps.of(text), s, buf) case False{} True{}: Smtp.helo.named(String.starts_with(name, "["), name, s, buf, next) case False{} False{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, "EHLO: " ++ text))def Smtp.hello.named(m: Socket & String, lmtp: Bool, buf: String, next: C.Caps -> Socket -> String -> IO(C.Out())) -> IO(C.Out()): (s, +name) = m Smtp.send(s, Bool.pick(String, lmtp, C.Smtp.lhlo(name), C.Smtp.ehlo(name)), s2 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s2, C.Smtp.wait(), s3 => b3 => +r => Smtp.hello.got(U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.class(r), 5), r, s3, b3, name, next)))def Smtp.hello.name(ask: Bool, name: String, s: Socket) -> IO(Socket & String): match ask: case True{}: N.Net.helo(s) case False{}: IO.pure(Socket & String, (s, name))# EHLO, or HELO when the server refuses EHLO with a 5xx (RFC 5321# 3.2): then there are no extensions. next gets the capabilities.def Smtp.hello(+o: C.Opts, s: Socket, buf: String, next: C.Caps -> Socket -> String -> IO(C.Out())) -> IO(C.Out()): +name = C.Opts.helo(o) do IO<C.Out()>: m : Socket & String <- Smtp.hello.name(String.is_empty(name), name, s) Smtp.hello.named(m, C.Opts.on(o, "lmtp"), buf, next)# Envelope and message# --------------------# Send a line and read its reply (up to ms), whatever it says.def Smtp.ask(s: Socket, buf: String, line: String, ms: U32, k: Socket -> String -> R.Reply -> IO(C.Out())) -> IO(C.Out()): Smtp.send(s, line, s2 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s2, ms, k))# A reply to a command: sent now, or already sent with the others.def Smtp.ask2(piped: Bool, s: Socket, buf: String, line: String, ms: U32, k: Socket -> String -> R.Reply -> IO(C.Out())) -> IO(C.Out()): match piped: case True{}: Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s, ms, k) case False{}: Smtp.ask(s, buf, line, ms, k)# A RCPT's reply: the address kept when taken; noted when refused, and# the talk goes on; a 421 (the server is closing) ends it.def Smtp.rcpt.got(ok: Bool, closing: Bool, +r: R.Reply, +a: String, s: Socket, buf: String, good: List<&2, String>, bad: List<&2, String>, k: Socket -> String -> List<&2, String> -> List<&2, String> -> IO(C.Out())) -> IO(C.Out()): match ok closing: case True{} _: k(s, buf, List.append(&2, String, good, [a]), bad) case False{} True{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, text)) case False{} False{}: k(s, buf, good, List.append(&2, String, bad, [C.Smtp.note(r, a)]))def Smtp.rcpts(to: List<&2, C.Rc>, +piped: Bool, s: Socket, buf: String, good: List<&2, String>, bad: List<&2, String>, k: Socket -> String -> List<&2, String> -> List<&2, String> -> IO(C.Out())) -> IO(C.Out()): match to: case Nil{}: k(s, buf, good, bad) case Con{rc, rest}: C.Rc{a, line} = rc Smtp.ask2(piped, s, buf, line, C.Smtp.wait(), s3 => b3 => +r => Smtp.rcpt.got( U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.code(r), 421), r, a, s3, b3, good, bad, s4 => b4 => g4 => bad4 => Smtp.rcpts(rest, piped, s4, b4, g4, bad4, k)))# A message stopped inside its transaction: RSET clears it (RFC 5321# 4.1.1.5), so the next message starts clean; then on with x.def Smtp.reset(s: Socket, buf: String, x: C.Sent, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): Smtp.talk(s, buf, "RSET\r\n", 2, C.Smtp.wait(), s2 => b2 => next(s2, b2, x))# The reply to the message itself: taken, or refused whole.def Smtp.end.got(ok: Bool, closing: Bool, r: R.Reply, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match ok closing: case True{} _: next(s, buf, C.Sent{0, "", bad}) case False{} True{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, text)) case False{} False{}: R.Reply{code, text} = r next(s, buf, C.Sent{code, text, bad})def Smtp.final.got(ok: Bool, +r: R.Reply, a: String, s: Socket, buf: String, +n: U32, bad: List<&2, String>, k: Socket -> String -> U32 -> List<&2, String> -> IO(C.Out())) -> IO(C.Out()): match ok: case True{}: k(s, buf, (n + 1 : U32), bad) case False{}: k(s, buf, n, List.append(&2, String, bad, [C.Smtp.note(r, a)]))# LMTP answers the message once per recipient taken, in RCPT's order# (RFC 2033 4.2); n counts the ones that got it.def Smtp.finals(good: List<&2, String>, s: Socket, buf: String, +n: U32, bad: List<&2, String>, k: Socket -> String -> U32 -> List<&2, String> -> IO(C.Out())) -> IO(C.Out()): match good: case Nil{}: k(s, buf, n, bad) case Con{a, rest}: Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s, C.Smtp.wait.end(), s2 => b2 => +r => Smtp.final.got(U32.is_eq(R.Reply.class(r), 2), r, a, s2, b2, n, bad, s3 => b3 => n3 => bad3 => Smtp.finals(rest, s3, b3, n3, bad3, k)))def Smtp.lmtp.end(none: Bool, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match none: case True{}: next(s, buf, C.Sent{550, "no recipient took the message", bad}) case False{}: next(s, buf, C.Sent{0, "", bad})# How the message went, once its bytes are out: one reply (SMTP), or# one per recipient (LMTP).def Smtp.outcome(lmtp: Bool, good: List<&2, String>, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match lmtp: case True{}: Smtp.finals(good, s, buf, 0, bad, s2 => b2 => +n => bad2 => Smtp.lmtp.end(U32.is_zero(n), bad2, s2, b2, next)) case False{}: Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s, C.Smtp.wait.end(), s2 => b2 => +r => Smtp.end.got(U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.code(r), 421), r, bad, s2, b2, next))# The message's bytes, then its outcome.def Smtp.put(text: String, lmtp: Bool, good: List<&2, String>, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): Smtp.send(s, text, s2 => Smtp.outcome(lmtp, good, bad, s2, buf, next))def Smtp.data.got(ok: Bool, closing: Bool, r: R.Reply, +p: C.Plan, good: List<&2, String>, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match ok closing: case True{} _: Smtp.put(C.Smtp.data(C.Plan.msg(p)), C.Plan.lmtp(p), good, bad, s, buf, next) case False{} True{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, text)) case False{} False{}: R.Reply{code, text} = r Smtp.reset(s, buf, C.Sent{code, text, bad}, next)def Smtp.undata.got(go: Bool, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match go: case True{}: Smtp.ask(s, buf, ".\r\n", C.Smtp.wait.end(), s2 => b2 => r => k(s2, b2)) case False{}: k(s, buf)# A piped DATA still to be answered, for a message that will not go: if# the server says 354 anyway, an empty message ends it (RFC 2920 3.1).def Smtp.undata(s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s, C.Smtp.wait.data(), s2 => b2 => r => Smtp.undata.got(U32.is_eq(R.Reply.class(r), 3), s2, b2, k))# The outcome of io with x kept: if the clean-up after a refused message# loses the connection, the refusal is still the message's outcome.def Smtp.kept(x: C.Sent, io: IO(C.Out())) -> IO(C.Out()): IO.bind(C.Out(), C.Out(), io, r => IO.pure(C.Out(), C.Batch.first(x, r)))# The message will not go: clear what is pending, then on with x.def Smtp.empty(pending: Bool, +x: C.Sent, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match pending: case True{}: Smtp.kept(x, Smtp.undata(s, buf, s2 => b2 => Smtp.reset(s2, b2, x, next))) case False{}: Smtp.kept(x, Smtp.reset(s, buf, x, next))# With no recipient taken there is nothing to send; else the message,# after DATA's 354 or as a BDAT chunk.def Smtp.body(none: Bool, bdat: Bool, +p: C.Plan, good: List<&2, String>, bad: List<&2, String>, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match none bdat: case True{} _: Smtp.empty(C.Plan.piped(p) && Bool.not(C.Plan.bdat(p)), C.Sent{550, "every recipient was refused", bad}, s, buf, next) case False{} True{}: Smtp.put(C.Plan.chunk(p), C.Plan.lmtp(p), good, bad, s, buf, next) case False{} False{}: Smtp.ask2(C.Plan.piped(p), s, buf, "DATA\r\n", C.Smtp.wait.data(), s2 => b2 => +r => Smtp.data.got(U32.is_eq(R.Reply.class(r), 3), U32.is_eq(R.Reply.code(r), 421), r, p, good, bad, s2, b2, next))# Replies to skip: the ones to commands piped after one that failed.def Smtp.skip(n: List<&2, C.Rc>, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match n: case Nil{}: k(s, buf) case Con{_, rest}: Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s, C.Smtp.wait(), s2 => b2 => r => Smtp.skip(rest, s2, b2, k))# MAIL was refused. Alone, that is all; piped, the RCPTs' and DATA's# replies are still to come.def Smtp.refused(piped: Bool, +p: C.Plan, +x: C.Sent, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match piped: case True{}: Smtp.kept(x, Smtp.skip(C.Plan.rcpts(p), s, buf, s2 => b2 => Smtp.empty(Bool.not(C.Plan.bdat(p)), x, s2, b2, next))) case False{}: next(s, buf, x)# MAIL's reply: on to the recipients, or the message is refused here.def Smtp.mail.got(ok: Bool, closing: Bool, r: R.Reply, +p: C.Plan, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match ok closing: case True{} _: Smtp.rcpts(C.Plan.rcpts(p), C.Plan.piped(p), s, buf, Nil{}, Nil{}, s3 => b3 => +good => bad => Smtp.body(List.is_empty(&2, String, good), C.Plan.bdat(p), p, good, bad, s3, b3, next)) case False{} True{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, text)) case False{} False{}: R.Reply{code, text} = r Smtp.refused(C.Plan.piped(p), p, C.Sent{code, text, Nil{}}, s, buf, next)def Smtp.deliver(piped: Bool, +p: C.Plan, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match piped: case True{}: Smtp.send(s, C.Plan.blob(p), s1 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s1, C.Smtp.wait(), s2 => b2 => +r => Smtp.mail.got( U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.code(r), 421), r, p, s2, b2, next))) case False{}: Smtp.ask(s, buf, C.Plan.mail(p), C.Smtp.wait(), s2 => b2 => +r => Smtp.mail.got( U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.code(r), 421), r, p, s2, b2, next))def Smtp.sized(big: Bool, +p: C.Plan, +size: U32, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match big: case True{}: next(s, buf, C.Sent{552, "the message has " ++ U32.show(C.Smtp.octets(C.Plan.msg(p))) ++ " bytes; the server takes at most " ++ U32.show(size), Nil{}}) case False{}: Smtp.deliver(C.Plan.piped(p), p, s, buf, next)def Smtp.utf8.ok(lacking: Bool, +p: C.Plan, +size: U32, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): match lacking: case True{}: next(s, buf, C.Sent{553, "a non-ASCII address needs SMTPUTF8, which the " ++ "server does not offer", Nil{}}) case False{}: Smtp.sized(Bool.not(U32.is_zero(size)) && (C.Smtp.octets(C.Plan.msg(p)) > size : U32), p, size, s, buf, next)# One message: MAIL (not even tried when SIZE says it is too big, or when# it needs SMTPUTF8 and the server lacks it), RCPT, DATA, the message.# next gets how it went; only a broken or closing connection ends here.def Smtp.one(+j: C.Job, +o: C.Opts, +c: C.Caps, s: Socket, buf: String, next: Socket -> String -> C.Sent -> IO(C.Out())) -> IO(C.Out()): C.Caps{_, _, +size, +utf8, _, _} = c Smtp.utf8.ok(C.Mail.utf8(C.Job.mail(j)) && Bool.not(utf8), C.Smtp.plan(o, c, j), size, s, buf, next)def Smtp.more(x: C.Sent, rest: IO(C.Out())) -> IO(C.Out()): IO.bind(C.Out(), C.Out(), rest, r => IO.pure(C.Out(), C.Batch.add(x, r)))# The messages, one transaction each on the same connection, then QUIT.# Each one's outcome is put in front of what the rest returns, so an# error later still reports the messages already sent.def Smtp.batch(js: List<&2, C.Job>, +o: C.Opts, +c: C.Caps, s: Socket, buf: String) -> IO(C.Out()): match js: case Nil{}: Smtp.quit(s, C.Batch{Nil{}, 0, ""}) case Con{j, rest}: Smtp.one(j, o, c, s, buf, s2 => b2 => x => Smtp.more(x, Smtp.batch(rest, o, c, s2, b2)))def Smtp.sasl.end(m: Socket & Result<&1, &1, U32 & String, Maybe<&1, String>>, +why: String) -> IO(C.Out()): (s, _) = m do IO<C.Out()>: N.Net.close(s) IO.pure(C.Out(), C.Smtp.fail(535, why))# The server's answer to the last response: 2xx goes on; a 334 is an# error in base64 (OAuth's JSON), answered with the cancel line, then# the 535; anything else is the failure itself.def Smtp.sasl.got(ok: Bool, more: Bool, +r: R.Reply, +mech: String, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match ok more: case True{} _: k(s, buf) case False{} True{}: R.Reply{_, text} = r +why = "AUTH " ++ mech ++ " refused: " ++ M.B64.ascii(M.B64.decode(text)) Smtp.send(s, C.Sasl.cancel(mech), s2 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s2, C.Smtp.wait(), s3 => b3 => r3 => Smtp.quit(s3, C.Smtp.fail(R.Reply.code(r3), why)))) case False{} False{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, "AUTH " ++ mech ++ ": " ++ text))# Send the last response and read how it went.def Smtp.sasl.last(s: Socket, buf: String, line: String, +mech: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): Smtp.send(s, line, s2 => Smtp.read(C.Smtp.fuel(), R.Reply.split(buf), s2, C.Smtp.wait(), s3 => b3 => +r => Smtp.sasl.got(U32.is_eq(R.Reply.class(r), 2), U32.is_eq(R.Reply.code(r), 334), r, mech, s3, b3, k)))def Smtp.sasl.at(fits: Bool, line: String, +mech: String, resp: String, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match fits: case True{}: Smtp.sasl.last(s, buf, line, mech, k) case False{}: Smtp.talk(s, buf, C.Cmd.line("AUTH " ++ mech), 3, C.Smtp.wait(), s2 => b2 => Smtp.sasl.last(s2, b2, C.Cmd.line(resp), mech, k))# AUTH with an initial response; past 512 octets the response follows# the server's 334 instead (RFC 4954 4, RFC 5321 4.5.3.1.4).def Smtp.sasl(+mech: String, +resp: String, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): +line = C.Cmd.line("AUTH " ++ mech ++ " " ++ resp) Smtp.sasl.at(Nat.is_le(String.length(line), 512n), line, mech, resp, s, buf, k)# CRAM-MD5's challenge, answered (RFC 2195 2).def Smtp.cram(ok: Bool, r: R.Reply, +o: C.Opts, s: Socket, buf: String, k: Socket -> String -> IO(C.Out())) -> IO(C.Out()): match ok: case True{}: Smtp.sasl.last(s, buf, C.Cmd.line(C.Smtp.cram.resp(C.Opts.user(o), C.Opts.pass(o), R.Reply.text(r))), "CRAM-MD5", k) case False{}: R.Reply{code, text} = r Smtp.quit(s, C.Smtp.fail(code, "AUTH CRAM-MD5: " ++ text))def Smtp.auth.with(mech: C.Mech, +o: C.Opts, +js: List<&2, C.Job>, +c: C.Caps, s: Socket, buf: String) -> IO(C.Out()): match mech: case C.MPlain{}: Smtp.sasl("PLAIN", C.Smtp.plain.resp(C.Opts.user(o), C.Opts.pass(o)), s, buf, s2 => b2 => Smtp.batch(js, o, c, s2, b2)) case C.MXoauth2{}: Smtp.sasl("XOAUTH2", C.Smtp.xoauth2.resp(C.Opts.user(o), C.Opts.token(o)), s, buf, s2 => b2 => Smtp.batch(js, o, c, s2, b2)) case C.MBearer{}: Smtp.sasl("OAUTHBEARER", C.Smtp.bearer.resp(C.Opts.user(o), C.Opts.host(o), C.Opts.port(o), C.Opts.token(o)), s, buf, s2 => b2 => Smtp.batch(js, o, c, s2, b2)) case C.MLogin{}: Smtp.talk(s, buf, "AUTH LOGIN\r\n", 3, C.Smtp.wait(), s2 => b2 => Smtp.talk(s2, b2, C.Smtp.b64.line(C.Opts.user(o)), 3, C.Smtp.wait(), s3 => b3 => Smtp.sasl.last(s3, b3, C.Smtp.b64.line(C.Opts.pass(o)), "LOGIN", s4 => b4 => Smtp.batch(js, o, c, s4, b4)))) case C.MCram{}: Smtp.ask(s, buf, "AUTH CRAM-MD5\r\n", C.Smtp.wait(), s2 => b2 => +r => Smtp.cram(U32.is_eq(R.Reply.code(r), 334), r, o, s2, b2, s3 => b3 => Smtp.batch(js, o, c, s3, b3))) case C.MNo{why}: Smtp.quit(s, C.Smtp.fail(0, why))def Smtp.auth(none: Bool, secure: Bool, +o: C.Opts, +js: List<&2, C.Job>, +c: C.Caps, s: Socket, buf: String) -> IO(C.Out()): match none secure: case True{} _: Smtp.batch(js, o, c, s, buf) case False{} False{}: Smtp.quit(s, C.Smtp.fail(0, "refusing to send credentials without TLS")) case False{} True{}: C.Caps{_, +mechs, _, _, _, _} = c Smtp.auth.with(C.Mech.pick(C.Opts.auth(o), Bool.not(String.is_empty(C.Opts.token(o))), mechs), o, js, c, s, buf)# AUTH when there is a user, and only over TLS (RFC 4954 4).def Smtp.login(+o: C.Opts, +js: List<&2, C.Job>, secure: Bool, +c: C.Caps, s: Socket, buf: String) -> IO(C.Out()): Smtp.auth(String.is_empty(C.Opts.user(o)), secure, o, js, c, s, buf)# TLS# ---def Smtp.tls.done(m: Socket & Result<&1, &1, U32 & String, Unit>, k: Socket -> IO(C.Out())) -> IO(C.Out()): (s, r) = m match r: case Done{_}: k(s) case Fail{e}: (code, msg) = e Smtp.drop(s, code, msg)# The TLS handshake for the host, then k.def Smtp.tls(+o: C.Opts, s: Socket, k: Socket -> IO(C.Out())) -> IO(C.Out()): do IO<C.Out()>: m : Socket & Result<&1, &1, U32 & String, Unit> <- N.Net.tls(s, C.Opts.host(o), C.Opts.cafile(o), C.Opts.opt(o, "cert"), C.Opts.opt(o, "key")) Smtp.tls.done(m, k)# After STARTTLS's 220, nothing may wait in the buffer: bytes sent# before the handshake would be taken as sent under it (RFC 3207 4.2,# the STARTTLS injection attack).def Smtp.starttls(clean: Bool, +o: C.Opts, +js: List<&2, C.Job>, s: Socket) -> IO(C.Out()): match clean: case True{}: Smtp.tls(o, s, s2 => Smtp.hello(o, s2, "", c => s3 => b3 => Smtp.login(o, js, True{}, c, s3, b3))) case False{}: Smtp.drop(s, 0, "the server sent data after STARTTLS's reply")def Smtp.upgrade(offered: Bool, +o: C.Opts, +js: List<&2, C.Job>, s: Socket, buf: String) -> IO(C.Out()): match offered: case True{}: Smtp.talk(s, buf, "STARTTLS\r\n", 2, C.Smtp.wait(), s2 => +b2 => Smtp.starttls(String.is_empty(b2), o, js, s2)) case False{}: Smtp.quit(s, C.Smtp.fail(0, "the server does not offer STARTTLS"))# After the first EHLO: STARTTLS and EHLO again in StartTls mode (with# no fallback to plain text), then AUTH and the envelope.def Smtp.secure(mode: C.Mode, +o: C.Opts, +js: List<&2, C.Job>, +c: C.Caps, s: Socket, buf: String) -> IO(C.Out()): match mode: case C.Plain{}: Smtp.login(o, js, False{}, c, s, buf) case C.Tls{}: Smtp.login(o, js, True{}, c, s, buf) case C.StartTls{}: C.Caps{tls, _, _, _, _, _} = c Smtp.upgrade(tls, o, js, s, buf)# Connect# -------def Smtp.greet(+o: C.Opts, +js: List<&2, C.Job>, s: Socket) -> IO(C.Out()): Smtp.read(C.Smtp.fuel(), R.Reply.split(""), s, C.Smtp.wait(), s1 => b1 => r => Smtp.expect(r, 2, s1, b1, s2 => b2 => Smtp.hello(o, s2, b2, c => s3 => b3 => Smtp.secure(C.Opts.mode(o), o, js, c, s3, b3))))def Smtp.opened(mode: C.Mode, +o: C.Opts, +js: List<&2, C.Job>, s: Socket) -> IO(C.Out()): match mode: case C.Tls{}: Smtp.tls(o, s, s2 => Smtp.greet(o, js, s2)) case _: Smtp.greet(o, js, s)def Smtp.connected(r: Result<&1, &1, U32 & String, Socket>, +o: C.Opts, +js: List<&2, C.Job>) -> IO(C.Out()): match r: case Fail{e}: (code, err) = e IO.pure(C.Out(), C.Smtp.fail(code, "connect: " ++ err)) case Done{s}: Smtp.opened(C.Opts.mode(o), o, js, s)def Smtp.dial.at(direct: Bool, kind: U32, ph: String, pp: U32, user: String, pass: String, host: String, port: U32) -> IO(Result<&1, &1, U32 & String, Socket>): match direct: case True{}: N.Net.connect(host, port) case False{}: N.Net.connect_via(ph, pp, user, pass, host, port, kind)# The connection: direct, or through the proxy.def Smtp.dial(p: C.Proxy, host: String, port: U32) -> IO(Result<&1, &1, U32 & String, Socket>): C.Proxy{kind, +ph, pp, user, pass} = p Smtp.dial.at(String.is_empty(ph), kind, ph, pp, user, pass, host, port)# A signing step's result, or the end of the program (exit 1) with why.def Smtp.must(r: Result<&1, &1, U32 & String, String>) -> IO(String): match r: case Done{v}: IO.pure(String, v) case Fail{e}: (_, msg) = e IO.die(String, 1, msg)def Smtp.sign.end(+tags: String, +hr: Bool, +fs: List<&2, Q.Field>, key: String, m: C.Mail, msg: String) -> IO(C.Job): do IO<C.Job>: r : Result<&1, &1, U32 & String, String> <- N.Dkim.sign(key, Q.Dkim.data(hr, fs, tags)) sig : String <- Smtp.must(r) IO.pure(C.Job, C.Job{m, Q.Dkim.header(tags, sig) ++ msg})def Smtp.sign.cut(c: Q.Cut, +o: C.Opts, t: U32, m: C.Mail, msg: String) -> IO(C.Job): Q.Cut{head, body} = c +fs = Q.Dkim.fields(head) +canon = C.Opts.opt(o, "dkim-canon") do IO<C.Job>: ra : Result<&1, &1, U32 & String, String> <- N.Dkim.alg(C.Opts.opt(o, "dkim-key")) alg : String <- Smtp.must(ra) rb : Result<&1, &1, U32 & String, String> <- N.Dkim.sha256( Q.Dkim.body.of(C.Canon.body(canon), body)) bh : String <- Smtp.must(rb) Smtp.sign.end(Q.Dkim.tags(alg, C.Canon.header(canon), C.Canon.body(canon), C.Opts.opt(o, "dkim-domain"), C.Opts.opt(o, "dkim-selector"), t, fs, Bool.pick(List<&2, String>, C.Opts.on(o, "dkim-no-oversign"), Nil{}, Q.Dkim.over()), bh), C.Canon.header(canon), fs, C.Opts.opt(o, "dkim-key"), m, msg)# The message with its DKIM-Signature in front, when a key was given. A# key that cannot be read or cannot sign ends the program: nothing goes# out unsigned by accident.def Smtp.sign(dkim: Bool, j: C.Job, +o: C.Opts, t: U32) -> IO(C.Job): match dkim: case False{}: IO.pure(C.Job, j) case True{}: C.Job{m, +msg} = j Smtp.sign.cut(Q.Dkim.cut(msg, ""), o, t, m, msg)def Smtp.job.io(+o: C.Opts, m: C.Mail, +t: U32, a: U32, b: U32, c: U32) -> IO(C.Job): Smtp.sign(C.Opts.on(o, "dkim-key"), C.Smtp.job(m, t, a, b, c), o, t)# Each message's text, with its own Date, Message-ID and boundary, and# signed if asked.def Smtp.jobs(ms: List<&2, C.Mail>, +o: C.Opts) -> IO(List<&2, C.Job>): match ms: case Nil{}: IO.pure(List<&2, C.Job>, Nil{}) case Con{m, rest}: do IO<List<&2, C.Job>>: t : U32 <- N.Net.time() a : U32 <- IO.try(U32, IO.random_u32()) b : U32 <- IO.try(U32, IO.random_u32()) c : U32 <- IO.try(U32, IO.random_u32()) j : C.Job <- Smtp.job.io(o, m, t, a, b, c) js : List<&2, C.Job> <- Smtp.jobs(rest, o) IO.pure(List<&2, C.Job>, j <> js)def Smtp.go(+o: C.Opts, ms: List<&2, C.Mail>) -> IO(C.Out()): do IO<C.Out()>: N.Net.debug(Bool.pick(U32, C.Opts.debug(o), 1, 0)) js : List<&2, C.Job> <- Smtp.jobs(ms, o) r : Result<&1, &1, U32 & String, Socket> <- Smtp.dial( C.Proxy.of(C.Opts.opt(o, "proxy")), C.Opts.host(o), C.Opts.port(o)) Smtp.connected(r, o, js)def Smtp.checked(problem: String, +o: C.Opts, ms: List<&2, C.Mail>) -> IO(C.Out()): match problem: case SNil{}: Smtp.go(o, ms) case SCon{h, t}: IO.pure(C.Out(), C.Smtp.fail(0, SCon{h, t}))# Send the messages over one connection, as o says: one transaction# each, in order. Nothing is sent if any of them is malformed.def Smtp.send_many(+o: C.Opts, +ms: List<&2, C.Mail>) -> IO(C.Out()): +bad = C.Opts.problem(o) Smtp.checked(Bool.pick(String, Bool.not(String.is_empty(bad)), bad, Bool.pick(String, List.is_empty(&2, C.Mail, ms), "no messages", C.Smtp.problems(ms))), o, C.Smtp.asciis(ms))# Send one message as o says.def Smtp.send_mail(+o: C.Opts, m: C.Mail) -> IO(C.Out()): Smtp.send_many(o, [m])