AW: [bug-anubis] anubis as smime proxy

[Sergey Poznyakoff]

Johannes,

I have analized the exact requirements imposed by openssl and
modified filter.scm accordingly. Please try the attached version.
It contains function 'openssl-filter' which should be used instead
of full-external-filter (see example below). 
Notice that there's no need giving it input file via -in option,
the following GUILE section should suffice:

---BEGIN RULE---
guile-process openssl-filter /usr/bin/openssl smime -sign -signer \
  /root/certtest/elksmime_priv.pem -passin pass:abcd
---END---

As always, I am waiting for your feedback.

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))
  (silent-waitpid (car p)))

;; Auxiliary function. Asynchronously feeds data to external program.
;; Returns pid of the feeder process.
(define (writer outport hdr body need-nul)
  (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)
          (if need-nul
              (display #\nul))
          (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 port)
  (let ((hdr-list '())
        (header-name #f)
        (header-value ""))
    (do ((line (read-line port) (read-line port)))
        ((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 port)
  (let ((text-list '()))
    (do ((line (read-line port) (read-line port)))
        ((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)
  (cons (read-headers inport) (read-body inport)))

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

(define (silent-waitpid pid)
  (catch #t
         (lambda ()
           (waitpid pid))
         (lambda args
           #t)))

;; 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 #f)))
      (let ((ret (reader (list-ref p 2))))
        (silent-waitpid wrpid)
        (close-subprocess p)
        ret))))

(define (openssl-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 #t)))
      (let ((ret (reader (list-ref p 2))))
        (silent-waitpid wrpid)
        (close-subprocess p)
        (cons (append hdr (car ret)) (cdr ret))))))

;; End of filter.scm