(open-protocol-stream): Protect against the low-level transport functions returning...
authorLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Tue, 11 Jan 2011 17:16:47 +0000 (18:16 +0100)
committerLars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
Tue, 11 Jan 2011 17:16:47 +0000 (18:16 +0100)
lisp/ChangeLog
lisp/proto-stream.el

index 47c7a4a..e56e923 100644 (file)
@@ -1,3 +1,8 @@
+2011-01-11  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * proto-stream.el (open-protocol-stream): Protect against the low-level
+       transport functions returning nil.
+
 2011-01-07  Daiki Ueno  <ueno@unixuser.org>
 
        * mml2015.el (epg-sub-key-fingerprint): Autoload.
index d1266cb..546461a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -101,14 +101,17 @@ command to switch on STARTTLS otherwise."
       (setq type 'network))
      ((eq type 'ssl)
       (setq type 'tls)))
-    (destructuring-bind (stream greeting capabilities)
-       (funcall (intern (format "proto-stream-open-%s" type) obarray)
-                name buffer host service parameters)
-      (list (and stream
-                (memq (process-status stream)
-                      '(open run))
-                stream)
-           greeting capabilities))))
+    (let ((open-result
+          (funcall (intern (format "proto-stream-open-%s" type) obarray)
+                   name buffer host service parameters)))
+      (if (null open-result)
+         (list nil nil nil)
+       (destructuring-bind (stream greeting capabilities) open-result
+         (list (and stream
+                    (memq (process-status stream)
+                          '(open run))
+                    stream)
+               greeting capabilities))))))
 
 (defun proto-stream-open-network-only (name buffer host service parameters)
   (let ((start (with-current-buffer buffer (point)))