* FLIM-ELS (flim-modules): Add `qmtp'.

* qmtp.el: New file.

diff --git a/FLIM-ELS b/FLIM-ELS
index bb6005e..4459596 100644 (file)
--- a/FLIM-ELS
+++ b/FLIM-ELS
@@ -11,7 +11,7 @@
                     mime mime-parse mmgeneric
                     mmbuffer mmcooked mmdbuffer mmexternal
                     mailcap
-                    net-trans smtp smtpmail))
+                    net-trans smtp qmtp smtpmail))
 
 (if (and (fboundp 'base64-encode-string)
         (subrp (symbol-function 'base64-encode-string)))

diff --git a/qmtp.el b/qmtp.el
new file mode 100644 (file)
index 0000000..40dff08
--- /dev/null
+++ b/qmtp.el
@@ -0,0 +1,118 @@
+;;; qmtp.el --- basic functions to send mail with QMTP server
+
+;; Copyright (C) 2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: QMTP, qmail
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program 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, or (at
+;; your option) any later version.
+
+;; This program 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 this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; 
+
+;;; Code:
+
+(require 'poem)
+(require 'pcustom)
+
+(defgroup qmtp nil
+  "QMTP protocol for sending mail."
+  :group 'mail)
+
+(defcustom qmtp-default-server nil
+  "Specify default QMTP server."
+  :type '(choice (const nil) string)
+  :group 'qmtp)
+
+(defvar qmtp-server qmtp-default-server
+  "The name of the host running QMTP server.
+It can also be a function
+called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.")
+
+(defcustom qmtp-service "qmtp"
+  "QMTP service port number.  \"qmtp\" or 25."
+  :type '(choice (integer :tag "25" 25)
+                 (string :tag "qmtp" "qmtp"))
+  :group 'qmtp)
+
+(defvar qmtp-open-connection-function (function open-network-stream))
+
+(defvar qmtp-error-response-alist
+  '((?Z "Temporary failure")
+    (?D "Permanent failure")))
+
+(defun qmtp-encode-netstring-string (string)
+  (format "%d:%s," (length string) string))
+
+(defun qmtp-via-qmtp (sender recipients buffer)
+  (save-excursion
+    (set-buffer
+     (get-buffer-create
+      (format "*trace of QMTP session to %s*" qmtp-server)))
+    (buffer-disable-undo)
+    (erase-buffer)
+    (let (process point response)
+      (unwind-protect
+         (progn
+           (as-binary-process
+            (setq process
+                  (funcall qmtp-open-connection-function
+                           "QMTP" (current-buffer) qmtp-server qmtp-service)))
+           (with-temp-buffer
+             (buffer-disable-undo)
+             (erase-buffer)
+             (set-buffer-multibyte nil)
+             (insert
+              (format "%d:\n"
+                      (with-current-buffer buffer
+                        (1+ (point-max));; for the "\n"
+                        )))
+             (insert-buffer-substring buffer)
+             (insert
+              "\n,"
+              (qmtp-encode-netstring-string sender)
+              (qmtp-encode-netstring-string
+               (mapconcat #'qmtp-encode-netstring-string
+                          recipients "")))
+             (process-send-region process (point-min)(point-max)))
+           (goto-char (point-min))
+           (while recipients
+             (setq point (point))
+             (while (and
+                     (memq (process-status process) '(open run))
+                     (not (re-search-forward "^[0-9]+:" nil 'noerror)))
+               (accept-process-output process)
+               (goto-char point))
+             (setq response (char-after (match-end 0)))
+             (if (eq response ?K)
+                 (progn
+                   (setq recipients (cdr recipients))
+                   (beginning-of-line 2))
+               (error
+                (nth 1 (assq response qmtp-error-response-alist)))))
+           t)
+       (when (and process
+                  (memq (process-status process) '(open run)))
+         ;; QUIT
+         (process-send-eof process)
+         (delete-process process))))))
+        
+(provide 'qmtp)
+
+;;; qmtp.el ends here