qmtp.el

   1 ;;; qmtp.el --- basic functions to send mail with QMTP server
   2
   3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: QMTP, qmail
   7
   8 ;; This file is part of FLIM (Faithful Library about Internet Message).
   9
  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.
  14
  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.
  19
  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.
  24
  25
  26 ;;; Commentary:
  27
  28 ;; Installation:
  29
  30 ;; To send mail using QMTP instead of SMTP, do
  31
  32 ;; (fset 'smtp-send-buffer 'qmtp-send-buffer)
  33
  34 ;;; Code:
  35
  36 (require 'poem)
  37 (require 'pcustom)
  38 (require 'mel) ; binary-funcall
  39
  40 (defgroup qmtp nil
  41   "QMTP protocol for sending mail."
  42   :group 'mail)
  43
  44 (defcustom qmtp-default-server nil
  45   "Specify default QMTP server."
  46   :type '(choice (const nil) string)
  47   :group 'qmtp)
  48
  49 (defvar qmtp-server qmtp-default-server
  50   "The name of the host running QMTP server.
  51 It can also be a function
  52 called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.")
  53
  54 (defcustom qmtp-service "qmtp"
  55   "QMTP service port number.  \"qmtp\" or 209."
  56   :type '(choice (integer :tag "209" 209)
  57                  (string :tag "qmtp" "qmtp"))
  58   :group 'qmtp)
  59
  60 (defcustom qmtp-timeout 30
  61   "Timeout for each QMTP session."
  62   :type 'integer
  63   :group 'qmtp)
  64
  65 ;;;###autoload
  66 (defvar qmtp-open-connection-function (function open-network-stream))
  67
  68 (defvar qmtp-error-response-alist
  69   '((?Z "Temporary failure")
  70     (?D "Permanent failure")))
  71
  72 (defvar qmtp-read-point nil)
  73
  74 (defun qmtp-encode-netstring-string (string)
  75   (format "%d:%s," (length string) string))
  76
  77 (defun qmtp-send-package (process sender recipients buffer)
  78   (with-temp-buffer
  79     (buffer-disable-undo)
  80     (erase-buffer)
  81     (set-buffer-multibyte nil)
  82     (insert
  83      (format "%d:\n"
  84              (with-current-buffer buffer
  85                (1+ (point-max));; for the "\n"
  86                )))
  87     (insert-buffer-substring buffer)
  88     (insert
  89      "\n,"
  90      (qmtp-encode-netstring-string sender)
  91      (qmtp-encode-netstring-string
  92       (mapconcat (function qmtp-encode-netstring-string)
  93                  recipients "")))
  94     (process-send-region process (point-min)(point-max)))
  95   (goto-char qmtp-read-point)
  96   (while (and (memq (process-status process) '(open run))
  97               (not (re-search-forward "^[0-9]+:" nil 'noerror)))
  98     (unless (accept-process-output process qmtp-timeout)
  99       (error "timeout expired: %d" qmtp-timeout))
 100     (goto-char qmtp-read-point))
 101   (let ((response (char-after (match-end 0))))
 102     (unless (eq response ?K)
 103       (error (nth 1 (assq response qmtp-error-response-alist))))
 104     (setq recipients (cdr recipients))
 105     (beginning-of-line 2)
 106     (setq qmtp-read-point (point))))
 107
 108 ;;;###autoload
 109 (defun qmtp-via-qmtp (sender recipients buffer)
 110   (condition-case nil
 111       (progn
 112         (qmtp-send-buffer sender recipients buffer)
 113         t)
 114     (error)))
 115
 116 (make-obsolete 'qmtp-via-qmtp "It's old API.")
 117
 118 ;;;###autoload
 119 (defun qmtp-send-buffer (sender recipients buffer)
 120   (save-excursion
 121     (set-buffer
 122      (get-buffer-create
 123       (format "*trace of QMTP session to %s*" qmtp-server)))
 124     (buffer-disable-undo)
 125     (erase-buffer)
 126     (make-local-variable 'qmtp-read-point)
 127     (setq qmtp-read-point (point-min))
 128     (let (process)
 129       (unwind-protect
 130           (progn
 131             (setq process
 132                   (binary-funcall qmtp-open-connection-function
 133                                   "QMTP" (current-buffer)
 134                                   qmtp-server qmtp-service))
 135             (qmtp-send-package process sender recipients buffer))
 136         (when (and process
 137                    (memq (process-status process) '(open run)))
 138           ;; QUIT
 139           (process-send-eof process)
 140           (delete-process process))))))
 141
 142 (provide 'qmtp)
 143
 144 ;;; qmtp.el ends here