Re: url-retrieve-synchronously randomly fails on https URLs (patch included)

[Richard Stallman <rms@gnu.org>]

Would someone please install this patch by Riccardo Murri
<riccardo.murri@gmail.com> into Emacs 22?  And then ack?

Simon, would you please add comments near the code in GNUtls that
outputs these messages, telling people to watch out for the need for
Emacs to detect the last part of the messages?



* (tls-end-of-info): New variable.
* (open-tls-stream): Keep reading input until `tls-end-of-info' is matched.


-- 
Riccardo Murri, via Galeazzo Alessi 61, 00176 Roma


--- src/emacs22/lisp/net/tls.el 2007-08-05 21:06:12.000000000 +0200
+++ emacs/lisp/tls.el   2007-10-29 19:17:33.000000000 +0100
@@ -51,6 +51,9 @@
   (autoload 'format-spec "format-spec")
   (autoload 'format-spec-make "format-spec"))

+(eval-when-compile
+  (require 'rx))  ; for writing readable regexps
+
 (defgroup tls nil
   "Transport Layer Security (TLS) parameters."
   :group 'comm)
@@ -89,6 +92,40 @@
   :type 'string
   :group 'tls)

+(defcustom tls-end-of-info
+ (rx
+  (or
+   ;; `openssl s_client` regexp
+   (sequence
+    ;; see ssl/ssl_txt.c lines 219--220
+    line-start
+    "    Verify return code: "
+    (one-or-more not-newline)
+    "\n"
+    ;; according to apps/s_client.c line 1515 this is always the last
+    ;; line that is printed by s_client before the real data
+    "---\n")
+
+   ;; `gnutls` regexp
+   (sequence
+    ;; see src/cli.c lines 721--
+    (sequence line-start "- Simple Client Mode:\n")
+    (zero-or-more
+     (or
+      "\n" ; ignore blank lines
+      ;; XXX: we have no way of knowing if the STARTTLS handshake
+      ;; sequence has completed successfully, because `gnutls` will
+      ;; only report failure.
+      (sequence line-start "\*\*\* Starting TLS handshake\n"))))))
+ "Regexp matching end of TLS client informational messages.
+Client data stream begins after the last character matched by this.
+
+The default matches `openssl s_client' (version 0.9.8c) and
+`gnutls-cli' (version 2.0.1) output."
+  :version "22.1"
+  :type 'regexp
+  :group 'tls)
+
 (defun tls-certificate-information (der)
   "Parse X.509 certificate in DER format into an assoc list."
   (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
@@ -130,6 +167,8 @@
        process cmd done)
     (if use-temp-buffer
        (setq buffer (generate-new-buffer " TLS")))
+    (save-excursion
+      (set-buffer buffer)
     (message "Opening TLS connection to `%s'..." host)
     (while (and (not done) (setq cmd (pop cmds)))
       (message "Opening TLS connection with `%s'..." cmd)
@@ -146,19 +185,34 @@
                              port)))))
        (while (and process
                    (memq (process-status process) '(open run))
-                   (save-excursion
-                     (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+                    (progn
                      (goto-char (point-min))
                      (not (setq done (re-search-forward tls-success nil t)))))
          (unless (accept-process-output process 1)
             (sit-for 1)))
        (message "Opening TLS connection with `%s'...%s" cmd
                 (if done "done" "failed"))
-       (if done
-           (setq done process)
-         (delete-process process))))
+        (if (not done)
+            (delete-process process)
+          ;; advance point to after all informational messages that
+          ;; `openssl s_client' and `gnutls' print
+          (let ((start-of-data nil))
+            (while
+                (not (setq start-of-data
+                           ;; the string matching `tls-end-of-info'
+                           ;; might come in separate chunks from
+                           ;; `accept-process-output', so start the
+                           ;; search where `tls-success' ended
+                           (save-excursion
+                             (if (re-search-forward tls-end-of-info nil t)
+                                 (match-end 0)))))
+              (accept-process-output process 1))
+            (if start-of-data
+                ;; move point to start of client data
+                (goto-char start-of-data)))
+          (setq done process))))
     (message "Opening TLS connection to `%s'...%s"
-            host (if done "done" "failed"))
+             host (if done "done" "failed")))
     (when use-temp-buffer
       (if done (set-process-buffer process nil))
       (kill-buffer buffer))