bug#32514: mailutils Guile bindings are broken

[Ludovic Courtès]

Hi!

Ricardo Wurmus <address@hidden> skribis:

> Are the bindings not usable with Guile 2.2?

No, but I have good news: those in Mailutils master are usable.  Here’s
a recipe:

--8<---------------cut here---------------start------------->8---
(define-public mailutils-next
  ;; This version of Mailutils supports Guile 2.2, unlike version <= 3.4.
  (let ((commit "62666075e3c7276d308dffef42c7c50dc526925b")
        (revision "0"))
    (package
      (inherit mailutils)
      (version (string-append (package-version mailutils)
                              "-" revision "." (string-take commit 7)))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://git.savannah.gnu.org/git/mailutils.git";)
                      (commit commit)
                      (recursive? #t)))           ;for Gnulib & co.
                (sha256
                 (base32
                  "1m4cbjn02hklp6li14ajfzfg29ibbk38n0c3g8vyfx71iy0pxpnb"))
                (file-name (string-append "mailutils-" version "-checkout"))))
      (outputs '("out" "debug"))
      (inputs
       `(("guile" ,guile-2.2)
         ("gsasl" ,gsasl)                         ;for SMTP authentication
         ,@(alist-delete "guile" (package-inputs mailutils))))
      (native-inputs
       `(("autoconf" ,autoconf-wrapper)
         ("automake" ,automake)
         ("libtool" ,libtool)
         ("gettext" ,gnu-gettext)
         ,@(package-native-inputs mailutils)))
      (arguments
       (substitute-keyword-arguments (package-arguments mailutils)
         ((#:modules modules %gnu-build-system-modules)
          `((srfi srfi-1) ,@modules))
         ((#:configure-flags flags ''())
          `(cons* "--disable-radius"

                  ;; Add "/2.2" to the installation directory.
                  (string-append "--with-guile-site-dir="
                                 (assoc-ref %outputs "out")
                                 "/share/guile/site/2.2")
                  ,flags))
         ((#:phases phases)
          `(modify-phases ,phases
             (replace 'bootstrap
               (lambda* (#:key inputs #:allow-other-keys)
                 (for-each patch-shebang
                           '("bootstrap" "gnulib/gnulib-tool"))
                 (substitute* "bootstrap.conf"
                   (("git submodule" all)
                    (string-append "#" all)))
                 (for-each make-file-writable (find-files "gnulib"))
                 (substitute* "configure.ac"
                   (("AM_GNU_RADIUS") ""))
                 (invoke "./bootstrap" "--no-git" "--skip-po"
                         (string-append "--gnulib-srcdir=gnulib"))
                 #t))
             (delete 'prepare-test-suite)))
         ((#:parallel-build? _ #f)                ;due to parser.y
          #f)
         ((#:tests? _ #f)                         ;XXX
          #f))))))
--8<---------------cut here---------------end--------------->8---

Below is a simple example to get started.  The Mailutils API is not this
complicated but it took me a while to figure it out, so you might find
that module helpful.

Happy emailing!  :-)

Ludo’.

;;; This module is licensed under the same terms, those of the GNU GPL
;;; version 3 or (at your option) any later version.
;;;
;;; Copyright © 2018 Ludovic Courtès <address@hidden>

(define-module (email)
  #:use-module ((guix build utils) #:select (dump-port))
  #:use-module (guix base64)
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (mailutils mailutils)
  #:export (compose-message
            send-message))

;; This variable is looked up by 'mu-message-send', uh!
(define-public mu-debug 0)

(define* (insert-newlines str #:optional (line-length 76))
  "Insert newlines in STR every LINE-LENGTH characters."
  (let loop ((result '())
             (str str))
    (if (string-null? str)
        (string-concatenate-reverse result)
        (let* ((length (min (string-length str) line-length))
               (prefix (string-take str length))
               (suffix (string-drop str length)))
          (loop (cons (string-append prefix "\n") result)
                suffix)))))

(define* (compose-message from to
                          #:key text subject file)
  "Compose a message, and return a message object."
  (let* ((mime    (mu-mime-create))
         (message (mu-message-create))
         (body    (mu-message-get-port message "w")))
    (mu-message-set-header message
                           "Content-Type"
                           "text/plain; charset=utf-8")

    (put-bytevector body (string->utf8 text))
    (close-port body)
    (mu-mime-add-part mime message)

    (when file
      (let* ((attach (mu-message-create))
             (port   (mu-message-get-port attach "w")))
        (display (insert-newlines
                  (base64-encode (call-with-input-file file
                                   get-bytevector-all)))
                 port)
        (close-port port)
        (mu-message-set-header attach
                               "Content-Transfer-Encoding"
                               "base64")
        (mu-message-set-header attach
                               "Content-Type" "image/jpeg")
        (mu-message-set-header attach
                               "Content-Disposition" "inline")
        (mu-mime-add-part mime attach)))

    (let ((result (mu-mime-get-message mime)))
      (mu-message-set-header result "From" from)
      (mu-message-set-header result "To" to)
      (when subject
        (mu-message-set-header result "Subject" subject))
      result)))

(define (display-body message)                    ;debug
  (let ((port (mu-message-get-port message "r")))
    (dump-port port (current-error-port))
    (close-port port)))

(define (send-message message)
  "Send MESSAGE, a message returned by 'compose-message', using the SMTP
parameters found in ~/.config/smtp."
  (define uri
    ;; Something like "smtp://USER:address@hidden:PORT" (info "(mailutils)
    ;; SMTP Mailboxes").
    (call-with-input-file (string-append (getenv "HOME") "/.config/smtp")
      read))

  (mu-register-format "smtp")
  (mu-message-send message uri))