blob: b67d7be889608e0edf65e3e19c3099b852572076 (
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
65
66
67
68
69
|
;;; 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-headers
email-body
email-attachments
soap-email->email))
(define-record-type <email>
(make-email headers body attachments)
email?
(headers email-headers)
(body email-body)
(attachments email-attachments))
(set-record-type-printer! <email>
(lambda (record port)
(simple-format port "#<email ~a>"
(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 '()))
(define (drop-lines str k)
(if (zero? k)
str
(drop-lines (substring str (1+ (string-index str #\newline)))
(1- k))))
(make-email (parse-headers (drop-lines header 2))
body attachments))
(define (soap-email->email email-item)
"Convert an SXML expression representing an email item from a SOAP
response to an <email> object."
(let ((email-properties (map soap->scheme (cdr email-item))))
(apply email
(append-map (match-lambda
((key . value)
(list (symbol->keyword key) value)))
email-properties))))
|
