From: okada Date: Sun, 21 Nov 1999 17:53:55 +0000 (+0000) Subject: * smtp.el (smtp-via-smtp): Fix to use `smtp-authentication-type', X-Git-Tag: slim-1_13_2~4 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a74595dac076f6d01659da2eea8ef4c717d92efb;p=elisp%2Fflim.git * smtp.el (smtp-via-smtp): Fix to use `smtp-authentication-type', `smtp-authentication-user', `smtp-authentication-passphrase' and `smtp-connection-type'. * smtp.el (smtp-authentication-type): New variable. (smtp-authentication-user): New variable. (smtp-authentication-passphrase): New variable. (smtp-connection-type): New variable. --- diff --git a/ChangeLog b/ChangeLog index f597382..b184c17 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +1999-10-22 Kenichi OKADA + + * smtp.el (smtp-via-smtp): Fix to use `smtp-authentication-type', + `smtp-authentication-user', `smtp-authentication-passphrase' and + `smtp-connection-type'. + +1999-10-22 Daiki Ueno + + * smtp.el (smtp-authentication-type): New variable. + (smtp-authentication-user): New variable. + (smtp-authentication-passphrase): New variable. + (smtp-connection-type): New variable. + 1999-10-20 Kenichi OKADA * SLIM: Version 1.13.1 released. diff --git a/SLIM-VERSION b/SLIM-VERSION index bc7f028..308485f 100644 --- a/SLIM-VERSION +++ b/SLIM-VERSION @@ -2,5 +2,5 @@ 1.13.0 藤原紀香 1.13.1 深田恭子 ------- 華原朋美 +1.13.2 華原朋美 ------ 飯島直子 diff --git a/mime-def.el b/mime-def.el index 18f5af8..746fcc2 100644 --- a/mime-def.el +++ b/mime-def.el @@ -35,7 +35,7 @@ (eval-when-compile (require 'cl)) ; list* (eval-and-compile - (defconst mime-library-product ["SLIM" (1 13 1) "深田恭子"] + (defconst mime-library-product ["SLIM" (1 13 2) "華原朋美"] "Product name, version number and code name of MIME-library package.") ) diff --git a/smtp.el b/smtp.el index 55d6f76..eb344ea 100644 --- a/smtp.el +++ b/smtp.el @@ -6,6 +6,7 @@ ;; Simon Leinen (ESMTP support) ;; Shuhei KOBAYASHI ;; Kenichi OKADA (SASL support) +;; Daiki Ueno ;; Keywords: SMTP, mail, SASL ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -84,6 +85,19 @@ don't define this value." to user (RFC1891)." :type 'boolean :group 'smtp) + +(defcustom smtp-authentication-type nil + "*SMTP authentication mechanism (RFC2554)." + :type 'symbol + :group 'smtp) + +(defvar smtp-authentication-user nil) +(defvar smtp-authentication-passphrase nil) + +(defcustom smtp-connection-type nil + "*SMTP connection type." + :type '(choice (const nil) (const :tag "TLS" starttls)) + :group 'smtp) (defvar smtp-read-point nil) @@ -98,8 +112,7 @@ don't define this value." (t (error "Cannot generate valid FQDN. Set `smtp-local-domain' correctly."))))) -(defun smtp-via-smtp (sender recipients smtp-text-buffer - &optional auth user passphrase starttls) +(defun smtp-via-smtp (sender recipients smtp-text-buffer) (let ((server (if (functionp smtp-server) (funcall smtp-server sender recipients) smtp-server)) @@ -115,7 +128,7 @@ don't define this value." (unwind-protect (catch 'done (setq process - (if starttls + (if smtp-connection-type (starttls-open-stream "SMTP" (current-buffer) server smtp-service) (open-network-stream-as-binary @@ -124,7 +137,7 @@ don't define this value." (set-process-filter process 'smtp-process-filter) - (if (eq starttls 'force) + (if (eq smtp-connection-type 'force) (starttls-negotiate process)) ;; Greeting @@ -163,8 +176,8 @@ don't define this value." (setq extension-lines (cdr extension-lines))))) ;; STARTTLS --- begin a TLS negotiation (RFC 2595) - (when (and starttls - (null (eq starttls 'force)) + (when (and smtp-connection-type + (null (eq smtp-connection-type 'force)) (memq 'starttls extensions)) (smtp-send-command process "STARTTLS") (setq response (smtp-read-response process)) @@ -175,12 +188,13 @@ don't define this value." (starttls-negotiate process)) ;; AUTH --- SMTP Service Extension for Authentication (RFC2554) - (when auth - (if (null (memq (intern auth) extensions)) + (when smtp-authentication-type + (if (null (memq (intern smtp-authentication-type) extensions)) (throw 'done - (concat "AUTH mechanism " auth " not available"))) + (concat "AUTH mechanism " + smtp-authentication-type " not available"))) - (cond ((string= "cram-md5" auth) + (cond ((string= "cram-md5" smtp-authentication-type) (smtp-send-command process "AUTH CRAM-MD5") (setq response (smtp-read-response process)) (if (or (null (car response)) @@ -191,7 +205,7 @@ don't define this value." process (base64-encode-string (sasl-cram-md5 - user passphrase + smtp-authentication-user smtp-authentication-passphrase (base64-decode-string (substring (car (cdr response)) 4))))) (setq response (smtp-read-response process)) @@ -200,12 +214,12 @@ don't define this value." (>= (car response) 400)) (throw 'done (car (cdr response))))) - ((string= "plain" auth) - (let ((enc-word (copy-sequence passphrase))) + ((string= "plain" smtp-authentication-type) + (let ((enc-word (copy-sequence smtp-authentication-passphrase))) (smtp-send-command process (setq enc-word (unwind-protect - (sasl-plain "" user enc-word) + (sasl-plain "" smtp-authentication-user enc-word) (fillarray enc-word 0)) enc-word (unwind-protect (base64-encode-string enc-word) @@ -220,10 +234,10 @@ don't define this value." (>= (car response) 400)) (throw 'done (car (cdr response))))) - ((string= "login" auth) + ((string= "login" smtp-authentication-type) (smtp-send-command process - (concat "AUTH LOGIN " user)) + (concat "AUTH LOGIN " smtp-authentication-user)) (setq response (smtp-read-response process)) (if (or (null (car response)) (not (integerp (car response))) @@ -231,7 +245,7 @@ don't define this value." (throw 'done (car (cdr response)))) (smtp-send-command process - (base64-encode-string passphrase)) + (base64-encode-string smtp-authentication-passphrase)) (setq response (smtp-read-response process)) (if (or (null (car response)) (not (integerp (car response))) @@ -239,7 +253,8 @@ don't define this value." (throw 'done (car (cdr response))))) (t - (throw 'done (concat "AUTH " auth " not supported"))))) + (throw 'done (concat "AUTH " + smtp-authentication-type " not supported"))))) ;; ONEX --- One message transaction only (sendmail extension?) (if (or (memq 'onex extensions) diff --git a/starttls.c b/starttls.c deleted file mode 100644 index bc7b525..0000000 --- a/starttls.c +++ /dev/null @@ -1,247 +0,0 @@ -/* TLSv1 filter for STARTTLS extension. - - Copyright (C) 1999 Daiki Ueno - - Author: Daiki Ueno - Created: 1999-11-19 - Keywords: TLS, OpenSSL - - 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 GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307, USA. - -*/ - -/* - How to compile: (OpenSSL is required) - - gcc -I/usr/local/ssl/include -o starttls starttls.c \ - -L/usr/local/ssl/lib -lssl -lcrypto - -*/ - -#include -#include -#include -#include - -#include - -/* OpenSSL library. */ - -#include -#include -#include -#include -#include -#include - -#ifdef HAVE_SOCKS_H -#include -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -static SSL *tls_conn = NULL; -static int tls_fd; - -static SSL_CTX * -tls_ssl_ctx_new (cert_file, key_file) - const char *cert_file, key_file; -{ - SSL_CTX *tls_ctx; - - SSL_load_error_strings (); - SSLeay_add_ssl_algorithms (); - - if ((tls_ctx = SSL_CTX_new (TLSv1_client_method())) == NULL) - return NULL; - - SSL_CTX_set_options (tls_ctx, SSL_OP_ALL /* Work around all known bugs */); - - if (cert_file) { - if (SSL_CTX_use_certificate_file (tls_ctx, NULL, SSL_FILETYPE_PEM) <= 0) - return NULL; - if (SSL_CTX_use_PrivateKey_file (tls_ctx, NULL, SSL_FILETYPE_PEM) <= 0) - return NULL; - if (!SSL_CTX_check_private_key (tls_ctx)) - return NULL; - } - - SSL_CTX_set_verify (tls_ctx, SSL_VERIFY_NONE, NULL); - - return tls_ctx; -} - -static SSL * -tls_ssl_new(tls_ctx, s) - SSL_CTX *tls_ctx; - int s; -{ - SSL_SESSION *session; - SSL_CIPHER *cipher; - X509 *peer; - - if ((tls_conn = (SSL *) SSL_new (tls_ctx)) == NULL) - return NULL; - SSL_clear(tls_conn); - - if (!SSL_set_fd (tls_conn, s)) - return NULL; - - SSL_set_connect_state (tls_conn); - - if (SSL_connect (tls_conn) <= 0) { - session = SSL_get_session (tls_conn); - if (session) { - SSL_CTX_remove_session (tls_ctx, session); - } - if (tls_conn!=NULL) - SSL_free (tls_conn); - return NULL; - } - - return tls_conn; -} - -static int -tls_connect (hostname, service) - const char *hostname, *service; -{ - struct protoent *proto; - struct addrinfo *in, hints; - int server, false = 0; - - if ((proto = getprotobyname ("tcp")) == NULL) - return -1; - - memset (&hints, 0, sizeof (hints)); - hints.ai_family = AF_UNSPEC; - hints.ai_socktype = SOCK_STREAM; - hints.ai_protocol = proto->p_proto; - if (getaddrinfo (hostname, service, &hints, &in) < 0) - return -1; - - if ((server = socket (in->ai_family, in->ai_socktype, 0)) < 0) - return -1; - - if (setsockopt (server, SOL_SOCKET, SO_KEEPALIVE, - (const char *) &false, sizeof (false))) - return -1; - - if (connect (server, in->ai_addr, in->ai_addrlen) < 0) { - close (server); - return -1; - } - - return server; -} - -static void -tls_negotiate (sig) - int sig; -{ - SSL_CTX *tls_ctx; - - if ((tls_ctx = tls_ssl_ctx_new (NULL, NULL)) == NULL) - return; - - tls_conn = tls_ssl_new (tls_ctx, tls_fd); /* Negotiation has done. */ -} - -int -main (argc, argv) - int argc; - char **argv; -{ - int in = fileno (stdin), out = fileno (stdout), nbuffer, wrote; - fd_set readfds, writefds; - char buffer[BUFSIZ], *retry; - struct sigaction act; - - if ((tls_fd = tls_connect (argv[1], argv[2])) < 0) { - perror ("tls_connect"); - return 1; - } - - memset (&act, 0, sizeof (act)); - act.sa_handler = tls_negotiate; - sigemptyset (&act.sa_mask); - act.sa_flags = SA_RESTART|SA_RESETHAND; - sigaction (SIGALRM, &act, NULL); - - while (1) { - FD_SET (tls_fd, &readfds); - FD_SET (in, &readfds); - if (select (tls_fd+1, &readfds, NULL, NULL, NULL) == -1 && - errno != EINTR ) { - perror ("select"); - return 1; - } - if (FD_ISSET (in, &readfds)) { - nbuffer = read (in, buffer, sizeof buffer -1); - - if (nbuffer == 0) - goto finish; - for (retry = buffer; nbuffer > 0; nbuffer -= wrote, retry += wrote) { - FD_SET (tls_fd, &writefds); - if (select (tls_fd+1, NULL, &writefds, NULL, NULL) == -1) { - perror ("select"); - return 1; - } - if (tls_conn) - wrote = SSL_write (tls_conn, retry, nbuffer); - else - wrote = write (tls_fd, retry, nbuffer); - if (wrote < 0) goto finish; - } - } - if (FD_ISSET (tls_fd, &readfds)) { - if (tls_conn) - nbuffer = SSL_read (tls_conn, buffer, sizeof buffer -1); - else - nbuffer = read (tls_fd, buffer, sizeof buffer -1); - if (nbuffer == 0) - goto finish; - for (retry = buffer; nbuffer > 0; nbuffer -= wrote, retry += wrote) { - FD_SET (out, &writefds); - if (select (out+1, NULL, &writefds, NULL, NULL) == -1) { - perror ("select"); - return 1; - } - wrote = write (out, retry, nbuffer); - if (wrote < 0) goto finish; - } - } - } - - finish: - close (in); - close (out); - - return 0; -}