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

[Riccardo Murri]

On 10/28/07, Richard Stallman <address@hidden> wrote:
>     I traced down the bug to `open-tls-stream', which returns immediately
>     after having seen the regexp `tls-success' in the buffer.  However,
>     both `openssl s_client' and `gnutls' print more information after that
>     line, thus `open-tls-stream' may occasionally return the buffer to the
>     caller when point is still amidst openssl/gnutls output.
>
>     A solution is to have `open-tls-stream' wait a little more to accept
>     output;
>     [deletia]
>
> This is not totally reliable, because it is possible for
> accept-process-output to get just part of the output.
> That may be unlikely, which is why you have not seen it happen,
> but it is possible.
>
> So here is another suggestion.  Can you change the `tls-success'
> regexp so that it matches all the text that openssl or gnutls
> would produce?  (You might need to use \(...\|...\) to match
> each on separately.)
>

No, I don't think that is feasible: `openssl s_client' is *very*
verbose and its output is meant for humans to read rather than for
programs to parse, so any regexp that matches the informational
messages has a good chance of eating up some of the data too.

I had a look at the sources, and wrote a regexp that tries to match
only the *last* informational message; the appended patch looks for
that *after* `tls-success' has been matched.

Unless I got it all wrong, this is much more complicated than the
original three-liner; I wonder if it is worth going this way instead of
a very simple patch that could still be buggy on rare occasions.


-- 
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-28 13:12:11.000000000 +0100
@@ -51,6 +51,10 @@
   (autoload 'format-spec "format-spec")
   (autoload 'format-spec-make "format-spec"))

+(eval-when-compile
+  (require 'rx)  ; for writing readable regexps
+  (require 'cl)) ; for `decf'
+
 (defgroup tls nil
   "Transport Layer Security (TLS) parameters."
   :group 'comm)
@@ -89,6 +93,50 @@
   :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 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 session information; client data begins
after 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)
+
+(defcustom tls-end-of-info-match-attempts 10
+  "How many attempts to make at matching `tls-end-of-info'.
+This is intended as a safety measure to avoid a potentially
+endless loop: after this many attempts, presume `tls-end-of-info'
+regexp is broken and will never be matched, so consider that
+stream is already at the start of client data and hope for the best.
+
+Use a negative value to retry indefinitely."
+  :version "22.1"
+  :type 'integer
+  :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 +178,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 +196,39 @@
                              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
+          (lexical-let ((attempts tls-end-of-info-match-attempts)
+                        (start-of-data nil))
+            (while  (and
+                    (not (= 0 (if (> attempts 0) (decf attempts) -1)))
+                    ;; the string matching `tls-end-of-info' might come
+                    ;; in separate chunks from `accept-process-output',
+                    ;; so start the search always where `tls-success' ended
+                    (not (setq start-of-data
+                               (save-excursion
+                                 (if (re-search-forward tls-end-of-info nil t)
+                                     (match-end 0))))))
+              (unless (accept-process-output process 1)
+                (sit-for 1)))
+            (if start-of-data
+                ;; move point to start of client data
+                (goto-char start-of-data)
+              (warn
+               "`open-tls-stream': Could not match `tls-end-of-info'
regexp in %d attempts."
+               tls-end-of-info-match-attempts)))
+          (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))