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

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

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

I seem to have missed the fact that `url-methods' populates the option
`url-proxy-services' from environment variables when initializing
`url-scheme-registry'. As explained in the docs, it actually accepts
full URLs instead of just host:port pairs. I take this to mean it's
probably less disruptive than initially thought to extend this liberty
to `url-proxy-services' itself. I've updated the POC patches to reflect
this, so it should now be possible to do:

    (setenv "HTTPS_PROXY" "socks5h://localhost:9050")
    (eww "https://check.torproject.org/")

Of course, this shouldn't interfere with traditional http proxies, such
as those that provide CONNECT tunneling:

    $ ncat -l --proxy-type http localhost 8888
    (setenv "HTTPS_PROXY" "localhost:8888")
    (eww "https://www.example.com/")


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

From 6e0e98f0bc89a2c9a434c9a1e837750a371f6d1e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 9 Sep 2023 06:22:33 -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

 doc/misc/url.texi            |   8 +-
 etc/NEWS                     |   7 ++
 lisp/net/socks.el            | 141 ++++++++++++++++++++++++++++-------
 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 |  84 ++++++++++++++++-----
 9 files changed, 248 insertions(+), 69 deletions(-)

Interdiff:
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 42cfb9959a7..47c785a0735 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1392,7 +1392,10 @@ url-http
                   (url-port url)))
           (_
            (if (and url-http-proxy
-                    (not (string-prefix-p "socks" (url-type 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
@@ -1476,7 +1479,7 @@ url-http-async-sentinel
        ((string= (substring why 0 4) "open")
 	(setq url-http-connection-opened t)
         (if (and url-http-proxy
-                 (not (string-prefix-p "socks" (url-type 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
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 9643e992044..9592307aea8 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -92,7 +92,6 @@ url-scheme-register-proxy
      ;; Then check if its a fully specified URL
      ((string-match url-nonrelative-link env-proxy)
       (setq urlobj (url-generic-parse-url env-proxy))
-      (setf (url-type urlobj) "http")
       (setf (url-target urlobj) nil))
      ;; Finally, fall back on the assumption that its just a hostname
      (t
@@ -103,8 +102,11 @@ url-scheme-register-proxy
      (if (and (not cur-proxy) urlobj)
 	 (progn
 	   (setq url-proxy-services
-		 (cons (cons scheme (format "%s:%d" (url-host urlobj)
-					    (url-port urlobj)))
+                 (cons (cons scheme (if (member (url-type urlobj)
+                                                url-proxy-full-address-types)
+                                        (url-recreate-url urlobj)
+                                      (format "%s:%d" (url-host urlobj)
+                                              (url-port urlobj))))
 		       url-proxy-services))
 	   (message "Using a proxy for %s..." scheme)))))
 
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index c9c5a7aacac..b1583523cc6 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -25,9 +25,6 @@
 
 (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)
@@ -38,13 +35,12 @@ url-default-find-proxy-for-url
 	(equal "www" (url-type urlobj)))
     "DIRECT")
    ((and-let* ((found (assoc (url-type urlobj) url-proxy-services)))
-      (concat (if (string-match url-proxy--socks-scheme-regexp (cdr found))
-                  "SOCKS "
+      (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))))
-   ;;
-   ;; Should check for socks
-   ;;
    (t
     "DIRECT")))
 
@@ -62,9 +58,9 @@ 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)
+     ((string-match  (rx bot "SOCKS" (** 0 2 alnum) " ") proxy)
       (if-let ((m (substring proxy (match-end 0)))
-               ((string-match url-proxy--socks-scheme-regexp m)))
+               ((string-search "://" m)))
           m
         (concat "socks://" m)))
      (t
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 87dfdb9916c..f10158d66a1 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -189,18 +189,27 @@ 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.  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."
+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")))
-  :version "30.1"
   :group 'url)
 
 (defcustom url-standalone-mode nil
@@ -317,7 +326,7 @@ url-using-proxy
   "Either nil or the fully qualified proxy URL in use, e.g.
 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.")
+a `url' struct object.")
 
 (defcustom url-news-server nil
   "The default news server from which to get newsgroups/articles.
-- 
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: 8566 bytes --]

From a58a38ff9a599bf93d5e5467a01198444be2cf15 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 | 53 +++++++++++++++++++++++++-----------
 1 file changed, 37 insertions(+), 16 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 958e2ff44a8..0890ace826f 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))
+                               (and (stringp pat) (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,24 @@ 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)
+  (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: 8777 bytes --]

From af4f2b326ec5bdceb039e861745dd4e79608181e 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

* doc/misc/url.texi: Mention version 4a in SOCKS portion of "Gateways
in general" node.
* etc/NEWS: Mention version 4a support.
* 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.  Use variable
`socks-username' for v4 variable-length ID field instead of calling
`user-full-name'.
* test/lisp/net/socks-tests.el (socks-tests-v4-basic): Don't mock
`user-full-name' because `socks-send-command' no longer calls it to
determine the id.
(socks-tests-v4a-basic, socks-tests-v4a-error): Add a couple tests for
SOCKS version 4a.  (Bug#53941)
---
 doc/misc/url.texi            |  8 +++++---
 etc/NEWS                     |  7 +++++++
 lisp/net/socks.el            | 30 ++++++++++++++++++++++++++----
 test/lisp/net/socks-tests.el | 31 ++++++++++++++++++++++++++++---
 4 files changed, 66 insertions(+), 10 deletions(-)

diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index e6636e32507..6517f858324 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -1083,16 +1083,18 @@ Gateways in general
 @defopt socks-server
 This specifies the default server, it takes the form
 @w{@code{("Default server" @var{server} @var{port} @var{version})}}
-where @var{version} can be either 4 or 5.
+where @var{version} can be 4, 4a, or 5.
 @end defopt
 @defvar socks-password
 If this is @code{nil} then you will be asked for the password,
 otherwise it will be used as the password for authenticating you to
-the @sc{socks} server.
+the @sc{socks} server.  You can often set this to @code{""} for
+servers on your local network.
 @end defvar
 @defvar socks-username
 This is the username to use when authenticating yourself to the
-@sc{socks} server.  By default this is your login name.
+@sc{socks} server.  By default, this is your login name.  In versions
+4 and 4a, ERC uses this for the @samp{ID} field.
 @end defvar
 @defvar socks-timeout
 This controls how long, in seconds, to wait for responses from the
diff --git a/etc/NEWS b/etc/NEWS
index f6be603294e..55bcf957021 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -756,6 +756,13 @@ neither of which have been supported by Emacs since version 23.1.
 The user option 'url-gateway-nslookup-program' and the function
 'url-gateway-nslookup-host' are consequently also obsolete.
 
+** socks
+
++++
+*** SOCKS supports version 4a.
+The 'socks-server' option now accepts '4a' as a valid value for its
+version field.
+
 \f
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 968a28d2be8..b781b6a4eab 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
@@ -423,8 +438,9 @@ socks-send-command
 		      (ash port -8)       ; port, high byte
 		      (logand port #xff)) ; port, low byte
 		     addr                 ; address
-		     (user-full-name)     ; username
-		     "\0")))              ; terminate username
+                     socks-username       ; 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 0890ace826f..1a4bac37bf9 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -197,6 +197,7 @@ socks-tests-v4-basic
   "Show correct preparation of SOCKS4 connect command (Bug#46342)."
   (let ((socks-server '("server" "127.0.0.1" t 4))
         (url-user-agent "Test/4-basic")
+        (socks-username "foo")
         (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])
            ,socks-tests--hello-world-http-request-pattern))
@@ -205,11 +206,35 @@ socks-tests-v4-basic
       (cl-letf (((symbol-function 'socks-nslookup-host)
                  (lambda (host)
                    (should (equal host "example.com"))
-                   (list 93 184 216 34)))
-                ((symbol-function 'user-full-name)
-                 (lambda (&optional _) "foo")))
+                   (list 93 184 216 34))))
         (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))
+        (socks-username "foo")
+        (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")
+      (socks-tests-perform-hello-world-http-request))))
+
+(ert-deftest socks-tests-v4a-error ()
+  "Show error signaled when destination address rejected."
+  (let ((socks-server '("server" "127.0.0.1" t 4a))
+        (url-user-agent "Test/4a-basic")
+        (socks-username "")
+        (socks-tests-canned-server-patterns
+         `(([4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+            . [0 91 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS4A")
+      (let ((err (should-error
+                  (socks-tests-perform-hello-world-http-request))))
+        (should (equal err '(error "SOCKS: Rejected or failed")))))))
+
 ;; 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: 7459 bytes --]

From f84edbf90bc249863ca6b8c28d90378ea4f22e9e 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 b781b6a4eab..f5820e7968c 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)))
+                     (unless (string-suffix-p ".onion" host)
+                       (nsm-verify-connection proc host port))))
+          proc)
+      (apply socks-connect-function name buffer host service params))))
+
+(defun socks--initiate-command-connect (proc buffer host service)
+  (progn ; preserve indentation level for git blame / code review
+    (progn
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.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: 10045 bytes --]

From 6e0e98f0bc89a2c9a434c9a1e837750a371f6d1e 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

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.
---
 lisp/url/url-gw.el      |  8 +++++++-
 lisp/url/url-http.el    | 19 ++++++++++---------
 lisp/url/url-methods.el |  8 +++++---
 lisp/url/url-proxy.el   | 22 +++++++++++++++-------
 lisp/url/url-vars.el    | 20 ++++++++++++++++++--
 5 files changed, 55 insertions(+), 22 deletions(-)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 568ce8679f5..a65245a58a3 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -28,7 +28,7 @@
 (require 'url-vars)
 (require 'url-parse)
 
-(autoload 'socks-open-network-stream "socks")
+(autoload 'socks-open-network-stream "socks") ; FIXME remove this
 
 (defgroup url-gateway nil
   "URL gateway variables."
@@ -226,6 +226,12 @@ url-open-stream
 Optional arg GATEWAY-METHOD specifies the gateway to be used,
 overriding the value of `url-gateway-method'."
   (unless url-gateway-unplugged
+    (when (url-p url-using-proxy)
+      (if (or (eq 'socks url-gateway-method)
+              (string-prefix-p "socks" (url-type url-using-proxy)))
+          (setq gateway-method 'socks)
+        (setq host (url-host url-using-proxy)
+              service (url-port url-using-proxy))))
     (let* ((gwm (or gateway-method url-gateway-method))
            (gw-method (if (and url-gateway-local-host-regexp
                                (not (eq 'tls gwm))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index ada6341ee73..47c785a0735 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,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)
@@ -1479,7 +1478,9 @@ url-http-async-sentinel
 	(url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
 	(setq url-http-connection-opened t)
-        (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+        (if (and url-http-proxy
+                 (equal "http" (url-type url-http-proxy))
+                 (string= "https" (url-type url-current-object)))
             (url-https-proxy-connect proc)
           (condition-case error
               (process-send-string proc (url-http-create-request))
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 9643e992044..9592307aea8 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -92,7 +92,6 @@ url-scheme-register-proxy
      ;; Then check if its a fully specified URL
      ((string-match url-nonrelative-link env-proxy)
       (setq urlobj (url-generic-parse-url env-proxy))
-      (setf (url-type urlobj) "http")
       (setf (url-target urlobj) nil))
      ;; Finally, fall back on the assumption that its just a hostname
      (t
@@ -103,8 +102,11 @@ url-scheme-register-proxy
      (if (and (not cur-proxy) urlobj)
 	 (progn
 	   (setq url-proxy-services
-		 (cons (cons scheme (format "%s:%d" (url-host urlobj)
-					    (url-port urlobj)))
+                 (cons (cons scheme (if (member (url-type urlobj)
+                                                url-proxy-full-address-types)
+                                        (url-recreate-url urlobj)
+                                      (format "%s:%d" (url-host urlobj)
+                                              (url-port urlobj))))
 		       url-proxy-services))
 	   (message "Using a proxy for %s..." scheme)))))
 
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 0c330069789..b1583523cc6 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -34,11 +34,13 @@ url-default-find-proxy-for-url
 	      host))
 	(equal "www" (url-type urlobj)))
     "DIRECT")
-   ((cdr (assoc (url-type urlobj) url-proxy-services))
-    (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
-   ;;
-   ;; Should check for socks
-   ;;
+   ((and-let* ((found (assoc (url-type urlobj) url-proxy-services)))
+      (concat (if-let ((non-scheme (string-search "://" (cdr found)))
+                       (scheme (substring (cdr found) 0 non-scheme))
+                       ((member scheme url-proxy-full-address-types)))
+                  (concat scheme " ")
+                "PROXY ")
+              (cdr found))))
    (t
     "DIRECT")))
 
@@ -56,8 +58,11 @@ url-find-proxy-for-url
      ((string-match "^DIRECT" proxy) nil)
      ((string-match "^PROXY +" proxy)
       (concat "http://" (substring proxy (match-end 0)) "/"))
-     ((string-match "^SOCKS +" proxy)
-      (concat "socks://" (substring proxy (match-end 0))))
+     ((string-match  (rx bot "SOCKS" (** 0 2 alnum) " ") proxy)
+      (if-let ((m (substring proxy (match-end 0)))
+               ((string-search "://" m)))
+          m
+        (concat "socks://" m)))
      (t
       (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
       nil))))
@@ -72,6 +77,9 @@ url-proxy
   (cond
    ((string= (url-type url-using-proxy) "http")
     (url-http url callback cbargs))
+   ((and (string-prefix-p "socks" (url-type url-using-proxy))
+         (string-prefix-p "http" (url-type url)))
+    (url-http url callback cbargs))
    (t
     (error "Don't know how to use proxy `%s'" url-using-proxy))))
 
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index ef4b8b2841b..f10158d66a1 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -189,10 +189,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")))
@@ -310,7 +324,9 @@ url-show-status
 
 (defvar url-using-proxy nil
   "Either nil or the fully qualified proxy URL in use, e.g.
-https://www.example.com/")
+https://www.example.com/.  Beware that some functions, such as
+`url-proxy' and `url-http-end-of-document-sentinel', set this to
+a `url' struct object.")
 
 (defcustom url-news-server nil
   "The default news server from which to get newsgroups/articles.
-- 
2.41.0