package async_smtp

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file simplemail.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
open Core
open Async
open Async_smtp_types
module Envelope_status = Client.Envelope_status

include (
  Email.Simple : module type of Email.Simple with module Expert := Email.Simple.Expert)

let system_default_server = Host_and_port.create ~host:"localhost" ~port:25
let default_server = ref system_default_server

module For_testing = struct
  let system_default_server = system_default_server
  let set_default_server server = default_server := server
end

let client_log =
  Lazy.map Async.Log.Global.log ~f:(fun log ->
    Mail_log.adjust_log_levels ~remap_info_to:`Debug log)
;;

module Expert = struct
  include Email.Simple.Expert

  let send_envelope ?(log = Lazy.force client_log) ?credentials ?server envelope =
    let server = Option.value server ~default:!default_server in
    Client.Tcp.with_ ?credentials server ~log ~f:(fun client ->
      Client.send_envelope client ~log envelope)
  ;;

  let send' ?log ?credentials ?server ~sender ?sender_args ~recipients email =
    let message =
      Smtp_envelope.create
        ~sender
        ?sender_args
        ~recipients
        ~rejected_recipients:[]
        ~email
        ()
    in
    send_envelope ?log ?credentials ?server message
  ;;

  let send ?log ?credentials ?server ~sender ?sender_args ~recipients email =
    send' ?log ?credentials ?server ~sender ?sender_args ~recipients email
    >>|? Envelope_status.ok_or_error ~allow_rejected_recipients:false
    >>| Or_error.join
    >>| Or_error.ignore_m
  ;;
end

let send'
      ?log
      ?credentials
      ?server
      ?(from = Email_address.local_address ())
      ?sender_args
      ~to_
      ?(cc = [])
      ?(bcc = [])
      ?reply_to
      ?bounce_to
      ~subject
      ?id
      ?in_reply_to
      ?date
      ?auto_generated
      ?extra_headers
      ?attachments
      ?no_tracing_headers
      content
  =
  let email =
    create
      ~from
      ~to_
      ~cc
      ?reply_to
      ~subject
      ?id
      ?in_reply_to
      ?date
      ?auto_generated
      ?extra_headers
      ?attachments
      ?no_tracing_headers
      content
  in
  let recipients = to_ @ cc @ bcc in
  let sender = `Email (Option.value ~default:from bounce_to) in
  Expert.send' ?log ?credentials ?server ~sender ?sender_args ~recipients email
;;

let send
      ?log
      ?credentials
      ?server
      ?from
      ?sender_args
      ~to_
      ?cc
      ?bcc
      ?reply_to
      ?bounce_to
      ~subject
      ?id
      ?in_reply_to
      ?date
      ?auto_generated
      ?extra_headers
      ?attachments
      ?no_tracing_headers
      content
  =
  send'
    ?log
    ?credentials
    ?server
    ?from
    ?sender_args
    ~to_
    ?cc
    ?bcc
    ?reply_to
    ?bounce_to
    ~subject
    ?id
    ?in_reply_to
    ?date
    ?auto_generated
    ?extra_headers
    ?attachments
    ?no_tracing_headers
    content
  >>|? Envelope_status.ok_or_error ~allow_rejected_recipients:false
  >>| Or_error.join
  >>| Or_error.ignore_m
;;