1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;; Copyright (C) 2007 Stelian Ionescu
5 ;; This code is free software; you can redistribute it and/or
6 ;; modify it under the terms of the version 2.1 of
7 ;; the GNU Lesser General Public License as published by
8 ;; the Free Software Foundation, as clarified by the
9 ;; preamble found here:
10 ;; http://opensource.franz.com/preamble.html
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU Lesser General
18 ;; Public License along with this library; if not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA
22 (in-package :net.smtp-client
)
24 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
25 (defvar *smtp-client-commands
* (make-hash-table :test
#'eq
))
27 (defun make-smtp-cmd-name (name)
28 (concat-symbol 'smtp- name
'-cmd
)))
30 (defun read-smtp-return-code (sock expected-code error-msg
)
31 (multiple-value-bind (code msg
)
33 (when (/= code expected-code
)
34 (error "~A: ~A" error-msg msg
))))
36 (defmacro define-smtp-command
(name (sock &rest args
) &body body
)
37 (let ((cmd-name (make-smtp-cmd-name name
)))
39 (defun ,cmd-name
(,sock
,@args
)
41 (setf (gethash ,name
*smtp-client-commands
*)
44 (defmacro invoke-smtp-command
(name sock
&rest args
)
45 (let ((cmd-sym (gethash name
*smtp-client-commands
*)))
47 `(,cmd-sym
,sock
,@args
)
48 (error "Unknown SMTP command: ~A" name
))))
54 (define-smtp-command :mail-from
(sock from
)
55 (format-socket sock
"MAIL FROM: <~A>" from
)
56 (read-smtp-return-code sock
250 "in MAIL FROM command"))
58 (define-smtp-command :rcpt-to
(sock addresses
)
59 (dolist (to addresses
)
60 (format-socket sock
"RCPT TO: <~A>" to
)
61 (read-smtp-return-code sock
250 "in RCPT TO command")))
63 (define-smtp-command :data
(sock)
64 (format-socket sock
"DATA")
65 (read-smtp-return-code sock
354 "in DATA command"))
67 (define-smtp-command :quit
(sock)
68 (format-socket sock
"QUIT")
69 (read-smtp-return-code sock
221 "in QUIT command"))
71 (define-smtp-command :ehlo
(sock host-name
)
72 (format-socket sock
"EHLO ~A" host-name
)
73 (read-smtp-return-code sock
250 "in EHLO command"))
75 (define-smtp-command :helo
(sock host-name
)
76 (format-socket sock
"HELO ~A" host-name
)
77 (read-smtp-return-code sock
250 "in HELO command"))