unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 53941@debbugs.gnu.org
Cc: Lars Ingebrigtsen <larsi@gnus.org>, Eli Zaretskii <eliz@gnu.org>,
	Jacobo <gnuhacker@member.fsf.org>
Subject: bug#53941: Last-minute socks.el improvements for Emacs 29?
Date: Mon, 28 Nov 2022 07:30:16 -0800	[thread overview]
Message-ID: <87mt8baygn.fsf_-_@neverwas.me> (raw)
In-Reply-To: <87lexikwu5.fsf@neverwas.me> (J. P.'s message of "Thu, 10 Mar 2022 00:58:42 -0800")

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

Hi people, maintainers,

I've lifted some fixes and minor enhancements from my POC stuff posted
to this thread earlier this year. Nothing is directly Tor related, so I
can create a new bug report, if necessary.

The second patch fixes a problem involving SOCKS 5 error handling. It
also adds support for SOCKS 4a, which allows tools that don't speak
SOCKS 5, like socat, to resolve host names. The third addresses a couple
FIXMEs but no bugs, strictly speaking. The fourth is just a demo [1].
Happy to explain whatever in detail.

Thanks,
J.P.


[1] The fourth patch demos a possible approach for tightening the
    integration between socks and url-proxy, but it's not fit for
    inclusion in Emacs 29. To try it out with Tor, do something like

      (setq url-proxy-services '(("https" . "socks5h://127.0.0.1:9050"))
            socks-username "foo"
            socks-password "")

    followed by an M-x eww RET https://check.torproject.org RET. (Note
    that this still leaks DNS.)


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

From 0780339ceee3b0068700f5a3bf6d48aa4023915e 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.  Also allow system to choose
port instead of hard-coding it.
---
 test/lisp/net/socks-tests.el | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 461796bdf9..f1ecf1630f 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
@@ -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")
@@ -266,7 +270,7 @@ socks-tests-v5-auth-user-pass-blank
 
 (ert-deftest socks-tests-v5-auth-none ()
   "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")
-- 
2.38.1


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

From 2de287eac55c577001ac5470e57f1a2ed80c5faf 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 choice `4a' to version
field of option.  This may appear to change the type of the field from
a number to a union of symbols and numbers.  However,
`socks-send-command' and `socks-filter' already expect a possible
`http' value for this field (also a symbol).
(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.
In some cases, errors from certain servers were inaccessible.
(socks-connect-function): New option for specifying an
`open-network-stream'-like connect function.
(socks-open-connection): Accept additional `open-network-stream'
params passed on to opener.
(socks-send-command): Massage existing handling for version 4 to
accommodate 4a.

* test/lisp/net/socks-tests.el (socks-tests-v4a-basic): Add test for
SOCKS version 4a.  (Bug#53941.)
---
 lisp/net/socks.el            | 50 +++++++++++++++++++++++++++++-------
 test/lisp/net/socks-tests.el | 13 ++++++++++
 2 files changed, 54 insertions(+), 9 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 2ba1c20566..b9af2aa06e 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)
@@ -327,15 +335,27 @@ socks-override-functions
 (when socks-override-functions
   (advice-add 'open-network-stream :around #'socks--open-network-stream))
 
-(defun socks-open-connection (server-info)
+(defcustom 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 "29.1"
+  :type '(choice (function-item :value open-network-stream)
+                 (function :tag "User-provided function")))
+
+(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
+accepted by `open-network-stream'."
   (interactive)
+  (unless (plist-member stream-params :coding)
+    (setf (plist-get stream-params :coding) '(binary . binary)))
   (save-excursion
     (let ((proc
-           (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+           (with-suppressed-warnings ((obsolete socks-override-functions))
+             (let ((socks-override-functions nil))
+               (apply socks-connect-function (nth 0 server-info) nil
+                      (nth 1 server-info) (nth 2 server-info) stream-params))))
 	  (authtype nil)
 	  version)
 
@@ -400,6 +420,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))
@@ -416,6 +437,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
@@ -425,7 +452,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
@@ -446,7 +474,11 @@ socks-send-command
 	nil				; Sweet sweet success!
       (delete-process proc)
       (error "SOCKS: %s"
-             (nth (or (process-get proc 'socks-reply) 1) socks-errors)))
+             (let ((no (or (process-get proc 'socks-reply) 99)))
+               (or (if (eq version 5) ; 99 - 90 >= length(errors)
+                       (nth no socks-errors)
+                     (nth (- no 90) socks--errors-4))
+                   "Unknown error"))))
     proc))
 
 \f
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index f1ecf1630f..9e341ebd4d 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.38.1


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

From e0593f5be91e27541a9a13bad9632696fceb9f2a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 1 Mar 2022 02:12:02 -0800
Subject: [PATCH 3/4] Simplify network-stream openers in socks.el

* lisp/net/socks.el (socks-override-functions): Make variable obsolete
and remove uses throughout.
(socks-open-network-stream-fallback): Add new custom option indicating
whether to fall back on non-SOCKS connections.
(socks-open-network-stream-tls-services): Add new custom option for
specifying ports for proxied connections that should be encrypted with
TLS.
(socks-open-network-stream): Recognize additional `url' struct param.
Also prefer parsed URL details when present in `url-using-proxy'.
(socks--open-network-stream): Reduce role to merely issuing the first
command using an existing process.
---
 lisp/net/socks.el | 109 ++++++++++++++++++++++++++++++++++++----------
 1 file changed, 86 insertions(+), 23 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index b9af2aa06e..ac732b228b 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
@@ -325,15 +325,15 @@ socks-filter
 	    (process-put proc 'socks-response string))))))
      ((= state socks-state-connected)))))
 
-;; FIXME this is a terrible idea.
-;; It is not even compatible with the argument spec of open-network-stream
-;; in 24.1.
-
 (defvar socks-override-functions nil
   "If non-nil, overwrite `open-network-stream' function with SOCKSified version.")
 
-(when socks-override-functions
-  (advice-add 'open-network-stream :around #'socks--open-network-stream))
+;; Libraries typically offer a "stream opener" option, such as ERC's
+;; `erc-server-connect-function'.  These provide a level of
+;; flexibility tantamount to what this variable formerly offered.
+(make-obsolete-variable
+ 'socks-override-functions
+ "see `socks-open-network-stream' and `socks-connect-function'." "29.1")
 
 (defcustom socks-connect-function 'open-network-stream
   "Function to open a network connection to a SOCKS provider.
@@ -539,22 +539,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))
+(defcustom socks-open-network-stream-fallback nil
+  "Whether `socks-open-network-stream' should fall back to non-SOCKS."
+  :version "29.1"
+  :type 'boolean)
+
+(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 "29.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', and on
+rejection either signal an error or fall back to non-SOCKS,
+depending on the value of `socks-open-network-stream-fallback'.
+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--open-network-stream 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)))
+                     (nsm-verify-connection proc host port))
+            proc))
+      ;; Retain legacy behavior and connect anyway without warning
+      (if socks-open-network-stream-fallback
+          (with-suppressed-warnings ((obsolete socks-override-functions))
+            (let (socks-override-functions)
+              (apply #'open-network-stream name buffer host service params)))
+        (error "Connection rejected by `socks-noproxy'")))))
+
+(defun socks--open-network-stream (proc buffer host service)
+  (progn ; preserve indentation level for git blame / code review
+    (progn ; could rename to something like `socks--initiate-command-connect'
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.38.1


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

From 5ac2987f3085dede2e20755bb6c9631f7d47380b 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/30.0.50] 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  | 13 ++++++++++---
 4 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index e4d1ca72a0..c93edc0d4e 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 94ef156108..864048a73c 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 c72e459a4e..f4ddd639f6 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 4cdca05554..209d387ea7 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -191,11 +191,16 @@ 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."
+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."
   :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.38.1


  reply	other threads:[~2022-11-28 15:30 UTC|newest]

Thread overview: 24+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-02-11 11:09 bug#53941: 27.2; socks + tor dont work with https Jacobo
2022-02-14 12:37 ` J.P.
2022-02-19 21:04   ` Jacobo
2022-02-21 15:01     ` J.P.
2022-03-01 14:29       ` J.P.
2022-03-02  2:37         ` J.P.
2022-03-06  2:40           ` Jacobo
2022-03-06  2:58             ` J.P.
2022-03-07  7:09               ` J.P.
2022-03-10  8:58                 ` J.P.
2022-11-28 15:30                   ` J.P. [this message]
2022-11-28 17:12                     ` bug#53941: Last-minute socks.el improvements for Emacs 29? Eli Zaretskii
2022-11-29 14:24                       ` J.P.
2022-11-29 14:36                         ` Eli Zaretskii
2023-09-06 22:25                           ` bug#53941: 27.2; socks + tor dont work with https Stefan Kangas
2023-09-07  5:53                             ` Eli Zaretskii
2023-09-07 13:25                               ` J.P.
2023-09-07 13:47                                 ` Stefan Kangas
2023-09-08  2:55                                   ` J.P.
2023-09-08 11:04                                     ` Stefan Kangas
2023-10-18 13:38                                     ` J.P.
2023-12-19 16:29                                       ` J.P.
2023-09-08 13:28                                 ` J.P.
2023-09-09 14:05                                   ` J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87mt8baygn.fsf_-_@neverwas.me \
    --to=jp@neverwas.me \
    --cc=53941@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    --cc=gnuhacker@member.fsf.org \
    --cc=larsi@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).