maildir-imap.el

;;; maildir-imap.el - imap sync for maildir

(require 'imap)
(require 'kva)
(require 'maildir)

(defcustom maildir/imap-source nil
  "An IMAP source for pulling mails from."
  :type '(choice
          (const :tag "Default" nil)
          (string :tag "Url" "imap.gmail.com"))
  :group 'maildir)

(defun maildir/new-filename (maildir)
  "Makes a new filename for MAILDIR.

MAILDIR is a maildir location.

It returns a list of a new file created on the MAILDIR and the
maildir unique filename with the expectation that you will rename
the created file to the new filename.

We do this to preserve the i-node of the created file."
  (destructuring-bind (bigtime littletime)
      (split-string (format "%f" (float-time)) "\\.")
    (let ((name (make-temp-name (file-name-directory maildir))))
      (with-temp-file name) ; make an empty file
      (list
       name
       (format
        "%s.I%sM%s.%s"
        bigtime
        (elt (file-attributes name) 10)
        littletime (system-name))))))

(defun maildir/new-file (maildir filename)
  "Make a new file for MAILDIR and FILENAME."
  (expand-file-name
   (format "%snew/%s"
           (file-name-as-directory maildir)
           filename)))

(defvar maildir/imap-connection nil
  "IMAP connection for syncing.")

(defun maildir/imap-month-ago ()
  "Make an IMAP string of the date 35 days ago."
  (upcase
   (format-time-string
    "%d-%h-%Y"
    (time-subtract
     (current-time)
     (seconds-to-time
      (* 35 (* 24 (* 60 60))))))))

(defun maildir/imap-check-connect ()
  "Check and connect to IMAP if necessary."
  (unless (eq 'run
              (condition-case nil
                  (process-status
                   (get-buffer-process
                    maildir/imap-connection))
                (error nil)))
    (setq maildir/imap-connection
          (imap-open
           maildir/imap-source
           ;; TODO: How to get this dependant on the maildir/imap-source?
           993 'ssl 'login))
    (imap-login-auth maildir/imap-connection)
    (let ((count (imap-mailbox-status ; we don't do this for any reason right now
                  "INBOX" 'messages maildir/imap-connection)))
      (imap-mailbox-select "INBOX" t maildir/imap-connection))))

(defun maildir/imap-search ()
  "Do the IMAP search for maildir.

Presumes `maildir/imap-connection' is made."
  (imap-search
   (format "UNSEEN SINCE %s" (maildir/imap-month-ago))
   maildir/imap-connection))

(defvar maildir/imap-message-doit nil
  "Whether to actually do message creation or not.")

(defvar maildir/imap-log nil
  "The log buffer used for when we're not doing actual pulling.")

(defun maildir/imap-message (msg maildir)
  "Fetch a single MSG over IMAP into the \"new\" folder."
  (with-temp-buffer ; (get-buffer-create "*imapscratch*")
    (destructuring-bind (file filename) (maildir/new-filename maildir)
      (let ((new-filename (maildir/new-file maildir filename))
            (coding-system-for-write 'no-conversion)
            (msg-uid (imap-fetch msg "(RFC822 UID FLAGS)" 'UID nil
                                 maildir/imap-connection)))
        (unless (member "\\Seen"
                        (imap-message-get msg-uid 'FLAGS maildir/imap-connection))
          (insert (imap-message-get msg-uid 'RFC822 maildir/imap-connection))
          ;; And mark it seen
          (imap-message-flags-add (number-to-string msg-uid)
                                  "SEEN" t maildir/imap-connection)
          (if (not maildir/imap-message-doit) ; debug mode, quite useful
              (let* ((hdr (save-excursion
                            (goto-char (point-min))
                            (mail-header-extract)))
                     (uid (imap-message-get msg-uid 'FLAGS maildir/imap-connection)))
                (maildir/log hdr new-filename (format "got %s from IMAP" uid)))
              ;; Else really save the message in the new file, preserving the i-node
              (rename-file file new-filename)
              (write-file new-filename)))))))

(defun maildir/imap-sync (&optional doit)
  "Sync `maildir/imap-source' with `maildir-mail-dir'.

Note that if you want to use other maildir's than the standard
one you should wrap this with a function to let-bind
`maildir-mail-dir'.

If DOIT is specified actually do the creation of maildir entries
in `maildir-mail-dir', otherwise just create a log of what would
be done and display it."
  (interactive
   (list current-prefix-arg))
  (if (not maildir/imap-source)
      (error "no `maildir/imap-source' is configured, configure one to sync.")
      ;; Reconnect to imap if necessary
      (maildir/imap-check-connect)
      (let ((maildir/imap-log (get-buffer-create "*maildir-imap-log*"))
            (maildir/imap-message-doit doit))
        (mapcar (lambda (msg)
                  (maildir/imap-message msg maildir-mail-dir))
                (maildir/imap-search)))))

;;(maildir/imap-sync "~/mymaildir/var/maildir/nferrier")

;;; maildir-imap.el ends here