2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts read-rfc822)) '\'main
')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; read-rfc822
--- Validate RFC822
file by displaying it to stdout
8 ;; Copyright
(C
) 2002, 2004, 2006 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 51 Franklin Street
, Fifth Floor
,
23 ;; Boston
, MA
02110-1301 USA
25 ;;; Author
: Thien-Thi Nguyen
<ttn@gnu.org
>
29 ;; Usage
: read-rfc822 FILE
31 ;; Read FILE
, assumed to be
in RFC822 format
, and display it to stdout.
32 ;; This is not very interesting
, admittedly.
34 ;; For Scheme programming
, this module exports two procs
:
35 ;; (read-rfc822 . args
) ; only first arg used
36 ;; (read-rfc822-silently port
)
38 ;; Parse FILE
(a string
) or PORT
, respectively
, and
return a query proc that
39 ;; takes a symbol COMP
, and returns the message component COMP. Supported
40 ;; values
for COMP
(and the associated query
return values
) are
:
41 ;; from
-- #f (reserved for future mbox support)
42 ;; headers
-- alist of
(HEADER-SYMBOL .
"VALUE-STRING") pairs
, in order
43 ;; body
-- rest of the
mail message
, a string
44 ;; body-lines
-- rest of the
mail message
, as a list of lines
45 ;; Any other query results
in a
"bad component" error.
47 ;; TODO
: Add
"-m" option
(mbox support
).
51 (define-module
(scripts read-rfc822
)
52 :use-module
(ice-9 regex
)
53 :use-module
(ice-9 rdelim
)
54 :autoload
(srfi srfi-13
) (string-join
)
55 :export (read-rfc822 read-rfc822-silently
))
57 (define from-line-rx
(make-regexp
"^From "))
58 (define header-name-rx
(make-regexp
"^([^:]+):[ \t]*"))
59 (define header-cont-rx
(make-regexp
"^[ \t]+"))
61 (define option
#f) ; for future "-m"
63 (define
(drain-message port
)
64 (let loop
((line
(read-line port
)) (acc
'()))
65 (cond ((eof-object? line)
67 ((and option (regexp-exec from-line-rx line))
71 (reverse (string->list line))))
74 (loop (read-line port) (cons line acc))))))
76 (define (parse-message port)
77 (let* ((from (and option
78 (match:suffix (regexp-exec from-line-rx
83 (add-header
! (lambda
(reversed-hlines
)
84 (let* ((hlines
(reverse reversed-hlines
))
86 (m
(regexp-exec header-name-rx first
))
87 (name
(string-
>symbol
(match
:substring m
1)))
89 (cons
(substring first
(match
:end m
))
92 (set! headers
(acons name data headers
))))))
93 ;; "From " is only one line
94 (let loop
((line
(read-line port
)) (current-header
#f))
95 (cond
((string-null? line
)
96 (and current-header
(add-header
! current-header
))
97 (set! body-lines
(drain-message port
)))
98 ((regexp-exec header-cont-rx line
)
100 (loop
(read-line port
)
101 (cons
(match
:suffix m
) current-header
))))
103 (and current-header
(add-header
! current-header
))
104 (loop
(read-line port
) (list line
)))))
105 (set! headers
(reverse headers
))
109 ((body-lines
) body-lines
)
112 (begin
(set! body
(string-join body-lines
"\n" 'suffix))
114 (else (error "bad component:" component))))))
116 (define (read-rfc822-silently port)
117 (parse-message port))
119 (define (display-rfc822 parse)
120 (cond ((parse 'from
) => (lambda
(from
) (format
#t "From ~A\n" from))))
121 (for-each
(lambda
(header
)
122 (format
#t "~A: ~A\n" (car header) (cdr header)))
124 (format #t "\n~A" (parse 'body
)))
126 (define
(read-rfc822 . args
)
127 (let ((parse
(read-rfc822-silently
(open-file
(car args
) OPEN_READ
))))
128 (display-rfc822 parse
))
131 (define main read-rfc822
)
133 ;;; read-rfc822 ends here