Commit 2c255874 authored by Jan Idzikowski's avatar Jan Idzikowski
Browse files

A lot of changes:

- add support for sending raw messages
- add character quoting in email headers (according to RFC2047)
- add condition classes for error reporting
- fixed STARTTLS
- change authentication functionality
See CHANGELOG and source.
Thanks Hans Huebner for these changes.
parent 898bc776
Version 20080202.1
2007.02.02
Added support for sending raw messages. (Hans Huebner)
Fixed STARTTLS so that an EHLO command is sent after STARTTLS. (Hans Huebner)
Changed Authentication functionality, the actual authentication method used is determined by looking at the advertised features of the SMTP server. (Hans Huebner)
Added non-ASCII character quoting in email headers (according to RFC2047). (Hans Huebner)
Added condition classes for error reporting. (Hans Huebner)
Change cl-smtp.lisp, cl-smtp.asd, CHANGELOG
Add smtp-output-stream.lisp
Version 20071113.1
2007.11.13
Add SSL support, thank Timothy Ritchey for the suggestions.
......
......@@ -25,26 +25,29 @@ To use cl-smtp:
Arguments:
- host (String) : hostname or ip-adress of the smtpserver
- from (String) : email adress
- to (String or Cons of Strings) : email adress
- to (String or List of Strings) : email adress
- subject (String) : subject text
- message (String) : message body
keywords:
- cc (String or Cons of Strings) : email adress carbon copy
- bcc (String or Cons of Strings): email adress blind carbon copy
- cc (String or List of Strings) : email adress carbon copy
- bcc (String or List of Strings): email adress blind carbon copy
- reply-to (String) : email adress
- displayname (String) : displayname of the sender
- extra-headers (Cons) : extra headers as alist
- extra-headers (List) : extra headers as alist
- html-message (String) : message body formatted with HTML tags
- authentication (Cons) : list with 3 elements
(:method "username" "password")
- authentication (List) : list with 2 or elements
([:method] "username" "password")
method is a keyword :plain or :login
If the method is not specified, the
proper method is determined automatically.
- attachments (String or Pathname: attachments to send
Cons of String/Pathnames)
List of String/Pathnames)
- buffer-size (Number default 256): controls how much of a attachment file
is read on each loop before encoding
and transmitting the contents,
the number is interpretted in KB
- ssl (Boolean) : if true than use the STARTTLS functionality to make a ssl connection
the number is interpreted in KB
- ssl (or t :starttls :tls) : if t or :STARTTLS: use the STARTTLS functionality
if :TLS: use TLS directly
Returns nil or error with message
......
......@@ -16,25 +16,18 @@
;;; File: cl-smtp.asd
;;; Description: cl-smtp ASDF system definition file
(defpackage :cl-smtp
(:use :cl :asdf)
(:export :send-email))
(in-package :cl-smtp)
(defparameter *debug* nil)
(defmacro print-debug (str)
`(when *debug*
(print ,str)))
(asdf:defsystem :cl-smtp
:version "20071113.1"
:perform (load-op :after (op webpage)
(pushnew :cl-smtp cl:*features*))
:depends-on (:usocket #-allegro :cl-base64
#-allegro :flexi-streams
#-allegro :cl+ssl)
:components ((:file "cl-smtp" :depends-on ("attachments"))
(:file "attachments")
(:file "mime-types")))
:version "20080202.1"
:perform (load-op :after (op webpage)
(pushnew :cl-smtp cl:*features*))
:depends-on (:usocket
:trivial-gray-streams
:flexi-streams
#-allegro :cl-base64
#-allegro :cl+ssl)
:serial t
:components ((:file "package")
(:file "attachments")
(:file "cl-smtp")
(:file "smtp-output-stream")
(:file "mime-types")))
This diff is collapsed.
;; -*- Lisp -*-
;; smtp-output-stream.lisp - Perform protocol and mail specific
;; processing to convert an email message into an external format
;; proper to be transfered through SMTP.
;; This stream type is used to do two things:
;; In the message header, convert all non-ASCII characters to their
;; equivalent Q-encoded representation (RFC2047)
;; In the whole message, convert all line endings to CR+LF as required
;; by the SMTP protocol.
;; This stream class should also perform automatic dot masking, tbd.
(in-package :cl-smtp)
(defclass smtp-output-stream (trivial-gray-stream-mixin fundamental-character-output-stream)
((encapsulated-stream
:initarg :encapsulated-stream
:reader encapsulated-stream)
(in-header
:initform t
:accessor in-header
:documentation
"Currently emitting the header of the message")
(line-has-non-ascii
:initform nil
:accessor line-has-non-ascii
:documentation
"The current line has non ASCII characters in it")
(previous-char
:initform nil
:accessor previous-char
:documentation
"Previous character sent to the stream, used to detect end of header")
(external-format
:initform (flex:make-external-format :iso-8859-15)
:initarg :external-format
:reader external-format)))
(defmethod stream-element-type ((stream smtp-output-stream))
(stream-element-type (stream stream)))
(defmethod close ((stream smtp-output-stream) &key abort)
(close (encapsulated-stream stream) :abort abort))
(defmethod stream-write-char ((stream smtp-output-stream) char)
(with-accessors ((in-header in-header)
(line-has-non-ascii line-has-non-ascii)
(previous-char previous-char)
(external-format external-format)
(encapsulated-stream encapsulated-stream)) stream
(when in-header
(cond
;; Newline processing
((eql char #\Newline)
;; Finish quoting
(when line-has-non-ascii
(format encapsulated-stream "?=")
(setf line-has-non-ascii nil))
;; Test for end of header
(when (eql previous-char #\Newline)
(setf in-header nil)))
((eql char #\Return)
;; CR is suppressed here and added before each #\Newline
)
;; Handle non-ASCII characters
((< 127 (char-code char))
(unless line-has-non-ascii
(format encapsulated-stream "=?~A?Q?" (flex:external-format-name external-format))
(setf line-has-non-ascii t))
(loop for byte across (flex:string-to-octets (make-string 1 :initial-element char)
:external-format external-format)
do (format encapsulated-stream "=~2,'0X" byte))))
(setf previous-char char))
#+nil(when (eql char #\Newline)
(write-char #\Return encapsulated-stream))
(unless (< 127 (char-code char))
(write-char char encapsulated-stream))))
(defmethod stream-write-sequence ((stream smtp-output-stream) sequence start end &key)
(if (in-header stream)
(loop for i from start below end
do (stream-write-char stream (elt sequence i)))
(write-sequence sequence (encapsulated-stream stream) :start start :end end)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment