mumi: Remove parser procedures.

* mumi/messages.scm (split-multipart-message, read-token, read-until,
read-between, read-key-value-pair, throw-away, parse-multipart-header,
multipart-header?): Remove procedures.

1 files changed, 0 insertions, 156 deletions

diff --git a/mumi/messages.scm b/mumi/messages.scm
index 2f4f1e5..43d5d1b 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -35,7 +35,6 @@
             fetch-bug
             recent-bugs
 
-            split-multipart-message
             multipart-message?
             extract-attachment
             qp-decoder))
@@ -95,67 +94,6 @@
   (bot? (sender-email message)))
 
 
-;; Taken from (debbugs rfc822).
-(define* (read-token predicate #:optional (port (current-input-port)))
-  "Read characters from PORT and call the procedure PREDICATE with
-each character until PREDICATE returns #F.  Return a string with the
-accumulated characters."
-  (let ((r (open-output-string)))
-    (define (finish) (get-output-string r))
-    (let loop ((c (peek-char port)))
-      (cond ((eof-object? c) (finish))
-            ((predicate c)
-             (write-char (read-char port) r)
-             (loop (peek-char port)))
-            (else (finish))))))
-
-(define* (read-until delimiter #:optional (port (current-input-port)))
-  "Return the string up to DELIMITER.  Also read DELIMITER and throw
-it away."
-  (let ((result (read-token (lambda (char) (not (char=? char delimiter))) port)))
-    (read-token (cut char=? <> delimiter) port)
-    result))
-
-(define* (read-between delimiter #:optional (port (current-input-port)))
-  "Return the string after DELIMITER and before DELIMITER from PORT."
-  (read-token (cut char=? <> delimiter) port)
-  (read-until delimiter port))
-
-(define* (read-key-value-pair #:optional (port (current-input-port)))
-  "Read a single key value pair from PORT.  The key is separated from
-the value by an equal sign.  The value may be wrapped in double
-quotes.  The pair must end with a semicolon."
-  (let* ((key (read-until #\= port))
-         (val (if (char=? (peek-char port) #\")
-                  (let ((return (read-between #\" port)))
-                    (read-until #\; port)
-                    return)
-                  (read-until #\; port))))
-    (cons (string-downcase key) val)))
-
-(define (throw-away char-pred)
-  "Return a procedure that reads and discards any number of characters
-for which the predicate CHAR-PRED returns #T from a port."
-  (lambda* (#:optional (port (current-input-port)))
-    (while (char-pred (peek-char port))
-      (read-token char-pred port))))
-
-(define (parse-multipart-header port)
-  "Read a multipart header string from PORT and return an alist of
-attributes."
-  (let loop ((acc `(("type" . ,(read-until #\; port)))))
-    (if (eof-object? (peek-char port))
-        acc
-        (begin
-          ((throw-away char-whitespace?) port)
-          (loop (cons (read-key-value-pair port) acc))))))
-
-(define (multipart-header? line)
-  "Return the attributes of the provided Content-Type header value."
-  (and (string? line)
-       (string-prefix? "multipart" line)
-       (call-with-input-string line parse-multipart-header)))
-
 (define (multipart-message? message)
   (eq? (assoc-ref (header message 'content-type)
                   'type)
@@ -185,100 +123,6 @@ HEADERS."
         (lambda () (qp-decoder (current-input-port))))
       str))
 
-(define* (collect-parts boundary port #:key nested?)
-  "Read multipart message parts from PORT and return them as a list of
-containing #:headers and #:body.  If NESTED? is #T look for nested
-multipart messages."
-  (define final-boundary (string-append boundary "--"))
-  (let loop ((headers (rfc822-header->list port))
-             (line (get-line port))
-             (current-part '())
-             (parts '()))
-    (cond
-     ((or (string=? line final-boundary)
-          (eof-object? line))
-      ;; We're done!
-      (reverse (cons `(#:headers ,headers
-                       #:body ,(decode headers
-                                       (string-join (reverse current-part) "\n")))
-                     parts)))
-     ((string=? boundary line)
-      ;; End of this part
-      (let ((next-headers (rfc822-header->list port))
-            (next-line (get-line port)))
-        (loop next-headers
-              next-line
-              '()
-              (cons `(#:headers ,headers
-                      #:body ,(decode headers
-                                      (string-join (reverse current-part) "\n")))
-                    parts))))
-     ;; New part beginning with an in-body multipart
-     ;; header.
-     ((and nested?
-           (null? current-part)
-           (and=> (assoc-ref headers "content-type")
-                  (match-lambda
-                    (() #f)
-                    ((val) (multipart-header? val)))))
-      => (lambda (attributes)
-           ;; Parse multipart body.
-           (let ((embedded-parts
-                  (let* ((boundary (string-append "--"
-                                                  (assoc-ref attributes "boundary")))
-                         (final-boundary (string-append boundary "--")))
-                    (cond
-                     ((or (string=? boundary line)
-                          ;; It's possible that the first line is
-                          ;; empty and is followed by the boundary.
-                          (and (string-null? line)
-                               (string=? boundary (get-line port))))
-                      (collect-parts boundary port))
-                     (else
-                      ;; Invalid multipart message
-                      '())))))
-             ;; TODO: there might be some white space after the end of
-             ;; this embedded multipart message.  Not sure what to do
-             ;; with it, though.
-             (loop '()
-                   (get-line port)
-                   '()
-                   (cons `(#:headers ,headers
-                           #:body ,(decode headers
-                                           embedded-parts))
-                         parts)))))
-     ;; Just a boring old message body: add the line to
-     ;; the current part.
-     (else
-      (loop headers
-            (get-line port)
-            (cons line current-part)
-            parts)))))
-
-;; A multipart message may contain a body that is a multipart message
-;; itself.  This is signalized by a Content-Type header on the first
-;; line after the boundary.
-(define (split-multipart-message attributes message)
-  "Return list of message parts contained in the multipart MESSAGE.
-The ATTRIBUTES alist must contain the boundary string and the
-multipart type, among other things.  A message part is either a list
-of strings, or if the body itself contains a multipart message a lists
-of message parts."
-  (let ((boundary (string-append "--"
-                                 (assoc-ref attributes "boundary"))))
-    (call-with-input-string (email-body message)
-      (lambda (port)
-        ;; Ignore everything up to the first boundary string.
-        (let ((found (let loop ((line (get-line port)))
-                       (cond
-                        ((eof-object? line) #f)
-                        ((string=? boundary line) #t)
-                        (else (loop (get-line port)))))))
-          (if found
-              (collect-parts boundary port #:nested? #t)
-              ;; Invalid multipart message
-              '()))))))
-
 (define* (extract-attachment id msg-num path)
   "Extract attachment from message number MSG-NUM in the thread for
 the bug with the given ID.  Follow PATH to get to the correct