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

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

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

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Stefan Kangas <stefankangas@gmail.com>
>> Date: Wed, 6 Sep 2023 15:25:19 -0700
>> Cc: "J.P." <jp@neverwas.me>, larsi@gnus.org, gnuhacker@member.fsf.org, 
>> 	53941@debbugs.gnu.org
>> 
>> Eli Zaretskii <eliz@gnu.org> writes:
>> 
>> >> > I'm really uncomfortable with installing these changes before the release
>> >> > branch is cut.  The changes are hardly trivial, some controversial even to
>> >> > my eyes, even though I'm no expert on network connections.
>> >>
>> >> Well, I myself am just about the furthest thing from (an expert), which
>> >> certainly doesn't comport well with dropping rash changes at the
>> >> eleventh hour. (That was rather disrespectful on my part, so shame on
>> >> me.) As such, if it's easier to revisit this once things settle down,
>> >> just ignore this email and I'll re-ping you sometime down the road.
>> >
>> > Yes, please do.  The branch is cut now, so if we agree on installing such
>> > changes on master, it's now up to you when to post another version of these
>> > changes with the requisite fixes.
>> 
>> Could we revisit this now?  It sounds like something we'd want to fix.
>
> No objections from me, but I don't think we saw "another version"
> posted.  J.P.?

Hi, unfortunately, there is no other version of any real note, at least
not yet. The attached version is slightly updated but lacks substantial
progress in the areas that matter most. As of now, the only patches I'd
be comfortable offering would be the first two, which aren't even
directly related to this bug.

In addition to providing some cosmetic refactoring [1], the third patch
is mainly just a working placeholder for the socks.el side of a
hypothetical integration with the URL framework (currently imagined as
an overhauled version of `socks-open-connection' made newly compatible
with the `url-proxy' and `open-network-stream' interfaces). A sketch of
the URL side of such an arrangement can be found in the fourth patch,
but it isn't well thought out (or thoroughly researched).

AFAIR, the OP's main complaint concerns the lack of a transparent and
easily configurable experience for proxying built-in Emacs applications
over SOCKS, perhaps compared to what you'd get with a typical web
browser. I think we can probably agree that users shouldn't have to
customize both `socks'- and `url'-owned options or write extra code to
achieve a working setup, which is how things are currently (AFAICT).

If we're to solve this using the `url' library's existing public API, it
may need to be more clearly defined in a few areas. For example, at
least one function (`url-http-find-free-connection') uses the `host' and
`service' parameters of `url-open-stream' for dialing HTTP proxies. But
if other protocols are meant to do the same, they'll need to somehow
encode both proxy- and logical-endpoint addresses into those two params
or find some other means of conveying the same info. The fourth patch
currently uses `url-using-proxy' as a dynamic variable for this purpose,
but perhaps that's unwise. It's quite possible I'm breaking something.

There's also the issue of DNS lookups for verifying domain certs. Last I
looked, we can't run `nsm' checks without involving the system resolver,
which may be a deal breaker for the more privacy minded. If that's true,
we may want to find an acceptable way of cluing folks in to the
situation.

As thing stand, I haven't really invested enough in understanding how
`url' works to take the lead in planning a comprehensive integration
strategy (sorry). But, perhaps others with open bugs in the same area
[2] might be interested in lending some expertise or insight. Thanks.


[1] The third patch also attempts to untangle some of the hairiness
    brought about by the `socks-override-functions' flag. The original
    picture looks like:

    s-o-f:    `socks-override-functions', flag var
    o-n-s:    `open-network-stream', standard (non-SOCKS) opener
    o-n-s*:   `open-network-stream' with s--o-n-s as :around advice
    s-o-c:    `socks-open-connection', proxy (SOCKS) opener
    s-o-n-s:  `socks-open-network-stream', semi o-n-s compatible thin
               wrapper around s--o-n-s
    s--o-n-s: `socks--open-network-stream': workhorse with SOCKS/non
               code paths

    | s-o-f | entry point         | no-route | route          |
    |-------+---------------------+----------+----------------|
    | t     | o-n-s* -> s--o-n-s  | o-n-s    | s-o-c -> o-n-s |
    | t/nil | s-o-n-s -> s--o-n-s | o-n-s    | s-o-c -> o-n-s |

    I've changed the above to:

    s--o-n-s: thin wrapper around `s-o-n-s'
    s-o-n-s:  o-n-s compatible workhorse with SOCKS/non code paths

    | s-o-f | entry point                   | no-route | route          |
    |-------+-------------------------------+----------+----------------|
    | t     | o-n-s* -> s--o-n-s -> s-o-n-s | o-n-s    | s-o-c -> o-n-s |
    | t/nil | s-o-n-s                       | o-n-s    | s-o-c -> o-n-s |


[2]  Bug#62598: "29.0.60; url-https-proxy-connect doesn't support
     multi-stage auth to proxies"

     https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62598


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

From 8a54568d3e7d70f23cfeda292aff21b8c2203f49 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 7 Sep 2023 06:08:38 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (4):
  Don't hard code server ports in SOCKS tests
  Improve SOCKS error handling and add support for 4a
  [POC] Simplify network-stream openers in socks.el
  [POC] Integrate the socks and url libraries

 lisp/net/socks.el            | 139 +++++++++++++++++++++++++++++------
 lisp/url/url-gw.el           |   8 +-
 lisp/url/url-http.el         |  16 ++--
 lisp/url/url-proxy.el        |  18 ++++-
 lisp/url/url-vars.el         |  11 ++-
 test/lisp/net/socks-tests.el |  67 +++++++++++++----
 6 files changed, 206 insertions(+), 53 deletions(-)

Interdiff:
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index f8881ba3990..1bb78113d52 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -335,17 +335,14 @@ socks-override-functions
 (when socks-override-functions
   (advice-add 'open-network-stream :around #'socks--open-network-stream))
 
-(defcustom socks-connect-function 'open-network-stream
+(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'."
-  :version "30.1"
-  :type '(choice (function-item :value open-network-stream)
-                 (function :tag "User-provided function")))
+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 take the
-form of `socks-server' and STREAM-PARAMS to be keyword params
+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
@@ -473,7 +470,9 @@ socks-send-command
              (let ((err (process-get proc 'socks-reply)))
                (if (eql version 5)
                    (nth (or err 1) socks-errors)
-                 (nth (- (if (and err (<= 90 err 93)) err 91) 90)
+                 ;; The defined error codes for v4 range from
+                 ;; 90-93, but we store them in a simple list.
+                 (nth (pcase err (90 0) (92 2) (93 3) (_ 1))
                       socks--errors-4)))))
     proc))
 
@@ -536,8 +535,12 @@ socks-find-services-entry
 	      (if udp socks-udp-services socks-tcp-services)))
 
 (defun socks--open-network-stream (orig-fun name buffer host service &rest params)
-  (let ((socks-override-functions orig-fun))
-    (apply #'socks-open-network-stream name buffer host service params)))
+  "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.
@@ -563,11 +566,9 @@ socks-open-network-stream
 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' and, on
-rejection, fall back to non-SOCKS.  Similarly, when
-`socks-override-functions' is a function, call it directly and
-trust that it's not interested in options defined in this
-library, such as `socks-server'.
+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,
@@ -589,9 +590,8 @@ socks-open-network-stream
                              socks-username))
          (socks-password (or (and url (url-password url))
                              socks-password)))
-    (if-let* (((booleanp socks-override-functions))
-              (route (socks-find-route host service))
-              (proc (apply #'socks-open-connection route params)))
+    (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)))
@@ -604,13 +604,10 @@ socks-open-network-stream
               (progn (gnutls-negotiate :process proc
                                        :hostname host
                                        :keylist (and certs (list certs)))
+                     ;; FIXME skip when TLD is .onion.
                      (nsm-verify-connection proc host port))
             proc))
-      (let ((fn (if (functionp socks-override-functions)
-                    socks-override-functions ; `socks-noproxy' not consulted
-                  #'open-network-stream)) ; `socks-noproxy' is non-nil
-            socks-override-functions)
-        (apply fn name buffer host service params)))))
+      (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
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 73585275a71..d96890db04a 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -191,12 +191,12 @@ url-mail-command
 
 (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.  Depending on
-the gateway type, values may instead be expected to look like
-\"proxyscheme://hostname:portnumber\" where \"proxyscheme\" is
-something like \"socks5\".  As of Emacs 30.1, this only applies
-to SOCKS servers."
+Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
+from the ACCESS_proxy environment variables.  Depending on the
+gateway type, Emacs may expect certain server values to specfiy a
+\"scheme\", for example, \"proxyscheme://hostname:portnumber\",
+in which \"proxyscheme\" is something like \"socks5\".  As of
+Emacs 30.1, this only applies to SOCKS servers."
   :type '(repeat (cons :format "%v"
 		       (string :tag "Protocol")
 		       (string :tag "Proxy")))
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 7c7f68eafa2..df69fb2f5cf 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -165,9 +165,9 @@ socks-tests--hello-world-http-request-pattern
                          "Content-Length: 13\r\n\r\n"
                          "Hello World!\n")))
 
-(defun socks-tests-perform-hello-world-http-request ()
+(defun socks-tests-perform-hello-world-http-request (&optional method)
   "Start canned server, validate hello-world response, and finalize."
-  (let* ((url-gateway-method 'socks)
+  (let* ((url-gateway-method (or method 'socks))
          (url (url-generic-parse-url "http://example.com"))
          (server (socks-tests-canned-server-create))
          ;;
@@ -281,7 +281,7 @@ socks-tests-v5-auth-user-pass-blank
 ;; against curl 7.71 with the following options:
 ;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
 
-(ert-deftest socks-tests-v5-auth-none ()
+(defun socks-tests-v5-auth-none (method)
   "Verify correct handling of SOCKS5 when auth method 0 requested."
   (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-authentication-methods (append socks-authentication-methods
@@ -295,7 +295,27 @@ socks-tests-v5-auth-none
     (socks-unregister-authentication-method 2)
     (should-not (assq 2 socks-authentication-methods))
     (ert-info ("Make HTTP request over SOCKS5 with no auth method")
-      (socks-tests-perform-hello-world-http-request)))
+      (socks-tests-perform-hello-world-http-request method)))
   (should (assq 2 socks-authentication-methods)))
 
+(ert-deftest socks-tests-v5-auth-none ()
+  (socks-tests-v5-auth-none 'socks))
+
+;; This simulates the top-level advice around `open-network-stream'
+;; that's applied when loading the library with a non-nil
+;; `socks-override-functions'.
+(ert-deftest socks-override-functions ()
+  (should-not socks-override-functions)
+  (should-not (advice-member-p #'socks--open-network-stream
+                               'open-network-stream))
+  (advice-add 'open-network-stream :around #'socks--open-network-stream)
+  (should (advice-member-p #'socks--open-network-stream 'open-network-stream))
+
+  (unwind-protect (let ((socks-override-functions t))
+                    (socks-tests-v5-auth-none 'native))
+    (advice-remove 'open-network-stream #'socks--open-network-stream))
+
+  (should-not (advice-member-p #'socks--open-network-stream
+                               'open-network-stream)))
+
 ;;; socks-tests.el ends here
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Don-t-hard-code-server-ports-in-SOCKS-tests.patch --]
[-- Type: text/x-patch, Size: 8571 bytes --]

From f76735a6beceb12f2e88befafe67aaef593e0763 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] Don't hard code server ports in SOCKS tests

* test/lisp/net/socks-tests.el (socks-tests-canned-server-create,
socks-tests-filter-response-parsing-v4, socks-tests-v4-basic,
socks-tests-v5-auth-user-pass, socks-tests-v5-auth-user-blank,
socks-tests-v5-auth-none): Fix bug in process filter to prevent
prepared outgoing responses from being implicitly encoded as UTF-8.
Fix similar mistake in v4 filter test.  Allow system to choose port
instead of hard-coding it.
(socks-tests-perform-hello-world-http-request):
Add option method parameter to specify a gateway method.
(socks-tests-v5-auth-none): Move body to helper function of the same
name.
(socks-override-functions): New test ensuring top-level advice around
`open-networks-stream' still supported.  (Bug#53941)
---
 test/lisp/net/socks-tests.el | 54 ++++++++++++++++++++++++++----------
 1 file changed, 39 insertions(+), 15 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 958e2ff44a8..d4c3828df45 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4
     (process-put proc 'socks-state socks-state-waiting)
     (process-put proc 'socks-server-protocol 4)
     (ert-info ("Receive initial incomplete segment")
-      (socks-filter proc (concat [0 90 0 0 93 184 216]))
-      ;; From example.com: OK status ^      ^ msg start
+      (socks-filter proc (unibyte-string 0 90 0 0 93 184 216))
+      ;; From example.com: OK status       ^      ^ msg start
       (ert-info ("State still set to waiting")
         (should (eq (process-get proc 'socks-state) socks-state-waiting)))
       (ert-info ("Response field is nil because processing incomplete")
         (should-not (process-get proc 'socks-response)))
       (ert-info ("Scratch field holds stashed partial payload")
-        (should (string= (concat [0 90 0 0 93 184 216])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216)
                          (process-get proc 'socks-scratch)))))
     (ert-info ("Last part arrives")
       (socks-filter proc "\42") ; ?\" 34
       (ert-info ("State transitions to complete (length check passes)")
         (should (eq (process-get proc 'socks-state) socks-state-connected)))
       (ert-info ("Scratch and response fields hold stash w. last chunk")
-        (should (string= (concat [0 90 0 0 93 184 216 34])
+        (should (string= (unibyte-string 0 90 0 0 93 184 216 34)
                          (process-get proc 'socks-response)))
         (should (string= (process-get proc 'socks-response)
                          (process-get proc 'socks-scratch)))))
@@ -133,17 +133,19 @@ socks-tests-canned-server-patterns
 (defun socks-tests-canned-server-create ()
   "Create and return a fake SOCKS server."
   (let* ((port (nth 2 socks-server))
-         (name (format "socks-server:%d" port))
+         (name (format "socks-server:%s"
+                       (if (numberp port) port (ert-test-name (ert-running-test)))))
          (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
                  (pcase-let ((`(,pat . ,resp) (pop pats)))
                    (unless (or (and (vectorp pat) (equal pat (vconcat line)))
                                (string-match-p pat line))
                      (error "Unknown request: %s" line))
+                   (setq resp (apply #'unibyte-string (append resp nil)))
                    (let ((print-escape-control-characters t))
                      (message "[%s] <- %s" name (prin1-to-string line))
                      (message "[%s] -> %s" name (prin1-to-string resp)))
-                   (process-send-string proc (concat resp)))))
+                   (process-send-string proc resp))))
          (serv (make-network-process :server 1
                                      :buffer (get-buffer-create name)
                                      :filter filt
@@ -151,8 +153,10 @@ socks-tests-canned-server-create
                                      :family 'ipv4
                                      :host 'local
                                      :coding 'binary
-                                     :service port)))
+                                     :service (or port t))))
     (set-process-query-on-exit-flag serv nil)
+    (unless (numberp (nth 2 socks-server))
+      (setf (nth 2 socks-server) (process-contact serv :service)))
     serv))
 
 (defvar socks-tests--hello-world-http-request-pattern
@@ -161,9 +165,9 @@ socks-tests--hello-world-http-request-pattern
                          "Content-Length: 13\r\n\r\n"
                          "Hello World!\n")))
 
-(defun socks-tests-perform-hello-world-http-request ()
+(defun socks-tests-perform-hello-world-http-request (&optional method)
   "Start canned server, validate hello-world response, and finalize."
-  (let* ((url-gateway-method 'socks)
+  (let* ((url-gateway-method (or method 'socks))
          (url (url-generic-parse-url "http://example.com"))
          (server (socks-tests-canned-server-create))
          ;;
@@ -191,7 +195,7 @@ socks-tests-perform-hello-world-http-request
 
 (ert-deftest socks-tests-v4-basic ()
   "Show correct preparation of SOCKS4 connect command (Bug#46342)."
-  (let ((socks-server '("server" "127.0.0.1" 10079 4))
+  (let ((socks-server '("server" "127.0.0.1" t 4))
         (url-user-agent "Test/4-basic")
         (socks-tests-canned-server-patterns
          `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
@@ -213,7 +217,7 @@ socks-tests-v4-basic
 (ert-deftest socks-tests-v5-auth-user-pass ()
   "Verify correct handling of SOCKS5 user/pass authentication."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10080 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo")
         (socks-password "bar")
         (url-user-agent "Test/auth-user-pass")
@@ -247,7 +251,7 @@ socks-tests-v5-auth-user-pass
 (ert-deftest socks-tests-v5-auth-user-pass-blank ()
   "Verify correct SOCKS5 user/pass authentication with empty pass."
   (should (assq 2 socks-authentication-methods))
-  (let ((socks-server '("server" "127.0.0.1" 10081 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo") ; defaults to (user-login-name)
         (socks-password "") ; simulate user hitting enter when prompted
         (url-user-agent "Test/auth-user-pass-blank")
@@ -264,9 +268,9 @@ socks-tests-v5-auth-user-pass-blank
 ;; against curl 7.71 with the following options:
 ;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
 
-(ert-deftest socks-tests-v5-auth-none ()
+(defun socks-tests-v5-auth-none (method)
   "Verify correct handling of SOCKS5 when auth method 0 requested."
-  (let ((socks-server '("server" "127.0.0.1" 10082 5))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-authentication-methods (append socks-authentication-methods
                                               nil))
         (url-user-agent "Test/auth-none")
@@ -278,7 +282,27 @@ socks-tests-v5-auth-none
     (socks-unregister-authentication-method 2)
     (should-not (assq 2 socks-authentication-methods))
     (ert-info ("Make HTTP request over SOCKS5 with no auth method")
-      (socks-tests-perform-hello-world-http-request)))
+      (socks-tests-perform-hello-world-http-request method)))
   (should (assq 2 socks-authentication-methods)))
 
+(ert-deftest socks-tests-v5-auth-none ()
+  (socks-tests-v5-auth-none 'socks))
+
+;; This simulates the top-level advice around `open-network-stream'
+;; that's applied when loading the library with a non-nil
+;; `socks-override-functions'.
+(ert-deftest socks-override-functions ()
+  (should-not socks-override-functions)
+  (should-not (advice-member-p #'socks--open-network-stream
+                               'open-network-stream))
+  (advice-add 'open-network-stream :around #'socks--open-network-stream)
+  (should (advice-member-p #'socks--open-network-stream 'open-network-stream))
+
+  (unwind-protect (let ((socks-override-functions t))
+                    (socks-tests-v5-auth-none 'native))
+    (advice-remove 'open-network-stream #'socks--open-network-stream))
+
+  (should-not (advice-member-p #'socks--open-network-stream
+                               'open-network-stream)))
+
 ;;; socks-tests.el ends here
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Improve-SOCKS-error-handling-and-add-support-for-4a.patch --]
[-- Type: text/x-patch, Size: 5320 bytes --]

From 60913c0951ebfe851c23c2d59479fcbc6ed0b80c 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] Improve SOCKS error handling and add support for 4a

* lisp/net/socks.el (socks-server): Add new Custom choice `4a' for
version field.  This change does not overload the field in terms of
expected type because `socks-send-command' and `socks-filter' already
accommodate the symbol `http'.
(socks--errors-4): Add new constant containing error messages for
version 4.  The semantics are faithful to the spec, but the exact
wording is adapted.
(socks-filter): Allow for a null "type" field on error with version 5.
Previously, certain errors would not propagate because a wrong-type
signal would get in the way.
(socks-send-command): Massage existing version 4 protocol parsing to
accommodate 4a, and add error handling for version 4.
* test/lisp/net/socks-tests.el (socks-tests-v4a-basic): Add test for
SOCKS version 4a.  (Bug#53941)
---
 lisp/net/socks.el            | 28 +++++++++++++++++++++++++---
 test/lisp/net/socks-tests.el | 13 +++++++++++++
 2 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 968a28d2be8..958d8bf23c9 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -162,6 +162,7 @@ socks-server
 	  (radio-button-choice :tag "SOCKS Version"
 			       :format "%t: %v"
 			       (const :tag "SOCKS v4  " :format "%t" :value 4)
+                               (const :tag "SOCKS v4a"  :format "%t" :value 4a)
 			       (const :tag "SOCKS v5"   :format "%t" :value 5))))
 
 
@@ -202,6 +203,12 @@ socks-errors
     "Command not supported"
     "Address type not supported"))
 
+(defconst socks--errors-4
+  '("Granted"
+    "Rejected or failed"
+    "Cannot connect to identd on the client"
+    "Client and identd report differing user IDs"))
+
 ;; The socks v5 address types
 (defconst socks-address-type-v4   1)
 (defconst socks-address-type-name 3)
@@ -309,7 +316,8 @@ socks-filter
 		     ((pred (= socks-address-type-name))
 		      (if (< (length string) 5)
 			  255
-		        (+ 1 (aref string 4)))))))
+                        (+ 1 (aref string 4))))
+                     (0 0))))
 	  (if (< (length string) desired-len)
 	      nil			; Need to spin some more
 	    (process-put proc 'socks-state socks-state-connected)
@@ -399,6 +407,7 @@ socks-send-command
 		(format "%c%s" (length address) address))
 	       (t
 		(error "Unknown address type: %d" atype))))
+        trailing
 	request version)
     (or (process-get proc 'socks)
         (error "socks-send-command called on non-SOCKS connection %S" proc))
@@ -415,6 +424,12 @@ socks-send-command
 			     (t
 			      (error "Unsupported address type for HTTP: %d" atype)))
 			    port)))
+     ((when (eq version '4a)
+        (setf addr "\0\0\0\1"
+              trailing (concat address "\0")
+              version 4 ; done with the "a" part
+              (process-get proc 'socks-server-protocol) 4)
+        nil)) ; fall through
      ((equal version 4)
       (setq request (concat
 		     (unibyte-string
@@ -424,7 +439,8 @@ socks-send-command
 		      (logand port #xff)) ; port, low byte
 		     addr                 ; address
 		     (user-full-name)     ; username
-		     "\0")))              ; terminate username
+                     "\0"                 ; terminate username
+                     trailing)))          ; optional host to look up
      ((equal version 5)
       (setq request (concat
 		     (unibyte-string
@@ -445,7 +461,13 @@ socks-send-command
 	nil				; Sweet sweet success!
       (delete-process proc)
       (error "SOCKS: %s"
-             (nth (or (process-get proc 'socks-reply) 1) socks-errors)))
+             (let ((err (process-get proc 'socks-reply)))
+               (if (eql version 5)
+                   (nth (or err 1) socks-errors)
+                 ;; The defined error codes for v4 range from
+                 ;; 90-93, but we store them in a simple list.
+                 (nth (pcase err (90 0) (92 2) (93 3) (_ 1))
+                      socks--errors-4)))))
     proc))
 
 \f
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index d4c3828df45..df69fb2f5cf 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -210,6 +210,19 @@ socks-tests-v4-basic
                  (lambda (&optional _) "foo")))
         (socks-tests-perform-hello-world-http-request)))))
 
+(ert-deftest socks-tests-v4a-basic ()
+  "Show correct preparation of SOCKS4a connect command."
+  (let ((socks-server '("server" "127.0.0.1" t 4a))
+        (url-user-agent "Test/4a-basic")
+        (socks-tests-canned-server-patterns
+         `(([4 1 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+            . [0 90 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS4A")
+      (cl-letf (((symbol-function 'user-full-name)
+                 (lambda (&optional _) "foo")))
+        (socks-tests-perform-hello-world-http-request)))))
+
 ;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate
 ;; against curl 7.71 with the following options:
 ;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
-- 
2.41.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: 7458 bytes --]

From a51bee63fb2b74d8eacdd0c3244df1f1a707f61b 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 | 111 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 90 insertions(+), 21 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 958d8bf23c9..1bb78113d52 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
@@ -335,14 +335,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)
 
@@ -528,22 +534,85 @@ 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))
+
+;;;###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))
+         (socks-server (if url
+                           (list 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)
+          (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)))
+                     ;; FIXME skip when TLD is .onion.
+                     (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.41.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: 7670 bytes --]

From 8a54568d3e7d70f23cfeda292aff21b8c2203f49 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

* 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 open
`url-https-proxy-connect' for non-SOCKS proxies.

* lisp/url/url-proxy.el (url-proxy--socks-scheme-regexp): Add new
const.
(url-default-find-proxy-for-url): Accommodate SOCKS entries but defy
original design somewhat by requiring a URL scheme in the host value
for detection.
(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-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  | 16 +++++++---------
 lisp/url/url-proxy.el | 18 ++++++++++++++++--
 lisp/url/url-vars.el  | 11 +++++++++--
 4 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 4d7297f6f2e..baf94b96819 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."
@@ -220,6 +220,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 ada6341ee73..42cfb9959a7 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)
@@ -1396,8 +1391,9 @@ 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
+                    (not (string-prefix-p "socks" (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)
@@ -1479,7 +1475,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
+                 (not (string-prefix-p "socks" (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-proxy.el b/lisp/url/url-proxy.el
index 0c330069789..1a278bb1673 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -25,6 +25,9 @@
 
 (require 'url-parse)
 
+(defconst url-proxy--socks-scheme-regexp
+  (rx bot "socks" (? (or "4" "4a" "5" "5h")) "://"))
+
 (defun url-default-find-proxy-for-url (urlobj host)
   (cond
    ((or (and (assoc "no_proxy" url-proxy-services)
@@ -35,7 +38,12 @@ url-default-find-proxy-for-url
 	(equal "www" (url-type urlobj)))
     "DIRECT")
    ((cdr (assoc (url-type urlobj) url-proxy-services))
-    (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
+    (let ((found (alist-get (url-type urlobj) url-proxy-services
+                            nil nil #'equal)))
+      (concat (if (string-match url-proxy--socks-scheme-regexp found)
+                  "SOCKS "
+                "PROXY ")
+              found)))
    ;;
    ;; Should check for socks
    ;;
@@ -57,7 +65,10 @@ url-find-proxy-for-url
      ((string-match "^PROXY +" proxy)
       (concat "http://" (substring proxy (match-end 0)) "/"))
      ((string-match "^SOCKS +" proxy)
-      (concat "socks://" (substring proxy (match-end 0))))
+      (if-let* ((m (substring proxy (match-end 0)))
+                ((string-match url-proxy--socks-scheme-regexp m)))
+          m
+        (concat "socks://" m)))
      (t
       (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
       nil))))
@@ -72,6 +83,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 7e2290217d0..d96890db04a 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -192,10 +192,15 @@ url-mail-command
 (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.  Depending on the
+gateway type, Emacs may expect certain server values to specfiy a
+\"scheme\", for example, \"proxyscheme://hostname:portnumber\",
+in which \"proxyscheme\" is something like \"socks5\".  As of
+Emacs 30.1, this only applies to SOCKS servers."
   :type '(repeat (cons :format "%v"
 		       (string :tag "Protocol")
 		       (string :tag "Proxy")))
+  :version "30.1"
   :group 'url)
 
 (defcustom url-standalone-mode nil
@@ -310,7 +315,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.")
 
 (defcustom url-news-server nil
   "The default news server from which to get newsgroups/articles.
-- 
2.41.0