Subject: Re: bug#53941: 27.2; socks + tor dont work with https

From: "J.P." <[email-masked]>
Date: Tue, 01 Mar 2022 06:29:49 -0800

v2. Minor corrections (another bug in existing test, etc.).
>From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Tue, 1 Mar 2022 06:09:00 -0800
Subject: [PATCH 0/5] NOT A PATCH

*** BLURB HERE ***

F. Jason Park (5):
  Simplify network-stream opener in socks.el
  Fix string encoding bug in socks tests
  Add support for SOCKS 4a
  Support SOCKS RESOLVE extension
  [POC] Demo SOCKS RESOLVE over HTTPS

 lisp/net/socks.el            | 130 +++++++++++++++++++++++++++--------
 test/lisp/net/socks-tests.el | 113 ++++++++++++++++++++++++++++--
 2 files changed, 208 insertions(+), 35 deletions(-)

Interdiff:
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 7201ed8e06..cd026fd163 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -333,24 +333,23 @@ socks-filter
 
 (defvar socks-override-functions nil
   "If non-nil, overwrite `open-network-stream' function with SOCKSified version.")
-
-(when socks-override-functions
-  (advice-add 'open-network-stream :around #'socks--open-network-stream))
-
-(defun socks-open-connection (server-info)
+(make-obsolete-variable 'socks-override-functions
+                        "`socks--open-network-stream' now takes a process arg."
+                        "29.1")
+
+(defun socks-open-connection (server-info &optional opener)
+  "Create and initialize a SOCKS process.
+Perform authentication if needed.  SERVER-INFO should resemble
+`socks-server'.  OPENER, when present, should be a substitute for
+`open-network-stream' and take the same arguments."
   (interactive)
   (save-excursion
-    (let ((proc
-           (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+    (let ((proc (funcall (or opener #'open-network-stream)
+                         "socks" nil (nth 1 server-info) (nth 2 server-info)))
 	  (authtype nil)
 	  version)
 
       ;; Initialize process and info about the process
-      (set-process-coding-system proc 'binary 'binary)
       (set-process-filter proc #'socks-filter)
       (set-process-query-on-exit-flag proc nil)
       (process-put proc 'socks t)
@@ -530,22 +529,18 @@ socks-find-services-entry
   (gethash (downcase service)
 	      (if udp socks-udp-services socks-tcp-services)))
 
-(defun socks-open-network-stream (name buffer host service)
-  (let ((socks-override-functions t))
-    (socks--open-network-stream
-     (lambda (&rest args)
-       (let ((socks-override-functions nil))
-         (apply #'open-network-stream args)))
-     name buffer host service)))
-
-(defun socks--open-network-stream (orig-fun name buffer host service &rest params)
-  (let ((route (and socks-override-functions
-                    (socks-find-route host service))))
-    (if (not route)
-	(apply orig-fun name buffer host service params)
-      ;; FIXME: Obey `params'!
-      (let* ((proc (socks-open-connection route))
-	     (version (process-get proc 'socks-server-protocol))
+(defun socks-open-network-stream (name buffer host service &rest params)
+  (if-let* ((route (socks-find-route host service))
+            (proc (socks-open-connection route #'open-network-stream)))
+      (socks--open-network-stream proc buffer host service)
+    (message "Warning: no SOCKS route found for %s:%s" host service)
+    ;; Support legacy behavior (likely undesirable in most cases)
+    (apply #'open-network-stream name buffer host service params)))
+
+(defun socks--open-network-stream (proc buffer host service)
+  (progn ; temporarily preserve git blame for easier reviewing
+    (progn ; could rename to something like `socks--initiate-command-sequence'
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 4963dd7b40..f2600210b0 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4
     (process-put proc 'socks-state socks-state-waiting)
     (process-put proc 'socks-server-protocol 4)
     (ert-info ("Receive initial incomplete segment")
-      (socks-filter proc (concat [0 90 0 0 93 184 216]))
-      ;; From example.com: OK status ^      ^ msg start
+      (socks-filter proc (unibyte-string 0 90 0 0 93 184 216))
+      ;; From example.com: OK status       ^      ^ msg start
       (ert-info ("State still set to waiting")
         (should (eq (process-get proc 'socks-state) socks-state-waiting)))
       (ert-info ("Response field is nil because processing incomplete")
         (should-not (process-get proc 'socks-response)))
       (ert-info ("Scratch field holds stashed partial payload")
-        (should (string= (concat [0 90 0 0 93 184 216])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216)
                          (process-get proc 'socks-scratch)))))
     (ert-info ("Last part arrives")
       (socks-filter proc "\42") ; ?\" 34
       (ert-info ("State transitions to complete (length check passes)")
         (should (eq (process-get proc 'socks-state) socks-state-connected)))
       (ert-info ("Scratch and response fields hold stash w. last chunk")
-        (should (string= (concat [0 90 0 0 93 184 216 34])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216 34)
                          (process-get proc 'socks-response)))
         (should (string= (process-get proc 'socks-response)
                          (process-get proc 'socks-scratch)))))
@@ -137,10 +137,10 @@ socks-tests-canned-server-create
          (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
                  (pcase-let ((`(,pat . ,resp) (pop pats)))
-                   (setq resp (apply #'unibyte-string (append resp nil)))
                    (unless (or (and (vectorp pat) (equal pat (vconcat line)))
                                (string-match-p pat line))
                      (error "Unknown request: %s" line))
+                   (setq resp (apply #'unibyte-string (append resp nil)))
                    (let ((print-escape-control-characters t))
                      (message "[%s] <- %s" name (prin1-to-string line))
                      (message "[%s] -> %s" name (prin1-to-string resp)))
@@ -374,11 +374,11 @@ test-socks-https-poc
                             #'socks-tor-resolve)
                 (should-not (nsm-host-settings id))
                 (url-http url cb '(nil))
-                (should (nsm-host-settings id))
                 (ert-info ("Wait for response")
                   (with-timeout (3 (error "Request timed out"))
                     (unless done
-                      (sleep-for 0.1)))))
+                      (sleep-for 0.1))))
+                (should (nsm-host-settings id)))
             (advice-remove 'network-lookup-address-info
                            #'socks-tor-resolve)))))))
 
-- 
2.35.1

>From e1b377ee054f95a4f2064eef6972d350f69767f3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Tue, 1 Mar 2022 02:12:02 -0800
Subject: [PATCH 1/5] Simplify network-stream opener in socks.el

* lisp/net/socks.el (socks-override-functions): Make variable
obsolete and remove uses.
(socks-open-connection): Add optional opener arg.
(socks-open-network-stream): Accept additional params for calling
`open-network-stream' as a fallback when a route cannot be found.
(socks--open-network-stream): Reduce role to merely issuing the first
command using an existing process.  Change signature accordingly.
---
 lisp/net/socks.el | 50 ++++++++++++++++++++++-------------------------
 1 file changed, 23 insertions(+), 27 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 8df0773e1d..9bc301618c 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -323,19 +323,19 @@ socks-filter
 
 (defvar socks-override-functions nil
   "If non-nil, overwrite `open-network-stream' function with SOCKSified version.")
-
-(when socks-override-functions
-  (advice-add 'open-network-stream :around #'socks--open-network-stream))
-
-(defun socks-open-connection (server-info)
+(make-obsolete-variable 'socks-override-functions
+                        "`socks--open-network-stream' now takes a process arg."
+                        "29.1")
+
+(defun socks-open-connection (server-info &optional opener)
+  "Create and initialize a SOCKS process.
+Perform authentication if needed.  SERVER-INFO should resemble
+`socks-server'.  OPENER, when present, should be a substitute for
+`open-network-stream' and take the same arguments."
   (interactive)
   (save-excursion
-    (let ((proc
-           (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+    (let ((proc (funcall (or opener #'open-network-stream)
+                         "socks" nil (nth 1 server-info) (nth 2 server-info)))
 	  (authtype nil)
 	  version)
 
@@ -508,22 +508,18 @@ socks-find-services-entry
   (gethash (downcase service)
 	      (if udp socks-udp-services socks-tcp-services)))
 
-(defun socks-open-network-stream (name buffer host service)
-  (let ((socks-override-functions t))
-    (socks--open-network-stream
-     (lambda (&rest args)
-       (let ((socks-override-functions nil))
-         (apply #'open-network-stream args)))
-     name buffer host service)))
-
-(defun socks--open-network-stream (orig-fun name buffer host service &rest params)
-  (let ((route (and socks-override-functions
-                    (socks-find-route host service))))
-    (if (not route)
-	(apply orig-fun name buffer host service params)
-      ;; FIXME: Obey `params'!
-      (let* ((proc (socks-open-connection route))
-	     (version (process-get proc 'socks-server-protocol))
+(defun socks-open-network-stream (name buffer host service &rest params)
+  (if-let* ((route (socks-find-route host service))
+            (proc (socks-open-connection route #'open-network-stream)))
+      (socks--open-network-stream proc buffer host service)
+    (message "Warning: no SOCKS route found for %s:%s" host service)
+    ;; Support legacy behavior (likely undesirable in most cases)
+    (apply #'open-network-stream name buffer host service params)))
+
+(defun socks--open-network-stream (proc buffer host service)
+  (progn ; temporarily preserve git blame for easier reviewing
+    (progn ; could rename to something like `socks--initiate-command-sequence'
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.35.1

>From 8f33588517c7333d3bd08375c406cd46726b51d6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 2/5] Fix string encoding bug in socks tests

* test/lisp/net/socks-tests.el (socks-tests-canned-server-create,
socks-tests-filter-response-parsing-v4): Fix bug in process filter to
prevent prepared outgoing responses from being implicitly encoded as
utf-8.  Fix similar mistake in v4 filter test.
---
 test/lisp/net/socks-tests.el | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 461796bdf9..d9ef53ae35 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4
     (process-put proc 'socks-state socks-state-waiting)
     (process-put proc 'socks-server-protocol 4)
     (ert-info ("Receive initial incomplete segment")
-      (socks-filter proc (concat [0 90 0 0 93 184 216]))
-      ;; From example.com: OK status ^      ^ msg start
+      (socks-filter proc (unibyte-string 0 90 0 0 93 184 216))
+      ;; From example.com: OK status       ^      ^ msg start
       (ert-info ("State still set to waiting")
         (should (eq (process-get proc 'socks-state) socks-state-waiting)))
       (ert-info ("Response field is nil because processing incomplete")
         (should-not (process-get proc 'socks-response)))
       (ert-info ("Scratch field holds stashed partial payload")
-        (should (string= (concat [0 90 0 0 93 184 216])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216)
                          (process-get proc 'socks-scratch)))))
     (ert-info ("Last part arrives")
       (socks-filter proc "\42") ; ?\" 34
       (ert-info ("State transitions to complete (length check passes)")
         (should (eq (process-get proc 'socks-state) socks-state-connected)))
       (ert-info ("Scratch and response fields hold stash w. last chunk")
-        (should (string= (concat [0 90 0 0 93 184 216 34])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216 34)
                          (process-get proc 'socks-response)))
         (should (string= (process-get proc 'socks-response)
                          (process-get proc 'socks-scratch)))))
@@ -140,10 +140,11 @@ socks-tests-canned-server-create
                    (unless (or (and (vectorp pat) (equal pat (vconcat line)))
                                (string-match-p pat line))
                      (error "Unknown request: %s" line))
+                   (setq resp (apply #'unibyte-string (append resp nil)))
                    (let ((print-escape-control-characters t))
                      (message "[%s] <- %s" name (prin1-to-string line))
                      (message "[%s] -> %s" name (prin1-to-string resp)))
-                   (process-send-string proc (concat resp)))))
+                   (process-send-string proc resp))))
          (serv (make-network-process :server 1
                                      :buffer (get-buffer-create name)
                                      :filter filt
-- 
2.35.1

>From b90a6474b6edb4dd33cffa0e05f1a7f1a3e1c9be Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 3/5] Add support for SOCKS 4a

* lisp/net/socks.el (socks-server): Add new choice `4a' to version
field of option.  This may appear to change the type of the field from
a number to a union of symbols and numbers.  However,
`socks-send-command' and `socks-filter' already expect a possible
`http' value for this field (also a symbol).
(socks--errors-4): Add new constant containing error messages for
socks version 4.  The semantics are faithful, but the wording is
ad-libbed.
(socks-send-command): Massage existing handling for version 4 to
accommodate 4a.

* test/lisp/net/socks-tests.el (socks-tests-v4a-basic): add test for
4a.
Bug#53941
---
 lisp/net/socks.el            | 22 ++++++++++++++++++++--
 test/lisp/net/socks-tests.el | 13 +++++++++++++
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 9bc301618c..0615db8681 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -162,6 +162,7 @@ socks-server
 	  (radio-button-choice :tag "SOCKS Version"
 			       :format "%t: %v"
 			       (const :tag "SOCKS v4  " :format "%t" :value 4)
+                               (const :tag "SOCKS v4a"  :format "%t" :value 4a)
 			       (const :tag "SOCKS v5"   :format "%t" :value 5))))

@@ -202,6 +203,12 @@ socks-errors
     "Command not supported"
     "Address type not supported"))
 
+(defconst socks--errors-4
+  '("Granted"
+    "Rejected or failed"
+    "Cannot connect to identd on the client"
+    "Client and identd report differing user IDs"))
+
 ;; The socks v5 address types
 (defconst socks-address-type-v4   1)
 (defconst socks-address-type-name 3)
@@ -400,6 +407,7 @@ socks-send-command
 		(format "%c%s" (length address) address))
 	       (t
 		(error "Unknown address type: %d" atype))))
+        trailing
 	request version)
     (or (process-get proc 'socks)
         (error "socks-send-command called on non-SOCKS connection %S" proc))
@@ -417,6 +425,12 @@ socks-send-command
 			     (t
 			      (error "Unsupported address type for HTTP: %d" atype)))
 			    port)))
+     ((when (eq version '4a)
+        (setf addr "\0\0\0\1"
+              trailing (concat address "\0")
+              version 4 ; done with the "a" part
+              (process-get proc 'socks-server-protocol) 4)
+        nil)) ; fall through
      ((equal version 4)
       (setq request (concat
 		     (unibyte-string
@@ -426,7 +440,8 @@ socks-send-command
 		      (logand port #xff)) ; port, low byte
 		     addr                 ; address
 		     (user-full-name)     ; username
-		     "\0")))              ; terminate username
+                     "\0"                 ; terminate username
+                     trailing)))          ; optional host to look up
      ((equal version 5)
       (setq request (concat
 		     (unibyte-string
@@ -447,7 +462,10 @@ socks-send-command
 	nil				; Sweet sweet success!
       (delete-process proc)
       (error "SOCKS: %s"
-             (nth (or (process-get proc 'socks-reply) 1) socks-errors)))
+             (let ((no (or (process-get proc 'socks-reply) 1)))
+               (if (eq version 5)
+                   (nth no socks-errors)
+                 (nth (+ 90 no) socks--errors-4)))))
     proc))
 
 
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index d9ef53ae35..4e990ffdba 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -207,6 +207,19 @@ socks-tests-v4-basic
                  (lambda (&optional _) "foo")))
         (socks-tests-perform-hello-world-http-request)))))
 
+(ert-deftest socks-tests-v4a-basic ()
+  "Show correct preparation of SOCKS4a connect command."
+  (let ((socks-server '("server" "127.0.0.1" 10083 4a))
+        (url-user-agent "Test/4a-basic")
+        (socks-tests-canned-server-patterns
+         `(([4 1 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+            . [0 90 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS4A")
+      (cl-letf (((symbol-function 'user-full-name)
+                 (lambda (&optional _) "foo")))
+        (socks-tests-perform-hello-world-http-request)))))
+
 ;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate
 ;; against curl 7.71 with the following options:
 ;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
-- 
2.35.1

>From 23a430c6d7fb2707dba7e217f279ba293ae2fce6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 4/5] Support SOCKS RESOLVE extension

* lisp/net/socks.el (socks-resolve-command): Add new constant for the
SOCKS command RESOLVE, which comes by way of a nonstandard extension
from the TOR project.  It mirrors CONNECT in most respects but asks
the server to RESOLVE a host name and return its IP.  For details, see
https://github.com/torproject/torspec/blob/master/socks-extensions.txt
This shouldn't be confused with 5h/5-hostname, which is used to by
clients like cURL to allow users to bypass attempts to resolve a name
locally.
(socks--extract-resolve-response, socks-tor-resolve): Add utility
functions to query a SOCKS service supporting the RESOLVE extension.
Bug#53941
---
 lisp/net/socks.el            | 58 ++++++++++++++++++++++++++++++++++++
 test/lisp/net/socks-tests.el | 34 +++++++++++++++++++++
 2 files changed, 92 insertions(+)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 0615db8681..cd026fd163 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -181,6 +181,9 @@ socks-udp-associate-command
 (defconst socks-authentication-null 0)
 (defconst socks-authentication-failure 255)
 
+;; Extensions
+(defconst socks-resolve-command #xf0)
+
 ;; Response codes
 (defconst socks-response-success               0)
 (defconst socks-response-general-failure       1)
@@ -649,6 +652,61 @@ socks-nslookup-host
 	res)
     host))
 
+(defun socks--extract-resolve-response (proc)
+  "Parse response for PROC and maybe return destination IP address."
+  (let ((response (process-get proc 'socks-response)))
+    (cl-assert response) ; otherwise, msg not received in its entirety
+    (pcase (process-get proc 'socks-server-protocol)
+      (4 ; https://www.openssh.com/txt/socks4a.protocol
+       (when-let (((zerop (process-get proc 'socks-reply)))
+                  ((eq (aref response 1) 90)) ; #x5a request granted
+                  (a (substring response 4)) ; ignore port for now
+                  ((not (string-empty-p a)))
+                  ((not (string= a "\0\0\0\0"))))
+         a))
+      (5 ; https://tools.ietf.org/html/rfc1928
+       (cl-assert (eq 5 (aref response 0)) t)
+       (pcase (aref response 3) ; ATYP
+         (1 (and-let* ((a (substring response 4 8))
+                       ((not (string= a "\0\0\0\0")))
+                       a)))
+         ;; No reason to support RESOLVE_PTR [F1] extension, right?
+         (3 (let ((len (1- (aref response 4))))
+              (substring response 5 (+ 5 len))))
+         (4 (substring response 4 20)))))))
+
+(declare-function puny-encode-domain "puny" (domain))
+
+(defun socks-tor-resolve (name &optional _family)
+  "Return list of one vector IPv4 address for domain NAME.
+Or return nil on failure.  See `network-lookup-address-info' for format
+of return value.  Server must support the Tor RESOLVE command."
+  (let ((socks-password (or socks-password ""))
+        host
+        (port 80)  ; unused for now
+        proc
+        ip)
+    (unless (string-suffix-p ".onion" name)
+      (setq host (if (string-match "\\`[[:ascii:]]+\\'" name)
+                     name
+                   (require 'puny)
+                   (puny-encode-domain name)))
+      ;; "Host unreachable" may be raised when the lookup fails
+      (unwind-protect
+          (progn
+            (setq proc (socks-open-connection (socks-find-route host port)))
+            (socks-send-command proc
+                                socks-resolve-command
+                                socks-address-type-name
+                                host
+                                port)
+            (cl-assert (eq (process-get proc 'socks-state)
+                           socks-state-connected))
+            (setq ip (socks--extract-resolve-response proc)))
+        (when proc
+          (delete-process proc)))
+      (list (vconcat ip [0])))))
+
 (provide 'socks)
 
 ;;; socks.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 4e990ffdba..3d1aca9af4 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -295,4 +295,38 @@ socks-tests-v5-auth-none
       (socks-tests-perform-hello-world-http-request)))
   (should (assq 2 socks-authentication-methods)))
 
+(ert-deftest tor-resolve-4a ()
+  "Make request to TOR resolve service over SOCKS4a"
+  (let* ((socks-server '("server" "127.0.0.1" 19050 4a))
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+             . [0 90 0 0 93 184 216 34])))
+         (inhibit-message noninteractive)
+         (server (socks-tests-canned-server-create)))
+    (ert-info ("Query TOR RESOLVE service over SOCKS4")
+      (cl-letf (((symbol-function 'user-full-name)
+                 (lambda (&optional _) "foo")))
+        (should (equal '([93 184 216 34 0])
+                       (socks-tor-resolve "example.com")))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
+(ert-deftest tor-resolve-5 ()
+  "Make request to TOR resolve service over SOCKS5"
+  (let* ((socks-server '("server" "127.0.0.1" 19051 5))
+         (socks-username "foo")
+         (socks-authentication-methods (append socks-authentication-methods
+                                               nil))
+         (inhibit-message noninteractive)
+         (socks-tests-canned-server-patterns
+          '(([5 2 0 2] . [5 2])
+            ([1 3 ?f ?o ?o 0] . [1 0])
+            ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+             . [5 0 0 1 93 184 216 34 0 0])))
+         (server (socks-tests-canned-server-create)))
+    (ert-info ("Query TOR RESOLVE service over SOCKS5")
+      (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com"))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
 ;;; socks-tests.el ends here
-- 
2.35.1

>From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 5/5] [POC] Demo SOCKS RESOLVE over HTTPS

* test/lisp/net/socks-test.el (test-socks-https-poc): Provide
throwaway test demoing an HTTPS connection over a TOR proxy service.
---
 test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++-
 1 file changed, 54 insertions(+), 1 deletion(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 3d1aca9af4..f2600210b0 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -21,7 +21,7 @@
 
 ;;; Code:
 
-(require 'ert)
+(require 'ert-x)
 (require 'socks)
 (require 'url-http)
 
@@ -329,4 +329,57 @@ tor-resolve-5
     (kill-buffer (process-buffer server))
     (delete-process server)))
 
+(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080)
+  (when-let ((present (getenv "TEST_SOCKS_SERVICE"))
+             (parts (split-string present ":")))
+    (list (car parts) (string-to-number (cadr parts)))))
+
+(declare-function gnutls-negotiate "gnutls"
+                  (&rest spec
+                         &key process type hostname priority-string
+                         trustfiles crlfiles keylist min-prime-bits
+                         verify-flags verify-error verify-hostname-error
+                         &allow-other-keys))
+
+(ert-deftest test-socks-https-poc ()
+  :tags '(:unstable)
+  (unless test-socks-service (ert-skip "SOCKS service missing"))
+  (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS"))
+  (ert-with-temp-file tempfile
+    :prefix "emacs-test-socks-network-security-"
+    (let* ((socks-server `("tor" ,@test-socks-service 5))
+           (socks-password "")
+           (nsm-settings-file tempfile)
+           (url-gateway-method 'socks)
+           (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e")
+           (host "check.torproject.org")
+           (url (url-generic-parse-url "https://check.torproject.org"))
+           ;;
+           done
+           ;;
+           (cb (lambda (&rest _r)
+                 (goto-char (point-min))
+                 (should (search-forward "Congratulations" nil t))
+                 (setq done t)))
+           (orig (symbol-function #'socks--open-network-stream)))
+      (cl-letf (((symbol-function 'socks--open-network-stream)
+                 (lambda (&rest rest)
+                   (let ((proc (apply orig rest)))
+                     (gnutls-negotiate :process proc :hostname host)
+                     (should (nsm-verify-connection proc host 443 t))))))
+        (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy")
+          (unwind-protect
+              (progn
+                (advice-add 'network-lookup-address-info :override
+                            #'socks-tor-resolve)
+                (should-not (nsm-host-settings id))
+                (url-http url cb '(nil))
+                (ert-info ("Wait for response")
+                  (with-timeout (3 (error "Request timed out"))
+                    (unless done
+                      (sleep-for 0.1))))
+                (should (nsm-host-settings id)))
+            (advice-remove 'network-lookup-address-info
+                           #'socks-tor-resolve)))))))
+
 ;;; socks-tests.el ends here
-- 
2.35.1