Permalink
Browse files

[enhance] Email: improved email.trx a bit, added Content-Disposition …

…header into mail, some format, cleanup and doc
  • Loading branch information...
Aqua-Ye committed Jan 3, 2012
1 parent dbc6699 commit 3274be835bef91b0e4cebe7f7307388e1fab1932
Showing with 44 additions and 19 deletions.
  1. +10 −8 libnet/email/email.trx
  2. +34 −11 libnet/smtpClient.ml
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -15,19 +15,21 @@
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
-{{ }}
-+email : {string * (string * string)}
- <- name [<] spacing address [>] spacing {{ __1, __4 }}
+(* Merge with email.opa ? *)
+
++email : {string * (string * string)}
+ <- name [<] spacing address [>] spacing {{ __1, __4 }}
/ address {{ "", __1 }}
name <- (![<] .)+ $_
-address <- id [@] domain {{ __1, __3 }}
+ / ["] (!["] .)+ ["] $_
+address <- local [@] domain {{ __1, __3 }}
-id <- char+ ([.] id)? $_
+local <- char+ ([.] local)? $_
domain <- domainpart [.] (domain / domainpart) $_
-domainpart <-
+domainpart <-
char [\-] domainpart $_
- / char domainpart? $_
+ / char domainpart? $_
(* special characters we should authorize ! # $ % & ' * + - / = ? ^ _ ` { | } ~ *)
char <- [A-Za-z0-9_\-+!#$%&'*/=?^_`{|}~]
View
@@ -16,6 +16,9 @@
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
+(** This is a module for handling smtp mail sending.
+ It is NOT really RFC compliant. *)
+
module SCC = SmtpClientCore
module List = Base.List
module String = Base.String
@@ -48,16 +51,24 @@ let simple_mail s =
let mail_content ?(charset="ISO-8859-1") ?(cte="7bit") body =
sprintf "Content-Type: text/plain; charset=%s\r\n\
Content-Transfer-Encoding: %s\r\n\
+Content-Disposition: inline\r\n\
\r\n%s\r\n" charset cte body
+(*
+ FIXME:
+ - we should produce quoted-printable content for html.
+ - we should handle Content-ID for inline content.
+*)
let mail_content_html ?(charset="ISO-8859-1") ?(cte="7bit") ~ascii_part body =
let ascii_part = sprintf
"Content-Type: text/plain; charset=%s\r\n\
Content-Transfer-Encoding: %s\r\n\
+Content-Disposition: inline\r\n\
\r\n%s\r\n" charset cte ascii_part in
let html_part = sprintf
"Content-Type: text/html; charset=%s\r\n\
Content-Transfer-Encoding: %s\r\n\
+Content-Disposition: inline\r\n\
\r\n%s\r\n" charset cte body in
let boundary = String.random 30 in
sprintf "Content-Type: multipart/alternative;\
@@ -110,7 +121,8 @@ let attach_one_file boundary content_type filename charset cte content =
Content-Type: %s; name=\"%s\"; charset=%s\r\n\
Content-Disposition: attachment; filename=\"%s\"\r\n\
Content-Transfer-Encoding: %s\r\n\
-X-Attachment-Id: %s\r\n\r\n%s\r\n" boundary content_type filename
+X-Attachment-Id: %s\r\n\
+\r\n%s\r\n" boundary content_type filename
charset filename cte xid (
if cte = "base64"
then split_encode content 76 "\r\n"
@@ -141,14 +153,23 @@ let full_email ?(subject="") mfrom mto mdata ?return_path ?html ?(files=[]) ?(cu
match return_path with
| Some return_path -> return_path
| None -> mfrom
- in
- (sprintf "From: %s\r\nReturn-Path:<%s>\r\nTo: %s\r\nMessage-ID: <%s.%s>\r\nX-Mailer: MLstate mailclient\r\nDate: %s\r\nMime-Version: 1.0\r\n%s%s"
- mfrom return_path mto (String.random 10) return_path (Date.rfc1123 (Time.gmtime (Time.now())))
- (if subject = "" then "" else sprintf "Subject: %s\r\n" subject)
- (attach_custom_headers custom_headers))
- ^(if files = []
- then mdata
- else attach_files files mdata ?charset ())
+ in sprintf
+"From: %s\r\n\
+To: %s\r\n\
+Return-Path:<%s>\r\n\
+Message-ID: <%s.%s>\r\n\
+X-Mailer: MLstate mailclient\r\n\
+Date: %s\r\n\
+Mime-Version: 1.0\r\n\
+%s\
+%s\
+%s"
+mfrom mto return_path (String.random 10) return_path (Date.rfc1123 (Time.gmtime (Time.now())))
+(if subject = "" then "" else sprintf "Subject: %s\r\n" subject)
+(attach_custom_headers custom_headers)
+(if files = []
+ then mdata
+ else attach_files files mdata ?charset ())
let resolve_UNIX name =
try
@@ -180,8 +201,10 @@ let get_mx name : string list =
|> Array.to_list
|> List.map fst
-(* FIXME: il faut en sortie une iterateur IntMapSort d'IP, triée par priorité
- ensuite, on doit tenter les IP une à une... *)
+(* FIXME:
+ - we should use native mx query, instead of calling a command line !!!
+ - il faut en sortie une iterateur IntMapSort d'IP, triée par priorité
+ ensuite, on doit tenter les IP une à une... *)
let resolve_mx name =
let output = File.process_output (sprintf "dig %s MX" name) in
try

0 comments on commit 3274be8

Please sign in to comment.