From 107a428bcbf607257d11db8c70285b7b7e371625 Mon Sep 17 00:00:00 2001
From: ueno <ueno>
Date: Tue, 15 Aug 2000 13:23:58 +0000
Subject: [PATCH] * FLIM-ELS (flim-modules): Add `qmtp'.

* qmtp.el: New file.
---
 FLIM-ELS |    2 +-
 qmtp.el  |  118 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 119 insertions(+), 1 deletion(-)
 create mode 100644 qmtp.el

diff --git a/FLIM-ELS b/FLIM-ELS
index bb6005e..4459596 100644
--- 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
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
-- 
1.7.10.4