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

From: "J.P." <[email-masked]>
Date: Mon, 16 Sep 2024 18:52:04 -0700

Robert Pluim <[email-masked]> writes:

> More information hiding by default is a good thing. (Iʼm not the
> original author, I just changed it to look at the actual local
> addresses instead of hardcoding them)

D'oh, I see that now. The original author was one Mr. Wong. If you'd
like to be spared any further spam related to this bug, please say so,
and I'll remove you from the Cc's. (But if not, I could certainly use
the input.)

>     JP> The API could be as simple as:
>
>     JP>   (make-network-process ... :nolookup t ...)
>
> Iʼm not sure what suppressing DNS lookups would get us apart from more
> failure modes, but I havenʼt thought about it deeply.

Hm, right. I suppose doing that would mostly be useless for this type of
proxy because the :host property of the process is usually the one being
looked up, and if the `socks' side is handling things properly, :host
should only ever be the proxy server itself. Also, the lookups I was
hoping to prevent (or redirect through Tor with something like the
attached 0002 PoC patch) would need to be limited to only a specific
application rather than all of Emacs, which seems rather unrealistic.

>     JP> * lisp/net/nsm.el (nsm-should-check): Rework in a functionally
>     JP> equivalent way, except forgo calling both `network-lookup-address-info'
>     JP> and `network-interface-list' unless the various conditions regarding
>     JP> `nsm-trust-local-network' are first satisfied.  Replace `mapc' with
>     JP> `dolist' to align with modern sensibilities.   (Bug#53941)
>
> Careful now, somebody even more modern might come along and replace `dolist' with
> `seq-do' ☺️

Good point. I'll be sure and use `brat-do' from now on, just to be safe.
(Hopefully, you have no idea what that means.)

>     JP> +  (not (and-let* (((or (and (functionp nsm-trust-local-network)
>     JP> +                            (funcall nsm-trust-local-network))
>     JP> +                       nsm-trust-local-network))
>     JP> +                  (addresses (network-lookup-address-info host))
>     JP> +                  (network-interface-list (network-interface-list t)))
>     JP> +         (catch 'off-net
>     JP> +           (dolist (ip addresses)
>     JP> +             (dolist (info network-interface-list)
>     JP> +               (when (nsm-network-same-subnet (substring (nth 1 info) 0 -1)
>     JP> +                                              (substring (nth 3 info) 0 -1)
>     JP> +                                              (substring ip 0 -1))
>     JP> +                 (throw 'off-net t))))))))
>
> Since youʼve inverted the test, you should probably invert the name of
> `off-net'.

Ah, took that "by rote" from the old sentinel variable, but as you say,
it doesn't comport with the semantics. Changed to `nsm-should-check'.

Overall, I'll have to think on this bug a bit more. If Christopher or
the Elpher people want this specific workaround in tree, I suppose we
can accommodate, but I doubt there's any rush.

Cheers.

>From c991ea14162921e3459fe6859234b5c1c1782a68 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
Date: Mon, 16 Sep 2024 18:27:58 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (4):
  Only conditionally resolve hosts in nsm-should-check
  [POC] Support SOCKS resolve extension
  [POC] Simplify network-stream openers in socks.el
  [POC] Integrate the socks and url libraries

 lisp/net/nsm.el              |  33 +++---
 lisp/net/socks.el            | 200 +++++++++++++++++++++++++++++++----
 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 | 110 +++++++++++++++++++
 8 files changed, 356 insertions(+), 64 deletions(-)

Interdiff:
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index a8a3abb6a2d..1ce2ff33ae6 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -231,13 +231,13 @@ nsm-should-check
                        nsm-trust-local-network))
                   (addresses (network-lookup-address-info host))
                   (network-interface-list (network-interface-list t)))
-         (catch 'off-net
+         (catch 'nsm-should-check
            (dolist (ip addresses)
              (dolist (info network-interface-list)
                (when (nsm-network-same-subnet (substring (nth 1 info) 0 -1)
                                               (substring (nth 3 info) 0 -1)
                                               (substring ip 0 -1))
-                 (throw 'off-net t))))))))
+                 (throw 'nsm-should-check t))))))))
 
 (defun nsm-check-tls-connection (process host port status settings)
   "Check TLS connection against potential security problems.
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index bcec6d98ae2..45685af77ba 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -562,25 +562,23 @@ socks-server-name-as-tor-service-regexp
 
 ;;;###autoload
 (defun socks-open-network-stream (name buffer host service &rest params)
-  "Open and return a connection, possibly proxied over SOCKS.
+  "Open a connection, possibly proxied over SOCKS, and return its process.
 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'.
+`open-network-stream'.  Assume HOST and SERVICE refer to the proxied
+logical peer rather than the local SOCKS server, but assume the opposite
+for PARAMS.  Signal an error if PARAMS contains a non-nil `:nowait',
+which is not supported (although `socks-connect-function' can circumvent
+this check).  If SERVICE appears in `socks-proxied-tls-services', use
+the `gnutls' library to arrange for the proxied connection to be
+encrypted, and verify the connection with the `nsm' library.
 
 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."
+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))
@@ -603,10 +601,12 @@ socks-open-network-stream
                         service
                       (process-contact proc :service)))
               (certs (plist-get params :client-certificate)))
+          (when (plist-get :nowait params)
+            (error "SOCKS: non-nil :nowait parameter not supported"))
           (socks--initiate-command-connect proc buffer host service)
           (when (memq port socks-proxied-tls-services)
             (unless (gnutls-available-p)
-              (error "GNUTLS required for port %S but missing" port))
+              (error "SOCKS: GNUTLS required for port %S but missing" port))
             (gnutls-negotiate :process proc
                               :hostname host
                               :keylist (and certs (list certs)))
@@ -738,6 +738,8 @@ socks--extract-resolve-response
   (when-let ((response (process-get proc 'socks-response)))
     (pcase (process-get proc 'socks-server-protocol)
       (4 ; https://www.openssh.com/txt/socks4a.protocol
+       ;; In the latest Tor version (0.4.8.12 in Sept 2024), a query
+       ;; that normally returns an IPv6 address gives a 91 error.
        (and-let* (((zerop (process-get proc 'socks-reply)))
                   ((eq (aref response 1) 90)) ; #x5a request granted
                   (a (substring response 4)) ; ignore port for now
@@ -753,51 +755,63 @@ socks--extract-resolve-response
          ;; 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)))))))
+         (4 (socks--convert-address (substring response 4 20))))))))
+
+(defun socks--convert-address (input)
+  "Unpack pairs of bytes into 2-byte words."
+  ;; This is a poor man's version of:
+  ;;
+  ;;   (let ((spec (bindat-type (words vec 8 uint 16))))
+  ;;     (bindat-get-field (bindat-unpack spec input) 'words))
+  ;;
+  (cl-assert (arrayp input))
+  (cl-assert (= (length input) 16))
+  (let ((result (make-vector 8 0))
+        (i -1))
+    (while-let (((< (cl-incf i) 8))
+                (j (* i 2))
+                (hi (aref input j))
+                (lo (aref input (1+ j))))
+      (aset result i (logior (ash hi 8) lo)))
+    result))
 
 (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))))))
-
+;; This is a hash table containing the most recent lookups.  It's
+;; cleared every 5 minutes, which is obviously dumb.
+;; FIXME use some kind of LRU instead.
 (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."
+
+See `make-network-process' for the format of the return value.  Note
+that this function exists for novelty purposes only."
   (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)))
+    (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)))))))
 
 (provide 'socks)
 
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index c8939d49c7f..7d65188872e 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -397,4 +397,44 @@ tor-resolve-5
     (kill-buffer (process-buffer server))
     (delete-process server)))
 
+;; On the latest Tor (0.4.8.12 as of Sept 2024), a query via tor-resolve
+;; that normally returns an IPv6 address instead returns a 91 code.
+(ert-deftest tor-resolve-4a-fail/ipv6 ()
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-username "") ; defaults to (user-login-name)
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 0 0 0 0 1 0
+                ?i ?p ?v ?6 ?. ?g ?o ?o ?g ?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")
+      (should-not (socks-tor-resolve "ipv6.google.com")))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
+(ert-deftest tor-resolve-5/ipv6 ()
+  "Make request to TOR resolve service over SOCKS5"
+  (let* ((socks-server '("server" "127.0.0.1" t 5))
+         (socks-username "foo")
+         (socks-authentication-methods
+          (copy-sequence socks-authentication-methods))
+         (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 15 ?i ?p ?v ?6 ?. ?g ?o ?o ?g ?l ?e ?. ?c ?o ?m 0 0]
+             . [5 0 0 4
+                  #x2a #x00 #x14 #x50 #x40 #x0e #x80 #xe0
+                  #x00 #x00 #x00 #x00 #x00 #x00 #x20 #x0e
+                  0 0])))
+         (server (socks-tests-canned-server-create))
+         socks--tor-resolve-cache)
+    (ert-info ("Query TOR RESOLVE service over SOCKS5")
+      (should (equal '([#x2a00 #x1450 #x400e #x80e0 0 0 0 #x200e 0])
+                     (socks-tor-resolve "ipv6.google.com"))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
 ;;; socks-tests.el ends here
-- 
2.46.0

>From 2f40776136fa41b8874889d45ce60847cab73427 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/4] Only conditionally resolve hosts in nsm-should-check

Libraries like `socks' need to run `nsm-verify-connection' without
performing DNS lookups.  This change allows such libraries to achieve
this by binding `nsm-trust-local-network' to nil around calls to that
function.

* lisp/net/nsm.el (nsm-should-check): Rework in a functionally
equivalent way, except forgo calling both `network-lookup-address-info'
and `network-interface-list' unless the various conditions regarding
`nsm-trust-local-network' are first satisfied.  Replace `mapc' with
`dolist' to align with modern sensibilities.   (Bug#53941)
---
 lisp/net/nsm.el | 33 ++++++++++++---------------------
 1 file changed, 12 insertions(+), 21 deletions(-)

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index e8fdb9b183b..1ce2ff33ae6 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -226,27 +226,18 @@ 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))
-        (network-interface-list (network-interface-list t))
-        (off-net t))
-    (when
-     (or (and (functionp nsm-trust-local-network)
-              (funcall nsm-trust-local-network))
-         nsm-trust-local-network)
-     (mapc
-      (lambda (ip)
-        (mapc
-         (lambda (info)
-           (let ((local-ip (nth 1 info))
-                 (mask (nth 3 info)))
-             (when
-                 (nsm-network-same-subnet (substring local-ip 0 -1)
-                                          (substring mask 0 -1)
-                                          (substring ip 0 -1))
-               (setq off-net nil))))
-         network-interface-list))
-      addresses))
-     off-net))
+  (not (and-let* (((or (and (functionp nsm-trust-local-network)
+                            (funcall nsm-trust-local-network))
+                       nsm-trust-local-network))
+                  (addresses (network-lookup-address-info host))
+                  (network-interface-list (network-interface-list t)))
+         (catch 'nsm-should-check
+           (dolist (ip addresses)
+             (dolist (info network-interface-list)
+               (when (nsm-network-same-subnet (substring (nth 1 info) 0 -1)
+                                              (substring (nth 3 info) 0 -1)
+                                              (substring ip 0 -1))
+                 (throw 'nsm-should-check t))))))))
 
 (defun nsm-check-tls-connection (process host port status settings)
   "Check TLS connection against potential security problems.
-- 
2.46.0

>From 8b51cb2ede10a1779cce18b3aede7092538104b1 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/4] [POC] Support SOCKS resolve extension

This change provides an alternate means of resolving host names for
users running a local Tor daemon.  Users can avoid appealing to the
glibc getaddrinfo suite and, by extension, the system itself, e.g.,
systemd-resolve, nss-dns, etc., for name resolution.

* 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 by clients like cURL to allow users to
bypass attempts to resolve a name locally.
(socks--convert-address, 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, tor-resolve-4a-fail/ipv6)
(tor-resolve-5/ipv6): New tests.  (Bug#53941)
---
 lisp/net/socks.el            |  83 ++++++++++++++++++++++++++
 test/lisp/net/socks-tests.el | 110 +++++++++++++++++++++++++++++++++++
 2 files changed, 193 insertions(+)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index ecbac7e2345..dad47f9c660 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,86 @@ 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
+       ;; In the latest Tor version (0.4.8.12 in Sept 2024), a query
+       ;; that normally returns an IPv6 address gives a 91 error.
+       (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 (socks--convert-address (substring response 4 20))))))))
+
+(defun socks--convert-address (input)
+  "Unpack pairs of bytes into 2-byte words."
+  ;; This is a poor man's version of:
+  ;;
+  ;;   (let ((spec (bindat-type (words vec 8 uint 16))))
+  ;;     (bindat-get-field (bindat-unpack spec input) 'words))
+  ;;
+  (cl-assert (arrayp input))
+  (cl-assert (= (length input) 16))
+  (let ((result (make-vector 8 0))
+        (i -1))
+    (while-let (((< (cl-incf i) 8))
+                (j (* i 2))
+                (hi (aref input j))
+                (lo (aref input (1+ j))))
+      (aset result i (logior (ash hi 8) lo)))
+    result))
+
+(declare-function puny-encode-domain "puny" (domain))
+
+;; This is a hash table containing the most recent lookups.  It's
+;; cleared every 5 minutes, which is obviously dumb.
+;; FIXME use some kind of LRU instead.
+(defvar socks--tor-resolve-cache nil)
+
+(defun socks-tor-resolve (name &optional _family _flags)
+  "Return list with a single IPv4 address for domain NAME.
+
+See `make-network-process' for the format of the return value.  Note
+that this function exists for novelty purposes only."
+  (unless (string-match (rx bot (+ ascii) eot) name)
+    (require 'puny)
+    (setq name (puny-encode-domain name)))
+  (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))
+    (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)))))))
+
 (provide 'socks)
 
 ;;; socks.el ends here
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index b9515876d6c..7d65188872e 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -327,4 +327,114 @@ 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)))
+
+;; On the latest Tor (0.4.8.12 as of Sept 2024), a query via tor-resolve
+;; that normally returns an IPv6 address instead returns a 91 code.
+(ert-deftest tor-resolve-4a-fail/ipv6 ()
+  (let* ((socks-server '("server" "127.0.0.1" t 4a))
+         (socks-username "") ; defaults to (user-login-name)
+         (socks-tests-canned-server-patterns
+          '(([4 #xf0 0 0 0 0 0 1 0
+                ?i ?p ?v ?6 ?. ?g ?o ?o ?g ?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")
+      (should-not (socks-tor-resolve "ipv6.google.com")))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
+(ert-deftest tor-resolve-5/ipv6 ()
+  "Make request to TOR resolve service over SOCKS5"
+  (let* ((socks-server '("server" "127.0.0.1" t 5))
+         (socks-username "foo")
+         (socks-authentication-methods
+          (copy-sequence socks-authentication-methods))
+         (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 15 ?i ?p ?v ?6 ?. ?g ?o ?o ?g ?l ?e ?. ?c ?o ?m 0 0]
+             . [5 0 0 4
+                  #x2a #x00 #x14 #x50 #x40 #x0e #x80 #xe0
+                  #x00 #x00 #x00 #x00 #x00 #x00 #x20 #x0e
+                  0 0])))
+         (server (socks-tests-canned-server-create))
+         socks--tor-resolve-cache)
+    (ert-info ("Query TOR RESOLVE service over SOCKS5")
+      (should (equal '([#x2a00 #x1450 #x400e #x80e0 0 0 0 #x200e 0])
+                     (socks-tor-resolve "ipv6.google.com"))))
+    (kill-buffer (process-buffer server))
+    (delete-process server)))
+
 ;;; socks-tests.el ends here
-- 
2.46.0

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

* 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/socks.el | 117 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 96 insertions(+), 21 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index dad47f9c660..45685af77ba 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,91 @@ 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 a connection, possibly proxied over SOCKS, and return its process.
+Expect PARAMS to contain keyword parameters recognized by
+`open-network-stream'.  Assume HOST and SERVICE refer to the proxied
+logical peer rather than the local SOCKS server, but assume the opposite
+for PARAMS.  Signal an error if PARAMS contains a non-nil `:nowait',
+which is not supported (although `socks-connect-function' can circumvent
+this check).  If SERVICE appears in `socks-proxied-tls-services', use
+the `gnutls' library to arrange for the proxied connection to be
+encrypted, and verify the connection with the `nsm' library.
+
+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)))
+          (when (plist-get :nowait params)
+            (error "SOCKS: non-nil :nowait parameter not supported"))
+          (socks--initiate-command-connect proc buffer host service)
+          (when (memq port socks-proxied-tls-services)
+            (unless (gnutls-available-p)
+              (error "SOCKS: GNUTLS required for port %S but missing" port))
+            (gnutls-negotiate :process proc
+                              :hostname host
+                              :keylist (and certs (list certs)))
+            (unless (string-suffix-p ".onion" host)
+              (require 'nsm)
+              (defvar nsm-trust-local-network)
+              (let (nsm-trust-local-network)
+                (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.46.0

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

Demo of the proposed API (only tried on GNU/Linux with a
traditional/default DNS setup)

Put something like this in *scratch* and eval it:

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

Then do something like

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

or

  M-x list-packages RET.

Assuming you have a traditional DNS setup, you can optionally run
something like

  tcpdump -i eth0 -nn udp port 53

in a terminal beforehand to verify that DNS is not being leaked.
To get a baseline, do something like

  M-:(network-lookup-address-info "example.com")

And ensure you see "example.com" in the output.

Note that the above assumes you have a Tor service running locally at
127.0.0.1:9050.

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.

* 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.  (Bug#53941)
---
 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 62be70827fa..b363242c680 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 184c1278072..1dead615e28 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 5681a4e3785..cea9990f672 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 15f117f0a34..67fa5a15dac 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 09b3019a553..390e234fc05 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/.  Be aware 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.46.0