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

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 2893 bytes --]

Stefan Kangas <stefankangas@gmail.com> writes:

> Christopher Howard <christopher@librehacker.com> writes:
>
>> Hello all. I don't pretend to track most of what is going on in this bug
>> thread, but I was wanting to draw more attention to the specific issue of
>> proxies and certs. I use Emacs Elpher for gemini browsing. As a privacy
>> minded individual, I want to by default route everything, including DNS,
>> through my local TOR proxy (localhost:9050). But I also want to be able to
>> check and approve capsule certs and, especially, cert changes. But in
>> Elpher, I have to pick one or the other, since turning on the proxy disables
>> the cert checks. As it has been explained to me, this is due to the current
>> situation with nsm, where you can't have `nsm' checks without also leaking
>> DNS.
>
> Is there an open bug report for leaking DNS with a tor proxy+nsm?

Not that I'm aware of.

>
> If not, would you be willing to report one (including all the details)?

In a sense, the issue only exists in the context of trying to integrate
`socks' with other libraries like `nsm' and `url' (this bug). As such,
there's currently no high-level way (I can think of) to demonstrate its
presence. For that, you'd need an app like Elpher to support connecting
to TLS-terminated endpoints through a SOCKS proxy while verifying them
with `nsm' checks. And you'd need to eavesdrop on it doing so in a
controlled environment where DNS lookups are well understood.

To see how something nearer to a proper (though limited) integration
_could_ work, you can try the demo in the log message of the last of the
attached PoC patches (0004). While it "works," it's quite brittle in the
sense that any unsupported but otherwise normal config patterns (e.g.,
:nowait t) or any related but undetected change to an affected library
(or the underlying networking stack) could render the whole thing bunk.

As I've struggled to explain up thread, the DNS leakage issue is larger
than any prospective integration, `nsm' or otherwise. But, for the sake
of discussion, if we were to zoom in on that library in particular, the
reason for the leakage should be pretty clear. AFAICT, the function
`nsm-should-check' always performs a lookup in order to support the
`nsm-trust-local-network' feature (original author Robert Cc'd). One
possible workaround might be to rework the function slightly to prevent
that, as shown in the first of the attached patches (0001).

Anyway, to truly tackle this issue, I still contend we'd need to
intercept calls to any glibc GAI-related functions and gate them with
some kind of async-friendly mechanism (perhaps a process property) that
suppresses their invocation for the lifetime of the process. The API
could be as simple as:

  (make-network-process ... :nolookup t ...)

But for this, we'd surely need help from someone familiar with that part
of Emacs.

Thanks.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v6-v7.diff --]
[-- Type: text/x-patch, Size: 5553 bytes --]

From 4f75c09b2a3d7315e3dcdba6933f1eacec51e2bb Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 15 Sep 2024 17:01:25 -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            | 186 +++++++++++++++++++++++++++++++----
 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, 302 insertions(+), 64 deletions(-)

Interdiff:
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 809f573aa15..a8a3abb6a2d 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -219,10 +219,6 @@ 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.
 
@@ -230,29 +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 (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
-     (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 'off-net
+           (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))))))))
 
 (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 daa93724cad..bcec6d98ae2 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -604,19 +604,16 @@ socks-open-network-stream
                       (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)
+          (when (memq port socks-proxied-tls-services)
+            (unless (gnutls-available-p)
+              (error "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))))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index c2b7e0430da..390e234fc05 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -329,7 +329,7 @@ url-show-status
 
 (defvar url-using-proxy nil
   "Either nil or the fully qualified proxy URL in use, e.g.
-https://www.example.com/.  Beware that some functions, such as
+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.")
 
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Only-conditionally-resolve-hosts-in-nsm-should-check.patch --]
[-- Type: text/x-patch, Size: 2800 bytes --]

From 2c1bf21bb5d58ebb3fcd3cba20bd8ed13764738c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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..a8a3abb6a2d 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 'off-net
+           (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))))))))
 
 (defun nsm-check-tls-connection (process host port status settings)
   "Check TLS connection against potential security problems.
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-POC-Support-SOCKS-resolve-extension.patch --]
[-- Type: text/x-patch, Size: 8656 bytes --]

From ccc2184badac294b23b49bab19605f28385ee8c9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 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): New tests.  (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 ecbac7e2345..b93a114a198 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 b9515876d6c..c8939d49c7f 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.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-POC-Simplify-network-stream-openers-in-socks.el.patch --]
[-- Type: text/x-patch, Size: 7805 bytes --]

From ce5e185fa9179fb88e36da7064b56befc2ee276c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 b93a114a198..bcec6d98ae2 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 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 (memq port socks-proxied-tls-services)
+            (unless (gnutls-available-p)
+              (error "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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-POC-Integrate-the-socks-and-url-libraries.patch --]
[-- Type: text/x-patch, Size: 10607 bytes --]

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

Demo of the current API (only tried on GNU/Linux):

  (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.

you can optionally run something like

  root:~# tcpdump -i eth0 -nn udp port 53

in a terminal beforehand to verify that DNS is not being leaked.

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