Changeset 15130 in project


Ignore:
Timestamp:
07/02/09 04:58:51 (10 years ago)
Author:
Ivan Raikov
Message:

proper declaration order in smtp

Location:
release/4/smtp/trunk
Files:
2 edited

Legend:

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

    r15129 r15130  
    4040(module smtp *
    4141
    42         (import scheme chicken data-structures extras srfi-1 srfi-13 srfi-14)
    43 
    44         (require-library srfi-1 abnf)
    45         (import (prefix abnf abnf:) )
     42        (import scheme chicken data-structures extras srfi-1 srfi-13)
     43
     44        (require-library srfi-14 abnf)
     45        (import (prefix abnf abnf:) srfi-14)
    4646        (require-extension datatype matchable)
    4747        (import-for-syntax matchable)
     
    266266
    267267;; backslash followed by any ASCII graphic (including itself) or space
    268 (define quoted-pairSMTP  (abnf:concatenation (abnf:char #\\) (abnf:set (char-set:printing))))
     268(define quoted-pairSMTP  (abnf:concatenation (abnf:char #\\) (abnf:set char-set:printing)))
    269269
    270270;; within a quoted string, any ASCII graphic or space is permitted
     
    316316                          (abnf:char #\.) sub-domain))))
    317317
    318 (define At-domain    (abnf:concatenation (abnf:char #\@ Domain)))
     318(define At-domain    (abnf:concatenation (abnf:char #\@) Domain))
    319319
    320320(define A-d-l        (abnf:concatenation At-domain (abnf:repetition (abnf:concatenation (abnf:char #\,) At-domain))))
     
    329329
    330330(define IPv6-comp    (abnf:concatenation
    331                       (abnf:optional-sequence IPv6-hex (abnf:variable-repetition 0 5 cIPv6-hex))
     331                      (abnf:optional-sequence (abnf:concatenation IPv6-hex (abnf:variable-repetition 0 5 cIPv6-hex)))
    332332                      (abnf:lit "::")
    333                       (abnf:optional-sequence IPv6-hex (abnf:variable-repetition 0 5 cIPv6-hex))))
     333                      (abnf:optional-sequence (abnf:concatenation IPv6-hex (abnf:variable-repetition 0 5 cIPv6-hex)))))
    334334;; The "::" represents at least 2 16-bit groups of zeros.  No more
    335335;; than 6 groups in addition to the "::" may be present.
     336
     337(define Snum        (abnf:variable-repetition 1 3 abnf:decimal))
     338
     339(define IPv4-address-literal  (abnf:concatenation Snum (abnf:repetition-n 3 (abnf:concatenation (abnf:char #\.)  Snum))))
    336340
    337341(define IPv6v4-full   (abnf:concatenation IPv6-hex (abnf:repetition-n 5 cIPv6-hex)
     
    350354(define IPv6-addr   (abnf:alternatives IPv6-full IPv6-comp IPv6v4-full IPv6v4-comp))
    351355
    352 (define Snum        (abnf:variable-repetition 1 3 abnf:decimal))
    353 
    354 (define IPv4-address-literal  (abnf:concatenation Snum (abnf:repetition-n 3 (abnf:concatenation (abnf:char #\.)  Snum))))
    355356
    356357(define IPv6-address-literal  (abnf:concatenation (abnf:lit "IPv6:") IPv6-addr))
     
    373374;; See Section 4.1.3
    374375
    375 (define Mailbox        (abnf:concatenation Local-part (abnf:char #\@ (abnf:alternatives Domain address-literal))))
     376(define Mailbox        (abnf:concatenation Local-part (abnf:char #\@) (abnf:alternatives Domain address-literal)))
    376377
    377378
     
    402403    (abnf:optional-sequence (abnf:concatenation abnf:sp Rcpt-parameters)))))
    403404
    404    
    405 
    406 ;; Command Parsers
    407 
    408 ;; Constructs a parser for a command without arguments.
    409 
    410 (define (mkcmdp0 s kons) 
    411   (define (ignore x) (kons))
    412   (let ((ss (->string s)))
    413     (abnf:bind ((lcollect ignore))
    414      (abnf:concatenation
    415       (consumed->symbol (abnf:lit ss))
    416       (abnf:drop-consumed (abnf:repetition abnf:sp))
    417       (abnf:drop-consumed abnf:crlf)
    418       ))))
    419 
    420 ;; Constructs a WrongArg command
    421 (define (wrong-arg cmd)
    422   (abnf:bind (lambda (x) (WrongArg cmd ""))
    423              abnf:pass))
    424 
    425 ;; Constructs a parser for a command with an argument, which the given
    426 ;; parser will handle. The result of the argument parser will be
    427 ;; applied to the given constructor procedure before returning.
    428 
    429 (define (mkcmdp1 s p kons) 
    430   (let ((ss (->string s)))
    431     (abnf:concatenation
    432      (consumed->symbol (abnf:lit ss))
    433      (abnf:drop-consumed (abnf:repetition abnf:sp))
    434      (abnf:alternatives (abnf:bind ((lcollect kons)) p)
    435                         (wrong-arg ss) )
    436      (abnf:drop-consumed abnf:crlf)
    437      )))
    438 
    439 
    440 ;; The SMTP parsers defined here correspond to the commands specified
    441 ;; in the RFC.
    442 
    443 
    444 (define data (mkcmdp0 "DATA" Data))
    445 (define rset (mkcmdp0 "RSET" Rset))
    446 (define quit (mkcmdp0 "QUIT" Quit))
    447 (define turn (mkcmdp0 "TURN" Turn))
    448 (define helo (mkcmdp1 "HELO" Helo     Domain))
    449 (define ehlo (mkcmdp1 "EHLO" Ehlo     Domain))
    450 (define mail (mkcmdp1 "MAIL" MailFrom from-path))
    451 (define rcpt (mkcmdp1 "RCPT" RcptTo   to-path))
    452 (define send (mkcmdp1 "SEND" Send     from-path))
    453 (define soml (mkcmdp1 "SOML" Soml     from-path))
    454 (define saml (mkcmdp1 "SAML" Saml     from-path))
    455 (define vrfy (mkcmdp1 "VRFY" Vrfy     (abnf:concatenation abnf:sp String)))
    456 (define expn (mkcmdp1 "EXPN" Expn     (abnf:concatenation abnf:sp String)))
    457 
    458 (define help (mkcmdp1 "HELP" (lambda (x) (if (null? x) (Help) (Help (car x))))
    459                       (abnf:optional-sequence (abnf:concatenation abnf:sp String))))
    460 
    461 (define noop (mkcmdp1 "NOOP" (lambda (x) (Noop))
    462                       (abnf:optional-sequence (abnf:concatenation abnf:sp String))))
    463                        
    464 
    465 (define smtp-cmd
    466   (abnf:longest
    467    (abnf:alternatives
    468     data rset noop quit turn helo mail rcpt
    469     send soml saml vrfy expn help ehlo
    470     )))
    471 
    472 (define (parse cont p)
    473   (let ((cont1 (lambda (s) (cont (map caar s)))))
    474     (lambda (s) (p cont1 s))))
    475 
    476 
    477 ;; ESMTP State Machine
     405;; ESMTP sessions, events, commands
    478406
    479407(define-datatype session-state session-state?
     
    548476         (WrongArg (s)  (fprintf out "Syntax error in argument of ~S." s))))
    549477
     478;; Command Parsers
     479
     480;; Constructs a parser for a command without arguments.
     481
     482(define (mkcmdp0 s kons) 
     483  (define (ignore x) (kons))
     484  (let ((ss (->string s)))
     485    (abnf:bind ((lcollect ignore))
     486     (abnf:concatenation
     487      (consumed->symbol (abnf:lit ss))
     488      (abnf:drop-consumed (abnf:repetition abnf:sp))
     489      (abnf:drop-consumed abnf:crlf)
     490      ))))
     491
     492;; Constructs a WrongArg command
     493(define (wrong-arg cmd)
     494  (abnf:bind (lambda (x) (WrongArg cmd ""))
     495             abnf:pass))
     496
     497;; Constructs a parser for a command with an argument, which the given
     498;; parser will handle. The result of the argument parser will be
     499;; applied to the given constructor procedure before returning.
     500
     501(define (mkcmdp1 s p kons) 
     502  (let ((ss (->string s)))
     503    (abnf:concatenation
     504     (consumed->symbol (abnf:lit ss))
     505     (abnf:drop-consumed (abnf:repetition abnf:sp))
     506     (abnf:alternatives (abnf:bind ((lcollect kons)) p)
     507                        (wrong-arg ss) )
     508     (abnf:drop-consumed abnf:crlf)
     509     )))
     510
     511
     512;; The SMTP parsers defined here correspond to the commands specified
     513;; in the RFC.
     514
     515(define data (mkcmdp0 "DATA" Data))
     516(define rset (mkcmdp0 "RSET" Rset))
     517(define quit (mkcmdp0 "QUIT" Quit))
     518(define turn (mkcmdp0 "TURN" Turn))
     519(define helo (mkcmdp1 "HELO" Helo     Domain))
     520(define ehlo (mkcmdp1 "EHLO" Ehlo     Domain))
     521(define mail (mkcmdp1 "MAIL" MailFrom from-path))
     522(define rcpt (mkcmdp1 "RCPT" RcptTo   to-path))
     523(define send (mkcmdp1 "SEND" Send     from-path))
     524(define soml (mkcmdp1 "SOML" Soml     from-path))
     525(define saml (mkcmdp1 "SAML" Saml     from-path))
     526(define vrfy (mkcmdp1 "VRFY" Vrfy     (abnf:concatenation abnf:sp String)))
     527(define expn (mkcmdp1 "EXPN" Expn     (abnf:concatenation abnf:sp String)))
     528
     529(define help (mkcmdp1 "HELP" (lambda (x) (if (null? x) (Help) (Help (car x))))
     530                      (abnf:optional-sequence (abnf:concatenation abnf:sp String))))
     531
     532(define noop (mkcmdp1 "NOOP" (lambda (x) (Noop))
     533                      (abnf:optional-sequence (abnf:concatenation abnf:sp String))))
     534                       
     535
     536(define smtp-cmd
     537  (abnf:longest
     538   (abnf:alternatives
     539    data rset noop quit turn helo mail rcpt
     540    send soml saml vrfy expn help ehlo
     541    )))
     542
     543(define (parse cont p)
     544  (let ((cont1 (lambda (s) (cont (map caar s)))))
     545    (lambda (s) (p cont1 s))))
     546
     547
     548;; ESMTP State Machine
     549
    550550(define-datatype session-fsm session-fsm?
    551551  (Event (ev event?))
  • release/4/smtp/trunk/smtp.setup

    r15129 r15130  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (compile -O2 -d0 -s smtp.scm -j smtp)
     6(compile -O -d2 -s smtp.scm -j smtp)
    77(compile -s smtp.import.scm)
    88
Note: See TracChangeset for help on using the changeset viewer.