Changeset 15800 in project


Ignore:
Timestamp:
09/09/09 03:07:03 (10 years ago)
Author:
Ivan Raikov
Message:

simplified handling of domain names in smtp

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/smtp/trunk/smtp.scm

    r15784 r15800  
    4141
    4242        (
     43         smtp-cmd help helo domain Ldh-str
     44
    4345         mailbox? Mailbox
    4446
     
    6567        )
    6668
    67         (import scheme chicken data-structures srfi-1 srfi-13 srfi-14)
     69        (import scheme chicken data-structures )
    6870
    6971        (require-library extras abnf)
    7072        (import (prefix abnf abnf:) (only extras sprintf fprintf ))
    7173
    72         (require-extension datatype matchable)
     74        (require-extension srfi-1 srfi-13 srfi-14 datatype matchable )
    7375        (import-for-syntax matchable)
    7476
     
    128130  (syntax-rules ()
    129131    ((_ p)    (abnf:bind scollect (abnf:longest p)))
     132    ))
     133
     134(define (list->domain-string lst)
     135  (if (and (pair? lst) (char=? (last lst) #\-))
     136      (error "domain string ends with - "
     137             (list->string lst))
     138      (list->string lst)))
     139
     140(define-syntax consumed->domain-string
     141  (syntax-rules ()
     142    ((_ p)    (abnf:bind (abnf:collect-chars list->domain-string)
     143                         (abnf:longest p)))
    130144    ))
    131145
     
    352366(define String           (abnf:alternatives Atom Quoted-string))
    353367
    354 (define Let-dig          (abnf:alternatives abnf:alpha abnf:decimal))
    355 
    356368(define esmtp-keyword   (consumed->symbol
    357369                         (abnf:concatenation
     
    391403(define Rcpt-parameters  Mail-parameters)
    392404
    393 
    394 (define Ldh-str         (abnf:concatenation
    395                           (abnf:repetition
    396                            (abnf:alternatives
    397                             abnf:alpha abnf:decimal (abnf:char #\-)))
    398                           Let-dig))
    399 
    400 (define Keyword        Ldh-str)
    401405(define Argument       Atom)
    402406
    403 (define sub-domain     (consumed->string
     407(define Ldh-str        (consumed->domain-string
    404408                        (abnf:concatenation
    405                          Let-dig
    406                          (abnf:optional-sequence Ldh-str))))
    407 
    408 (define Domain         (consumed-strings->list
     409                         abnf:alpha
     410                         (abnf:repetition
     411                          (abnf:alternatives
     412                           abnf:alpha abnf:decimal (abnf:char #\-))))))
     413
     414(define sub-domain     Ldh-str)
     415
     416(define domain         (consumed-strings->list
    409417                        (abnf:concatenation
    410418                         sub-domain
     
    416424(define At-domain    (abnf:concatenation
    417425                      (abnf:drop-consumed (abnf:char #\@))
    418                       Domain))
     426                      domain))
    419427
    420428(define A-d-l        (abnf:concatenation
     
    514522;; See Section 4.1.3
    515523
    516 (define Mailbox        (abnf:concatenation Local-part (abnf:char #\@) (abnf:alternatives Domain address-literal)))
     524(define Mailbox        (abnf:concatenation Local-part (abnf:char #\@) (abnf:alternatives domain address-literal)))
    517525
    518526(define Path           (abnf:concatenation (abnf:char #\<)
     
    536544   (abnf:lit "TO:")
    537545   (abnf:alternatives
    538     (abnf:concatenation (abnf:char #\<) (abnf:lit "Postmaster@") Domain (abnf:char #\>))
     546    (abnf:concatenation (abnf:char #\<) (abnf:lit "Postmaster@") domain (abnf:char #\>))
    539547    (abnf:concatenation (abnf:char #\<) (abnf:lit "Postmaster") (abnf:char #\>))
    540548    Forward-path
     
    635643;; applied to the given constructor procedure before returning.
    636644
    637 (define (mkcmdp1 s p kons
     645(define (mkcmdp1 s kons p
    638646  (let ((ss (->string s)))
    639     (abnf:concatenation
    640      (consumed->symbol (abnf:lit ss))
    641      (abnf:drop-consumed (abnf:repetition abnf:sp))
    642      (abnf:alternatives (abnf:bind ((lcollect kons)) p)
    643                         (wrong-arg ss) )
    644      (abnf:drop-consumed abnf:crlf)
    645      )))
     647    (lambda (cont s)
     648      (print "mkcmdp1: ss = " ss)
     649      (print "mkcmdp1: s = " s)
     650      ((abnf:concatenation
     651        (lambda (cont s)
     652          (print "mkcmdp1: header s = " s)
     653          ((consumed->symbol (abnf:lit ss))
     654           (lambda (x) (print "mkcmdp1: header = " x) (cont x))
     655           s))
     656        (abnf:repetition abnf:sp)
     657        (abnf:alternatives
     658         (abnf:bind (abnf:collect-chars (compose kons list->string)) p)
     659         (wrong-arg ss) )
     660        (abnf:drop-consumed abnf:crlf))
     661       (lambda (x) (print "mkcmdp1: x = " x) (cont x)) s)
     662      )))
    646663
    647664
     
    653670(define quit (mkcmdp0 "QUIT" Quit))
    654671(define turn (mkcmdp0 "TURN" Turn))
    655 (define helo (mkcmdp1 "HELO" Helo     Domain))
    656 (define ehlo (mkcmdp1 "EHLO" Ehlo     Domain))
     672(define helo (mkcmdp1 "HELO" Helo     domain))
     673(define ehlo (mkcmdp1 "EHLO" Ehlo     domain))
    657674(define mail (mkcmdp1 "MAIL" MailFrom from-path))
    658675(define rcpt (mkcmdp1 "RCPT" RcptTo   to-path))
     
    675692    data rset noop0 quit turn helo mail rcpt
    676693    send soml saml vrfy expn help ehlo
    677     )))
     694    ))
     695  )
    678696
    679697(define (parse-cmd cont)
Note: See TracChangeset for help on using the changeset viewer.