X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fproto-stream.el;h=307d227fc39a64e1901d5e58263839598f0793ae;hp=45cc974e7a92decc826fe61bc469ed4a02c0d0d6;hb=94f288135f95ca48fb50f5aa43bc09f9669c5c23;hpb=06f8178fff242510622829d31a4c994c46724c1d

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index 45cc974e7..307d227fc 100644
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -1,6 +1,6 @@
 ;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
 
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -51,8 +51,8 @@
 (require 'tls)
 (require 'starttls)
 
-(declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+(autoload 'gnutls-negotiate "gnutls")
+(autoload 'open-gnutls-stream "gnutls")
 
 ;;;###autoload
 (defun open-protocol-stream (name buffer host service &rest parameters)
@@ -94,6 +94,10 @@ PARAMETERS should be a sequence of keywords and values:
 :end-of-command specifies a regexp matching the end of a command.
   If non-nil, it defaults to \"\\n\".
 
+:end-of-capability specifies a regexp matching the end of the
+  response to the command specified for :capability-command.
+  It defaults to the regexp specified for :end-of-command.
+
 :success specifies a regexp matching a message indicating a
   successful STARTTLS negotiation.  For instance, the default
   should be \"^3\" for an NNTP connection.
@@ -151,24 +155,31 @@ PARAMETERS should be a sequence of keywords and values:
 	 (success-string     (plist-get parameters :success))
 	 (capability-command (plist-get parameters :capability-command))
 	 (eoc                (plist-get parameters :end-of-command))
+ 	 (eo-capa            (or (plist-get parameters :end-of-capability)
+ 				 eoc))
 	 ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
 	 (stream (open-network-stream name buffer host service))
 	 (greeting (proto-stream-get-response stream start eoc))
 	 (capabilities (when capability-command
 			 (proto-stream-command stream
-					       capability-command eoc)))
+					       capability-command
+					       (or eo-capa eoc))))
 	 (resulting-type 'plain)
+	 (builtin-starttls (and (fboundp 'gnutls-available-p)
+				(gnutls-available-p)))
 	 starttls-command)
 
-    ;; If we have STARTTLS support, try to upgrade the connection.
-    (when (and (or (fboundp 'open-gnutls-stream)
-		   (executable-find "gnutls-cli"))
+    ;; If we have built-in STARTTLS support, try to upgrade the
+    ;; connection.
+    (when (and (or builtin-starttls
+		   (and require-tls
+			(executable-find "gnutls-cli")))
 	       capabilities success-string starttls-function
 	       (setq starttls-command
 		     (funcall starttls-function capabilities)))
       ;; If using external STARTTLS, drop this connection and start
       ;; anew with `starttls-open-stream'.
-      (unless (fboundp 'open-gnutls-stream)
+      (unless builtin-starttls
 	(delete-process stream)
 	(setq start (with-current-buffer buffer (point-max)))
 	(let* ((starttls-use-gnutls t)
@@ -183,8 +194,8 @@ PARAMETERS should be a sequence of keywords and values:
       (when (string-match success-string
 			  (proto-stream-command stream starttls-command eoc))
 	;; The server said it was OK to begin STARTTLS negotiations.
-	(if (fboundp 'open-gnutls-stream)
-	    (gnutls-negotiate stream nil)
+	(if builtin-starttls
+	    (gnutls-negotiate :process stream :hostname host)
 	  (unless (starttls-negotiate stream)
 	    (delete-process stream)))
 	(if (memq (process-status stream) '(open run))
@@ -196,7 +207,7 @@ PARAMETERS should be a sequence of keywords and values:
 	    (proto-stream-get-response stream start eoc)))
 	;; Re-get the capabilities, which may have now changed.
 	(setq capabilities
-	      (proto-stream-command stream capability-command eoc))))
+	      (proto-stream-command stream capability-command eo-capa))))
 
     ;; If TLS is mandatory, close the connection if it's unencrypted.
     (and require-tls
@@ -227,18 +238,20 @@ PARAMETERS should be a sequence of keywords and values:
 
 (defun proto-stream-open-tls (name buffer host service parameters)
   (with-current-buffer buffer
-    (let ((start (point-max))
-	  (stream
-	   (funcall (if (fboundp 'open-gnutls-stream)
-			'open-gnutls-stream
-		      'open-tls-stream)
-		    name buffer host service))
-	  (eoc (plist-get parameters :end-of-command)))
+    (let* ((start (point-max))
+	   (builtin-starttls (and (fboundp 'gnutls-available-p)
+				  (gnutls-available-p)))
+	   (stream
+	    (funcall (if builtin-starttls
+			 'open-gnutls-stream
+		       'open-tls-stream)
+		     name buffer host service))
+	   (eoc (plist-get parameters :end-of-command)))
       (if (null stream)
 	  (list nil nil nil 'plain)
 	;; If we're using tls.el, we have to delete the output from
 	;; openssl/gnutls-cli.
-	(unless (fboundp 'open-gnutls-stream)
+	(unless builtin-starttls
 	  (proto-stream-get-response stream start eoc)
 	  (goto-char (point-min))
 	  (when (re-search-forward eoc nil t)
@@ -262,11 +275,16 @@ PARAMETERS should be a sequence of keywords and values:
 
 (defun proto-stream-capability-open (start stream parameters stream-type)
   (let* ((capability-command (plist-get parameters :capability-command))
-	 (eoc 		     (plist-get parameters :end-of-command))
-	 (greeting (proto-stream-get-response stream start eoc)))
+	 (greeting (proto-stream-get-response
+		    stream start
+		    (plist-get parameters :end-of-command))))
     (list stream greeting
 	  (and capability-command
-	       (proto-stream-command stream capability-command eoc))
+	       (proto-stream-command
+		stream capability-command
+		(or
+		 (plist-get parameters :end-of-capability)
+		 (plist-get parameters :end-of-command))))
 	  stream-type)))
 
 (provide 'proto-stream)