blob: e73229145daa9db7ab873b51fe65295bc505ea06 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;;; Guile-Debbugs --- Guile bindings for Debbugs
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of Guile-Debbugs.
;;;
;;; Guile-Debbugs is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Guile-Debbugs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-Debbugs. If not, see <http://www.gnu.org/licenses/>.
(define-module (debbugs email)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:use-module (debbugs soap)
#:use-module (debbugs rfc822)
#:export (email
email?
email-headers
email-body
email-msg-num
email-attachments
soap-email->email))
(define-record-type <email>
(make-email headers body msg-num attachments)
email?
(headers email-headers)
(body email-body)
(msg-num email-msg-num)
(attachments email-attachments))
(set-record-type-printer! <email>
(lambda (record port)
(simple-format port "#<email ~s ~a>"
(email-msg-num record)
(number->string (object-address record) 16))))
(define (parse-headers header-text)
"Parse the email headers and return them as an alist."
(with-input-from-string header-text
(lambda () (rfc822-header->list (current-input-port)))))
(define* (email #:key header body msg-num (attachments '()))
(make-email (parse-headers header) body msg-num attachments))
(define (soap-email->email email-item)
(let ((email-properties (map soap->scheme (cdr email-item))))
(apply email
(append-map (match-lambda
((key . value)
(list (symbol->keyword key) value)))
email-properties))))
|
