1 ;;; qmtp.el --- basic functions to send mail with QMTP server
3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
5 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: QMTP, qmail
8 ;; This file is part of FLIM (Faithful Library about Internet Message).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
30 ;; To send mail using QMTP instead of SMTP, do
32 ;; (fset 'smtp-via-smtp 'qmtp-via-qmtp)
40 "QMTP protocol for sending mail."
43 (defcustom qmtp-default-server nil
44 "Specify default QMTP server."
45 :type '(choice (const nil) string)
48 (defvar qmtp-server qmtp-default-server
49 "The name of the host running QMTP server.
50 It can also be a function
51 called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.")
53 (defcustom qmtp-service "qmtp"
54 "QMTP service port number. \"qmtp\" or 209."
55 :type '(choice (integer :tag "209" 209)
56 (string :tag "qmtp" "qmtp"))
59 (defcustom qmtp-timeout 30
60 "Timeout for each QMTP session."
64 (defvar qmtp-open-connection-function (function open-network-stream))
66 (defvar qmtp-error-response-alist
67 '((?Z "Temporary failure")
68 (?D "Permanent failure")))
70 (defvar qmtp-read-point nil)
72 (defun qmtp-encode-netstring-string (string)
73 (format "%d:%s," (length string) string))
75 (defun qmtp-send-package (process sender recipients buffer)
79 (set-buffer-multibyte nil)
82 (with-current-buffer buffer
83 (1+ (point-max));; for the "\n"
85 (insert-buffer-substring buffer)
88 (qmtp-encode-netstring-string sender)
89 (qmtp-encode-netstring-string
90 (mapconcat #'qmtp-encode-netstring-string
92 (process-send-region process (point-min)(point-max)))
93 (goto-char qmtp-read-point)
94 (while (and (memq (process-status process) '(open run))
95 (not (re-search-forward "^[0-9]+:" nil 'noerror)))
96 (unless (accept-process-output process qmtp-timeout)
97 (error "timeout expired: %d" qmtp-timeout))
98 (goto-char qmtp-read-point))
99 (let ((response (char-after (match-end 0))))
100 (unless (eq response ?K)
101 (error (nth 1 (assq response qmtp-error-response-alist))))
102 (setq recipients (cdr recipients))
103 (beginning-of-line 2)
104 (setq qmtp-read-point (point))))
107 (defun qmtp-via-qmtp (sender recipients buffer)
110 (qmtp-send-buffer sender recipients buffer)
114 (make-obsolete 'qmtp-via-qmtp "It's old API.")
117 (defun qmtp-send-buffer (sender recipients buffer)
121 (format "*trace of QMTP session to %s*" qmtp-server)))
122 (buffer-disable-undo)
124 (make-local-variable 'qmtp-read-point)
125 (setq qmtp-read-point (point-min))
131 (funcall qmtp-open-connection-function
132 "QMTP" (current-buffer) qmtp-server qmtp-service)))
133 (qmtp-send-package process sender recipients buffer))
135 (memq (process-status process) '(open run)))
137 (process-send-eof process)
138 (delete-process process))))))
142 ;;; qmtp.el ends here