debbugs: Use guile-email.

* debbugs/email.scm: Delete file.
(soap-email->email): Move to debbugs/operations.scm.
* debbugs/operations.scm (soap-email->email): Use guile-email to parse
email.
* Makefile.am (SOURCES): Unregister debbugs/email.scm.

3 files changed, 33 insertions, 71 deletions

diff --git a/Makefile.am b/Makefile.am
index 0fc86ad..4606e76 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -26,7 +26,6 @@ SOURCES =									\
   debbugs/bug.scm							\
   debbugs/cache.scm							\
   debbugs/config.scm						\
-  debbugs/email.scm							\
   debbugs/operations.scm 					\
   debbugs/rfc822.scm	 					\
   debbugs/soap.scm
diff --git a/debbugs/email.scm b/debbugs/email.scm
deleted file mode 100644
index b67d7be..0000000
--- a/debbugs/email.scm
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; 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))))
diff --git a/debbugs/operations.scm b/debbugs/operations.scm
index dda1413..c4cd80f 100644
--- a/debbugs/operations.scm
+++ b/debbugs/operations.scm
@@ -1,5 +1,6 @@
 ;;; Guile-Debbugs --- Guile bindings for Debbugs
 ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of Guile-Debbugs.
 ;;;
@@ -19,13 +20,44 @@
 (define-module (debbugs operations)
   #:use-module (debbugs soap)
   #:use-module (debbugs bug)
-  #:use-module (debbugs email)
+  #:use-module (email email)
   #:use-module (sxml xpath)
   #:use-module (sxml match)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 optargs))
 
+(define (soap-email->email email-item)
+  "Convert an SXML expression representing an email item from a SOAP
+response to an <email> object."
+  (define (drop-lines str k)
+    (if (zero? k)
+        str
+        (drop-lines (substring str (1+ (string-index str #\newline)))
+                    (1- k))))
+
+  (let ((email-properties (map soap->scheme (cdr email-item))))
+    (let* ((headers (parse-email-headers
+                     (drop-lines (assoc-ref email-properties 'header) 2)))
+           (content-type (assoc-ref headers 'content-type))
+           (body (assoc-ref email-properties 'body)))
+      (case (assoc-ref content-type 'type)
+        ((multipart)
+         (let ((boundary (assoc-ref content-type 'boundary)))
+           (make-email
+            headers
+            ;; Sometimes the debbugs SOAP API provides only the first
+            ;; MIME entity of a multipart message. This is a bug, and
+            ;; the following works around it until it can be fixed in
+            ;; the debbugs SOAP service.
+            (if (string-contains body (string-append "--" boundary))
+                (parse-email-body headers body)
+                (list (make-mime-entity
+                       `(content-type (type . text)
+                                      (subtype . plain))
+                       body))))))
+        (else (make-email headers body))))))
+
 (define-public (newest-bugs amount)
   "Return a list of bug numbers corresponding to the newest AMOUNT
 bugs."