.

lib/mxs.ml

@@ -1,23 +1,22 @@
-type elt = {
-    preference: int
-  ; mx_ipaddr: Ipaddr.t
-  ; mx_domain: [ `host ] Domain_name.t option
-}
+type key = Dns.Mx.t
 
-let pp_elt : elt Fmt.t =
+let pp_key : key Fmt.t =
  fun ppf elt ->
-  Fmt.pf ppf "{ @[<hov>preference= %d;@ mx_ipaddr= %a;@ mx_domain= %a;@] }"
-    elt.preference Ipaddr.pp elt.mx_ipaddr
-    (Fmt.option Domain_name.pp)
-    elt.mx_domain
+  Fmt.pf ppf "{ @[<hov>preference= %d;@ mail_exchange= %a;@] }"
+    elt.Dns.Mx.preference Domain_name.pp
+    elt.Dns.Mx.mail_exchange
 
-module Elt = struct
-  type t = elt
+module Key = struct
+  type t = key
 
-  let compare {mx_ipaddr= a; _} {mx_ipaddr= b; _} = Ipaddr.compare a b
+  let compare {Dns.Mx.preference= a; _} {Dns.Mx.preference= b; _} = Int.compare a b
 end
 
-include (Set.Make (Elt) : Set.S with type elt := elt)
+include (Map.Make (Key) : Map.S with type key := key)
 
-let v ~preference ?domain ipaddr =
-  {preference; mx_domain= domain; mx_ipaddr= ipaddr}
+let v ~preference ~domain:mail_exchange ipaddr =
+  singleton { preference; mail_exchange } ipaddr
+
+let vs =
+  (Fun.flip List.fold_left empty) begin fun acc (mx, ipaddr) ->
+    add mx ipaddr acc end

lib/mxs.mli

@@ -1,18 +1,8 @@
-(** A domain can have several Mail eXchange services ordered by a preference
-    number. The lower preference is a higher priority. This module provides a
-    way to store them. The uniq identifier for each MX value is the
-    [Ipaddr.V4.t]. *)
+type key = Dns.Mx.t
 
-type elt = {
-    preference: int
-  ; mx_ipaddr: Ipaddr.t
-  ; mx_domain: [ `host ] Domain_name.t option
-}
-(** Type of a MX value. *)
+val pp_key : key Fmt.t
 
-val pp_elt : elt Fmt.t
+include Map.S with type key := key
 
-val v : preference:int -> ?domain:[ `host ] Domain_name.t -> Ipaddr.t -> elt
-(** [v ~preference ?domain mx_ipaddr] returns an MX value. *)
-
-include Set.S with type elt := elt
+val v : preference:int -> domain:[ `host ] Domain_name.t -> Ipaddr.t -> Ipaddr.t t
+val vs : (Dns.Mx.t * Ipaddr.t) list -> Ipaddr.t t

lib/sendmail.ml

@@ -0,0 +1,44 @@
+type recipients =
+  { domain : [ `Ipaddr of Ipaddr.t | `Domain of [ `host ] Domain_name.t ]
+  ; locals : [ `All | `Some of Emile.local list ] }
+
+let warn_about_an_unreachable_mail_exchange ~domain ~mail_exchange msg =
+  Log.warn @@ fun m -> m "Impossible to resolve %a, a mail exchange server for %a: %s"
+    Domain_name.pp mail_exchange Domain_name.pp domain msg
+
+type error =
+  [ `No_mail_exchange_servers_for of [ `host ] Domain_name.t ]
+
+let recipients_to_forward_paths ~domain recipients =
+  let open Colombe in
+  let open Forward_path in
+  let local_to_forward_path local =
+    let local = List.map (function `Atom x -> x | `String x -> x) local in
+    { Path.local= `Dot_string local; domain; rest= [] } in
+  match recipients.locals with
+  | `All -> [ Domain domain ]
+  | `Some locals -> Lust.map local_to_forward_path locals
+
+let single_sendmail stack 
+
+let sendmail ~pool ~info ~tls stack recipients data =
+  let ( let** ) = Lwt_result.bind in
+  let** mx_domain, mxs =
+    match recipients.domain with
+    | `Ipaddr (Ipaddr.V4 v4 as mx_ipaddr) ->
+      Lwt.return_ok (Domain.IPv4 v4, Ptt.Mxs.(v ~preference:0 mx_ipaddr))
+    | `Ipaddr (Ipaddr.V6 v6 as mx_ipaddr) ->
+      Lwt.return_ok (Domain.IPv6 v6, Ptt.Mxs.(v ~preference:0 mx_ipaddr))
+    | `Domain domain ->
+      let* result = getmxbyname dns host in
+      match result with
+      | Ok mxs ->
+          let mxs = (Fun.flip Lwt_list.fold_left_s (Dns.Mx_set.to_list mxs))
+            begin fun acc ({ Dns.Mx.mail_exchange; _ } as mx) -> getabyname dns mail_exchange >>= function
+            | Ok ipaddr -> Lwt.return ((mx, ipaddr) :: acc)
+            | Error (`Msg err) ->
+              warn_about_an_unreachable_mail_exchange ~domain ~mail_exchange msg;
+              Lwt.return acc end |> Mxs.vs in
+          Domain.Domain (Domain_name.to_strings domain), mxs in
+      | Error (`Msg err) ->
+        Lwt.return_error (`No_mail_exchange_servers_for domain)