Re: [bug-anubis] openssl and s/mime emails

[Sergey Poznyakoff]

Hello Robert,

> Has anyone figured out how to use Anubis to do S/MIME emails using Gnu
> Anubis?

The support for S/MIME is planned for the next version. In the meantime
it is possible to use S/MIME via an external program.
 
> Unfortunately, AFAICT, anubis supports only external BODY processors,
> but for S/MIME I need to process the whole dang message.

It is possible to feed the entire message to an external program with the
alpha version of Anubis 3.9.93. Here is a short instruction:

1) Download the alpha version from anonymous

   ftp://mirddin.farlep.net/pub/alpha/anubis-3.9.93.tar.gz

MD5sum of the file is ec725d82be4b1958fd2294550728bd1e

2) You will need Guile version 1.6 or later. Make sure it is
installed on your system. Guile is available from ftp.gnu.org
(directory /gnu/guile) or its mirrors worldwide.

3) Compile and install anubis 3.9.93. Please, notice that the
configuration file syntax has changed in this version. Take a look into
file NEWS for a short summary. The detailed description of the syntax is
available in the accompanying documentation.

4) Attached is a Guile module that you can use to pass the entire
message to the program. Copy this file where it is convenient to you
(/usr/local/share/anubis will be a good place for it). To your
anubisrc add the following section:

SECTION GUILE
guile-load-path-append (directory where you put filter.scm)
guile-load-program filter.scm
END

Now, to invoke the external filter, add the following line to your
RULE section:

guile-process full-external-filter PROGNAME [ARGS...]

where PROGNAME is the name of the program to execute (preferably the
full path specification) ARGS are any arguments it may need. For
example:

trigger "smime:(.*)"
 guile-process /usr/local/bin/openssl smime -sender \1 ....
done

Feel free to write as if you have any problems or questions.

Regards,
Sergey

;;;; GNU Anubis -- an outgoing mail processor and the SMTP tunnel.
;;;; Copyright (C) 2003 The Anubis Team.
;;;;
;;;; GNU Anubis 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 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; GNU Anubis 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 GNU Anubis; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;;;
;;;; GNU Anubis is released under the GPL with the additional exemption that
;;;; compiling, linking, and/or using OpenSSL is allowed.

(use-modules (ice-9 popen))

;; Starts program PROG with arguments ARGS
;; Returns a list:
;;   (PID OUTPUT-PORT INPUT-PORT)
;; Where
;;  PID          -- pid of the program
;;  OUTPUT-PORT  -- output port connected to the stdin of the program
;;  INPUT-PORT   -- input port connected to the stdout of the program
;; Note:
;;  When no longer needed, the returned list must be fed to
;;  (close-subprocess). See below.
(define (create-subprocess prog args)
  (let ((inp (pipe))
        (outp (pipe))
        (pid (primitive-fork)))
    (setvbuf (cdr inp) _IONBF)
    (setvbuf (cdr outp) _IONBF)
    ;; (car inp)  -> child current-input-port
    ;; (cdr inp)  -> parent write port
    ;; (car outp) -> parent read port
    ;; (cdr outp) -> child current-output-port
    (cond
     ((= pid 0)
      ;; Child
      (let ((in-fd (fileno (car inp)))
            (out-fd (fileno (cdr outp)))
            (err-fd (fileno (current-error-port))))
        (port-for-each (lambda (pt-entry)
                         (false-if-exception
                          (let ((pt-fileno (fileno pt-entry)))
                            (if (not (or (= pt-fileno in-fd)
                                         (= pt-fileno out-fd)
                                         (= pt-fileno err-fd)))
                                (close-fdes pt-fileno))))))
        ;; copy the three selected descriptors to the standard
        ;; descriptors 0, 1, 2.  

        (cond ((not (= in-fd 0))
               (if (= out-fd 0)
                   (set! out-fd (dup->fdes 0)))
               (if (= err-fd 0)
                   (set! err-fd (dup->fdes 0)))
               (dup2 in-fd 0)))

        (cond ((not (= out-fd 1))
               (if (= err-fd 1)
                   (set! err-fd (dup->fdes 1)))
               (dup2 out-fd 1)))
        
        (dup2 err-fd 2)
        
        (apply execlp prog prog args)))
     (else
      ;; Parent
      (close-port (car inp))
      (close-port (cdr outp))
      (list pid (cdr inp) (car outp))))))

;; Closes the communication channels and destroys the subprocess created
;; by (create-subprocess)
(define (close-subprocess p)
  (close-port (list-ref p 1))
  (close-port (list-ref p 2))
  (cdr (waitpid (car p))))

;; Auxiliary function. Asynchronously feeds data to external program.
;; Returns pid of the feeder process.
(define (writer outport hdr body)
  (let ((pid (primitive-fork)))
    (cond
     ((= pid 0)
      (with-output-to-port
          outport
        (lambda ()
          (for-each
           (lambda (x)
             (display (car x))
             (display ": ")
             (display (cdr x))
             (newline))
           hdr)
          (newline)
          (display body)))
      (port-for-each close-port)
      (primitive-exit 0))
     (else
      ;; Parent
      (close-port outport)
      pid))))

;; Auxiliary function. Returns #t if LINE is an empty line.
(define (empty-line? line)
  (or (eof-object? line)
      (string-null? line)))

;; Read RFC822 headers from current input port and convert them
;; to the form understandable by Anubis
(define (read-headers)
  (let ((hdr-list '())
        (header-name #f)
        (header-value ""))
    (do ((line (read-line) (read-line)))
        ((empty-line? line) #t)
      (cond
       ((char-whitespace? (string-ref line 0))
        (set! header-value (string-append header-value line)))
       (else
        (if header-name
            (set! hdr-list (append hdr-list
                                   (list (cons header-name header-value)))))
        (let ((off (string-index line #\:)))
          (set! header-name (substring line 0 off))
          (set! header-value (substring
                              line
                              (do ((i (1+ off) (1+ i)))
                                  ((not (char-whitespace?
                                         (string-ref line i))) i))))))))
    (if header-name
        (set! hdr-list (append hdr-list
                               (list (cons header-name header-value)))))
    hdr-list))

;; Read message body from the current input port
(define (read-body)
  (let ((text-list '()))
    (do ((line (read-line) (read-line)))
        ((eof-object? line) #t)
      (set! text-list (append text-list (list line "\n"))))
    (apply string-append text-list)))

;; Auxiliary function. Reads output from the external program and
;; converts it to the internal Anubis representation.
(define (reader inport)
    (with-input-from-port
        inport
      (lambda ()
        (cons (read-headers) (read-body))))) 

(define (optarg-value opt-args tag)
  (cond
   ((member tag opt-args) =>
    (lambda (x)
      (car (cdr x))))
   (else
    #f)))

;; A Guile interface for feeding the entire message (including headers)
;; to an external program.
;;
;; Usage:
;;   SECTION GUILE
;;   guile-load-program filter.scm
;;   END
;;
;;   guile-process full-external-filter PROGNAME [ARGS...]

(define (full-external-filter hdr body . rest)
  (let ((progname (car rest))
        (args (cdr rest)))
    (let* ((p (create-subprocess progname args))
           (wrpid (writer (list-ref p 1) hdr body)))
      (let ((ret (reader (list-ref p 2))))
        (waitpid wrpid)
        (close-subprocess p)
        ret))))

;; End of filter.scm