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

From: "J.P." <[email-masked]>
Date: Thu, 10 Mar 2022 00:58:42 -0800

v5. Forgot to account for look-up failures (shocking not shocking).
Also removed hard-coded port numbers from tests.

The EWW example from earlier needs some adapting:

  ;; M-x eww RET https://check.torproject.org RET

  (require 'socks)
  (require 'gnutls)
  (require 'nsm)

  (defun my-socks-open-https (name buffer host service &rest params)
    (let ((proc (apply #'socks-open-network-stream-legacy
                       name buffer host service params)))
      (advice-add 'network-lookup-address-info :override #'socks-tor-resolve)
      (unwind-protect
          (when (eq service 443)
            (gnutls-negotiate :process proc :hostname host)
            (unless (string-suffix-p ".onion" host)
              (nsm-verify-connection proc host service)))
        (advice-remove 'network-lookup-address-info #'socks-tor-resolve))
      proc))

  (setq socks-server '("tor" "127.0.0.1" 9050 5)
        socks-username ""
        socks-password ""
        url-gateway-method 'socks
        socks-open-network-stream-function #'my-socks-open-https)

Let me know if you need help. Thanks.

>From 52a7f3269992166074ebe277f6905c219885d7cf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Thu, 10 Mar 2022 00:18:09 -0800
Subject: [PATCH 0/6] *** SUBJECT HERE ***

*** BLURB HERE ***

F. Jason Park (6):
  Simplify network-stream opener in socks.el
  ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method
  Fix string encoding bug in socks tests
  Add support for SOCKS 4a
  Support SOCKS resolve extension
  [POC] Demo SOCKS resolve with HTTPS

 lisp/net/socks.el            | 157 +++++++++++++++++++++++++-------
 lisp/url/url-gw.el           |   2 +
 test/lisp/net/socks-tests.el | 168 ++++++++++++++++++++++++++++++++---
 3 files changed, 285 insertions(+), 42 deletions(-)

Interdiff:
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 9285cbf805..9ce23b517e 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -319,7 +319,8 @@ socks-filter
 		     ((pred (= socks-address-type-name))
 		      (if (< (length string) 5)
 			  255
-		        (+ 1 (aref string 4)))))))
+                        (+ 1 (aref string 4))))
+                     (0 0))))
 	  (if (< (length string) desired-len)
 	      nil			; Need to spin some more
 	    (process-put proc 'socks-state socks-state-connected)
@@ -469,7 +470,7 @@ socks-send-command
              (let ((no (or (process-get proc 'socks-reply) 1)))
                (if (eq version 5)
                    (nth no socks-errors)
-                 (nth (+ 90 no) socks--errors-4)))))
+                 (nth (- no 90) socks--errors-4)))))
     proc))
 
 
@@ -692,19 +693,11 @@ socks--extract-resolve-response
 
 (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 (if (string-match "\\`[[:ascii:]]+\\'" name)
-                   name
-                 (require 'puny)
-                 (puny-encode-domain name)))
-         (port 80)  ; unused for now
-         (route (socks-find-route host nil))
-         proc
-         ip)
+(defun socks--tor-resolve (host)
+  (let ((socks-password (or socks-password ""))
+        (route (socks-find-route host nil))
+        proc
+        ip)
     (cl-assert route)
     ;; "Host unreachable" may be raised when the lookup fails
     (unwind-protect
@@ -714,13 +707,30 @@ socks-tor-resolve
                               socks-resolve-command
                               socks-address-type-name
                               host
-                              port)
-          (cl-assert (eq (process-get proc 'socks-state)
-                         socks-state-connected))
+                              0)
           (setq ip (socks--extract-resolve-response proc)))
       (when proc
         (delete-process proc)))
-    (list (vconcat ip [0]))))
+    ip))
+
+(defun socks-tor-resolve (name &optional _family)
+  "Return list of one IPv4 address for domain NAME.
+See `network-lookup-address-info' for format of return value.  Return
+nil on failure.
+
+SOCKS server must support the Tor RESOLVE command.  Note that using this
+in place of `network-lookup-address-info' may not be enough to prevent a
+DNS leak.  For example, see `url-gateway-broken-resolution'."
+  (unless (string-match "\\`[[:ascii:]]+\\'" name)
+    (require 'puny)
+    (setq name (puny-encode-domain name)))
+  (condition-case err
+      (when-let ((ip (socks--tor-resolve name)))
+        (list (vconcat ip [0])))
+    (error
+     (unless (member (cadr err)
+                     '("SOCKS: Host unreachable" "SOCKS: Rejected or failed"))
+       (signal (car err) (cdr err))))))
 
 (provide 'socks)
 
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 402ccf979d..0c58fcc863 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -133,7 +133,8 @@ socks-tests-canned-server-patterns
 (defun socks-tests-canned-server-create ()
   "Create and return a fake SOCKS server."
   (let* ((port (nth 2 socks-server))
-         (name (format "socks-server:%d" port))
+         (name (format "socks-server:%s"
+                       (or (numberp port) (ert-test-name (ert-running-test)))))
          (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
                  (pcase-let ((`(,pat . ,resp) (pop pats)))
@@ -152,8 +153,10 @@ socks-tests-canned-server-create
                                      :family 'ipv4
                                      :host 'local
                                      :coding 'binary
-                                     :service port)))
+                                     :service (or port t))))
     (set-process-query-on-exit-flag serv nil)
+    (unless (numberp (nth 2 socks-server))
+      (setf (nth 2 socks-server) (process-contact serv :service)))
     serv))
 
 (defvar socks-tests--hello-world-http-request-pattern
@@ -192,7 +195,7 @@ socks-tests-perform-hello-world-http-request
 
 (ert-deftest socks-tests-v4-basic ()
   "Show correct preparation of SOCKS4 connect command (Bug#46342)."
-  (let ((socks-server '("server" "127.0.0.1" 10079 4))
+  (let ((socks-server '("server" "127.0.0.1" t 4))
         (url-user-agent "Test/4-basic")
         (socks-tests-canned-server-patterns
          `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
@@ -209,7 +212,7 @@ socks-tests-v4-basic
 
 (ert-deftest socks-tests-v4a-basic ()
   "Show correct preparation of SOCKS4a connect command."
-  (let ((socks-server '("server" "127.0.0.1" 10083 4a))
+  (let ((socks-server '("server" "127.0.0.1" t 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]
@@ -227,7 +230,7 @@ socks-tests-v4a-basic
 (ert-deftest socks-tests-v5-auth-user-pass ()
   "Verify correct handling of SOCKS5 user/pass authentication."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10080 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo")
         (socks-password "bar")
         (url-user-agent "Test/auth-user-pass")
@@ -261,7 +264,7 @@ socks-tests-v5-auth-user-pass
 (ert-deftest socks-tests-v5-auth-user-pass-blank ()
   "Verify correct SOCKS5 user/pass authentication with empty pass."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10081 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo") ; defaults to (user-login-name)
         (socks-password "") ; simulate user hitting enter when prompted
         (url-user-agent "Test/auth-user-pass-blank")
@@ -280,7 +283,7 @@ socks-tests-v5-auth-user-pass-blank
 
 (ert-deftest socks-tests-v5-auth-none ()
   "Verify correct handling of SOCKS5 when auth method 0 requested."
-  (let ((socks-server '("server" "127.0.0.1" 10082 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-authentication-methods (append socks-authentication-methods
                                               nil))
         (url-user-agent "Test/auth-none")
@@ -297,9 +300,9 @@ socks-tests-v5-auth-none
 
 (ert-deftest tor-resolve-4a ()
   "Make request to TOR resolve service over SOCKS4a"
-  (let* ((socks-server '("server" "127.0.0.1" 19050 4a))
+  (let* ((socks-server '("server" "127.0.0.1" t 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]
+          '(([4 #xf0 0 0 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)))
@@ -311,9 +314,40 @@ tor-resolve-4a
     (kill-buffer (process-buffer server))
     (delete-process server)))
 
+(ert-deftest tor-resolve-4a-fail ()
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+             . [0 91 0 0 0 0 0 0])))
+         (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-not (socks-tor-resolve "example.com"))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
+(ert-deftest tor-resolve-5-fail ()
+  (let* ((socks-server '("server" "127.0.0.1" t 5))
+         (socks-username "")
+         (socks-authentication-methods (copy-sequence
+                                        socks-authentication-methods))
+         (inhibit-message noninteractive)
+         (socks-tests-canned-server-patterns
+          '(([5 2 0 2] . [5 2])
+            ([1 0 0] . [1 0])
+            ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0]
+             . [5 4 0 0 0 0 0 0 0 0])))
+         (server (socks-tests-canned-server-create)))
+    (ert-info ("Query TOR RESOLVE service over SOCKS5")
+      (should-not (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))
+  (let* ((socks-server '("server" "127.0.0.1" t 5))
          (socks-username "foo")
          (socks-authentication-methods (append socks-authentication-methods
                                                nil))
@@ -321,7 +355,7 @@ tor-resolve-5
          (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 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0]
              . [5 0 0 1 93 184 216 34 0 0])))
          (server (socks-tests-canned-server-create)))
     (ert-info ("Query TOR RESOLVE service over SOCKS5")
@@ -341,6 +375,15 @@ test-socks-service
                          verify-flags verify-error verify-hostname-error
                          &allow-other-keys))
 
+(ert-deftest test-socks-resolve-fail ()
+  :tags '(:unstable)
+  (unless test-socks-service (ert-skip "SOCKS service missing"))
+  (let* ((socks-server `("tor" ,@test-socks-service 5)) ; also try 4a
+         (socks-username "")
+         (socks-password ""))
+    (ert-info ("Connect to HTTP endpoint over Tor SOCKS proxy")
+      (should-not (socks-tor-resolve "test-socks-resolve-fail--fake.com")))))
+
 (ert-deftest test-socks-https-poc ()
   :tags '(:unstable)
   (unless test-socks-service (ert-skip "SOCKS service missing"))
-- 
2.35.1

>From dcb7c638d970c0924933ebd83f361298ebccf242 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/6] Simplify network-stream opener in socks.el

* lisp/net/socks.el (socks-override-functions): Make variable obsolete
and remove uses throughout.
(socks-open-connection): Accept additional `make-network-process'
params passed on to opener.
(socks-open-network-stream-function): Add new custom option to hold an
opener function.
(socks-open-network-stream-legacy): Simulate original
`socks-open-network-stream' functionality, only without
`socks-override-functions'.  Call `open-network-stream' as a fallback
when a route cannot be found.
(socks-open-network-stream): Accept additional params.  Delegate to
`socks-open-network-stream-function' for actual work.
(socks--open-network-stream): Reduce role to merely issuing the first
command using an existing process.
---
 lisp/net/socks.el | 65 +++++++++++++++++++++++++++--------------------
 1 file changed, 38 insertions(+), 27 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 8df0773e1d..fe66a94d18 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -323,19 +323,20 @@ 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
+                        "see `socks-open-network-stream-function'."
+                        "29.1")
+
+(defun socks-open-connection (server-info &rest kw-args)
+  "Create and initialize a SOCKS process.
+Perform authentication if needed.  SERVER-INFO should resemble
+`socks-server'.  KW-ARGS are those accepted by `open-network-stream'."
   (interactive)
+  (unless (plist-member kw-args :coding)
+    (setf (plist-get kw-args :coding) '(binary . binary)))
   (save-excursion
-    (let ((proc
-           (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+    (let ((proc (apply #'open-network-stream "socks" nil
+                       (nth 1 server-info) (nth 2 server-info) kw-args))
 	  (authtype nil)
 	  version)
 
@@ -508,22 +509,32 @@ 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))
+(defcustom socks-open-network-stream-function
+  #'socks-open-network-stream-legacy
+  "Function to open a SOCKS connection.
+Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with
+similar functions in the url-gw framework.  May also be passed
+additional keyword args suitable for `make-network-process'."
+  :type '(choice (const :tag "Default fallback-oriented opener.")
+                 (function :tag "User-provided function")))
+
+(defun socks-open-network-stream-legacy (name buffer host service &rest params)
+  "Open a SOCKS connection for a valid route.
+Fall back to non-SOCKS connections for unknown or undesired routes."
+  (if-let* ((route (socks-find-route host service))
+            (proc (apply #'socks-open-connection route params)))
+      (socks--open-network-stream proc buffer host service)
+    ;; Retain legacy behavior and connect anyway without warning
+    (apply #'open-network-stream name buffer host service params)))
+
+(defun socks-open-network-stream (name buffer host service &rest params)
+  "Open a SOCKS connection.  PARAMS are passed to `open-network-stream'."
+  (apply socks-open-network-stream-function 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-connect'
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.35.1

>From dde4ed3bfdc5cebd4649534efe04b32c488f7b56 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Sun, 6 Mar 2022 17:14:50 -0800
Subject: [PATCH 2/6] ; * lisp/url/url-gw.el (url-open-stream): Honor socks
 gateway-method

---
 lisp/url/url-gw.el | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index c4a41f56b3..822cbcb64e 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -215,6 +215,8 @@ url-open-stream
 Optional arg GATEWAY-METHOD specifies the gateway to be used,
 overriding the value of `url-gateway-method'."
   (unless url-gateway-unplugged
+    (when (eq url-gateway-method 'socks)
+      (setq gateway-method nil))
     (let* ((gwm (or gateway-method url-gateway-method))
            (gw-method (if (and url-gateway-local-host-regexp
                                (not (eq 'tls gwm))
-- 
2.35.1

>From 1af9240dee9fdd2b112d7e1580f4d2ce4bc66321 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/6] 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.  Also allow system
to choose port instead of hard-coding it.
---
 test/lisp/net/socks-tests.el | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 461796bdf9..807c926185 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)))))
@@ -133,17 +133,19 @@ socks-tests-canned-server-patterns
 (defun socks-tests-canned-server-create ()
   "Create and return a fake SOCKS server."
   (let* ((port (nth 2 socks-server))
-         (name (format "socks-server:%d" port))
+         (name (format "socks-server:%s"
+                       (or (numberp port) (ert-test-name (ert-running-test)))))
          (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
                  (pcase-let ((`(,pat . ,resp) (pop pats)))
                    (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
@@ -151,8 +153,10 @@ socks-tests-canned-server-create
                                      :family 'ipv4
                                      :host 'local
                                      :coding 'binary
-                                     :service port)))
+                                     :service (or port t))))
     (set-process-query-on-exit-flag serv nil)
+    (unless (numberp (nth 2 socks-server))
+      (setf (nth 2 socks-server) (process-contact serv :service)))
     serv))
 
 (defvar socks-tests--hello-world-http-request-pattern
@@ -191,7 +195,7 @@ socks-tests-perform-hello-world-http-request
 
 (ert-deftest socks-tests-v4-basic ()
   "Show correct preparation of SOCKS4 connect command (Bug#46342)."
-  (let ((socks-server '("server" "127.0.0.1" 10079 4))
+  (let ((socks-server '("server" "127.0.0.1" t 4))
         (url-user-agent "Test/4-basic")
         (socks-tests-canned-server-patterns
          `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
@@ -213,7 +217,7 @@ socks-tests-v4-basic
 (ert-deftest socks-tests-v5-auth-user-pass ()
   "Verify correct handling of SOCKS5 user/pass authentication."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10080 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo")
         (socks-password "bar")
         (url-user-agent "Test/auth-user-pass")
@@ -247,7 +251,7 @@ socks-tests-v5-auth-user-pass
 (ert-deftest socks-tests-v5-auth-user-pass-blank ()
   "Verify correct SOCKS5 user/pass authentication with empty pass."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10081 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo") ; defaults to (user-login-name)
         (socks-password "") ; simulate user hitting enter when prompted
         (url-user-agent "Test/auth-user-pass-blank")
@@ -266,7 +270,7 @@ socks-tests-v5-auth-user-pass-blank
 
 (ert-deftest socks-tests-v5-auth-none ()
   "Verify correct handling of SOCKS5 when auth method 0 requested."
-  (let ((socks-server '("server" "127.0.0.1" 10082 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-authentication-methods (append socks-authentication-methods
                                               nil))
         (url-user-agent "Test/auth-none")
-- 
2.35.1

>From 55702321a8b17914ff577b5e7fc426ffb7ff0462 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/6] 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 fe66a94d18..73afcc38d3 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)
@@ -401,6 +408,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))
@@ -418,6 +426,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
@@ -427,7 +441,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
@@ -448,7 +463,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 (- no 90) socks--errors-4)))))
     proc))
 
 
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 807c926185..a0191d9341 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -210,6 +210,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" t 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 a26bf29fb9363d4face0049dcf5ec3d353c799ac 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/6] 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.
(socks--tor-resolve, socks-tor-resolve): Provide internal function to
perform resolve command as well as a partial drop-in replacement for
`network-lookup-address-info'.
(socks-filter): Allow for a null type field on error with version 5.
Bug#53941
---
 lisp/net/socks.el            | 70 +++++++++++++++++++++++++++++++++++-
 test/lisp/net/socks-tests.el | 65 +++++++++++++++++++++++++++++++++
 2 files changed, 134 insertions(+), 1 deletion(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 73afcc38d3..9ce23b517e 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)
@@ -316,7 +319,8 @@ socks-filter
 		     ((pred (= socks-address-type-name))
 		      (if (< (length string) 5)
 			  255
-		        (+ 1 (aref string 4)))))))
+                        (+ 1 (aref string 4))))
+                     (0 0))))
 	  (if (< (length string) desired-len)
 	      nil			; Need to spin some more
 	    (process-put proc 'socks-state socks-state-connected)
@@ -664,6 +668,70 @@ 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 (host)
+  (let ((socks-password (or socks-password ""))
+        (route (socks-find-route host nil))
+        proc
+        ip)
+    (cl-assert route)
+    ;; "Host unreachable" may be raised when the lookup fails
+    (unwind-protect
+        (progn
+          (setq proc (socks-open-connection route))
+          (socks-send-command proc
+                              socks-resolve-command
+                              socks-address-type-name
+                              host
+                              0)
+          (setq ip (socks--extract-resolve-response proc)))
+      (when proc
+        (delete-process proc)))
+    ip))
+
+(defun socks-tor-resolve (name &optional _family)
+  "Return list of one IPv4 address for domain NAME.
+See `network-lookup-address-info' for format of return value.  Return
+nil on failure.
+
+SOCKS server must support the Tor RESOLVE command.  Note that using this
+in place of `network-lookup-address-info' may not be enough to prevent a
+DNS leak.  For example, see `url-gateway-broken-resolution'."
+  (unless (string-match "\\`[[:ascii:]]+\\'" name)
+    (require 'puny)
+    (setq name (puny-encode-domain name)))
+  (condition-case err
+      (when-let ((ip (socks--tor-resolve name)))
+        (list (vconcat ip [0])))
+    (error
+     (unless (member (cadr err)
+                     '("SOCKS: Host unreachable" "SOCKS: Rejected or failed"))
+       (signal (car err) (cdr err))))))
+
 (provide 'socks)
 
 ;;; socks.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index a0191d9341..077b80cb0b 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -298,4 +298,69 @@ 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" t 4a))
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 0 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-4a-fail ()
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+             . [0 91 0 0 0 0 0 0])))
+         (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-not (socks-tor-resolve "example.com"))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
+(ert-deftest tor-resolve-5-fail ()
+  (let* ((socks-server '("server" "127.0.0.1" t 5))
+         (socks-username "")
+         (socks-authentication-methods (copy-sequence
+                                        socks-authentication-methods))
+         (inhibit-message noninteractive)
+         (socks-tests-canned-server-patterns
+          '(([5 2 0 2] . [5 2])
+            ([1 0 0] . [1 0])
+            ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0]
+             . [5 4 0 0 0 0 0 0 0 0])))
+         (server (socks-tests-canned-server-create)))
+    (ert-info ("Query TOR RESOLVE service over SOCKS5")
+      (should-not (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" t 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 0]
+             . [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 52a7f3269992166074ebe277f6905c219885d7cf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 6/6] [POC] Demo SOCKS resolve with 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 | 64 +++++++++++++++++++++++++++++++++++-
 1 file changed, 63 insertions(+), 1 deletion(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 077b80cb0b..0c58fcc863 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)
 
@@ -363,4 +363,66 @@ 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-resolve-fail ()
+  :tags '(:unstable)
+  (unless test-socks-service (ert-skip "SOCKS service missing"))
+  (let* ((socks-server `("tor" ,@test-socks-service 5)) ; also try 4a
+         (socks-username "")
+         (socks-password ""))
+    (ert-info ("Connect to HTTP endpoint over Tor SOCKS proxy")
+      (should-not (socks-tor-resolve "test-socks-resolve-fail--fake.com")))))
+
+(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-username "user")
+           (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)))
+           (socks-open-network-stream-function
+            (lambda (&rest rest)
+              (let ((proc (apply #'socks-open-network-stream-legacy 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-https 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