Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

141 lines (118 sloc) 6.27 kb
(:refer-clojure :exclude (send))
(:use [appengine-magic.utils :only [record copy-stream]])
(:import [ MailServiceFactory
MailService$Message MailService$Attachment]))
(defonce ^{:dynamic true} *mail-service* (atom nil))
(defn get-mail-service []
(when (nil? @*mail-service*)
(reset! *mail-service* (MailServiceFactory/getMailService)))
(defrecord MailMessage [from to subject text-body html-body
sent-date received-date
reply-to cc bcc attachments message-id])
(defn make-attachment [filename data]
(MailService$Attachment. filename (if (instance? (class (byte-array 0)) data)
(.getBytes data))))
(defn make-message [& {:keys [from to subject text-body html-body
reply-to cc bcc attachments]
:or {text-body "", html-body "", cc [], bcc [], attachments []}}]
;; normalize and error-check
(let [from (if-not (nil? from)
(throw (IllegalArgumentException. ":from argument required")))
to (cond
;; not given
(nil? to)
(throw (IllegalArgumentException. ":to argument required"))
;; normalize for multiple recipients
(sequential? to)
:else [to])
subject (if-not (nil? subject)
(throw (IllegalArgumentException. ":subject argument required")))
cc (if (not (or (nil? cc) (sequential? cc))) [cc] cc)
bcc (if (not (or (nil? bcc) (sequential? bcc))) [bcc] bcc)]
(record MailMessage
:from from :to to :subject subject
:text-body text-body :html-body html-body
:reply-to reply-to :cc cc :bcc bcc
:attachments attachments)))
(defn- make-mail-service-message [^MailMessage msg]
(doto (MailService$Message.)
(.setSender (:from msg))
(.setTo (:to msg))
(.setSubject (:subject msg))
(.setTextBody (:text-body msg))
(.setHtmlBody (:html-body msg))
(.setReplyTo (:reply-to msg))
(.setCc (:cc msg))
(.setBcc (:bcc msg))
(.setAttachments (:attachments msg))))
(defn send [^MailMessage msg]
(.send (get-mail-service) (make-mail-service-message msg)))
(defn send-to-admins [^MailMessage msg]
(.sendToAdmins (get-mail-service) (make-mail-service-message msg)))
(defrecord #^{:private true} MessageAlternativeParts [parts])
(defrecord #^{:private true} MessagePart [filename content-type data])
(defn- deconstruct-message [#^javax.mail.internet.MimeMessage message]
(let [all-subparts (fn [part]
(map #(.getBodyPart part %) (range (.getCount part))))
subparts (fn subparts [part]
(let [content-type (.toLowerCase (.getContentType part))]
;; multiple attachments
(re-matches #"multipart\/mixed.*" content-type)
(doall (map subparts (all-subparts (.getContent part))))
;; probably message text
(re-matches #"multipart\/alternative.*" content-type)
(doall (map subparts (all-subparts (.getContent part)))))
;; a specific attachment
:else (let [content (.getContent part)]
(if (string? content)
(MessagePart. (.getFileName part) content-type content)
(with-open [tempout (]
(copy-stream (.getInputStream part) tempout)
(MessagePart. (.getFileName part) content-type
(.toByteArray tempout))))))))]
(flatten [(subparts message)])))
(defn parse-message [request]
(let [session (javax.mail.Session/getDefaultInstance (java.util.Properties.) nil)
raw-msg (javax.mail.internet.MimeMessage. session (.getInputStream (:request request)))
from (first (map #(.toString %) (.getFrom raw-msg)))
subject (.getSubject raw-msg)
sent-date (.getSentDate raw-msg)
received-date (.getReceivedDate raw-msg)
to (map #(.toString %) (.getRecipients raw-msg javax.mail.Message$RecipientType/TO))
cc (map #(.toString %) (.getRecipients raw-msg javax.mail.Message$RecipientType/CC))
reply-to (first (map #(.toString %) (.getReplyTo raw-msg)))
message-id (.getMessageID raw-msg)
msg-raw-parts (deconstruct-message raw-msg)
msg-parts (reduce (fn breakdown [acc raw-part]
;; alternatives
(instance? MessageAlternativeParts raw-part)
(reduce breakdown acc (:parts raw-part))
;; has a valid filename, must be an attachment
(not (nil? (:filename raw-part)))
(assoc acc :attachments
(conj (:attachments acc)
(make-attachment (:filename raw-part)
(:data raw-part))))
;; text part
(re-matches #"text\/plain.*" (:content-type raw-part))
(assoc acc :text-body (:data raw-part))
;; HTML part
(re-matches #"text\/html.*" (:content-type raw-part))
(assoc acc :html-body (:data raw-part))))
{:attachments []}
(record MailMessage
:from from :to to :subject subject
:reply-to reply-to :cc cc
:text-body (:text-body msg-parts) :html-body (:html-body msg-parts)
:attachments (:attachments msg-parts)
:message-id message-id)))
Jump to Line
Something went wrong with that request. Please try again.