From: czkmt <czkmt>
Date: Mon, 17 May 1999 15:35:11 +0000 (+0000)
Subject: From Daiki Ueno  <daiki@kiss.kake.info.waseda.ac.jp>
X-Git-Tag: t-gnus-6_10_064-06
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=17a12faa601b2496e020f4106ffe3ddba9b37ae3;p=elisp%2Fgnus.git-

From Daiki Ueno  <daiki@kiss.kake.info.waseda.ac.jp>
* lisp/gnus.el (gnus-revision-number): Increment to 06.
* lisp/mail-source.el (mail-source-keyword-map): New keyword
:connection for pop. This is introduced to enable SSL connection.
(mail-source-fetch-pop): Use it to bind `pop3-connection-type'.
* lisp/pop3.el : Add an autoload for `open-ssl-stream' defined in
`ssl'.
(pop3-connection-type, pop3-ssl-program-arguments): New variables.
(pop3-open-ssl-stream-1, pop3-open-ssl-stream): New functions.
(pop3-open-server): Call the latter when `pop3-connection-type' is
ssl.
---

diff --git a/ChangeLog b/ChangeLog
index c0e662d..0c867c1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+1999-05-17   Daiki Ueno  <daiki@kiss.kake.info.waseda.ac.jp>
+	     Tsukamoto Tetsuo  <czkmt@remus.dti.ne.jp>
+
+	* lisp/gnus.el (gnus-revision-number): Increment to 06.
+
+	* lisp/mail-source.el (mail-source-keyword-map): New keyword
+	:connection for pop. It is introduced to enable SSL connection.
+	(mail-source-fetch-pop): Use it to bind `pop3-connection-type'.
+
+	* lisp/pop3.el : Add an autoload for `open-ssl-stream' defined in
+	`ssl'.
+	(pop3-connection-type, pop3-ssl-program-arguments): New variables.
+	(pop3-open-ssl-stream-1, pop3-open-ssl-stream): New functions.
+	(pop3-open-server): Call the latter when `pop3-connection-type' is
+	ssl.
+
 1999-05-17  Katsumi Yamaoka   <yamaoka@jpl.org>
 
 	* lisp/gnus.el (gnus-revision-number): Increment to 05.
diff --git a/lisp/gnus.el b/lisp/gnus.el
index 957285e..fda3428 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -267,7 +267,7 @@ is restarted, and sometimes reloaded."
 (defconst gnus-version-number "6.10.064"
   "Version number for this version of gnus.")
 
-(defconst gnus-revision-number "04"
+(defconst gnus-revision-number "06"
   "Revision number for this version of gnus.")
 
 (defconst gnus-original-version-number "0.84"
diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index acd758c..31e1029 100644
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -85,6 +85,7 @@ This variable is a list of mail source specifiers."
        (:program)
        (:function)
        (:password)
+       (:connection)
        (:authentication password))
       (maildir
        (:path "~/Maildir/new/")))
@@ -387,7 +388,8 @@ If ARGS, PROMPT is used as an argument to `format'."
 		    (pop3-mailhost server)
 		    (pop3-port port)
 		    (pop3-authentication-scheme
-		     (if (eq authentication 'apop) 'apop 'pass)))
+		     (if (eq authentication 'apop) 'apop 'pass))
+		    (pop3-connection-type connection))
 		(save-excursion (pop3-movemail mail-source-crash-box))))))
       (if result
 	  (prog1
diff --git a/lisp/pop3.el b/lisp/pop3.el
index fb37155..6b3b2b0 100644
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -45,6 +45,8 @@
   "*POP3 mailhost.")
 (defvar pop3-port 110
   "*POP3 port.")
+(defvar pop3-connection-type nil
+  "*POP3 connection type.")
 
 (defvar pop3-password-required t
   "*Non-nil if a password is required when connecting to POP server.")
@@ -63,6 +65,13 @@ Used for APOP authentication.")
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 
+(eval-and-compile
+  (autoload 'open-ssl-stream "ssl"))
+
+(defvar pop3-ssl-program-arguments
+  '("-quiet")
+  "Arguments to be passed to the program `pop3-ssl-program-name'.")
+
 (defun pop3-movemail (&optional crashbox)
   "Transfer contents of a maildrop to the specified CRASHBOX."
   (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
@@ -119,13 +128,40 @@ Returns the process associated with the connection."
       (setq pop3-read-point (point-min))
       )
     (setq process
-	  (open-network-stream-as-binary "POP" process-buffer mailhost port))
+	  (cond ((eq pop3-connection-type 'ssl)
+		 (pop3-open-ssl-stream "POP" process-buffer mailhost port))
+		(t
+		 (open-network-stream-as-binary "POP" process-buffer mailhost port))))
     (let ((response (pop3-read-response process t)))
       (setq pop3-timestamp
 	    (substring response (or (string-match "<" response) 0)
 		       (+ 1 (or (string-match ">" response) -1)))))
     process))
 
+(defun pop3-open-ssl-stream-1 (name buffer host service extra-arg)
+  (let* ((ssl-program-arguments 
+	  (` ((,@ pop3-ssl-program-arguments) (, extra-arg) 
+	      "-connect" (, (format "%s:%d" host service)))))
+         (process (open-ssl-stream name buffer host service)))
+    (when process
+      (with-current-buffer buffer
+	(goto-char (point-min))
+	(while (and (memq (process-status process) '(open run))
+                    (goto-char (point-max))
+                    (forward-line -1)
+                    (not (looking-at "+OK")))
+          (accept-process-output process 1)
+          (sit-for 1))
+	(delete-region (point-min) (point)))
+      (and process (memq (process-status process) '(open run))
+	   process))))
+
+(defun pop3-open-ssl-stream (name buffer host service)
+  "Open a SSL connection for a service to a host."
+  (as-binary-process
+   (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
+       (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))
+
 ;; Support functions
 
 (defun pop3-process-filter (process output)