From: ueno <ueno>
Date: Sat, 20 Nov 1999 17:28:54 +0000 (+0000)
Subject: * lisp/imap.el: Add autoload setting for `starttls-open-stream'
X-Git-Tag: t-gnus-6_13_3-02~9
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=219b64e60dbfa0b8a477d2b74c2bf572cb4f9b4b;p=elisp%2Fgnus.git-

* lisp/imap.el: Add autoload setting for `starttls-open-stream'
and `starttls-negotiate'.
(imap-stream-alist): Add TLS entry.
(imap-tls-p): New function.
(imap-tls-open): New function.
---

diff --git a/lisp/imap.el b/lisp/imap.el
index d46b383..6507fbc 100644
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -136,6 +136,8 @@
 
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
+  (autoload 'starttls-open-stream "starttls")
+  (autoload 'starttls-negotiate "starttls")
   (autoload 'base64-decode-string "mel")
   (autoload 'base64-encode-string "mel")
   (autoload 'rfc2104-hash "rfc2104")
@@ -193,7 +195,8 @@ server.")
 (defvar imap-stream-alist
   '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
     (ssl       imap-ssl-p        imap-ssl-open)
-    (network   imap-network-p    imap-network-open))
+    (network   imap-network-p    imap-network-open)
+    (tls       imap-tls-p        imap-tls-open))
   "Definition of network streams.
 
 (NAME CHECK OPEN)
@@ -422,9 +425,10 @@ argument to `format'."
 	 (ssl-program-arguments (append imap-ssl-arguments extra-ssl-args
 					(list "-connect" 
 					      (format "%s:%d" server port))))
-	 (process (ignore-errors (open-ssl-stream name buffer server port))))
+	 (process (ignore-errors 
+		    (as-binary-process 
+		     (open-ssl-stream name buffer server port)))))
     (when process
-      (set-process-coding-system process 'binary 'binary)
       (with-current-buffer buffer
 	(goto-char (point-min))
 	(while (and (memq (process-status process) '(open run))
@@ -483,6 +487,35 @@ argument to `format'."
 	     (insert-buffer-substring buffer)))
       (when (memq (process-status process) '(open run))
 	process))))
+
+(defun imap-tls-p (buffer)
+  (imap-capability 'STARTTLS buffer))
+
+(defun imap-tls-open (name buffer server port)
+  (let* ((port (or port imap-default-port))
+	 (process (as-binary-process
+		   (starttls-open-stream name buffer server port))))
+    (when process
+      (while (and (memq (process-status process) '(open run))
+		  (goto-char (point-min))
+		  (not (imap-parse-greeting)))
+	(accept-process-output process 1)
+	(sit-for 1))
+      (and imap-log
+	   (with-current-buffer (get-buffer-create imap-log)
+	     (buffer-disable-undo)
+	     (goto-char (point-max))
+	     (insert-buffer-substring buffer)))
+      (let ((imap-process process))
+	(unwind-protect
+	    (progn
+	      (set-process-filter imap-process 'imap-arrival-filter)
+	      (when (and (eq imap-stream 'tls)
+			 (imap-ok-p (imap-send-command-wait "STARTTLS")))
+		(starttls-negotiate imap-process)))
+	  (set-process-filter imap-process nil)))
+      (when (memq (process-status process) '(open run))
+	process))))
   
 ;; Server functions; authenticator stuff: