Skip to content

Instantly share code, notes, and snippets.

@chaitanyagupta
Last active December 8, 2016 10:39
Show Gist options
  • Save chaitanyagupta/7c2ff9b890dcfba03f1b to your computer and use it in GitHub Desktop.
Save chaitanyagupta/7c2ff9b890dcfba03f1b to your computer and use it in GitHub Desktop.
mbox-parser
;;; mbox parser in Common Lisp
;; needs cl-mime and cl-base64
;; (ql:quickload :cl-mime)
;; (ql:quickload :cl-base64)
;;
;; Example: returns all emails in an mbox (as CL-MIME:MIME objects)
;;
;; (with-open-file (in #p"/path/to/mbox")
;; (let ((p (make-parser :stream in)))
;; (loop for mime = (next-mime p)
;; while mime
;; collect mime)))
(defpackage #:mbox-parser
(:use #:cl))
(in-package #:mbox-parser)
(defparameter *mail-start* "From ")
(defstruct parser
stream
from-line)
(defun starts-with (prefix string &key (start 0) end)
(string= prefix string
:start2 start
:end2 (min (or end (length string)) (+ start (length prefix)))))
(defun is-from-line (line)
(starts-with *mail-start* line))
(defun is-escaped-line (line)
(and (not (zerop (length line)))
(eql (char line 0) #\>)
(let ((rest-start (position #\> line :test (complement #'eql) :start 1)))
(starts-with *mail-start* line :start rest-start))))
(defun unescape-line (line)
(if (is-escaped-line line)
(subseq line 1)
line))
(defun next-mime (parser)
(with-slots (stream from-line)
parser
(let ((first-line (read-line stream nil nil)))
(cond ((null first-line) nil)
((null from-line)
(assert (is-from-line first-line)
nil
"Expected From_ line, got: ~A" first-line)
(setf from-line first-line)
(next-mime parser))
(t (cl-mime:parse-mime
(with-output-to-string (out)
(write-line (unescape-line first-line) out)
(loop
(let ((line (read-line stream nil nil)))
(cond
((null line) (return))
((is-from-line line) (setf from-line line) (return))
(t (write-line (unescape-line line) out))))))))))))
(defun mime-attachments (mime)
(let* ((parts (cl-mime:content mime)))
(remove-if-not (lambda (mime)
(string= (cl-mime:content-disposition mime) "attachment"))
parts)))
(defun attachment-filename (attachment)
(or (cl-mime:get-content-disposition-parameter attachment :filename)
(cl-mime:get-content-type-parameter attachment :name)))
(defun write-attachment (attachment pathname)
(when (zerop (length (file-namestring pathname)))
(setf pathname (merge-pathnames (parse-namestring (attachment-filename attachment))
pathname)))
(with-open-file (out pathname :direction :output :element-type '(unsigned-byte 8))
(let ((array (cl-base64:base64-string-to-usb8-array (cl-mime:content attachment))))
(write-sequence array out)))
pathname)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment