From: ueno <ueno>
Date: Wed, 16 Aug 2000 04:07:55 +0000 (+0000)
Subject: * qmtp.el (qmtp-timeout): New user option.
X-Git-Tag: deisui-1_14_0-1~50
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0634374ae417e13ebdaceea2693bbae91c85ad83;p=elisp%2Fflim.git

* qmtp.el (qmtp-timeout): New user option.
(qmtp-read-point): New variable.
(qmtp-send-package): New function.
---

diff --git a/qmtp.el b/qmtp.el
index 40dff08..e9560c0 100644
--- a/qmtp.el
+++ b/qmtp.el
@@ -46,20 +46,59 @@ 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)
+  "QMTP service port number.  \"qmtp\" or 209."
+  :type '(choice (integer :tag "209" 209)
                  (string :tag "qmtp" "qmtp"))
   :group 'qmtp)
 
+(defcustom qmtp-timeout 30
+  "Timeout for each QMTP session."
+  :type 'integer
+  :group 'qmtp)
+
 (defvar qmtp-open-connection-function (function open-network-stream))
 
 (defvar qmtp-error-response-alist
   '((?Z "Temporary failure")
     (?D "Permanent failure")))
 
+(defvar qmtp-read-point nil)
+
 (defun qmtp-encode-netstring-string (string)
   (format "%d:%s," (length string) string))
 
+(defun qmtp-send-package (process sender recipients buffer)
+  (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 qmtp-read-point)
+  (while recipients
+    (while (and (memq (process-status process) '(open run))
+		(not (re-search-forward "^[0-9]+:" nil 'noerror)))
+      (or (accept-process-output process qmtp-timeout)
+	  (error "timeout expired: %d" qmtp-timeout))
+      (goto-char qmtp-read-point))
+    (let ((response (char-after (match-end 0))))
+      (if (not (eq response ?K))
+	  (error (nth 1 (assq response qmtp-error-response-alist))))
+      (setq recipients (cdr recipients))
+      (beginning-of-line 2)
+      (setq qmtp-read-point (point)))))
+
 (defun qmtp-via-qmtp (sender recipients buffer)
   (save-excursion
     (set-buffer
@@ -67,52 +106,26 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.")
       (format "*trace of QMTP session to %s*" qmtp-server)))
     (buffer-disable-undo)
     (erase-buffer)
-    (let (process point response)
+    (make-local-variable 'qmtp-read-point)
+    (setq qmtp-read-point (point-min))
+    (let (process)
       (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)
+	    (condition-case nil
+		(progn
+		  (qmtp-send-package process sender recipients buffer)
+		  t)
+	      (error)))
 	(when (and process
 		   (memq (process-status process) '(open run)))
 	  ;; QUIT
 	  (process-send-eof process)
 	  (delete-process process))))))
-	 
+
 (provide 'qmtp)
 
 ;;; qmtp.el ends here