v0.17~preview.129.36+325

README.org

@@ -17,7 +17,7 @@ Users wishing to act as SMTP clients (i.e. to send an email) should look at the
   Simplemail.send
     ~to_:[Email_address.of_string_exn "[email protected]"]
     ~subject:"Example message"
-    (Simplemail.Content.text "This is an example message.")
+    (Simplemail.Content.text_utf8 "This is an example message.")
 #+END_SRC
 
 ~async_smtp~ supports more advanced features including TLS and various modes of

async_smtp.opam

@@ -14,10 +14,13 @@ depends: [
   "async"
   "async_extra"
   "async_inotify"
+  "async_log"
   "async_sendfile"
   "async_shell"
   "async_ssl"
+  "bin_prot"
   "core"
+  "core_kernel"
   "core_unix"
   "email_message"
   "ppx_jane"

command/common.ml

@@ -18,7 +18,7 @@ module Command : sig
         | `Rpc of Rpc.Connection.t
         ]
         -> unit Deferred.t)
-       Param.t
+         Param.t
     -> t
 end = struct
   include Command

command/common.mli

@@ -18,6 +18,6 @@ module Command : sig
         | `Rpc of Rpc.Connection.t
         ]
         -> unit Deferred.t)
-       Param.t
+         Param.t
     -> t
 end

command/dune

@@ -1,6 +1,7 @@
 (library
  (name async_smtp_command)
  (public_name async_smtp.command)
- (libraries async core email_message async_smtp core_unix.filename_unix)
+ (libraries async core email_message async_smtp core_unix.filename_unix re2
+   core_unix.time_float_unix)
  (preprocess
   (pps ppx_jane)))

command/spool.ml

@@ -198,11 +198,11 @@ module Count = struct
     Rpc.Rpc.dispatch_exn Smtp_rpc_intf.Spool.status client ()
     >>| Client_side_filter.filter_opt client_side_filter
     >>| List.filter ~f:(fun message_info ->
-          let status = Smtp_spool.Spooled_message_info.status message_info in
-          match which with
-          | `All -> true
-          | `Only_frozen -> is_frozen status
-          | `Only_active -> is_active status)
+      let status = Smtp_spool.Spooled_message_info.status message_info in
+      match which with
+      | `All -> true
+      | `Only_frozen -> is_frozen status
+      | `Only_active -> is_active status)
     >>| (List.length :> _ -> _)
   ;;
 

sample/dune

@@ -1,7 +1,7 @@
 (executables
  (modes byte exe)
  (names run_async_smtp sendmail inline_image)
- (libraries async core async_smtp core_unix.command_unix
-   core_unix.filename_unix)
+ (libraries async core async_smtp async_smtp_types core_unix.command_unix
+   core_unix.filename_unix resource_cache)
  (preprocess
   (pps ppx_jane)))

sample/run_async_smtp.ml

@@ -41,37 +41,37 @@ let spool_config =
 let the_spool = Set_once.create ()
 
 module Server = Smtp_server.Make (struct
-  open Smtp_monad.Let_syntax
-  module State = Smtp_server.Plugin.Simple.State
-  module Session = Smtp_server.Plugin.Simple.Session
+    open Smtp_monad.Let_syntax
+    module State = Smtp_server.Plugin.Simple.State
+    module Session = Smtp_server.Plugin.Simple.Session
 
-  module Envelope = struct
-    include Smtp_server.Plugin.Simple.Envelope
+    module Envelope = struct
+      include Smtp_server.Plugin.Simple.Envelope
 
-    let next_hop_choices = [ Host_and_port.create ~host:"localhost" ~port:25 ]
+      let next_hop_choices = [ Host_and_port.create ~host:"localhost" ~port:25 ]
 
-    let retry_intervals =
-      let minute x = Smtp_envelope.Retry_interval.create (Time_float.Span.of_min x) in
-      [ minute 1.; minute 2.; minute 2.; minute 5. ]
-    ;;
+      let retry_intervals =
+        let minute x = Smtp_envelope.Retry_interval.create (Time_float.Span.of_min x) in
+        [ minute 1.; minute 2.; minute 2.; minute 5. ]
+      ;;
 
-    let process ~state:_ ~log:_ ~flows _session t email =
-      let spool = Set_once.get_exn the_spool [%here] in
-      let envelope = smtp_envelope t email in
-      let routed_envelope =
-        Smtp_envelope.Routed.create ~envelope ~next_hop_choices ~retry_intervals
-        |> Smtp_envelope.Routed.Batch.single_envelope
-      in
-      let%bind _spooled_ids =
-        Smtp_spool.add spool ~flows ~original_msg:envelope [ routed_envelope ]
-        |> Smtp_monad.of_or_error ~here:[%here]
-      in
-      return (Smtp_envelope.id envelope |> Smtp_envelope.Id.to_string)
-    ;;
-  end
+      let process ~state:_ ~log:_ ~flows _session t email =
+        let spool = Set_once.get_exn the_spool [%here] in
+        let envelope = smtp_envelope t email in
+        let routed_envelope =
+          Smtp_envelope.Routed.create ~envelope ~next_hop_choices ~retry_intervals
+          |> Smtp_envelope.Routed.Batch.single_envelope
+        in
+        let%bind _spooled_ids =
+          Smtp_spool.add spool ~flows ~original_msg:envelope [ routed_envelope ]
+          |> Smtp_monad.of_or_error ~here:[%here]
+        in
+        return (Smtp_envelope.id envelope |> Smtp_envelope.Id.to_string)
+      ;;
+    end
 
-  let rpcs () = []
-end)
+    let rpcs () = []
+  end)
 
 let handle_signals () =
   Signal.handle [ Signal.term; Signal.int ] ~f:(fun signal ->

src/auth.ml

@@ -30,16 +30,16 @@ module Plain = struct
   let mechanism = "PLAIN"
 
   module Server (Session : sig
-    type t
-
-    val authenticate
-      :  log:Mail_log.t
-      -> ?on_behalf_of:string
-      -> t
-      -> username:string
-      -> password:string
-      -> t Smtp_monad.t
-  end) : Server with type session = Session.t = struct
+      type t
+
+      val authenticate
+        :  log:Mail_log.t
+        -> ?on_behalf_of:string
+        -> t
+        -> username:string
+        -> password:string
+        -> t Smtp_monad.t
+    end) : Server with type session = Session.t = struct
     open Smtp_monad.Let_syntax
 
     type session = Session.t
@@ -69,10 +69,10 @@ module Plain = struct
   end
 
   module Client (Cred : sig
-    val on_behalf_of : string option
-    val username : string
-    val password : string
-  end) : Client = struct
+      val on_behalf_of : string option
+      val username : string
+      val password : string
+    end) : Client = struct
     let require_tls = true
     let mechanism = mechanism
 
@@ -98,15 +98,15 @@ module Login = struct
   let mechanism = "LOGIN"
 
   module Server (Session : sig
-    type t
-
-    val authenticate
-      :  log:Mail_log.t
-      -> t
-      -> username:string
-      -> password:string
-      -> t Smtp_monad.t
-  end) : Server with type session = Session.t = struct
+      type t
+
+      val authenticate
+        :  log:Mail_log.t
+        -> t
+        -> username:string
+        -> password:string
+        -> t Smtp_monad.t
+    end) : Server with type session = Session.t = struct
     type session = Session.t
 
     let mechanism = mechanism
@@ -120,9 +120,9 @@ module Login = struct
   end
 
   module Client (Cred : sig
-    val username : string
-    val password : string
-  end) : Client = struct
+      val username : string
+      val password : string
+    end) : Client = struct
     let require_tls = true
     let mechanism = mechanism
 

src/auth.mli

@@ -65,38 +65,38 @@ end
 
 module Login : sig
   module Server (Session : sig
-    type t
+      type t
 
-    val authenticate
-      :  log:Mail_log.t
-      -> t
-      -> username:string
-      -> password:string
-      -> t Smtp_monad.t
-  end) : Server with type session = Session.t
+      val authenticate
+        :  log:Mail_log.t
+        -> t
+        -> username:string
+        -> password:string
+        -> t Smtp_monad.t
+    end) : Server with type session = Session.t
 
   module Client (C : sig
-    val username : string
-    val password : string
-  end) : Client
+      val username : string
+      val password : string
+    end) : Client
 end
 
 module Plain : sig
   module Server (Session : sig
-    type t
+      type t
 
-    val authenticate
-      :  log:Mail_log.t
-      -> ?on_behalf_of:string
-      -> t
-      -> username:string
-      -> password:string
-      -> t Smtp_monad.t
-  end) : Server with type session = Session.t
+      val authenticate
+        :  log:Mail_log.t
+        -> ?on_behalf_of:string
+        -> t
+        -> username:string
+        -> password:string
+        -> t Smtp_monad.t
+    end) : Server with type session = Session.t
 
   module Client (C : sig
-    val on_behalf_of : string option
-    val username : string
-    val password : string
-  end) : Client
+      val on_behalf_of : string option
+      val username : string
+      val password : string
+    end) : Client
 end