source: project/wiki/eggref/4/smtp @ 15903

Last change on this file since 15903 was 15903, checked in by Ivan Raikov, 10 years ago

updated smtp documentation

File size: 9.3 KB
Line 
1[[tags: eggs]]
2[[toc:]]
3
4== smtp
5
6=== Description
7
8{{smtp}} is a collection of parser combinators and state machine
9primitives for the grammar defined in
10[[http://www.ietf.org/rfc/rfc5321.txt|RFC 5321]]
11(Simple Mail Transfer Protocol).
12
13=== Data Types for SMTP Commands
14
15Represenation of SMTP commands:
16 
17 (define-datatype cmd cmd?
18  (Helo (s string?))
19  (Ehlo (s string?))
20  (MailFrom (m mailbox?) (parameters list?))
21  (RcptTo   (m mailbox?) (parameters list?))
22  (Data)
23  (Rset)
24  (Send  (m mailbox?))
25  (Soml  (m mailbox?))
26  (Saml  (m mailbox?))
27  (Vrfy  (s string?))
28  (Expn  (s string?))
29  (Help  (s string?))
30  (Noop)
31  (Quit)
32  (Turn)
33  (WrongArg (cmd string?)  (message string?)))
34
35The record printer defined for this datatype prints values of this
36type in a format conforming to the RFC. For example:
37
38  csi> (print (Helo "myhost.org"))
39  HELO myhost.org
40
41The {{mailbox}} datatype has the following definition:
42
43 (define-datatype mailbox mailbox?
44   (Mailbox (local-part string?)
45            (domain string?)))
46
47
48=== Data Types for SMTP Replies
49
50Representation of SMTP replies:
51
52  (define-datatype reply reply?
53   (Reply (code code?) (msg list?)))
54
55
56An SMTP reply is a three-digit return code plus comments. This is what
57the list of strings is for; one string per line in the reply.  the
58record printer will append an CRLF end-of-line marker to each entry in
59that list, so that the resulting string is ready to be sent back to
60the peer.
61
62
63For example:
64
65 > (print (Reply (Code (Success) (MailSystem) 0)
66                     (list "worked" "like" "a charm")))
67 250-worked
68 250-like
69 250 a charm
70
71
72The {{code}} datatype consists of success code, category and
73supplemental code:
74
75 (define-datatype code code?
76   (Code (suc success-code?) (cat category?) (num integer?)))
77
78In addition, the {{success-code}} and {{category}} datatypes can be
79used to map symbolic identifiers to integers and vice versa:
80
81 (define-enumerated-type
82   success-code success-code? success-vector
83   success-code-inject success-code-project
84   (Unused)
85   (PreliminarySuccess)
86   (Success)
87   (IntermediateSuccess)
88   (TransientFailure)
89   (PermanentFailure))
90
91 (define-enumerated-type
92   category category? category-vector
93   category-inject category-project
94   (Syntax)
95   (Information)
96   (Connection)
97   (Unspecified3)
98   (Unspecified4)
99   (MailSystem))
100
101{{define-enumerated-type}} defines a new record type, with as many
102instances as there are instance names. {{name-vector}} is bound to a
103vector containing the instances of the type in the same order as the
104{{instance-name}} list. {{name-inject}} and {{name-project}} are
105procedures that map integers to an instance and vice versa.
106
107=== ESMTP State Machine
108
109<procedure>(start-session)</procedure> 
110
111Procedure {{start-session}} returns an ESMTP state machine object (a
112procedure), which takes in a stream containing an SMTP command and
113returns an appropriate {{session-fsm}} value:
114
115  (define-datatype session-fsm session-fsm?
116    (Event (ev event?))
117    (Trans (ev event?) (fsm procedure?)))
118
119A stream in this case is defined as the representation used by the
120[[abnf]] library.
121
122The {{Event}} variant signals an event that must be processed by the
123calling library, while {{Trans}} signals an event and a state machine
124transition. The following events can be returned by this state
125machine:
126
127 (define-datatype event event?
128   (SayHelo       (s string?))
129   (SayHeloAgain  (s string?))
130   (SayEhlo       (s string?))
131   (SayEhloAgain  (s string?))
132   (SetMailFrom   (m mailbox?) (parameters? list))
133   (AddRcptTo     (m mailbox?) (parameters? list))
134   (StartData)
135   (NeedHeloFirst)
136   (NeedMailFromFirst)
137   (NeedRcptToFirst)
138   (NotImplemented) ;; Turn, Send, Soml, Saml, Vrfy, Expn.
139   (ResetState)
140   (SayOK)
141   (SeeksHelp    (s string?))
142   (Shutdown)
143   (SyntaxErrorIn (s string?))
144   (Unrecognized  (s string?)))
145
146
147
148=== Requires
149
150* [[abnf]]
151* [[datatype]]
152* [[matchable]]
153
154=== Examples
155
156<enscript highlight="scheme">
157
158;; An example MTA implementation
159
160(use datatype smtp)
161
162(define domain    "example.net")
163(define host      "chicken-mta")
164(define mailfrom  (make-parameter #f))
165(define rcpto     (make-parameter '()))
166(define data      (make-parameter #f))
167
168(define (handle-event ev)
169  (cases event ev
170         (SayHelo (s)
171          (Reply (Code (Success) (MailSystem) 0)
172                 (list host " " "Hello " s)))
173         
174         (SayHeloAgain (s)
175          (Reply (Code (Success) (MailSystem) 0)
176                 (list host " " "Hello " s)))
177
178         (SayEhlo (s)
179          (Reply (Code (Success) (MailSystem) 0)
180                 (list host " " "Hello " s)))
181         
182         (SayEhloAgain (s)
183          (Reply (Code (Success) (MailSystem) 0)
184                 (list host " " "Hello " s)))
185         
186         (SetMailFrom (m)
187           (mailfrom m)
188           (Reply (Code (Success) (MailSystem) 0)
189                  (list "OK")))
190
191         (AddRcptTo (m)
192            (if (not (mailfrom))
193               (Reply (Code (PermanentFailure) (Syntax) 3)
194                      (list "command out of sequence"))
195               (begin
196                 (rcpto (cons m (rcpto)))
197                 (Reply (Code (Success) (MailSystem) 0)
198                        (list "Accepted")))))
199
200         (StartData ()
201            (if (not (rcpto))
202               (Reply (Code (PermanentFailure) (MailSystem) 4)
203                      (list "no valid recipients"))
204               (begin
205                 (data (list))
206                 (Reply (Code (IntermediateSuccess) (MailSystem) 4)
207                        (list "Ready")))))
208
209         (NeedHeloFirst ()
210           (Reply (Code (PermanentFailure) (Syntax) 3)
211                      (list "command out of sequence: "
212                            "need HELO first")
213                      ))
214
215         (NeedMailFromFirst ()
216           (Reply (Code (PermanentFailure) (Syntax) 3)
217                      (list "command out of sequence: "
218                            "need MAIL first")
219                      ))
220
221         (NeedMailRcptToFirst ()
222           (Reply (Code (PermanentFailure) (Syntax) 3)
223                      (list "command out of sequence: "
224                            "need RCPT first")
225                      ))
226
227         (NotImplemented ()
228           (Reply (Code (PermanentFailure) (Syntax) 2)
229                  (list "command not implemented")))
230
231
232         (ResetState ()
233             (mailfrom #f)
234             (rcpto    #f)
235             (data     #f)
236             (Reply (Code (Success) (MailSystem) 0)
237                    (list "Reset OK")))
238
239         (SayOK ()
240             (Reply (Code (Success) (MailSystem) 0)
241                    (list "OK")))
242
243         (SeeksHelp (s)
244             (Reply (Code (Success) (Information) 4)
245                    (list "Commands supported:"
246                          "HELO EHLO MAIL RCPT DATA QUIT RSET NOOP HELP")))
247
248         (Shutdown ()
249            (Reply (Code (Success) (MailSystem) 1)
250                   (list host " closing connection")))
251
252         (SyntaxErrorIn (s)
253            (Reply (Code (PermanentFailure) (Syntax) 1)
254                   (list "syntax error in " s)))
255
256         (Unrecognized (s)
257            (Reply (Code (PermanentFailure) (Syntax) 0)
258                   (list "Unrecognized " s)))
259         ))
260
261;; from SSAX lib
262(define (peek-next-char port)
263  (read-char port)
264  (peek-char port))
265
266(define (read-smtp-line port)
267  (let loop ((cs (list)))
268    (let ((c (peek-char port)))
269    (if (eof-object? c) (reverse cs)
270        (let ((n (peek-next-char port)))
271          (cond ((and (eq? n #\newline) (eq? c #\return))
272                 (begin
273                   (read-char port)
274                   (reverse (cons* n c cs)))
275                 )
276                (else (loop (cons c cs)))))))))
277
278(define data-end (list #\. #\return #\newline))
279     
280(define (handle-data in out cont)
281  (let loop ((tempdata (list)))
282    (let ((line (read-smtp-line in)))
283      (if (equal? line data-end)
284          (begin (data (reverse tempdata))
285                 (fprintf out "~A"
286                          (Reply (Code (Success) (MailSystem) 0) (list "OK")))
287                 (cont))
288          (loop (cons (list->string line) tempdata))))))
289
290(define (main in out) 
291  (let loop ((fsm (start-session)))
292    (let ((line     (read-smtp-line in)))
293      (if (null? line) (loop fsm)
294          (let ((instream (list `(() ,line))))
295            (let-values
296             (((reply ev fsm)
297               (cases session-fsm (fsm instream)
298                      (Event (ev)
299                             (let ((reply (handle-event ev)))
300                               (values reply ev fsm)))
301                      (Trans (ev fsm)
302                             (let ((reply (handle-event ev)))
303                               (values reply ev fsm))))))
304             (fprintf out "~A" reply)
305             (cases event ev
306                    (StartData ()
307                               (handle-data in out (lambda () (loop fsm))))
308                    (Shutdown ()
309                              (begin))
310                    (else (loop fsm)))))))))
311                     
312
313
314</enscript>
315
316=== Version History
317
318* 1.0 Initial release
319
320=== License
321
322Based on the Haskell Rfc2821 module by Peter Simons.
323
324  Copyright 2009 Ivan Raikov.
325  All rights reserved.
326 
327  Redistribution and use in source and binary forms, with or without
328  modification, are permitted provided that the following conditions are
329  met:
330 
331  Redistributions of source code must retain the above copyright
332  notice, this list of conditions and the following disclaimer.
333 
334  Redistributions in binary form must reproduce the above copyright
335  notice, this list of conditions and the following disclaimer in the
336  documentation and/or other materials provided with the distribution.
337 
338  Neither the name of the author nor the names of its contributors may
339  be used to endorse or promote products derived from this software
340  without specific prior written permission.
341 
342  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
343  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
344  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
345  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
346  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
347  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
348  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
349  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
350  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
351  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
352  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
353  OF THE POSSIBILITY OF SUCH DAMAGE.
Note: See TracBrowser for help on using the repository browser.