defmodule Spf.Lexer do
@moduledoc """
Lexer for SPF strings and explain-strings.
See [the collected ABNF](https://www.rfc-editor.org/rfc/rfc7208.html#section-12).
"""
@typedoc """
qualifier = ?+ / ?- / ?~ / ??
"""
@type q :: ?+ | ?- | ?~ | ??
@typedoc """
`range` denotes a token's `start..stop`-slice in the input string.
"""
@type range :: Range.t()
@typedoc """
The token's `type`.
There are several classes of tokens:
- the version: `:version`,
- a mechanism: `:a, :all, :exists, :exp, :include, :ip4, :ip6, :mx, :ptr`
- a modifier: `:exp, :redirect`,
- an explain string: `:exp_str`,
- an unknown modifier: `:unknown`,
- a syntax error: `:error`
- whitespace: `:whitespace`,
- a subtoken: `:expand, :literal, :cidr`
Subtokens may appear as part of another token's value.
`:exp_str` is produced by tokenizing the explain string. After expanding the
domain-spec of modifier `exp=domain-spec` into a domain name, that domain's
TXT RR is retrieved and tokenized for later expansion into an explanation
string. This only happens when the SPF verdict is `:fail` and the `exp`
modifier is present and has a valid domain name.
The `:whitespace` token will match both spaces and tab characters in order to
be able to warn about multiple spaces and/or tab characters being used. Use
of a tab character is technically a syntax error, but this library only warns
about its use.
The `:error` token is tried as a last resort and matches any non-space
sequence. When matched, it means the SPF string has a syntax error.
"""
@type type ::
:a
| :all
| :exists
| :exp
| :include
| :ip4
| :ip6
| :mx
| :ptr
| :redirect
| :unknown
| :version
| :whitespace
# catch all
| :error
# explain-string
| :exp_str
# subtokens
| :cidr
| :expand
| :literal
@typedoc """
A token represented as a tuple: `{type, list, range}`.
Where:
- `type` is an atom which denotes the token `t:type/0`
- `list` may be empty or contain one or more values (including subtokens)
- `range` is the `start..stop`-slice in the input string
"""
@type token :: {type, list(), range}
@typedoc """
An ok/error tuple produced by lexing some input
"""
@type result :: {:ok, [token], binary, map} | {:error, atom, binary, map}
@typedoc """
A lexer is a function that takes a binary & a lexer-context, and returns a `t:result/0`
"""
@type lexer :: (binary, map -> result)
@wspace [?\s, ?\t]
@eoterm @wspace ++ [-1]
@mdelimiters [?., ?-, ?+, ?,, ?/, ?_, ?=]
@mletters [?s, ?l, ?o, ?d, ?i, ?p, ?h, ?c, ?r, ?t, ?v] ++
[?S, ?L, ?O, ?D, ?I, ?P, ?H, ?C, ?R, ?T, ?V]
# when used to slice a string -> yields ""
@null_slice 1..0//-1
@doc """
Returns a lexer `t:result/0` after consuming an SPF string.
The SPF string can be a full SPF TXT string or a partial string.
The lexer produces a list of tokens found, including a catch-all
`:error` token for character sequences that were not recognized.
## Example
iex> {:ok, tokens, _rest, _map} = Spf.Lexer.tokenize_spf("a:%{d}")
iex> tokens
[{:a, [43, {:expand, [100, -1, false, ["."]], 2..5}, {:cidr, [32, 128], 1..0//-1}], 0..5}]
"""
@spec tokenize_spf(binary) :: result
def tokenize_spf(input) when is_binary(input),
do: spf_tokenize().(input, %{offset: 0, input: input})
@doc """
Returns a lexer `t:result/0` after consuming an explain-string.
An explaing-string is the TXT RR value of the domain specified by the
domain specification of the `exp`-modifier and is basically a series
of macro-strings and spaces. This is the only time `c`, `r`, `t`-macros
may be used.
The lexer produces an `:error` token for character-sequences it doesn't know.
## Example
iex> {:ok, tokens, _rest, _map} = Spf.Lexer.tokenize_exp("timestamp %{t}")
iex> tokens
[
{:exp_str,
[{:literal, ["timestamp"], 0..8},
{:whitespace, [" "], 9..9},
{:expand, [116, -1, false, ["."]], 10..13}
], 0..13}
]
"""
@spec tokenize_exp(binary) :: result
def tokenize_exp(input) when is_binary(input),
do: exp_tokenize().(input, %{offset: 0, input: input})
# Context Helpers
@spec del(map, atom) :: map
defp del(map, name),
do: Map.delete(map, name)
@spec range(map, atom) :: range
defp range(map, name) do
# note: if stop < start -> a token is being generated out of nothing
start = Map.get(map, name, 0)
stop = Map.get(map, :offset) - 1
cond do
start > stop -> @null_slice
true -> start..stop
end
end
@spec set(map, atom) :: map
defp set(map, name) do
# record current offset for given `name`
Map.put(map, name, map.offset)
end
@spec upd(map, binary) :: map
defp upd(map, rest) do
# update offset after some input was accepted by some parser
offset = map.offset + String.length(map.input) - String.length(rest)
Map.put(map, :offset, offset)
|> Map.put(:input, rest)
end
# Tokenizers
@spec spf_tokenize :: lexer
defp spf_tokenize() do
choice([
whitespace(),
# mechanisms
mechanism(:a),
mechanism(:mx),
mechanism(:ip4),
mechanism(:ip6),
mechanism(:include),
mechanism(:exists),
mechanism(:ptr),
mechanism(:all),
# modifiers
modifier(:redirect),
modifier(:v),
modifier(:exp),
modifier(:unknown),
# catch all
error()
])
|> many()
end
@spec exp_tokenize :: lexer
defp exp_tokenize() do
choice([whitespace(), mstring() |> satisfy(fn l -> l != [] end), error()])
|> many()
|> map(fn l -> List.flatten(l) end)
|> mark(:exp_str)
|> map(fn token -> [token] end)
end
# Token parsers
@spec error :: lexer
defp error() do
until(fn c -> c in @eoterm end)
|> map(fn chars -> [to_string(chars)] end)
|> mark(:error)
end
@spec mechanism(atom) :: lexer
defp mechanism(key) when key in [:a, :mx] do
choice([
sequence([qualifier(), keyword(key, eot())])
|> map(fn [q, _key] -> [q, default_cidr([])] end),
sequence([qualifier(), keyword(key, char1(?/)), cidr()])
|> map(fn [q, _key, cidr] -> [q, cidr] end),
sequence([
qualifier(),
keyword(key, char1(?:)),
char1(?:),
choice([expand(), literals(), merror()])
|> until(eot())
|> satisfy(fn x -> x != [] end)
])
|> map(fn [q, _key, _skip, terms] -> cidr_check(key, [q | terms]) end)
])
|> mark(key)
end
defp mechanism(:ptr) do
choice([
sequence([qualifier(), keyword(:ptr, eot())])
|> map(fn [q, _key] -> [q] end),
sequence([
qualifier(),
keyword(:ptr, char1(?:)),
char1(?:),
choice([expand(), literals(), merror()])
|> until(eot())
|> satisfy(fn x -> x != [] end)
])
|> map(fn [q, _key, _skip, terms] -> [q | terms] end)
])
|> mark(:ptr)
end
defp mechanism(:all) do
sequence([qualifier(), keyword(:all, eot())])
|> map(fn [q, _key] -> [q] end)
|> mark(:all)
end
defp mechanism(key) do
# mechanisms :ip4, :ip6, :include, :exists
sequence([
qualifier(),
keyword(key, char1(?:)),
char1(?:),
choice([expand(), literals(), merror()])
|> until(eot())
|> satisfy(fn x -> x != [] end)
])
|> map(fn [q, _key, _skip, terms] -> cidr_check(key, [q | terms]) end)
|> mark(key)
end
@spec modifier(atom) :: lexer
defp modifier(:v) do
sequence([
keyword(:v, char1(?=)),
char1(?=),
keyword(:spf, number()),
number(),
eot()
])
|> map(fn [_v, _is, _spf, n, _eot] -> [n] end)
|> mark(:version)
end
defp modifier(:unknown) do
# name = *( expand / literal )
sequence([name(), char1(?=), mstring()])
|> map(fn [name, _, macro_string] -> List.flatten([name, macro_string]) end)
|> mark(:unknown)
end
defp modifier(key) do
sequence([
keyword(key, char1(?=)),
char1(?=),
choice([expand(), literals(), merror()])
|> until(eot())
|> map(fn l -> if l == [], do: [{:error, [""], @null_slice}], else: l end)
# |> satisfy(fn x -> x != [] end)
])
|> map(fn [_key, _skip, terms] -> cidr_check(key, terms) end)
|> mark(key)
end
@spec whitespace() :: lexer
defp whitespace() do
until(fn c -> c not in @wspace end)
|> map(fn chars -> [to_string(chars)] end)
|> mark(:whitespace)
end
# TokenParser Helpers
@spec cidr_check(atom, [token]) :: [token]
defp cidr_check(key, tokens) when key in [:a, :mx] do
with {:literal, [str], range} <- List.last(tokens),
context <- %{offset: range.first, input: str},
{:ok, [literal, cidr], "", _} <- cidr_lex().(str, context) do
case literal do
{:literal, [""], @null_slice} -> List.replace_at(tokens, -1, cidr)
_ -> List.replace_at(tokens, -1, literal) |> List.insert_at(-1, cidr)
end
else
_ -> List.insert_at(tokens, -1, {:cidr, [32, 128], @null_slice})
end
end
defp cidr_check(_key, tokens),
do: tokens
@spec cidr_lex() :: lexer
defp cidr_lex() do
# parse the last cidr from a literal string and return [lead_literal, cidr_or_default]
sequence([
char()
|> until(choice([cidr(), eot()]))
|> map(fn l -> [to_string(l)] end)
|> mark(:literal),
optional(cidr()) |> map(&default_cidr/1)
])
end
@spec default_cidr(list) :: list
defp default_cidr(l),
do: if(l == [], do: {:cidr, [32, 128], @null_slice}, else: l)
@spec default_mdelims(list) :: list
defp default_mdelims(l),
do: if(l == [], do: ["."], else: Enum.map(l, fn n -> to_string([n]) end))
defp expand() do
# note: keep param defaults to -1, since keep==0 is actually valid (albeit useless)
choice([
sequence([
keyword("%{"),
any(@mletters),
optional(number()) |> map(fn x -> if x == [], do: -1, else: x end),
optional(keyword("r")) |> map(fn x -> if x == [], do: false, else: true end),
optional(any(@mdelimiters) |> many()) |> map(&default_mdelims/1),
keyword("}")
])
|> map(fn [_, ltr, keep, reverse, delims, _] -> [ltr, keep, reverse, delims] end)
|> mark(:expand),
keyword("%%") |> map(fn _ -> ["%"] end) |> mark(:expand),
keyword("%-") |> map(fn _ -> ["-"] end) |> mark(:expand),
keyword("%_") |> map(fn _ -> ["_"] end) |> mark(:expand)
])
end
defp mliteral?(c),
do: 0x21 <= c and c <= 0x7E and c != 0x25
defp mstring(),
do: choice([expand(), literals(), merror()]) |> until(eot())
defp merror() do
char()
|> satisfy(fn _ -> true end)
|> map(fn l -> [to_string([l])] end)
|> mark(:error)
end
defp literals() do
until(fn c -> not mliteral?(c) end)
|> map(fn l -> [List.flatten(l) |> to_string()] end)
|> mark(:literal)
end
# SPF parsers
# token = {:type, list, range}
# subtokens may have null_slice as range (i.e. they're defaults, not present in input)
defp cidr() do
# cidr can only match if it ends a term
choice([
sequence([cidr4(), cidr6()]),
cidr4() |> map(fn n -> [n, 128] end),
cidr6() |> map(fn n -> [32, n] end)
])
|> eot()
|> mark(:cidr)
end
defp cidr4() do
# just lex the number, parser will check validity (incl. leading zeros)
sequence([char1(?/), number()])
|> map(fn [_, number] -> number end)
end
defp cidr6() do
# just lex the number, parser will check validity
sequence([char1(?/), char1(?/), number()])
|> map(fn [_, _, number] -> number end)
end
defp qualifier() do
# when used always yields a qualifier
any([?+, ?-, ?~, ??])
|> optional()
|> map(fn x -> if x == [], do: ?+, else: x end)
end
# GENERIC Parsers > return parser results
defp any(codepoints),
do: char() |> satisfy(fn c -> c in codepoints end)
defp alpha(),
do: char() |> satisfy(fn x -> (?a <= x and x <= ?z) or (?A <= x and x <= ?Z) end)
defp alnum(),
do: choice([alpha(), digit()])
defp char1(expected),
do: char() |> satisfy(fn x -> x == expected end)
defp digit(),
do: char() |> satisfy(fn x -> ?0 <= x and x <= ?9 end)
defp keyword(expected) do
to_string(expected)
|> anycase(empty())
|> map(fn _ -> expected end)
end
defp keyword(expected, accept) do
to_string(expected)
|> anycase(accept)
|> map(fn _ -> expected end)
end
defp name() do
sequence([alpha(), choice([alnum(), any([?., ?_, ?-])]) |> many()])
|> satisfy(fn list -> list != [] end)
|> map(fn chars -> to_string(chars) end)
end
defp number() do
sequence([digit(), digit() |> many()])
|> map(fn digits -> List.flatten(digits) |> List.to_integer() end)
end
# COMBINATORS > return a parser function
# @spec parser_fun: (binary, map) -> {:error, reason, input, ctx} | {:ok, terms, rest, upd(ctx, rest)}
defp anycase(str, accept) do
fn input, ctx ->
want = String.upcase(str)
{have, rest} = String.split_at(input, String.length(want))
with {:ok, _, _, _} <- accept.(rest, ctx) do
if want == String.upcase(have),
do: {:ok, str, rest, upd(ctx, rest)},
else: {:error, :anycase, input, ctx}
end
end
end
defp empty(),
do: fn input, ctx -> {:ok, [], input, ctx} end
defp char() do
fn input, ctx ->
case input do
"" -> {:error, :eos, input, ctx}
<<byte::8, rest::binary>> -> {:ok, byte, rest, ctx}
end
end
end
defp choice(parsers) do
fn input, ctx ->
case parsers do
[] ->
{:error, :choice, input, ctx}
[first | others] ->
with {:error, _, _, ctx} <- first.(input, ctx),
do: choice(others).(input, ctx)
end
end
end
defp eot() do
# end of term means wspace is next or end of input
fn input, ctx ->
c =
case input do
"" -> -1
<<c::8, _rest::binary>> -> c
end
if c in @eoterm,
do: {:ok, [], input, ctx},
else: {:error, :eot, input, ctx}
end
end
defp eot(parser) do
# usage: parser() |> eot()
fn input, ctx ->
with {:ok, term, rest, ctx} <- parser.(input, ctx),
{:ok, _, _, _} <- eot().(rest, ctx),
do: {:ok, term, rest, upd(ctx, rest)}
end
end
defp many(parser) do
# note, applies `parser` 0 or more times:
# - if `parser` *never* fails, this will loop forever!
# - if having one many inside another many, it'll loop forever as well
fn input, ctx ->
case parser.(input, ctx) do
{:error, _, _, ctx} ->
{:ok, [], input, ctx}
{:ok, term, rest, ctx} ->
{:ok, terms, rest, ctx} = many(parser).(rest, ctx)
{:ok, [term | terms], rest, upd(ctx, rest)}
end
end
end
defp mark(parser, name) do
fn input, ctx ->
with {:ok, term, rest, ctx} <- parser.(input, set(ctx, name)) do
{:ok, {name, term, range(ctx, name)}, rest, del(ctx, name)}
end
end
end
defp map(parser, mapper) do
fn input, ctx ->
with {:ok, term, rest, ctx} <- parser.(input, ctx),
do: {:ok, mapper.(term), rest, ctx}
end
end
defp satisfy(parser, accept) do
fn input, ctx ->
with {:ok, term, rest, ctx} <- parser.(input, ctx) do
if accept.(term),
do: {:ok, term, rest, upd(ctx, rest)},
else: {:error, :reject, rest, ctx}
end
end
end
defp optional(parser) do
fn input, ctx ->
with {:error, _, _, ctx} <- parser.(input, ctx),
do: {:ok, [], input, ctx}
end
end
defp sequence(parsers) do
fn input, ctx ->
case parsers do
[] ->
{:ok, [], input, ctx}
[first | others] ->
with {:ok, term, rest, ctx_s} <- first.(input, ctx),
{:ok, terms, rest, ctx_s} <- sequence(others).(rest, ctx_s) do
{:ok, [term | terms], rest, ctx_s}
else
_ -> {:error, :sequence, input, ctx}
end
end
end
end
defp until(stop) when is_function(stop, 1) do
# gobble up chars until stop function says so or till eos
fn input, ctx ->
{char, rest} =
case input do
"" -> {-1, ""}
<<c::8, rest::binary>> -> {c, rest}
end
if stop.(char) do
if input == ctx.input,
do: {:error, :until, input, ctx},
else: {:ok, [], input, ctx}
else
with {:ok, chars, rest, ctx} <- until(stop).(rest, ctx),
do: {:ok, [char | chars], rest, upd(ctx, rest)}
end
end
end
defp until(parser, stop) when is_function(stop, 2) do
# apply parser 0 or more times, until stop parser says so or fail
# - note: if parser fails before stop says to stop, nothing is parsed
fn input, ctx ->
case stop.(input, ctx) do
{:ok, _, _, _} ->
{:ok, [], input, ctx}
_ ->
with {:ok, term, rest, ctx} <- parser.(input, ctx),
{:ok, terms, rest, ctx} <- until(parser, stop).(rest, ctx) do
{:ok, [term | terms], rest, upd(ctx, rest)}
end
end
end
end
end
