1 files changed, 162 insertions, 0 deletions
diff --git a/apps/dreki/src/world/dreki_world_dns.erl b/apps/dreki/src/world/dreki_world_dns.erl
new file mode 100644
index 0000000..058c9db
--- /dev/null
+++ b/apps/dreki/src/world/dreki_world_dns.erl
@@ -0,0 +1,162 @@
+-module(dreki_world_dns).
+
+-export([start/0, graph/0, node_ips/1, node/0, parents/1, nodes/0, regions/0, vertex/1, node_params/1, node_param/2, as_map/0]).
+-export([get_path/2, in_neighbours/1, out_neighbours/1]).
+
+get_path(V1, V2) ->
+    digraph:get_path(graph(), V1, V2).
+
+in_neighbours(V) ->
+    digraph:in_neighbours(graph(), V).
+
+out_neighbours(V) ->
+    digraph:out_neighbours(graph(), V).
+
+as_map() ->
+  Vertices = lists:foldr(fun (V = {Type, Key}, Acc) ->
+    {_, Label} = digraph:vertex(graph(), V),
+    BType = atom_to_binary(Type),
+    Node = <<BType/binary, ":", Key/binary>>,
+    [#{node => Node, type => Type, name => Key, data => Label} | Acc]
+  end, [], digraph:vertices(graph())),
+  Edges = lists:foldr(fun (E, Acc) ->
+    {_, {Ft, Fn}, {Tt, Tn}, Label} = digraph:edge(graph(), E),
+    BFt = atom_to_binary(Ft),
+    BTt = atom_to_binary(Tt),
+    Fk = <<BFt/binary, ":", Fn/binary>>,
+    Tk = <<BTt/binary, ":", Tn/binary>>,
+    [#{from => Fk, to => Tk, data => Label} | Acc]
+  end, [], digraph:edges(graph())),
+  #{vertices => Vertices, edges => Edges}.
+
+vertex(V) ->
+  digraph:vertex(graph(), V).
+
+nodes() ->
+  [N || V = {node, N} <- digraph_utils:topsort(graph())].
+
+regions() ->
+  vertices(region).
+
+vertices(Type) ->
+  [V || V = {Type, _} <- digraph_utils:topsort(graph())].
+
+node() ->
+  {node, dreki_world:domain()}.
+
+node_params(N) ->
+  case digraph:vertex(graph(), {node, N}) of
+    {_, Params} -> {ok, Params};
+    _ -> {error, no_such_node}
+  end.
+
+node_param(N, Key) ->
+  case node_params(N) of
+    {ok, P} -> {ok, maps:get(Key, P)};
+    Err -> Err
+  end.
+
+parents(V) ->
+  digraph:in_neighbours(graph(), V).
+
+node_ips(N) ->
+  case digraph:vertex(graph(), {node, N}) of
+    {{node, N}, #{srvs := SRVs}} ->
+      IPs = [ {I,Port} || #{name := Name, port := Port} <- SRVs,
+                          T <- [a, aaaa],
+                          {ok, {_,_,_,_,_,Ip}} <- [inet_res:getbyname(binary_to_list(Name), T)],
+                          I <- Ip],
+      {ok, lists:flatten(IPs)};
+    Err ->
+      {error, {no_such_node, N, Err}}
+  end.
+
+start() ->
+  {ok, Graph, Errs} = build(),
+  persistent_term:put({?MODULE, graph}, Graph),
+  {ok, Errs}.
+
+graph() ->
+  persistent_term:get({?MODULE, graph}).
+
+build() ->
+  Root = dreki_world:internal_domain(),
+  Host = sd_dns(Root),
+  case inet_res:getbyname(Host, srv) of
+    {ok, {hostent, _Host, [], srv, _, SRVs}} ->
+      Graph = digraph:new([acyclic]),
+      {Name, NameErrs} = read_txt(name_dns(Root), Root),
+      V = {root, Root},
+      digraph:add_vertex(Graph, V, #{display_name => Name}),
+      Errs = collect_sd_srvs(SRVs, V, Graph, NameErrs),
+      {ok, Graph, lists:flatten(Errs)};
+    {error, DNSErr} when is_atom(DNSErr) ->
+      {error, #{error => "world_dns_error", dns_error => DNSErr, host => Host}}
+  end.
+
+expand_sd_srv(Host, Parent, Graph) ->
+  NodeHost = node_dns(Host),
+  {Vn, Acc0} = case inet_res:getbyname(NodeHost, srv) of
+    {ok, {hostent, _, _, srv, _, NSRVs}} ->
+      Targets = lists:foldr(fun ({Priority, Weight, Port, Name}, Acc) ->
+        [#{name => list_to_binary(Name), port => Port, priority => Priority, weight => Weight} | Acc]
+      end, [], NSRVs),
+      {NName, NameErrs} = read_txt(name_dns(Host), name(Host)),
+      {NodeName, NameErrs2} = read_txt(node_name_dns(Host), <<"dreki@", Host/binary>>),
+      Nv = {node, Host},
+      digraph:add_vertex(Graph, Nv, #{display_name => NName, srvs => Targets, node_name => binary_to_atom(NodeName)}),
+      digraph:add_edge(Graph, Parent, Nv, #{}),
+      {Nv, [] ++ NameErrs ++ NameErrs2};
+    {error, nxdomain} -> {undefined, []};
+    {error, VDNSErr} when is_atom(VDNSErr) ->
+      logger:log(error, #{dns_error => VDNSErr, host => NodeHost}),
+      {undefined, [{error, #{error => "world_dns_error", dns_error => VDNSErr, host => NodeHost}}]}
+  end,
+  SdHost = sd_dns(Host),
+  Acc1 = case inet_res:getbyname(SdHost, srv) of
+    {ok, {hostent, _SdHost, [], srv, _, SSRVs}} ->
+      {RName, RNameErrs} = read_txt(name_dns(Host), name(Host)),
+      V = {region, Host},
+      digraph:add_vertex(Graph, V, #{display_name => RName}),
+      case Vn of
+        undefined -> digraph:add_edge(Graph, Parent, V, #{});
+        Vn -> digraph:add_edge(Graph, Vn, V, #{})
+      end,
+      collect_sd_srvs(SSRVs, V, Graph, RNameErrs);
+    {error, nxdomain} -> [];
+    {error, DNSErr} when is_atom(DNSErr) ->
+      logger:log(error, #{dns_error => DNSErr, host => SdHost}),
+      [{error, #{error => "world_dns_error", dns_error => DNSErr, host => SdHost}}]
+  end,
+  [Acc0, Acc1].
+
+collect_sd_srvs([], _, _Graph, Acc) -> Acc;
+collect_sd_srvs([{0, 0, 1337, Entry} | Rest], Parent, Graph, Acc) ->
+  collect_sd_srvs(Rest, Parent, Graph, [expand_sd_srv(list_to_binary(Entry), Parent, Graph) | Acc]).
+
+read_txt(Host, Default) ->
+  case inet_res:getbyname(Host, txt) of
+    {error, nxdomain} -> {Default, []};
+    {ok,{hostent, _,  _, _, _, Lines}} -> {list_to_binary(Lines), []};
+    {error, DNSErr} when is_atom(DNSErr) ->
+      logger:log(error, #{dns_error => DNSErr, host => Host}),
+      {Default, [#{error => "world_dns_error", dns_error => DNSErr, host => Host}]}
+  end.
+
+sd_dns(Domain) -> dnsname(<<"_dreki">>, Domain).
+node_dns(Domain) -> dnsname(<<"_node._dreki">>, Domain).
+name_dns(Domain) -> dnsname(<<"_name._dreki">>, Domain).
+node_name_dns(Domain) -> dnsname(<<"_name._node._dreki">>, Domain).
+
+dnsname(Prefix, Domain) when is_list(Prefix) ->
+  dnsname(list_to_binary(Prefix), Domain);
+dnsname(Prefix, Domain) when is_list(Domain) ->
+  dnsname(Prefix, list_to_binary(Domain));
+dnsname(Prefix, Domain) ->
+  Full = <<Prefix/binary, ".", Domain/binary>>,
+  binary:bin_to_list(Full).
+
+name(Host) when is_list(Host) ->
+  name(list_to_binary(Host));
+name(Host) ->
+  hd(binary:split(Host, <<".">>)).