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

From: "J.P." <[email-masked]>
Date: Tue, 19 Dec 2023 08:29:43 -0800

In light of recent related activity on the development mailing list [1],
I think it's worth summarizing where this bug stands, even though that
discussion seems to favor other approaches that I personally have little
interest in. As a reminder, this bug is about integrating the built-in
`socks' and `url' libraries to make proxying specific connections over
Tor mostly transparent and hassle free.

As it stands, the two biggest blockers I can see are both heavy on the
legwork side of things. The first and more daunting involves surveying
how the `url' library is used in the wild when it comes to proxies: what
interfaces people use and how that compares with what's prescribed in
the manual and what was promised in the original design discussions. The
goal would be to use these findings to enhance or overhaul the existing
interface and behavior and to affirm the result as canon. This will
likely involve reworking parts of the existing documentation and
saturating affected parts of the library in comprehensive test coverage.
It may also require central coordination to ensure interoperability
among consuming libraries and continuity of purpose among future
contributors.

The second and IMO easier (but still labor-intensive) task is fleshing
out and fortifying the actual networking implementation. What I propose
is that we start by leveraging the built-in logging facility of torsocks
itself [2]. By default, the verbose-level output is noisy but tolerable
after minimal modifications (e.g., by commenting out the "close" and
"fclose" statements). We'd need volunteers with access to the various
platforms Emacs supports (capable of running a Tor daemon) to run
through some contrived recipes, such as loading a site with `eww' and
fetching a package from an ELPA endpoint.

  $ LD_PRELOAD=/home/me/torsocks/src/lib/.libs/libtorsocks.so \
    TORSOCKS_LOG_FILE_PATH=/tmp/torsocks.log \
    TORSOCKS_LOG_LEVEL=5 ./src/emacs -Q

What we'd be looking for in the output is activity in those libc "GAI"
functions shadowed by the program.

While this methodology seems hokey, I think it's actually preferable (at
least as a starting point) over more traditional tracing solutions
because with the latter we'd still have to isolate the set of
torsocks-shadowed functions in whatever recording is produced, and then
filter out all the false positives from things like connect(2) calls for
AF_LOCAL/AF_UNIX, which we don't care about. Moreover, these
hand-crafted logs show us other niceties, like parameters of interest
(socket type, hint flags, etc.), which makes sense because this program
comes from the Tor Project itself and is well written. Anyway, once we
have a solid idea of what needs intercepting and/or inhibiting [3],
we'll need volunteers yet again, this time to help run packet traces
against a prototype both for the proxied connection and for DNS leakage.
Obviously, help from those familiar with the Emacs network stack would
go a long way here.

Anyway, the attached POC implementation is basically just a slightly
cleaned up version of the same patch set I've been fiddling with this
entire bug thread. WRT to the `url' side, I've done basically zero
additional research, and the interface you see is just a "best guess"
based on the current documentation and a cursory stroll around the
library. As for the `socks' side, everything is based on observations
from exactly one Emacs installation on one GNU/Linux machine. That it
doesn't leak DNS (for me) should just be a data point.

If others want to work on this or take over, please let me know. I
encourage anyone with a similar setup (GNU/Linux, x86_64, modern
libraries) to try them out. You'll need a Tor service running locally,
preferably with the default configuration. The API is pretty basic and
could be simplified even further. For now, it's

  (require 'socks)
  (require 'url)
  (setopt url-proxy-services '(("https" . "socks5h://localhost:9050")
                               ("http" . "socks5h://localhost:9050"))
          socks-server '("tor" "localhost" 9050 5)
          socks-username ""
          socks-password "")

then something like

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

or

  M-x list-packages RET.

[1] https://lists.gnu.org/archive/html/emacs-devel/2023-12/msg00570.html

[2] https://gitlab.torproject.org/tpo/core/torsocks.git

[3] Just to clarify a couple things I've personally found confusing,
    in case others may find them beneficial:

    If we only decide to support local proxies, we don't have to worry
    about DNS leakage for the proxy service itself. I've heard folks
    express concern about calls to getaddrinfo and, in particular, the
    async `:nowait' variant getaddrinfo_a (because torsocks AFAIK
    doesn't shadow it). But those won't come into play since our only
    connections through `make-network-process' are to the local proxy
    service. IOW, the actual remote lookup is tunneled, so the only
    calls we'll need to care about intercepting WRT DNS are those from
    `nsm-check' to `network-lookup-address-info'. (In the attached POC
    implementation, I simply reroute these through a tor-specific
    resolver.)

    The "onion cookie" bookkeeping business performed by torsocks is of
    no interest to us because we control the means of connection. IOW,
    at no point should an onion address (or that of a normal remote
    endpoint) be exposed to the underlying networking machinery. It's
    all just part of the opaque application data unit (payload).

>From a32e6d440e38b97090c9ae3fbf607ec71a49277e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Tue, 19 Dec 2023 07:08:36 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (3):
  [POC] Support SOCKS resolve extension
  [POC] Simplify network-stream openers in socks.el
  [POC] Integrate the socks and url libraries

 lisp/net/nsm.el              |   8 +-
 lisp/net/socks.el            | 189 +++++++++++++++++++++++++++++++----
 lisp/url/url-gw.el           |   8 +-
 lisp/url/url-http.el         |  19 ++--
 lisp/url/url-methods.el      |   8 +-
 lisp/url/url-proxy.el        |  22 ++--
 lisp/url/url-vars.el         |  20 +++-
 test/lisp/net/socks-tests.el |  70 +++++++++++++
 8 files changed, 300 insertions(+), 44 deletions(-)

Interdiff:
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 09f7ac52537..234a7c5e74a 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -220,6 +220,10 @@ nsm-network-same-subnet
                                       (aref mask i))))))
         matches)))
 
+(defvar nsm--network-lookup-address-function nil
+  "Function to replace `network-lookup-address-info' in nsm check.
+It should have the same signature as the original.")
+
 (defun nsm-should-check (host)
   "Determine whether NSM should check for TLS problems for HOST.
 
@@ -227,7 +231,9 @@ nsm-should-check
 host address is a localhost address, or in the same subnet as one
 of the local interfaces, this function returns nil.  Non-nil
 otherwise."
-  (let ((addresses (network-lookup-address-info host))
+  (let ((addresses (if nsm--network-lookup-address-function
+                       (funcall nsm--network-lookup-address-function host)
+                     (network-lookup-address-info host)))
         (network-interface-list (network-interface-list t))
         (off-net t))
     (when
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index a04f93e0960..8d16db75834 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)
@@ -554,6 +557,9 @@ socks-proxied-tls-services
                   (process host port &optional
                            save-fingerprint warn-unencrypted))
 
+(defvar socks-server-name-as-tor-service-regexp (rx bow "tor" eow)
+  "Regexp to determine if a `socks-server' entry is TOR service.")
+
 ;;;###autoload
 (defun socks-open-network-stream (name buffer host service &rest params)
   "Open and return a connection, possibly proxied over SOCKS.
@@ -579,17 +585,18 @@ socks-open-network-stream
   (let* ((url (and (url-p url-using-proxy)
                    (string-prefix-p "socks" (url-type url-using-proxy))
                    url-using-proxy))
+         (server-name (and url (string= (nth 1 socks-server) (url-host url))
+                           (= (nth 2 socks-server) (url-port url))
+                           (car socks-server)))
          (socks-server (if url
-                           (list name (url-host url) (url-port url)
+                           (list server-name (url-host url) (url-port url)
                                  (pcase (url-type url)
                                    ("socks4" 4)
                                    ("socks4a" '4a)
                                    (_ 5)))
                          socks-server))
-         (socks-username (or (and url (url-user url))
-                             socks-username))
-         (socks-password (or (and url (url-password url))
-                             socks-password)))
+         (socks-username (or (and url (url-user url)) socks-username))
+         (socks-password (or (and url (url-password url)) socks-password)))
     (if-let ((route (socks-find-route host service))
              (proc (apply #'socks-open-connection route params)))
         (let ((port (if (numberp service)
@@ -597,15 +604,20 @@ socks-open-network-stream
                       (process-contact proc :service)))
               (certs (plist-get params :client-certificate)))
           (socks--initiate-command-connect proc buffer host service)
-          (if (and (memq port socks-proxied-tls-services)
-                   (gnutls-available-p)
-                   (require 'gnutls nil t)
-                   (require 'nsm nil t))
-              (progn (gnutls-negotiate :process proc
-                                       :hostname host
-                                       :keylist (and certs (list certs)))
-                     (unless (string-suffix-p ".onion" host)
-                       (nsm-verify-connection proc host port))))
+          (when (and (memq port socks-proxied-tls-services)
+                     (gnutls-available-p)
+                     (require 'gnutls nil t)
+                     (require 'nsm nil t))
+            (defvar nsm--network-lookup-address-function)
+            (let ((nsm--network-lookup-address-function
+                   (and (string-match socks-server-name-as-tor-service-regexp
+                                      (car socks-server))
+                        #'socks-tor-resolve)))
+              (gnutls-negotiate :process proc
+                                :hostname host
+                                :keylist (and certs (list certs)))
+              (unless (string-suffix-p ".onion" host)
+                (nsm-verify-connection proc host port))))
           proc)
       (apply socks-connect-function name buffer host service params))))
 
@@ -724,6 +736,72 @@ socks-nslookup-host
 	res)
     host))
 
+(defun socks--extract-resolve-response (proc)
+  "Parse response for PROC and maybe return destination IP address."
+  (when-let ((response (process-get proc 'socks-response)))
+    (pcase (process-get proc 'socks-server-protocol)
+      (4 ; https://www.openssh.com/txt/socks4a.protocol
+       (and-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 _flags)
+  (condition-case err
+      (if-let ((socks-password (or socks-password ""))
+               (route (socks-find-route name nil))
+               (proc (socks-send-command (socks-open-connection route)
+                                         socks-resolve-command
+                                         socks-address-type-name
+                                         name
+                                         0))
+               (ip (prog1 (socks--extract-resolve-response proc)
+                     (delete-process proc))))
+          (list (vconcat ip [0]))
+        (error "Failed to resolve %s" name))
+    (error
+     (unless (member (cadr err)
+                     '("SOCKS: Host unreachable" "SOCKS: Rejected or failed"))
+       (signal (car err) (cdr err))))))
+
+(defvar socks--tor-resolve-cache nil)
+
+(defun socks-tor-resolve (name &optional _family _flags)
+  "Return list with a single IPv4 address for domain NAME.
+Return nil on failure.
+
+See `network-lookup-address-info' for format of return value.  As
+of 0.4.8.9, TOR's resolution service does not support IPv6.
+SOCKS server must support the Tor RESOLVE command.  Note that
+this function exists for novelty purposes only.  Using it in
+place of `network-lookup-address-info' or similar may not prevent
+DNS leaks."
+  (unless (string-match (rx bot (+ ascii) eot) name)
+    (require 'puny)
+    (setq name (puny-encode-domain name)))
+  ;; FIXME use some kind of LRU here.  Currently resets at 5 min.
+  (if socks--tor-resolve-cache
+      (when (time-less-p (car socks--tor-resolve-cache) (current-time))
+        (clrhash (cdr socks--tor-resolve-cache)))
+    (setq socks--tor-resolve-cache (cons (time-add (* 60 5) (current-time))
+                                         (make-hash-table :test #'equal))))
+  (with-memoization (gethash name (cdr socks--tor-resolve-cache))
+    (socks--tor-resolve name)))
+
 (provide 'socks)
 
 ;;; socks.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 1a4bac37bf9..cc9f5a385d2 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -327,4 +327,74 @@ socks-override-functions
   (should-not (advice-member-p #'socks--open-network-stream
                                'open-network-stream)))
 
+(ert-deftest tor-resolve-4a ()
+  "Make request to TOR resolve service over SOCKS4a"
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-username "foo") ; defaults to (user-login-name)
+         (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))
+         socks--tor-resolve-cache)
+    (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-username "foo") ; defaults to (user-login-name)
+         (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))
+         socks--tor-resolve-cache)
+    (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))
+         socks--tor-resolve-cache)
+    (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.42.0

>From d7cca6703475b8bcdf523407383a813ec3749fad Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 1/3] [POC] Support SOCKS resolve extension

* lisp/net/socks.el (socks-resolve-command): Add new constant for the
RESOLVE command, a nonstandard SOCKS 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
doc/socks/socks-extensions.txt in the source tree for torsocks.  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.
* test/lisp/net/socks-tests.el (tor-resolve-4a, tor-resolve-4a-fail,
tor-resolve-5-fail, tor-resolve-5):  (Bug#53941.)
---
 lisp/net/socks.el            | 69 +++++++++++++++++++++++++++++++++++
 test/lisp/net/socks-tests.el | 70 ++++++++++++++++++++++++++++++++++++
 2 files changed, 139 insertions(+)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index e572e5c9bdf..4c4eb8cf751 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)
@@ -655,6 +658,72 @@ socks-nslookup-host
 	res)
     host))
 
+(defun socks--extract-resolve-response (proc)
+  "Parse response for PROC and maybe return destination IP address."
+  (when-let ((response (process-get proc 'socks-response)))
+    (pcase (process-get proc 'socks-server-protocol)
+      (4 ; https://www.openssh.com/txt/socks4a.protocol
+       (and-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 _flags)
+  (condition-case err
+      (if-let ((socks-password (or socks-password ""))
+               (route (socks-find-route name nil))
+               (proc (socks-send-command (socks-open-connection route)
+                                         socks-resolve-command
+                                         socks-address-type-name
+                                         name
+                                         0))
+               (ip (prog1 (socks--extract-resolve-response proc)
+                     (delete-process proc))))
+          (list (vconcat ip [0]))
+        (error "Failed to resolve %s" name))
+    (error
+     (unless (member (cadr err)
+                     '("SOCKS: Host unreachable" "SOCKS: Rejected or failed"))
+       (signal (car err) (cdr err))))))
+
+(defvar socks--tor-resolve-cache nil)
+
+(defun socks-tor-resolve (name &optional _family _flags)
+  "Return list with a single IPv4 address for domain NAME.
+Return nil on failure.
+
+See `network-lookup-address-info' for format of return value.  As
+of 0.4.8.9, TOR's resolution service does not support IPv6.
+SOCKS server must support the Tor RESOLVE command.  Note that
+this function exists for novelty purposes only.  Using it in
+place of `network-lookup-address-info' or similar may not prevent
+DNS leaks."
+  (unless (string-match (rx bot (+ ascii) eot) name)
+    (require 'puny)
+    (setq name (puny-encode-domain name)))
+  ;; FIXME use some kind of LRU here.  Currently resets at 5 min.
+  (if socks--tor-resolve-cache
+      (when (time-less-p (car socks--tor-resolve-cache) (current-time))
+        (clrhash (cdr socks--tor-resolve-cache)))
+    (setq socks--tor-resolve-cache (cons (time-add (* 60 5) (current-time))
+                                         (make-hash-table :test #'equal))))
+  (with-memoization (gethash name (cdr socks--tor-resolve-cache))
+    (socks--tor-resolve name)))
+
 (provide 'socks)
 
 ;;; socks.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 1a4bac37bf9..cc9f5a385d2 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -327,4 +327,74 @@ socks-override-functions
   (should-not (advice-member-p #'socks--open-network-stream
                                'open-network-stream)))
 
+(ert-deftest tor-resolve-4a ()
+  "Make request to TOR resolve service over SOCKS4a"
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-username "foo") ; defaults to (user-login-name)
+         (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))
+         socks--tor-resolve-cache)
+    (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-username "foo") ; defaults to (user-login-name)
+         (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))
+         socks--tor-resolve-cache)
+    (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))
+         socks--tor-resolve-cache)
+    (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.42.0

>From dd72b020f3ceca191f2d18d16253501d16ed582b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 28 Nov 2022 22:31:50 -0800
Subject: [PATCH 2/3] [POC] Simplify network-stream openers in socks.el

* lisp/net/nsm.el (nsm--network-lookup-address-function):
New function-valued variable to override `network-lookup-address-info'
during nsm checks.
(nsm-should-check): Defer to `nsm--network-lookup-address-function'
to resolve hosts when non-nil.
* lisp/net/socks.el (socks-connect-function): New variable for
specifying an `open-network-stream'-like connect function.
(socks-open-connection): Accept additional `open-network-stream'
params passed on to opener, now `socks-connect-function',
in place of `open-network-stream'.
(socks-proxied-tls-services): Add new option for specifying ports
whose proxied connections should use TLS.
(socks--open-network-stream): Rework to serve as thin wrapper for
`socks-open-network-stream' that now hinges on rather than ignores the
variable `socks-override-functions'.
(socks-open-network-stream): Prefer parsed URL details, when present
in a non-nil `url-using-proxy', for improved compatibility with the gw
framework.
(socks--initiate-command-connect): New function to house renamed
latter half of the original `socks--open-network-stream'.  Role now
reduced to issuing the first command using an existing
process.  (Bug#53941)
---
 lisp/net/nsm.el   |   8 +++-
 lisp/net/socks.el | 120 ++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 106 insertions(+), 22 deletions(-)

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 09f7ac52537..234a7c5e74a 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -220,6 +220,10 @@ nsm-network-same-subnet
                                       (aref mask i))))))
         matches)))
 
+(defvar nsm--network-lookup-address-function nil
+  "Function to replace `network-lookup-address-info' in nsm check.
+It should have the same signature as the original.")
+
 (defun nsm-should-check (host)
   "Determine whether NSM should check for TLS problems for HOST.
 
@@ -227,7 +231,9 @@ nsm-should-check
 host address is a localhost address, or in the same subnet as one
 of the local interfaces, this function returns nil.  Non-nil
 otherwise."
-  (let ((addresses (network-lookup-address-info host))
+  (let ((addresses (if nsm--network-lookup-address-function
+                       (funcall nsm--network-lookup-address-function host)
+                     (network-lookup-address-info host)))
         (network-interface-list (network-interface-list t))
         (off-net t))
     (when
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 4c4eb8cf751..8d16db75834 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -34,7 +34,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ;;; Custom widgets
@@ -338,14 +338,20 @@ socks-override-functions
 (when socks-override-functions
   (advice-add 'open-network-stream :around #'socks--open-network-stream))
 
-(defun socks-open-connection (server-info)
+(defvar socks-connect-function #'open-network-stream
+  "Function to open a network connection to a SOCKS provider.
+Called with arguments suitable for `open-network-stream'.")
+
+(defun socks-open-connection (server-info &rest stream-params)
+  "Create and initialize a SOCKS process.
+Perform authentication if needed.  Expect SERVER-INFO to resemble
+`socks-server' and STREAM-PARAMS to be keyword parameters
+accepted by `open-network-stream'."
   (save-excursion
     (let ((proc
            (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+             (apply socks-connect-function (nth 0 server-info) nil
+                    (nth 1 server-info) (nth 2 server-info) stream-params)))
 	  (authtype nil)
 	  version)
 
@@ -531,22 +537,94 @@ 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))
+  "Call `socks-open-network-stream', falling back to ORIG-FUN.
+Expect NAME, BUFFER, HOST, SERVICE, and PARAMS to be compatible
+with `open-network-stream'."
+  (let ((socks-connect-function orig-fun))
+    (apply (if socks-override-functions #'socks-open-network-stream orig-fun)
+           name buffer host service params)))
+
+(defcustom socks-proxied-tls-services '(443 6697)
+  "Ports whose connections should use TLS.
+Note that the system resolver may be consulted to look up host
+names for checking domain validation certs."
+  :version "30.1"
+  :type '(repeat number))
+
+(declare-function gnutls-negotiate "gnutls" (&rest rest))
+(declare-function nsm-verify-connection "nsm"
+                  (process host port &optional
+                           save-fingerprint warn-unencrypted))
+
+(defvar socks-server-name-as-tor-service-regexp (rx bow "tor" eow)
+  "Regexp to determine if a `socks-server' entry is TOR service.")
+
+;;;###autoload
+(defun socks-open-network-stream (name buffer host service &rest params)
+  "Open and return a connection, possibly proxied over SOCKS.
+Expect PARAMS to contain keyword parameters recognized by
+`open-network-stream'.  Assume HOST and SERVICE refer to the
+proxied remote peer rather than the SOCKS server, but assume the
+opposite for PARAMS.  That is, if PARAMS contains a `:type' of
+`tls', treat the underlying connection to the proxy server as
+destined for encryption rather than the tunneled connection (even
+though `socks-connect-function' has the final say).  For TLS with
+proxied connections, see the option `socks-proxied-tls-services'.
+
+Before connecting, check the HOST against `socks-noproxy'.  On
+rejection, fall back to a non-SOCKS connection determined by
+the variable `socks-connect-function'.
+
+But, before doing anything, check if `url-using-proxy' is bound
+to a `url' struct object, as defined in `url-parse'.  If so,
+assume it represents the address of the desired SOCKS server
+rather than that of the remote peer, and use its fields instead
+of `socks-server' for all SOCKS connection details."
+  (require 'url-parse)
+  (let* ((url (and (url-p url-using-proxy)
+                   (string-prefix-p "socks" (url-type url-using-proxy))
+                   url-using-proxy))
+         (server-name (and url (string= (nth 1 socks-server) (url-host url))
+                           (= (nth 2 socks-server) (url-port url))
+                           (car socks-server)))
+         (socks-server (if url
+                           (list server-name (url-host url) (url-port url)
+                                 (pcase (url-type url)
+                                   ("socks4" 4)
+                                   ("socks4a" '4a)
+                                   (_ 5)))
+                         socks-server))
+         (socks-username (or (and url (url-user url)) socks-username))
+         (socks-password (or (and url (url-password url)) socks-password)))
+    (if-let ((route (socks-find-route host service))
+             (proc (apply #'socks-open-connection route params)))
+        (let ((port (if (numberp service)
+                        service
+                      (process-contact proc :service)))
+              (certs (plist-get params :client-certificate)))
+          (socks--initiate-command-connect proc buffer host service)
+          (when (and (memq port socks-proxied-tls-services)
+                     (gnutls-available-p)
+                     (require 'gnutls nil t)
+                     (require 'nsm nil t))
+            (defvar nsm--network-lookup-address-function)
+            (let ((nsm--network-lookup-address-function
+                   (and (string-match socks-server-name-as-tor-service-regexp
+                                      (car socks-server))
+                        #'socks-tor-resolve)))
+              (gnutls-negotiate :process proc
+                                :hostname host
+                                :keylist (and certs (list certs)))
+              (unless (string-suffix-p ".onion" host)
+                (nsm-verify-connection proc host port))))
+          proc)
+      (apply socks-connect-function name buffer host service params))))
+
+(defun socks--initiate-command-connect (proc buffer host service)
+  (progn ; preserve indentation level for git blame / code review
+    (progn
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.42.0

>From a32e6d440e38b97090c9ae3fbf607ec71a49277e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Tue, 1 Mar 2022 01:38:33 -0800
Subject: [PATCH 3/3] [POC] Integrate the socks and url libraries

FIXME add tests, and mention in doc/misc/url.texi that some
`url-proxy-services' items can have full URLs, much like their env-var
counterparts. Current API (only known to work on GNU/Linux):

  (require 'socks)
  (require 'url)
  (setopt url-proxy-services '(("https" . "socks5h://localhost:9050")
                               ("http" . "socks5h://localhost:9050"))
          socks-server '("tor" "localhost" 9050 5)
          socks-username ""
          socks-password "")

Then do something like

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

or

  M-x list-packages RET.

* lisp/url/url-gw.el (url-open-stream): Use presence and type of
`url-using-proxy' to detect caller and massage input values according
to legacy practices.
* lisp/url/url-http.el: (url-http-find-free-connection): Don't call
`url-open-stream' with host and port from active proxy.
(url-http, url-http-async-sentinel): Only run
`url-https-proxy-connect' for http proxies.
* lisp/url/url-methods.el (url-scheme-register-proxy): When an
environment variable's value is a full URL, include the scheme in the
value of the new entry added to the `url-proxy-services' option if it
appears in the variable `url-proxy-full-address-types'.
* lisp/url/url-proxy.el (url-default-find-proxy-for-url): Preserve
`url-proxy-services' entries whose value is a URL containing a scheme
that appears in `url-proxy-full-address-type', and return that URL
prefixed by the upcased scheme.
(url-find-proxy-for-url): Recognize modified host/address value for
socks entries of `url-proxy-services' and deal accordingly.
(url-proxy): Handle a SOCKS proxy for http(s) connections only.
* lisp/url/url-vars.el (url-proxy-full-address-types): New variable to
specify types of URLs that should be preserved in full in the values
of `url-proxy-services' entries.
(url-proxy-services): Explain that values for
certain gateways may need a leading scheme:// portion.
(url-using-proxy): Add warning regarding expected type.
---
 lisp/url/url-gw.el      |  8 +++++++-
 lisp/url/url-http.el    | 19 ++++++++++---------
 lisp/url/url-methods.el |  8 +++++---
 lisp/url/url-proxy.el   | 22 +++++++++++++++-------
 lisp/url/url-vars.el    | 20 ++++++++++++++++++--
 5 files changed, 55 insertions(+), 22 deletions(-)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 568ce8679f5..a65245a58a3 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -28,7 +28,7 @@
 (require 'url-vars)
 (require 'url-parse)
 
-(autoload 'socks-open-network-stream "socks")
+(autoload 'socks-open-network-stream "socks") ; FIXME remove this
 
 (defgroup url-gateway nil
   "URL gateway variables."
@@ -226,6 +226,12 @@ 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 (url-p url-using-proxy)
+      (if (or (eq 'socks url-gateway-method)
+              (string-prefix-p "socks" (url-type url-using-proxy)))
+          (setq gateway-method 'socks)
+        (setq host (url-host url-using-proxy)
+              service (url-port url-using-proxy))))
     (let* ((gwm (or gateway-method url-gateway-method))
            (gw-method (if (and url-gateway-local-host-regexp
                                (not (eq 'tls gwm))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 947c6517ed1..abe2649a474 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -195,12 +195,7 @@ url-http-find-free-connection
 	;; like authentication.  But we use another buffer afterwards.
 	(unwind-protect
             (let ((proc (url-open-stream host buf
-                                         (if url-using-proxy
-                                             (url-host url-using-proxy)
-                                           host)
-                                         (if url-using-proxy
-                                             (url-port url-using-proxy)
-                                           port)
+                                         host port
                                          gateway-method)))
 	      ;; url-open-stream might return nil.
 	      (when (processp proc)
@@ -1392,8 +1387,12 @@ url-http
            (error "Could not create connection to %s:%d" (url-host url)
                   (url-port url)))
           (_
-           (if (and url-http-proxy (string= "https"
-                                            (url-type url-current-object)))
+           (if (and url-http-proxy
+                    ;; Set to "http" by `url-find-proxy-for-url' for
+                    ;; any matching non-blacklisted, non-SOCKS scheme
+                    ;; in `url-proxy-services', including "https".
+                    (equal "http" (url-type url-http-proxy))
+                    (string= "https" (url-type url-current-object)))
                (url-https-proxy-connect connection)
              (set-process-sentinel connection
                                    #'url-http-end-of-document-sentinel)
@@ -1475,7 +1474,9 @@ url-http-async-sentinel
 	(url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
 	(setq url-http-connection-opened t)
-        (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+        (if (and url-http-proxy
+                 (equal "http" (url-type url-http-proxy))
+                 (string= "https" (url-type url-current-object)))
             (url-https-proxy-connect proc)
           (condition-case error
               (process-send-string proc (url-http-create-request))
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 9643e992044..9592307aea8 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -92,7 +92,6 @@ url-scheme-register-proxy
      ;; Then check if its a fully specified URL
      ((string-match url-nonrelative-link env-proxy)
       (setq urlobj (url-generic-parse-url env-proxy))
-      (setf (url-type urlobj) "http")
       (setf (url-target urlobj) nil))
      ;; Finally, fall back on the assumption that its just a hostname
      (t
@@ -103,8 +102,11 @@ url-scheme-register-proxy
      (if (and (not cur-proxy) urlobj)
 	 (progn
 	   (setq url-proxy-services
-		 (cons (cons scheme (format "%s:%d" (url-host urlobj)
-					    (url-port urlobj)))
+                 (cons (cons scheme (if (member (url-type urlobj)
+                                                url-proxy-full-address-types)
+                                        (url-recreate-url urlobj)
+                                      (format "%s:%d" (url-host urlobj)
+                                              (url-port urlobj))))
 		       url-proxy-services))
 	   (message "Using a proxy for %s..." scheme)))))
 
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 0c330069789..b1583523cc6 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -34,11 +34,13 @@ url-default-find-proxy-for-url
 	      host))
 	(equal "www" (url-type urlobj)))
     "DIRECT")
-   ((cdr (assoc (url-type urlobj) url-proxy-services))
-    (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
-   ;;
-   ;; Should check for socks
-   ;;
+   ((and-let* ((found (assoc (url-type urlobj) url-proxy-services)))
+      (concat (if-let ((non-scheme (string-search "://" (cdr found)))
+                       (scheme (substring (cdr found) 0 non-scheme))
+                       ((member scheme url-proxy-full-address-types)))
+                  (concat scheme " ")
+                "PROXY ")
+              (cdr found))))
    (t
     "DIRECT")))
 
@@ -56,8 +58,11 @@ url-find-proxy-for-url
      ((string-match "^DIRECT" proxy) nil)
      ((string-match "^PROXY +" proxy)
       (concat "http://" (substring proxy (match-end 0)) "/"))
-     ((string-match "^SOCKS +" proxy)
-      (concat "socks://" (substring proxy (match-end 0))))
+     ((string-match  (rx bot "SOCKS" (** 0 2 alnum) " ") proxy)
+      (if-let ((m (substring proxy (match-end 0)))
+               ((string-search "://" m)))
+          m
+        (concat "socks://" m)))
      (t
       (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
       nil))))
@@ -72,6 +77,9 @@ url-proxy
   (cond
    ((string= (url-type url-using-proxy) "http")
     (url-http url callback cbargs))
+   ((and (string-prefix-p "socks" (url-type url-using-proxy))
+         (string-prefix-p "http" (url-type url)))
+    (url-http url callback cbargs))
    (t
     (error "Don't know how to use proxy `%s'" url-using-proxy))))
 
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 6d7d0d3c94c..ba219905fde 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -194,10 +194,24 @@ url-mail-command
   :type 'function
   :group 'url)
 
+(defvar url-proxy-full-address-types
+  '("socks" "socks5" "socks5h" "socks4" "socks4a")
+  "Schemes for URL types preserved in `url-proxy-services' entries.
+When dynamically adding a new `url-proxy-services' entry derived
+from the environment, Emacs only retains the host and port
+portions unless the URL's scheme appears in this variable's
+value.")
+
 (defcustom url-proxy-services nil
   "An alist of schemes and proxy servers that gateway them.
 Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
-from the ACCESS_proxy environment variables."
+from the ACCESS_proxy environment variables.  Certain gateway
+types need server values to take the form of full URLs in order
+to convey addtional information about for the proxy connection
+itself, for example, SCHEME://USER@HOSTNAME:PORTNUMBER, in which
+SCHEME is something like \"socks5\".  As of Emacs 30.1, this only
+applies to SCHEMEs appearing in the variable
+`url-proxy-full-address-types'."
   :type '(repeat (cons :format "%v"
 		       (string :tag "Protocol")
 		       (string :tag "Proxy")))
@@ -315,7 +329,9 @@ url-show-status
 
 (defvar url-using-proxy nil
   "Either nil or the fully qualified proxy URL in use, e.g.
-https://www.example.com/")
+https://www.example.com/.  Beware that some functions, such as
+`url-proxy' and `url-http-end-of-document-sentinel', set this to
+a `url' struct object.")
 
 (defcustom url-news-server nil
   "The default news server from which to get newsgroups/articles.
-- 
2.42.0