* bug#53941: 27.2; socks + tor dont work with https
@ 2022-02-11 11:09 Jacobo
2022-02-14 12:37 ` J.P.
0 siblings, 1 reply; 24+ messages in thread
From: Jacobo @ 2022-02-11 11:09 UTC (permalink / raw)
To: 53941
Emacs can not resolve domains when it is https if you are using a socks
proxy (socks.el)
Emacs Config:
#+begin_src elisp
(setq socks-override-functions t)
(setq url-gateway-method 'socks) ; same problem without this line in conf
(require 'socks)
(setq socks-noproxy '("localhost"))
(setq socks-server
'("TOR"
"localhost"
9050
5))
#+end_src
Tor is the socks proxy
Im running tor.
When I try:
M-x eww RET gnu.org RET
It works, load http://gnu.org (HTTP in plain)
Also work with .onion domains in HTTP plain
No problems with HTTP but
When I try:
M-x eww RET https://gnu.org RET
Return an error:
Bad Request
Your browser sent a request that this server could not understand.
Reason: You're speaking plain HTTP to an SSL-enabled server port.
Instead use the HTTPS scheme to access this URL, please.
In GNU Emacs 27.2 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.30, cairo version 1.16.0)
Windowing system distributor 'The X.Org Foundation', version 11.0.12101002
System Description: GNU Guix System
Configured using:
'configure
CONFIG_SHELL=/gnu/store/4y5m9lb8k3qkb1y9m02sw9w9a6hacd16-bash-minimal-5.1.8/bin/bash
SHELL=/gnu/store/4y5m9lb8k3qkb1y9m02sw9w9a6hacd16-bash-minimal-5.1.8/bin/bash
--prefix=/gnu/store/c4bb68f53mw3sjf6xbyr7ba83csgjdkk-emacs-27.2
--enable-fast-install --with-modules --with-cairo
--disable-build-details'
Configured features:
XPM JPEG TIFF GIF PNG RSVG CAIRO SOUND GPM DBUS GSETTINGS GLIB NOTIFY
INOTIFY ACL GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT LIBOTF ZLIB
TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM MODULES THREADS JSON PDUMPER GMP
^ permalink raw reply [flat|nested] 24+ messages in thread* bug#53941: 27.2; socks + tor dont work with https 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 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-02-14 12:37 UTC (permalink / raw) To: Jacobo; +Cc: 53941 [-- Attachment #1: Type: text/plain, Size: 1541 bytes --] Hi Jacobo, Jacobo <gnuhacker@member.fsf.org> writes: > Emacs can not resolve domains when it is https if you are using a > socks proxy (socks.el) [...] It works, load http://gnu.org (HTTP in > plain) Also work with .onion domains in HTTP plain No problems with > HTTP but When I try: M-x eww RET https://gnu.org RET > > Return an error: Bad Request It's certainly possible (see attached). But can it be done responsibly? In this day and age, when processes and services resolve host names in all manner of ways, how can we be confident there won't be any leaks? At present, the main interfaces to various protocol stacks (for example, url-gw.el and friends) don't seem geared toward making those kinds of assurances. (Not that they ought to be.) That said, providing the building blocks on the SOCKS side doesn't seem like the crime of the century. I've been sitting on what became the basis for these patches for a while now, but these here were hastily adapted and might come with some warts. Still, I believe them straightforward enough to illustrate a basic means of achieving what you're after. > In GNU Emacs 27.2 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.30, I also have some examples with shims for 27 running periodically in CI. These include a demo of using ERC to connect to Libera.Chat via SOCKS over TLS. (But that requires an IRCv3 library, which is still a work in progress.) If you're interested in experimenting with any of this stuff, please let me know. That goes for anyone else out there as well. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Set-coding-system-for-SOCKS-connections-to-binary.patch --] [-- Type: text/x-patch, Size: 2226 bytes --] From 1cf058fe106e01d55e9269503994e2e9b274b07a 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] Set coding system for SOCKS connections to binary * lisp/net/socks.el (socks-opens-connection): Don't perform conversions when receiving and sending text. * test/lisp/net/socks-tests.el (socks-tests-canned-server-create): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as utf-8. --- lisp/net/socks.el | 1 + test/lisp/net/socks-tests.el | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 8df0773e1d..c15b323c9c 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -340,6 +340,7 @@ socks-open-connection version) ;; Initialize process and info about the process + (set-process-coding-system proc 'binary 'binary) (set-process-filter proc #'socks-filter) (set-process-query-on-exit-flag proc nil) (process-put proc 'socks t) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 461796bdf9..708b964020 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -137,13 +137,14 @@ socks-tests-canned-server-create (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) (pcase-let ((`(,pat . ,resp) (pop pats))) + (setq resp (apply #'unibyte-string (append resp nil))) (unless (or (and (vectorp pat) (equal pat (vconcat line))) (string-match-p pat line)) (error "Unknown request: %s" line)) (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 -- 2.34.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Add-support-for-SOCKS-4a.patch --] [-- Type: text/x-patch, Size: 4547 bytes --] From 84299e3e9dac1e3620a83cf807b564ee276f0cdf 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] Add support for SOCKS 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 socks version 4. The semantics are faithful, but the wording is ad-libbed. (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 4a. --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index c15b323c9c..0d5ef307e7 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) @@ -401,6 +408,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)) @@ -418,6 +426,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 @@ -427,7 +441,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 @@ -448,7 +463,10 @@ 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) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (+ 90 no) socks--errors-4))))) proc)) \f diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 708b964020..b81923fc56 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -207,6 +207,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" 10083 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.34.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Support-SOCKS-RESOLVE-extension.patch --] [-- Type: text/x-patch, Size: 6017 bytes --] From ffda45081444e14ca687a505f1fc697b8ef59e0f 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 3/4] Support SOCKS RESOLVE extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. --- lisp/net/socks.el | 58 ++++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 34 +++++++++++++++++++++ 2 files changed, 92 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 0d5ef307e7..7201ed8e06 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -654,6 +657,61 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one vector IPv4 address for domain NAME. +Or return nil on failure. See `network-lookup-address-info' for format +of return value. Server must support the Tor RESOLVE command." + (let ((socks-password (or socks-password "")) + host + (port 80) ; unused for now + proc + ip) + (unless (string-suffix-p ".onion" name) + (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection (socks-find-route host port))) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0]))))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index b81923fc56..51e2e40631 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -295,4 +295,38 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 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 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.34.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-POC-Demo-SOCKS-RESOLVE-over-HTTPS.patch --] [-- Type: text/x-patch, Size: 3390 bytes --] From efe0b1bff206efb6f6559154a560a71239aaa78e 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 4/4] [POC] Demo SOCKS RESOLVE over HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 51e2e40631..4963dd7b40 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -329,4 +329,57 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (orig (symbol-function #'socks--open-network-stream))) + (cl-letf (((symbol-function 'socks--open-network-stream) + (lambda (&rest rest) + (let ((proc (apply orig rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-http url cb '(nil)) + (should (nsm-host-settings id)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1))))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve))))))) + ;;; socks-tests.el ends here -- 2.34.1 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-02-14 12:37 ` J.P. @ 2022-02-19 21:04 ` Jacobo 2022-02-21 15:01 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: Jacobo @ 2022-02-19 21:04 UTC (permalink / raw) To: J.P.; +Cc: 53941 "J.P." <jp@neverwas.me> writes: > Jacobo <gnuhacker@member.fsf.org> writes: >> Emacs can not resolve domains when it is https if you are using a >> socks proxy (socks.el) [...] It works, load http://gnu.org (HTTP in >> plain) Also work with .onion domains in HTTP plain No problems with >> HTTP but When I try: M-x eww RET https://gnu.org RET >> Return an error: Bad Request > It's certainly possible (see attached). But can it be done responsibly? > In this day and age, when processes and services resolve host names in > all manner of ways, how can we be confident there won't be any leaks? oh, nevermind > At present, the main interfaces to various protocol stacks (for > example, url-gw.el and friends) don't seem geared toward making those > kinds of assurances. (Not that they ought to be.) That said, > providing the building blocks on the SOCKS side doesn't seem like the > crime of the century. I've been sitting on what became the basis for > these patches for a while now, but these here were hastily adapted and > might come with some warts. Still, I believe them straightforward > enough to illustrate a basic means of achieving what you're after. >> In GNU Emacs 27.2 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.30, > I also have some examples with shims for 27 running periodically in CI. > These include a demo of using ERC to connect to Libera.Chat via SOCKS > over TLS. (But that requires an IRCv3 library, which is still a work in > progress.) Now Ive tryed same in other computer with Trisquel 10, the problem still happend > If you're interested in experimenting with any of this stuff, please > let me know. That goes for anyone else out there as well. Thanks. yes, how can I help? -- Emacs Lover. FSF Member. Free/Libre Software supporter. stallmansupport.org - Disinformation succeeds because so many people care deeply about injustice but do not take the time to check the facts. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-02-19 21:04 ` Jacobo @ 2022-02-21 15:01 ` J.P. 2022-03-01 14:29 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-02-21 15:01 UTC (permalink / raw) To: Jacobo; +Cc: 53941 Jacobo <gnuhacker@member.fsf.org> writes: >> In this day and age, when processes and services resolve host names in >> all manner of ways, how can we be confident there won't be any leaks? > > oh, nevermind I certainly don't want to discourage anyone from trying to solve this. But DNS leaks aside, predicting what ought to be proxied still seems like a serious undertaking (at least from my peabrained perspective). For example, if you connect to an IRC network over Tor and click a hyperlink in a channel, should the resulting connection also happen over Tor? What about when the SOCKS service isn't Tor but something else, like SSH? Should similar follow-on connections also originate from the proxy host (your VPS or shell provider, for example)? >> I also have some examples with shims for 27 running periodically in CI. >> These include a demo of using ERC to connect to Libera.Chat via SOCKS >> over TLS. (But that requires an IRCv3 library, which is still a work in >> progress.) > > Now Ive tryed same in other computer with Trisquel 10, the problem still > happend Sorry, are you saying you repeated the steps in your original post and got the same result (failure) on another computer? If so, that's to be expected because Tor over SOCKS with TLS isn't supported OOTB with any Emacs, not even 29. Apologies if I implied otherwise. >> If you're interested in experimenting with any of this stuff, please >> let me know. That goes for anyone else out there as well. Thanks. > > yes, how can I help? When 28 comes out, you can try applying those patches. Or, if you're not cool with that, I can give you a replacement socks.el to shadow the original. To check whether it's working, do M-: (boundp 'socks--errors-4) RET or similar and then try mimicking the recipe in that last patch (the one named POC demo something). Once that works, try adapting it to your needs for whatever protocol (except for ERC, for which you'll need to install an unofficial WIP version). ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-02-21 15:01 ` J.P. @ 2022-03-01 14:29 ` J.P. 2022-03-02 2:37 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-03-01 14:29 UTC (permalink / raw) To: Jacobo; +Cc: 53941 [-- Attachment #1: Type: text/plain, Size: 60 bytes --] v2. Minor corrections (another bug in existing test, etc.). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-NOT-A-PATCH-v1-v2.diff --] [-- Type: text/x-patch, Size: 6958 bytes --] From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Tue, 1 Mar 2022 06:09:00 -0800 Subject: [PATCH 0/5] NOT A PATCH *** BLURB HERE *** F. Jason Park (5): Simplify network-stream opener in socks.el Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS RESOLVE extension [POC] Demo SOCKS RESOLVE over HTTPS lisp/net/socks.el | 130 +++++++++++++++++++++++++++-------- test/lisp/net/socks-tests.el | 113 ++++++++++++++++++++++++++++-- 2 files changed, 208 insertions(+), 35 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 7201ed8e06..cd026fd163 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -333,24 +333,23 @@ socks-filter (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)) - -(defun socks-open-connection (server-info) +(make-obsolete-variable 'socks-override-functions + "`socks--open-network-stream' now takes a process arg." + "29.1") + +(defun socks-open-connection (server-info &optional opener) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. OPENER, when present, should be a substitute for +`open-network-stream' and take the same arguments." (interactive) (save-excursion - (let ((proc - (let ((socks-override-functions nil)) - (open-network-stream "socks" - nil - (nth 1 server-info) - (nth 2 server-info)))) + (let ((proc (funcall (or opener #'open-network-stream) + "socks" nil (nth 1 server-info) (nth 2 server-info))) (authtype nil) version) ;; Initialize process and info about the process - (set-process-coding-system proc 'binary 'binary) (set-process-filter proc #'socks-filter) (set-process-query-on-exit-flag proc nil) (process-put proc 'socks t) @@ -530,22 +529,18 @@ 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)) +(defun socks-open-network-stream (name buffer host service &rest params) + (if-let* ((route (socks-find-route host service)) + (proc (socks-open-connection route #'open-network-stream))) + (socks--open-network-stream proc buffer host service) + (message "Warning: no SOCKS route found for %s:%s" host service) + ;; Support legacy behavior (likely undesirable in most cases) + (apply #'open-network-stream name buffer host service params))) + +(defun socks--open-network-stream (proc buffer host service) + (progn ; temporarily preserve git blame for easier reviewing + (progn ; could rename to something like `socks--initiate-command-sequence' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4963dd7b40..f2600210b0 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))))) @@ -137,10 +137,10 @@ socks-tests-canned-server-create (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) (pcase-let ((`(,pat . ,resp) (pop pats))) - (setq resp (apply #'unibyte-string (append resp nil))) (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))) @@ -374,11 +374,11 @@ test-socks-https-poc #'socks-tor-resolve) (should-not (nsm-host-settings id)) (url-http url cb '(nil)) - (should (nsm-host-settings id)) (ert-info ("Wait for response") (with-timeout (3 (error "Request timed out")) (unless done - (sleep-for 0.1))))) + (sleep-for 0.1)))) + (should (nsm-host-settings id))) (advice-remove 'network-lookup-address-info #'socks-tor-resolve))))))) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Simplify-network-stream-opener-in-socks.el.patch --] [-- Type: text/x-patch, Size: 3695 bytes --] From e1b377ee054f95a4f2064eef6972d350f69767f3 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 1/5] Simplify network-stream opener in socks.el * lisp/net/socks.el (socks-override-functions): Make variable obsolete and remove uses. (socks-open-connection): Add optional opener arg. (socks-open-network-stream): Accept additional params for calling `open-network-stream' as a fallback when a route cannot be found. (socks--open-network-stream): Reduce role to merely issuing the first command using an existing process. Change signature accordingly. --- lisp/net/socks.el | 50 ++++++++++++++++++++++------------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 8df0773e1d..9bc301618c 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -323,19 +323,19 @@ socks-filter (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)) - -(defun socks-open-connection (server-info) +(make-obsolete-variable 'socks-override-functions + "`socks--open-network-stream' now takes a process arg." + "29.1") + +(defun socks-open-connection (server-info &optional opener) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. OPENER, when present, should be a substitute for +`open-network-stream' and take the same arguments." (interactive) (save-excursion - (let ((proc - (let ((socks-override-functions nil)) - (open-network-stream "socks" - nil - (nth 1 server-info) - (nth 2 server-info)))) + (let ((proc (funcall (or opener #'open-network-stream) + "socks" nil (nth 1 server-info) (nth 2 server-info))) (authtype nil) version) @@ -508,22 +508,18 @@ 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)) +(defun socks-open-network-stream (name buffer host service &rest params) + (if-let* ((route (socks-find-route host service)) + (proc (socks-open-connection route #'open-network-stream))) + (socks--open-network-stream proc buffer host service) + (message "Warning: no SOCKS route found for %s:%s" host service) + ;; Support legacy behavior (likely undesirable in most cases) + (apply #'open-network-stream name buffer host service params))) + +(defun socks--open-network-stream (proc buffer host service) + (progn ; temporarily preserve git blame for easier reviewing + (progn ; could rename to something like `socks--initiate-command-sequence' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Fix-string-encoding-bug-in-socks-tests.patch --] [-- Type: text/x-patch, Size: 3161 bytes --] From 8f33588517c7333d3bd08375c406cd46726b51d6 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/5] Fix string encoding bug in socks tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as utf-8. Fix similar mistake in v4 filter test. --- test/lisp/net/socks-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 461796bdf9..d9ef53ae35 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))))) @@ -140,10 +140,11 @@ socks-tests-canned-server-create (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 -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Add-support-for-SOCKS-4a.patch --] [-- Type: text/x-patch, Size: 4557 bytes --] From b90a6474b6edb4dd33cffa0e05f1a7f1a3e1c9be 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 3/5] Add support for SOCKS 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 socks version 4. The semantics are faithful, but the wording is ad-libbed. (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 4a. Bug#53941 --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 9bc301618c..0615db8681 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) @@ -400,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)) @@ -417,6 +425,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 @@ -426,7 +440,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 @@ -447,7 +462,10 @@ 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) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (+ 90 no) socks--errors-4))))) proc)) \f diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index d9ef53ae35..4e990ffdba 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -207,6 +207,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" 10083 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.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Support-SOCKS-RESOLVE-extension.patch --] [-- Type: text/x-patch, Size: 6027 bytes --] From 23a430c6d7fb2707dba7e217f279ba293ae2fce6 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 4/5] Support SOCKS RESOLVE extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. Bug#53941 --- lisp/net/socks.el | 58 ++++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 34 +++++++++++++++++++++ 2 files changed, 92 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 0615db8681..cd026fd163 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -649,6 +652,61 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one vector IPv4 address for domain NAME. +Or return nil on failure. See `network-lookup-address-info' for format +of return value. Server must support the Tor RESOLVE command." + (let ((socks-password (or socks-password "")) + host + (port 80) ; unused for now + proc + ip) + (unless (string-suffix-p ".onion" name) + (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection (socks-find-route host port))) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0]))))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4e990ffdba..3d1aca9af4 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -295,4 +295,38 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 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 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-POC-Demo-SOCKS-RESOLVE-over-HTTPS.patch --] [-- Type: text/x-patch, Size: 3390 bytes --] From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 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 5/5] [POC] Demo SOCKS RESOLVE over HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 3d1aca9af4..f2600210b0 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -329,4 +329,57 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (orig (symbol-function #'socks--open-network-stream))) + (cl-letf (((symbol-function 'socks--open-network-stream) + (lambda (&rest rest) + (let ((proc (apply orig rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-http url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve))))))) + ;;; socks-tests.el ends here -- 2.35.1 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-03-01 14:29 ` J.P. @ 2022-03-02 2:37 ` J.P. 2022-03-06 2:40 ` Jacobo 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-03-02 2:37 UTC (permalink / raw) To: 53941; +Cc: Jacobo [-- Attachment #1: Type: text/plain, Size: 297 bytes --] v3. Passing around an opener function was clunky, so I've opted for passing around contact params instead. I've also gone back to explicitly setting the coding to binary because folks may not be using `url-open-stream' (which does this indirectly by let-binding `coding-system-for-{read,write}'). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-NOT-A-PATCH-v2-v3.diff --] [-- Type: text/x-patch, Size: 3838 bytes --] From 45be9bbb941e91efe9dacf1b3c34d4d362593d53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Tue, 1 Mar 2022 14:45:26 -0800 Subject: [PATCH 0/5] NOT A PATCH *** BLURB HERE *** F. Jason Park (5): Simplify network-stream opener in socks.el Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS resolve extension [POC] Demo SOCKS resolve with HTTPS lisp/net/socks.el | 133 ++++++++++++++++++++++++++++------- test/lisp/net/socks-tests.el | 113 +++++++++++++++++++++++++++-- 2 files changed, 213 insertions(+), 33 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index cd026fd163..02edd95328 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -334,18 +334,22 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") (make-obsolete-variable 'socks-override-functions - "`socks--open-network-stream' now takes a process arg." + "use custom opener with `socks-open-stream-function'." "29.1") -(defun socks-open-connection (server-info &optional opener) +(defvar socks-open-stream-function #'open-network-stream + "Function called to open a network stream connection.") + +(defun socks-open-connection (server-info &rest params) "Create and initialize a SOCKS process. Perform authentication if needed. SERVER-INFO should resemble -`socks-server'. OPENER, when present, should be a substitute for -`open-network-stream' and take the same arguments." +`socks-server'. PARAMS are those accepted by `make-network-process'." (interactive) + (unless (plist-member params :coding) + (setf (plist-get params :coding) '(binary . binary))) (save-excursion - (let ((proc (funcall (or opener #'open-network-stream) - "socks" nil (nth 1 server-info) (nth 2 server-info))) + (let ((proc (apply socks-open-stream-function "socks" nil + (nth 1 server-info) (nth 2 server-info) params)) (authtype nil) version) @@ -531,11 +535,11 @@ socks-find-services-entry (defun socks-open-network-stream (name buffer host service &rest params) (if-let* ((route (socks-find-route host service)) - (proc (socks-open-connection route #'open-network-stream))) + (proc (apply #'socks-open-connection route params))) (socks--open-network-stream proc buffer host service) (message "Warning: no SOCKS route found for %s:%s" host service) ;; Support legacy behavior (likely undesirable in most cases) - (apply #'open-network-stream name buffer host service params))) + (apply socks-open-stream-function name buffer host service params))) (defun socks--open-network-stream (proc buffer host service) (progn ; temporarily preserve git blame for easier reviewing @@ -684,17 +688,20 @@ socks-tor-resolve (let ((socks-password (or socks-password "")) host (port 80) ; unused for now + route proc ip) (unless (string-suffix-p ".onion" name) (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) name (require 'puny) - (puny-encode-domain name))) + (puny-encode-domain name)) + route (socks-find-route host port)) + (cl-assert route) ;; "Host unreachable" may be raised when the lookup fails (unwind-protect (progn - (setq proc (socks-open-connection (socks-find-route host port))) + (setq proc (socks-open-connection route)) (socks-send-command proc socks-resolve-command socks-address-type-name -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Simplify-network-stream-opener-in-socks.el.patch --] [-- Type: text/x-patch, Size: 4074 bytes --] From 90247189d5fe90619f00ef3319012df0f6f6688e 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 1/5] Simplify network-stream opener in socks.el * lisp/net/socks.el (socks-override-functions, socks-open-stream-function): Make first variable obsolete and remove uses. Replace somewhat with the second, which holds a network stream opener that defaults to `open-network-stream'. (socks-open-connection): Accept additional `make-network-process' params passed on to opener. (socks-open-network-stream): Likewise with the additional params. Call `open-network-stream' as a fallback when a route cannot be found. (socks--open-network-stream): Reduce role to merely issuing the first command using an existing process. This may warrant a renaming. Change signature accordingly. --- lisp/net/socks.el | 50 +++++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 8df0773e1d..5b78eb6e84 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -323,19 +323,23 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") +(make-obsolete-variable 'socks-override-functions + "use custom opener with `socks-open-stream-function'." + "29.1") -(when socks-override-functions - (advice-add 'open-network-stream :around #'socks--open-network-stream)) +(defvar socks-open-stream-function #'open-network-stream + "Function called to open a network stream connection.") -(defun socks-open-connection (server-info) +(defun socks-open-connection (server-info &rest params) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. PARAMS are those accepted by `make-network-process'." (interactive) + (unless (plist-member params :coding) + (setf (plist-get 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)))) + (let ((proc (apply socks-open-stream-function "socks" nil + (nth 1 server-info) (nth 2 server-info) params)) (authtype nil) version) @@ -508,22 +512,18 @@ 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)) +(defun socks-open-network-stream (name buffer host service &rest params) + (if-let* ((route (socks-find-route host service)) + (proc (apply #'socks-open-connection route params))) + (socks--open-network-stream proc buffer host service) + (message "Warning: no SOCKS route found for %s:%s" host service) + ;; Support legacy behavior (likely undesirable in most cases) + (apply socks-open-stream-function name buffer host service params))) + +(defun socks--open-network-stream (proc buffer host service) + (progn ; temporarily preserve git blame for easier reviewing + (progn ; could rename to something like `socks--initiate-command-sequence' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Fix-string-encoding-bug-in-socks-tests.patch --] [-- Type: text/x-patch, Size: 3161 bytes --] From 181548ce7f931fedd66e243632c42c5c51af640e 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/5] Fix string encoding bug in socks tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as utf-8. Fix similar mistake in v4 filter test. --- test/lisp/net/socks-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 461796bdf9..d9ef53ae35 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))))) @@ -140,10 +140,11 @@ socks-tests-canned-server-create (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 -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Add-support-for-SOCKS-4a.patch --] [-- Type: text/x-patch, Size: 4557 bytes --] From db601f1fcbaf5cf088b280966cbac2808a773ee0 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 3/5] Add support for SOCKS 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 socks version 4. The semantics are faithful, but the wording is ad-libbed. (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 4a. Bug#53941 --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 5b78eb6e84..a2198d898a 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) @@ -404,6 +411,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)) @@ -421,6 +429,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 @@ -430,7 +444,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 @@ -451,7 +466,10 @@ 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) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (+ 90 no) socks--errors-4))))) proc)) \f diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index d9ef53ae35..4e990ffdba 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -207,6 +207,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" 10083 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.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Support-SOCKS-resolve-extension.patch --] [-- Type: text/x-patch, Size: 6091 bytes --] From 67ba3f6e6fcb12b99757fcc49f86f951ad59c02b 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 4/5] Support SOCKS resolve extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. Bug#53941 --- lisp/net/socks.el | 61 ++++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 34 ++++++++++++++++++++ 2 files changed, 95 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index a2198d898a..02edd95328 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -653,6 +656,64 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one vector IPv4 address for domain NAME. +Or return nil on failure. See `network-lookup-address-info' for format +of return value. Server must support the Tor RESOLVE command." + (let ((socks-password (or socks-password "")) + host + (port 80) ; unused for now + route + proc + ip) + (unless (string-suffix-p ".onion" name) + (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name)) + route (socks-find-route host port)) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0]))))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4e990ffdba..3d1aca9af4 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -295,4 +295,38 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 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 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-POC-Demo-SOCKS-resolve-with-HTTPS.patch --] [-- Type: text/x-patch, Size: 3390 bytes --] From 45be9bbb941e91efe9dacf1b3c34d4d362593d53 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 5/5] [POC] Demo SOCKS resolve with HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 3d1aca9af4..f2600210b0 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -329,4 +329,57 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (orig (symbol-function #'socks--open-network-stream))) + (cl-letf (((symbol-function 'socks--open-network-stream) + (lambda (&rest rest) + (let ((proc (apply orig rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-http url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve))))))) + ;;; socks-tests.el ends here -- 2.35.1 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-03-02 2:37 ` J.P. @ 2022-03-06 2:40 ` Jacobo 2022-03-06 2:58 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: Jacobo @ 2022-03-06 2:40 UTC (permalink / raw) To: J.P.; +Cc: 53941 "J.P." <jp@neverwas.me> writes: > v3. Passing around an opener function was clunky, so I've opted for > passing around contact params instead. I've also gone back to explicitly > setting the coding to binary because folks may not be using > `url-open-stream' (which does this indirectly by let-binding > `coding-system-for-{read,write}'). Emacs 28.0.91 compiled with this patches, dont work, connections dont use the proxy -- Emacs Lover. FSF Member. Free/Libre Software supporter. stallmansupport.org - Disinformation succeeds because so many people care deeply about injustice but do not take the time to check the facts. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-03-06 2:40 ` Jacobo @ 2022-03-06 2:58 ` J.P. 2022-03-07 7:09 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-03-06 2:58 UTC (permalink / raw) To: Jacobo; +Cc: 53941 Jacobo <gnuhacker@member.fsf.org> writes: > "J.P." <jp@neverwas.me> writes: > >> v3. Passing around an opener function was clunky, so I've opted for >> passing around contact params instead. I've also gone back to explicitly >> setting the coding to binary because folks may not be using >> `url-open-stream' (which does this indirectly by let-binding >> `coding-system-for-{read,write}'). > > Emacs 28.0.91 compiled with this patches, dont work, connections dont > use the proxy As I tried to explain up thread, the patches only get you half way there. But perhaps that wasn't clear. You still need to do something like the following, which is what I MemoServ'd you about (but I guess you didn't get it). Quoting from there: ;; This works with eww. Try https://check.torproject.org (require 'socks) (require 'gnutls) (require 'nsm) (setq socks-server '("tor" "127.0.0.1" 9050 5) socks-username "user" socks-password "" url-gateway-method 'socks) (defun my-socks-open-https (orig name buffer host service &rest params) (let ((proc (apply orig name buffer host service params))) (advice-add 'network-lookup-address-info :override #'socks-tor-resolve) (unwind-protect (when (eq service 443) (gnutls-negotiate :process proc :hostname host) (unless (string-suffix-p ".onion" host) (nsm-verify-connection proc host service))) (advice-remove 'network-lookup-address-info #'socks-tor-resolve)) proc)) (defun my-url-open-stream (args) (pcase-let ((`(,name ,buffer ,host ,service ,gateway-method) args)) (when (and (eq url-gateway-method 'socks) (eq gateway-method 'tls)) (setq gateway-method nil)) (list name buffer host service gateway-method))) (advice-add 'socks-open-network-stream :around #'my-socks-open-https) (advice-add 'url-open-stream :filter-args #'my-url-open-stream) The above is an example of what I was getting at in my initial reply about mimicking the recipe in the last patch (the ERT test). If you have questions about how to use it, I can help you in real time on Libera, as we did with applying the patches. Also, please try this with emacs -Q. Thanks. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-03-06 2:58 ` J.P. @ 2022-03-07 7:09 ` J.P. 2022-03-10 8:58 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-03-07 7:09 UTC (permalink / raw) To: Jacobo; +Cc: 53941 [-- Attachment #1: Type: text/plain, Size: 3485 bytes --] v4. Include a minimal (hacky[1]) url-gw integration. I'm now slightly of the opinion that offering no interface whatsoever is probably too stark an approach. Ignoring the three Tor-related patches for now, it seems that even without proper url.el integration[2], we can still try to ensure that for most use cases, no unnecessary hackery need apply. Another issue is whether to address the questionable top-level advising going on with `open-network-streams', since we're already refactoring all the functions it affects. Assuming users exist who still have `socks-override-functions' non-nil at load time, would it make sense to warn them more fervently than would be done for a normal deprecation? The thinking is that folks may be relying on this for things like bypassing firewalls at work (and could therefore get dinged more than usual just for upgrading Emacs). As a start, I figured we could try and determine exactly why this (perhaps somewhat ill-considered) top-level advising was ever instituted in the first place[3]. AFAICT, it was mainly intended to 1. allow libraries calling `open-network-stream' (and unaware of `socks-open-network-stream') to proxy transparently[4] 2. guard the tunneled protocol from being accidentally subject to a recommencing of the SOCKS dialog If anyone has better ideas, please share. Thanks. Notes ~~~~~ [1] The second patch is new and a bit of an ugly hack. It has to do with this change from a while back: Do not set `url-gateway-method' in `url-https' commit 98c58df832975b01287ef749dd5235199d4cd431 Sun Sep 28 20:00:54 2014 +0200 which made it impossible for `url-gateway-method' to be respected by `url-open-stream' when called by `url-https'. But rather than undoing the offending portions out of hand, it might be nicer to first figure out how url-proxy.el is supposed to work and maybe get it and `url-retrieve-internal' (and `url-https') more in sync and sensitive to `url-gateway-method'. [2] If we do end up with a proper url.el solution, it might then make more sense to emphasize the fact that `socks-open-network-stream' is really mostly about catering to url-gw (which it is). If that's agreeable, we could rename the following like so: socks-open-network-stream -> socks-url-open socks-open-network-stream-legacy -> socks-open-network-stream socks-open-network-stream-function -> socks-url-open-function [3] A summary of the advice-based behavior triggered by `socks-override-functions', assuming `socks-find-route' returns non-nil: | topmost function invoked | o-n-s advised | s-o-f | proxied | |---------------------------+---------------+-------+---------| | socks-open-network-stream | nil | t | yes | | socks-open-network-stream | nil | nil | yes | | socks-open-network-stream | t | t | yes | | socks-open-network-stream | t | nil | yes | | open-network-stream | nil | t | no | | open-network-stream | nil | nil | no | | open-network-stream | t | nil | no | | open-network-stream | t | t | yes | o-n-s: open-network-stream s-o-f: socks-override-functions [4] It could be argued that the 2014 commit in [1] converted gw into one such library insofar as `url-https' is concerned. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-NOT-A-PATCH-v3-v4.diff --] [-- Type: text/x-patch, Size: 9916 bytes --] From 62062472fd14dc9911a105016badcc921d63ae95 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 6 Mar 2022 21:21:49 -0800 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): Simplify network-stream opener in socks.el ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS resolve extension [POC] Demo SOCKS resolve with HTTPS lisp/net/socks.el | 145 ++++++++++++++++++++++++++++------- lisp/url/url-gw.el | 2 + test/lisp/net/socks-tests.el | 113 +++++++++++++++++++++++++-- 3 files changed, 225 insertions(+), 35 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 02edd95328..9285cbf805 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -334,22 +334,19 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") (make-obsolete-variable 'socks-override-functions - "use custom opener with `socks-open-stream-function'." + "see `socks-open-network-stream-function'." "29.1") -(defvar socks-open-stream-function #'open-network-stream - "Function called to open a network stream connection.") - -(defun socks-open-connection (server-info &rest params) +(defun socks-open-connection (server-info &rest kw-args) "Create and initialize a SOCKS process. Perform authentication if needed. SERVER-INFO should resemble -`socks-server'. PARAMS are those accepted by `make-network-process'." +`socks-server'. KW-ARGS are those accepted by `open-network-stream'." (interactive) - (unless (plist-member params :coding) - (setf (plist-get params :coding) '(binary . binary))) + (unless (plist-member kw-args :coding) + (setf (plist-get kw-args :coding) '(binary . binary))) (save-excursion - (let ((proc (apply socks-open-stream-function "socks" nil - (nth 1 server-info) (nth 2 server-info) params)) + (let ((proc (apply #'open-network-stream "socks" nil + (nth 1 server-info) (nth 2 server-info) kw-args)) (authtype nil) version) @@ -533,17 +530,31 @@ socks-find-services-entry (gethash (downcase service) (if udp socks-udp-services socks-tcp-services))) -(defun socks-open-network-stream (name buffer host service &rest params) +(defcustom socks-open-network-stream-function + #'socks-open-network-stream-legacy + "Function to open a SOCKS connection. +Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with +similar functions in the url-gw framework. May also be passed +additional keyword args suitable for `make-network-process'." + :type '(choice (const :tag "Default fallback-oriented opener.") + (function :tag "User-provided function"))) + +(defun socks-open-network-stream-legacy (name buffer host service &rest params) + "Open a SOCKS connection for a valid route. +Fall back to non-SOCKS connections for unknown or undesired routes." (if-let* ((route (socks-find-route host service)) (proc (apply #'socks-open-connection route params))) (socks--open-network-stream proc buffer host service) - (message "Warning: no SOCKS route found for %s:%s" host service) - ;; Support legacy behavior (likely undesirable in most cases) - (apply socks-open-stream-function name buffer host service params))) + ;; Retain legacy behavior and connect anyway without warning + (apply #'open-network-stream name buffer host service params))) + +(defun socks-open-network-stream (name buffer host service &rest params) + "Open a SOCKS connection. PARAMS are passed to `open-network-stream'." + (apply socks-open-network-stream-function name buffer host service params)) (defun socks--open-network-stream (proc buffer host service) (progn ; temporarily preserve git blame for easier reviewing - (progn ; could rename to something like `socks--initiate-command-sequence' + (progn ; could rename to something like `socks--initiate-command-connect' (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond @@ -685,34 +696,31 @@ socks-tor-resolve "Return list of one vector IPv4 address for domain NAME. Or return nil on failure. See `network-lookup-address-info' for format of return value. Server must support the Tor RESOLVE command." - (let ((socks-password (or socks-password "")) - host - (port 80) ; unused for now - route - proc - ip) - (unless (string-suffix-p ".onion" name) - (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) - name - (require 'puny) - (puny-encode-domain name)) - route (socks-find-route host port)) - (cl-assert route) - ;; "Host unreachable" may be raised when the lookup fails - (unwind-protect - (progn - (setq proc (socks-open-connection route)) - (socks-send-command proc - socks-resolve-command - socks-address-type-name - host - port) - (cl-assert (eq (process-get proc 'socks-state) - socks-state-connected)) - (setq ip (socks--extract-resolve-response proc))) - (when proc - (delete-process proc))) - (list (vconcat ip [0]))))) + (let* ((socks-password (or socks-password "")) + (host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + (port 80) ; unused for now + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0])))) (provide 'socks) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index c4a41f56b3..822cbcb64e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -215,6 +215,8 @@ 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 (eq url-gateway-method 'socks) + (setq gateway-method nil)) (let* ((gwm (or gateway-method url-gateway-method)) (gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls gwm)) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index f2600210b0..402ccf979d 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -348,6 +348,7 @@ test-socks-https-poc (ert-with-temp-file tempfile :prefix "emacs-test-socks-network-security-" (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") (socks-password "") (nsm-settings-file tempfile) (url-gateway-method 'socks) @@ -361,25 +362,24 @@ test-socks-https-poc (goto-char (point-min)) (should (search-forward "Congratulations" nil t)) (setq done t))) - (orig (symbol-function #'socks--open-network-stream))) - (cl-letf (((symbol-function 'socks--open-network-stream) - (lambda (&rest rest) - (let ((proc (apply orig rest))) - (gnutls-negotiate :process proc :hostname host) - (should (nsm-verify-connection proc host 443 t)))))) - (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") - (unwind-protect - (progn - (advice-add 'network-lookup-address-info :override - #'socks-tor-resolve) - (should-not (nsm-host-settings id)) - (url-http url cb '(nil)) - (ert-info ("Wait for response") - (with-timeout (3 (error "Request timed out")) - (unless done - (sleep-for 0.1)))) - (should (nsm-host-settings id))) - (advice-remove 'network-lookup-address-info - #'socks-tor-resolve))))))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) ;;; socks-tests.el ends here -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Simplify-network-stream-opener-in-socks.el.patch --] [-- Type: text/x-patch, Size: 4765 bytes --] From ed93ee2fdc8d6b920a44ddaa2b0571948cf77c88 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 1/6] Simplify network-stream opener in socks.el * lisp/net/socks.el (socks-override-functions): Make variable obsolete and remove uses throughout. (socks-open-connection): Accept additional `make-network-process' params passed on to opener. (socks-open-network-stream-function): Add new custom option to hold an opener function. (socks-open-network-stream-legacy): Simulate original `socks-open-network-stream' functionality, only without `socks-override-functions'. Call `open-network-stream' as a fallback when a route cannot be found. (socks-open-network-stream): Accept additional params. Delegate to `socks-open-network-stream-function' for actual work. (socks--open-network-stream): Reduce role to merely issuing the first command using an existing process. --- lisp/net/socks.el | 65 +++++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 27 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 8df0773e1d..fe66a94d18 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -323,19 +323,20 @@ socks-filter (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)) - -(defun socks-open-connection (server-info) +(make-obsolete-variable 'socks-override-functions + "see `socks-open-network-stream-function'." + "29.1") + +(defun socks-open-connection (server-info &rest kw-args) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. KW-ARGS are those accepted by `open-network-stream'." (interactive) + (unless (plist-member kw-args :coding) + (setf (plist-get kw-args :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)))) + (let ((proc (apply #'open-network-stream "socks" nil + (nth 1 server-info) (nth 2 server-info) kw-args)) (authtype nil) version) @@ -508,22 +509,32 @@ 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-function + #'socks-open-network-stream-legacy + "Function to open a SOCKS connection. +Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with +similar functions in the url-gw framework. May also be passed +additional keyword args suitable for `make-network-process'." + :type '(choice (const :tag "Default fallback-oriented opener.") + (function :tag "User-provided function"))) + +(defun socks-open-network-stream-legacy (name buffer host service &rest params) + "Open a SOCKS connection for a valid route. +Fall back to non-SOCKS connections for unknown or undesired routes." + (if-let* ((route (socks-find-route host service)) + (proc (apply #'socks-open-connection route params))) + (socks--open-network-stream proc buffer host service) + ;; Retain legacy behavior and connect anyway without warning + (apply #'open-network-stream name buffer host service params))) + +(defun socks-open-network-stream (name buffer host service &rest params) + "Open a SOCKS connection. PARAMS are passed to `open-network-stream'." + (apply socks-open-network-stream-function name buffer host service params)) + +(defun socks--open-network-stream (proc buffer host service) + (progn ; temporarily preserve git blame for easier reviewing + (progn ; could rename to something like `socks--initiate-command-connect' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-lisp-url-url-gw.el-url-open-stream-Honor-socks-gatew.patch --] [-- Type: text/x-patch, Size: 882 bytes --] From a8bc5fe336356528dd0ebca86ec18ca541cb4b27 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 6 Mar 2022 17:14:50 -0800 Subject: [PATCH 2/6] ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method --- lisp/url/url-gw.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index c4a41f56b3..822cbcb64e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -215,6 +215,8 @@ 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 (eq url-gateway-method 'socks) + (setq gateway-method nil)) (let* ((gwm (or gateway-method url-gateway-method)) (gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls gwm)) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Fix-string-encoding-bug-in-socks-tests.patch --] [-- Type: text/x-patch, Size: 3161 bytes --] From e365303eeced26d5fc901e623eb44b3f6c2515cb 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 3/6] Fix string encoding bug in socks tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as utf-8. Fix similar mistake in v4 filter test. --- test/lisp/net/socks-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 461796bdf9..d9ef53ae35 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))))) @@ -140,10 +140,11 @@ socks-tests-canned-server-create (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 -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Add-support-for-SOCKS-4a.patch --] [-- Type: text/x-patch, Size: 4557 bytes --] From bb2187da12d88e8b32f9fd005926342e116970c3 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 4/6] Add support for SOCKS 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 socks version 4. The semantics are faithful, but the wording is ad-libbed. (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 4a. Bug#53941 --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index fe66a94d18..9f60ecbf36 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) @@ -401,6 +408,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)) @@ -418,6 +426,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 @@ -427,7 +441,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 @@ -448,7 +463,10 @@ 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) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (+ 90 no) socks--errors-4))))) proc)) \f diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index d9ef53ae35..4e990ffdba 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -207,6 +207,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" 10083 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.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Support-SOCKS-resolve-extension.patch --] [-- Type: text/x-patch, Size: 5979 bytes --] From a33717db1379a661ba8007f924dc937feeb2ad1b 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 5/6] Support SOCKS resolve extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. Bug#53941 --- lisp/net/socks.el | 58 ++++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 34 +++++++++++++++++++++ 2 files changed, 92 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 9f60ecbf36..9285cbf805 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -664,6 +667,61 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one vector IPv4 address for domain NAME. +Or return nil on failure. See `network-lookup-address-info' for format +of return value. Server must support the Tor RESOLVE command." + (let* ((socks-password (or socks-password "")) + (host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + (port 80) ; unused for now + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0])))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4e990ffdba..3d1aca9af4 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -295,4 +295,38 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 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 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0006-POC-Demo-SOCKS-resolve-with-HTTPS.patch --] [-- Type: text/x-patch, Size: 3325 bytes --] From 62062472fd14dc9911a105016badcc921d63ae95 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 6/6] [POC] Demo SOCKS resolve with HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 3d1aca9af4..402ccf979d 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -329,4 +329,57 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) + ;;; socks-tests.el ends here -- 2.35.1 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-03-07 7:09 ` J.P. @ 2022-03-10 8:58 ` J.P. 2022-11-28 15:30 ` bug#53941: Last-minute socks.el improvements for Emacs 29? J.P. 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-03-10 8:58 UTC (permalink / raw) To: Jacobo; +Cc: 53941 [-- Attachment #1: Type: text/plain, Size: 1094 bytes --] v5. Forgot to account for look-up failures (shocking not shocking). Also removed hard-coded port numbers from tests. The EWW example from earlier needs some adapting: ;; M-x eww RET https://check.torproject.org RET (require 'socks) (require 'gnutls) (require 'nsm) (defun my-socks-open-https (name buffer host service &rest params) (let ((proc (apply #'socks-open-network-stream-legacy name buffer host service params))) (advice-add 'network-lookup-address-info :override #'socks-tor-resolve) (unwind-protect (when (eq service 443) (gnutls-negotiate :process proc :hostname host) (unless (string-suffix-p ".onion" host) (nsm-verify-connection proc host service))) (advice-remove 'network-lookup-address-info #'socks-tor-resolve)) proc)) (setq socks-server '("tor" "127.0.0.1" 9050 5) socks-username "" socks-password "" url-gateway-method 'socks socks-open-network-stream-function #'my-socks-open-https) Let me know if you need help. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-NOT-A-PATCH-v4-v5.diff --] [-- Type: text/x-patch, Size: 10939 bytes --] From 52a7f3269992166074ebe277f6905c219885d7cf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Thu, 10 Mar 2022 00:18:09 -0800 Subject: [PATCH 0/6] *** SUBJECT HERE *** *** BLURB HERE *** F. Jason Park (6): Simplify network-stream opener in socks.el ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS resolve extension [POC] Demo SOCKS resolve with HTTPS lisp/net/socks.el | 157 +++++++++++++++++++++++++------- lisp/url/url-gw.el | 2 + test/lisp/net/socks-tests.el | 168 ++++++++++++++++++++++++++++++++--- 3 files changed, 285 insertions(+), 42 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 9285cbf805..9ce23b517e 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -319,7 +319,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) @@ -469,7 +470,7 @@ socks-send-command (let ((no (or (process-get proc 'socks-reply) 1))) (if (eq version 5) (nth no socks-errors) - (nth (+ 90 no) socks--errors-4))))) + (nth (- no 90) socks--errors-4))))) proc)) \f @@ -692,19 +693,11 @@ socks--extract-resolve-response (declare-function puny-encode-domain "puny" (domain)) -(defun socks-tor-resolve (name &optional _family) - "Return list of one vector IPv4 address for domain NAME. -Or return nil on failure. See `network-lookup-address-info' for format -of return value. Server must support the Tor RESOLVE command." - (let* ((socks-password (or socks-password "")) - (host (if (string-match "\\`[[:ascii:]]+\\'" name) - name - (require 'puny) - (puny-encode-domain name))) - (port 80) ; unused for now - (route (socks-find-route host nil)) - proc - ip) +(defun socks--tor-resolve (host) + (let ((socks-password (or socks-password "")) + (route (socks-find-route host nil)) + proc + ip) (cl-assert route) ;; "Host unreachable" may be raised when the lookup fails (unwind-protect @@ -714,13 +707,30 @@ socks-tor-resolve socks-resolve-command socks-address-type-name host - port) - (cl-assert (eq (process-get proc 'socks-state) - socks-state-connected)) + 0) (setq ip (socks--extract-resolve-response proc))) (when proc (delete-process proc))) - (list (vconcat ip [0])))) + ip)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one IPv4 address for domain NAME. +See `network-lookup-address-info' for format of return value. Return +nil on failure. + +SOCKS server must support the Tor RESOLVE command. Note that using this +in place of `network-lookup-address-info' may not be enough to prevent a +DNS leak. For example, see `url-gateway-broken-resolution'." + (unless (string-match "\\`[[:ascii:]]+\\'" name) + (require 'puny) + (setq name (puny-encode-domain name))) + (condition-case err + (when-let ((ip (socks--tor-resolve name))) + (list (vconcat ip [0]))) + (error + (unless (member (cadr err) + '("SOCKS: Host unreachable" "SOCKS: Rejected or failed")) + (signal (car err) (cdr err)))))) (provide 'socks) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 402ccf979d..0c58fcc863 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -133,7 +133,8 @@ 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" + (or (numberp port) (ert-test-name (ert-running-test))))) (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) (pcase-let ((`(,pat . ,resp) (pop pats))) @@ -152,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 @@ -192,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]) @@ -209,7 +212,7 @@ socks-tests-v4-basic (ert-deftest socks-tests-v4a-basic () "Show correct preparation of SOCKS4a connect command." - (let ((socks-server '("server" "127.0.0.1" 10083 4a)) + (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] @@ -227,7 +230,7 @@ socks-tests-v4a-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") @@ -261,7 +264,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") @@ -280,7 +283,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") @@ -297,9 +300,9 @@ socks-tests-v5-auth-none (ert-deftest tor-resolve-4a () "Make request to TOR resolve service over SOCKS4a" - (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (let* ((socks-server '("server" "127.0.0.1" t 4a)) (socks-tests-canned-server-patterns - '(([4 #xf0 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 93 184 216 34]))) (inhibit-message noninteractive) (server (socks-tests-canned-server-create))) @@ -311,9 +314,40 @@ tor-resolve-4a (kill-buffer (process-buffer server)) (delete-process server))) +(ert-deftest tor-resolve-4a-fail () + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should-not (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5-fail () + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "") + (socks-authentication-methods (copy-sequence + socks-authentication-methods)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 0 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 4 0 0 0 0 0 0 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should-not (socks-tor-resolve "example.com"))) + (kill-buffer (process-buffer server)) + (delete-process server))) + (ert-deftest tor-resolve-5 () "Make request to TOR resolve service over SOCKS5" - (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (let* ((socks-server '("server" "127.0.0.1" t 5)) (socks-username "foo") (socks-authentication-methods (append socks-authentication-methods nil)) @@ -321,7 +355,7 @@ tor-resolve-5 (socks-tests-canned-server-patterns '(([5 2 0 2] . [5 2]) ([1 3 ?f ?o ?o 0] . [1 0]) - ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] . [5 0 0 1 93 184 216 34 0 0]))) (server (socks-tests-canned-server-create))) (ert-info ("Query TOR RESOLVE service over SOCKS5") @@ -341,6 +375,15 @@ test-socks-service verify-flags verify-error verify-hostname-error &allow-other-keys)) +(ert-deftest test-socks-resolve-fail () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (let* ((socks-server `("tor" ,@test-socks-service 5)) ; also try 4a + (socks-username "") + (socks-password "")) + (ert-info ("Connect to HTTP endpoint over Tor SOCKS proxy") + (should-not (socks-tor-resolve "test-socks-resolve-fail--fake.com"))))) + (ert-deftest test-socks-https-poc () :tags '(:unstable) (unless test-socks-service (ert-skip "SOCKS service missing")) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Simplify-network-stream-opener-in-socks.el.patch --] [-- Type: text/x-patch, Size: 4765 bytes --] From dcb7c638d970c0924933ebd83f361298ebccf242 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 1/6] Simplify network-stream opener in socks.el * lisp/net/socks.el (socks-override-functions): Make variable obsolete and remove uses throughout. (socks-open-connection): Accept additional `make-network-process' params passed on to opener. (socks-open-network-stream-function): Add new custom option to hold an opener function. (socks-open-network-stream-legacy): Simulate original `socks-open-network-stream' functionality, only without `socks-override-functions'. Call `open-network-stream' as a fallback when a route cannot be found. (socks-open-network-stream): Accept additional params. Delegate to `socks-open-network-stream-function' for actual work. (socks--open-network-stream): Reduce role to merely issuing the first command using an existing process. --- lisp/net/socks.el | 65 +++++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 27 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 8df0773e1d..fe66a94d18 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -323,19 +323,20 @@ socks-filter (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)) - -(defun socks-open-connection (server-info) +(make-obsolete-variable 'socks-override-functions + "see `socks-open-network-stream-function'." + "29.1") + +(defun socks-open-connection (server-info &rest kw-args) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. KW-ARGS are those accepted by `open-network-stream'." (interactive) + (unless (plist-member kw-args :coding) + (setf (plist-get kw-args :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)))) + (let ((proc (apply #'open-network-stream "socks" nil + (nth 1 server-info) (nth 2 server-info) kw-args)) (authtype nil) version) @@ -508,22 +509,32 @@ 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-function + #'socks-open-network-stream-legacy + "Function to open a SOCKS connection. +Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with +similar functions in the url-gw framework. May also be passed +additional keyword args suitable for `make-network-process'." + :type '(choice (const :tag "Default fallback-oriented opener.") + (function :tag "User-provided function"))) + +(defun socks-open-network-stream-legacy (name buffer host service &rest params) + "Open a SOCKS connection for a valid route. +Fall back to non-SOCKS connections for unknown or undesired routes." + (if-let* ((route (socks-find-route host service)) + (proc (apply #'socks-open-connection route params))) + (socks--open-network-stream proc buffer host service) + ;; Retain legacy behavior and connect anyway without warning + (apply #'open-network-stream name buffer host service params))) + +(defun socks-open-network-stream (name buffer host service &rest params) + "Open a SOCKS connection. PARAMS are passed to `open-network-stream'." + (apply socks-open-network-stream-function name buffer host service params)) + +(defun socks--open-network-stream (proc buffer host service) + (progn ; temporarily preserve git blame for easier reviewing + (progn ; could rename to something like `socks--initiate-command-connect' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-lisp-url-url-gw.el-url-open-stream-Honor-socks-gatew.patch --] [-- Type: text/x-patch, Size: 882 bytes --] From dde4ed3bfdc5cebd4649534efe04b32c488f7b56 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 6 Mar 2022 17:14:50 -0800 Subject: [PATCH 2/6] ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method --- lisp/url/url-gw.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index c4a41f56b3..822cbcb64e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -215,6 +215,8 @@ 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 (eq url-gateway-method 'socks) + (setq gateway-method nil)) (let* ((gwm (or gateway-method url-gateway-method)) (gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls gwm)) -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Fix-string-encoding-bug-in-socks-tests.patch --] [-- Type: text/x-patch, Size: 6075 bytes --] From 1af9240dee9fdd2b112d7e1580f4d2ce4bc66321 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 3/6] Fix string encoding bug in socks tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): 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..807c926185 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" + (or (numberp 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.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Add-support-for-SOCKS-4a.patch --] [-- Type: text/x-patch, Size: 4553 bytes --] From 55702321a8b17914ff577b5e7fc426ffb7ff0462 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 4/6] Add support for SOCKS 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 socks version 4. The semantics are faithful, but the wording is ad-libbed. (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 4a. Bug#53941 --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index fe66a94d18..73afcc38d3 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) @@ -401,6 +408,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)) @@ -418,6 +426,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 @@ -427,7 +441,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 @@ -448,7 +463,10 @@ 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) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (- no 90) socks--errors-4))))) proc)) \f diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 807c926185..a0191d9341 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.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Support-SOCKS-resolve-extension.patch --] [-- Type: text/x-patch, Size: 8253 bytes --] From a26bf29fb9363d4face0049dcf5ec3d353c799ac 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 5/6] Support SOCKS resolve extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. (socks--tor-resolve, socks-tor-resolve): Provide internal function to perform resolve command as well as a partial drop-in replacement for `network-lookup-address-info'. (socks-filter): Allow for a null type field on error with version 5. Bug#53941 --- lisp/net/socks.el | 70 +++++++++++++++++++++++++++++++++++- test/lisp/net/socks-tests.el | 65 +++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 1 deletion(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 73afcc38d3..9ce23b517e 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -316,7 +319,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) @@ -664,6 +668,70 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks--tor-resolve (host) + (let ((socks-password (or socks-password "")) + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + 0) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + ip)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one IPv4 address for domain NAME. +See `network-lookup-address-info' for format of return value. Return +nil on failure. + +SOCKS server must support the Tor RESOLVE command. Note that using this +in place of `network-lookup-address-info' may not be enough to prevent a +DNS leak. For example, see `url-gateway-broken-resolution'." + (unless (string-match "\\`[[:ascii:]]+\\'" name) + (require 'puny) + (setq name (puny-encode-domain name))) + (condition-case err + (when-let ((ip (socks--tor-resolve name))) + (list (vconcat ip [0]))) + (error + (unless (member (cadr err) + '("SOCKS: Host unreachable" "SOCKS: Rejected or failed")) + (signal (car err) (cdr err)))))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index a0191d9341..077b80cb0b 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -298,4 +298,69 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-4a-fail () + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should-not (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5-fail () + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "") + (socks-authentication-methods (copy-sequence + socks-authentication-methods)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 0 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 4 0 0 0 0 0 0 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should-not (socks-tor-resolve "example.com"))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.35.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0006-POC-Demo-SOCKS-resolve-with-HTTPS.patch --] [-- Type: text/x-patch, Size: 3732 bytes --] From 52a7f3269992166074ebe277f6905c219885d7cf 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 6/6] [POC] Demo SOCKS resolve with HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 64 +++++++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 077b80cb0b..0c58fcc863 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -363,4 +363,66 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-resolve-fail () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (let* ((socks-server `("tor" ,@test-socks-service 5)) ; also try 4a + (socks-username "") + (socks-password "")) + (ert-info ("Connect to HTTP endpoint over Tor SOCKS proxy") + (should-not (socks-tor-resolve "test-socks-resolve-fail--fake.com"))))) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) + ;;; socks-tests.el ends here -- 2.35.1 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: Last-minute socks.el improvements for Emacs 29? 2022-03-10 8:58 ` J.P. @ 2022-11-28 15:30 ` J.P. 2022-11-28 17:12 ` Eli Zaretskii 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-11-28 15:30 UTC (permalink / raw) To: 53941; +Cc: Lars Ingebrigtsen, Eli Zaretskii, Jacobo [-- 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 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: Last-minute socks.el improvements for Emacs 29? 2022-11-28 15:30 ` bug#53941: Last-minute socks.el improvements for Emacs 29? J.P. @ 2022-11-28 17:12 ` Eli Zaretskii 2022-11-29 14:24 ` J.P. 0 siblings, 1 reply; 24+ messages in thread From: Eli Zaretskii @ 2022-11-28 17:12 UTC (permalink / raw) To: J.P.; +Cc: larsi, gnuhacker, 53941 > From: "J.P." <jp@neverwas.me> > Cc: Jacobo <gnuhacker@member.fsf.org>, Lars Ingebrigtsen <larsi@gnus.org>, > Eli Zaretskii <eliz@gnu.org> > Date: Mon, 28 Nov 2022 07:30:16 -0800 > > 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. 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. For example: > +(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))) AFAIU, this constitutes an incompatible change in behavior: the default for :coding is was never 'binary' before, it was determined from the locale's preferences. Why are we making this change here? > @@ -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")))) I don't really understand the semantics here (so maybe comments need to be upgraded), but the old and the new versions don't look to me like equivalent code -- why the change? > -(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") Why this last-minute obsolescence? > +(defun socks-open-network-stream (name buffer host service &rest params) > + "Open and return a connection, possibly proxied over SOCKS. The changes in this public function are so significant that I don't understand how they can be suggested so close to the branching. If it is possible to add support for SOCKS 4a without affecting any previously supported versions, I'm fine. Adding tests is also fine. But for the rest, I think you should wait until after the release branch is cut and install this on the master branch. Sorry, it really is too late for such changes. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: Last-minute socks.el improvements for Emacs 29? 2022-11-28 17:12 ` Eli Zaretskii @ 2022-11-29 14:24 ` J.P. 2022-11-29 14:36 ` Eli Zaretskii 0 siblings, 1 reply; 24+ messages in thread From: J.P. @ 2022-11-29 14:24 UTC (permalink / raw) To: Eli Zaretskii; +Cc: larsi, gnuhacker, 53941 [-- Attachment #1: Type: text/plain, Size: 4912 bytes --] 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. > For example: > >> +(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))) > > AFAIU, this constitutes an incompatible change in behavior: the default for > :coding is was never 'binary' before, it was determined from the locale's > preferences. Why are we making this change here? Just good old fashioned stupidity, I'm afraid. (And also recklessness in overly trusting the me from eight months ago, surely.) I guess I somehow assumed that if the caller didn't set :coding explicitly, they would do so once handed back the process, which is certifiably dumb. >> @@ -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")))) > > I don't really understand the semantics here (so maybe comments need to be > upgraded), but the old and the new versions don't look to me like equivalent > code -- why the change? This sets the fallback message to "Unknown error" (made up) rather than "General SOCKS server failure" (an official error code). At first, I figured the distinction more faithfully conveyed the nature of the error, but now I see that it just adds clutter because the fallback path can only be triggered by a protocol mishap, and that's unlikely, given that the conversation must progress to its third back-and-forth by the time this runs. (BTW, the words "error handling" in the patch's title refer to the added "(0 0)" `pcase' condition in `socks-filter' and not the snippet above.) >> -(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") > > Why this last-minute obsolescence? Just my being callous. I now see that obsoleting that variable is problematic, not least because we continue to honor `socks-noproxy'. But the two complement each other and are closely coupled, usage-wise. Getting rid of the one and pretending the other still works as intended was doubly irresponsible. >> +(defun socks-open-network-stream (name buffer host service &rest params) >> + "Open and return a connection, possibly proxied over SOCKS. > > The changes in this public function are so significant that I don't > understand how they can be suggested so close to the branching. The old signature was (name buffer host service) -> process and the new &rest arguments would be optional. And since the lone in-tree call site sticks to the four required positionals, I didn't think a move from (4 . 4) to (4 . many), in `func-arity' terms, stood to break any advice in the wild. Still, there are side effects in the new version that could use more thorough exploring, and further attention could be paid to its treatment of `socks-override-functions' in terms of preserving old behavior. > If it is possible to add support for SOCKS 4a without affecting any > previously supported versions, I'm fine. Adding tests is also fine. > But for the rest, I think you should wait until after the release > branch is cut and install this on the master branch. Sorry, it really > is too late for such changes. You're very gracious, but I think I've learned my lesson and will refrain from pursuing any of these changes for Emacs 29. Apologies for abusing your time and maintainerly patience (yet again). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v1-v2.diff --] [-- Type: text/x-patch, Size: 7474 bytes --] From 96a4de741663672e928fd30af6c93b335b346691 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Tue, 29 Nov 2022 00:18:42 -0800 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): ; Don't hard code server ports in SOCKS tests [30.0.50] Improve SOCKS error handling and add support for 4a [WIP/30.0.50] Simplify network-stream openers in socks.el [POC/30.0.50] Integrate the socks and url libraries lisp/net/socks.el | 142 +++++++++++++++++++++++++++++------ lisp/url/url-gw.el | 8 +- lisp/url/url-http.el | 16 ++-- lisp/url/url-proxy.el | 18 ++++- lisp/url/url-vars.el | 13 +++- test/lisp/net/socks-tests.el | 39 +++++++--- 6 files changed, 186 insertions(+), 50 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index ac732b228b..65436ed047 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -325,20 +325,20 @@ 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.") -;; 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") +(when socks-override-functions + (advice-add 'open-network-stream :around #'socks--open-network-stream)) (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" + :version "30.1" :type '(choice (function-item :value open-network-stream) (function :tag "User-provided function"))) @@ -348,14 +348,11 @@ socks-open-connection 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 - (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)))) + (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) @@ -474,11 +471,11 @@ socks-send-command nil ; Sweet sweet success! (delete-process proc) (error "SOCKS: %s" - (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")))) + (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) + socks--errors-4))))) proc)) \f @@ -539,16 +536,15 @@ socks-find-services-entry (gethash (downcase service) (if udp socks-udp-services socks-tcp-services))) -(defcustom socks-open-network-stream-fallback nil - "Whether `socks-open-network-stream' should fall back to non-SOCKS." - :version "29.1" - :type 'boolean) +(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))) (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" + :version "30.1" :type '(repeat number)) (declare-function gnutls-negotiate "gnutls" (&rest rest)) @@ -568,9 +564,12 @@ 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 either signal an error or fall back to non-SOCKS, -depending on the value of `socks-open-network-stream-fallback'. +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'. + 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 @@ -591,13 +590,14 @@ socks-open-network-stream socks-username)) (socks-password (or (and url (url-password url)) socks-password))) - (if-let* ((route (socks-find-route host service)) + (if-let* (((booleanp socks-override-functions)) + (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) + (socks--initiate-command-connect proc buffer host service) (if (and (memq port socks-proxied-tls-services) (gnutls-available-p) (require 'gnutls nil t) @@ -607,16 +607,15 @@ socks-open-network-stream :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) + (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))))) + +(defun socks--initiate-command-connect (proc buffer host service) (progn ; preserve indentation level for git blame / code review - (progn ; could rename to something like `socks--initiate-command-connect' + (progn (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond -- 2.38.1 [-- 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: 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 #4: 0002-30.0.50-Improve-SOCKS-error-handling-and-add-support.patch --] [-- Type: text/x-patch, Size: 5195 bytes --] From 0f199273a45210ba577e958e9b9205f1e4fcc9a7 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] [30.0.50] 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-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 | 26 +++++++++++++++++++++++--- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 2ba1c20566..0e84a2d594 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) @@ -400,6 +408,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 +425,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 +440,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 +462,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 ((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) + socks--errors-4))))) 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 #5: 0003-WIP-30.0.50-Simplify-network-stream-openers-in-socks.patch --] [-- Type: text/x-patch, Size: 7667 bytes --] From cee91dc42dd90bce6faab93bcfe85f2889166ebd 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] [WIP/30.0.50] Simplify network-stream openers in socks.el * lisp/net/socks.el (socks-open-network-stream-tls-services): Add new custom option for specifying ports whose proxied connections should use TLS. (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, now `socks-connect-function' in place of `open-network-stream'. (socks-open-network-stream): Recognize additional `url' struct param. Also prefer parsed URL details when present in `url-using-proxy'. (socks--initiate-command-connect): New function to house renamed latter half of the original `socks--open-network-stream'. Role now reduced issuing the first command using an existing process. (socks--open-network-stream): Serve as thin advice-only wrapper for `socks-open-network-stream'. --- lisp/net/socks.el | 116 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 95 insertions(+), 21 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 0e84a2d594..65436ed047 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,15 +335,24 @@ 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 "30.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) (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) @@ -527,22 +536,87 @@ 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)) + (let ((socks-override-functions orig-fun)) + (apply #'socks-open-network-stream 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' 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'. + +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* (((booleanp socks-override-functions)) + (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))) + (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))))) + +(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.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-POC-30.0.50-Integrate-the-socks-and-url-libraries.patch --] [-- Type: text/x-patch, Size: 7709 bytes --] From 96a4de741663672e928fd30af6c93b335b346691 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 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: Last-minute socks.el improvements for Emacs 29? 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 0 siblings, 1 reply; 24+ messages in thread From: Eli Zaretskii @ 2022-11-29 14:36 UTC (permalink / raw) To: J.P.; +Cc: larsi, gnuhacker, 53941 > From: "J.P." <jp@neverwas.me> > Cc: 53941@debbugs.gnu.org, gnuhacker@member.fsf.org, larsi@gnus.org > Date: Tue, 29 Nov 2022 06:24:15 -0800 > > 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. > >> +(defun socks-open-network-stream (name buffer host service &rest params) > >> + "Open and return a connection, possibly proxied over SOCKS. > > > > The changes in this public function are so significant that I don't > > understand how they can be suggested so close to the branching. > > The old signature was > > (name buffer host service) -> process I didn't mean the signature (which is OK), I meant the body. It is very different from the previous version. > > If it is possible to add support for SOCKS 4a without affecting any > > previously supported versions, I'm fine. Adding tests is also fine. > > But for the rest, I think you should wait until after the release > > branch is cut and install this on the master branch. Sorry, it really > > is too late for such changes. > > You're very gracious, but I think I've learned my lesson and will > refrain from pursuing any of these changes for Emacs 29. Apologies for > abusing your time and maintainerly patience (yet again). No need to apologize, this is software development. Thanks for working on these issues. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2022-11-29 14:36 ` Eli Zaretskii @ 2023-09-06 22:25 ` Stefan Kangas 2023-09-07 5:53 ` Eli Zaretskii 0 siblings, 1 reply; 24+ messages in thread From: Stefan Kangas @ 2023-09-06 22:25 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 53941, larsi, gnuhacker, J.P. 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. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 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. 0 siblings, 1 reply; 24+ messages in thread From: Eli Zaretskii @ 2023-09-07 5:53 UTC (permalink / raw) To: jp, Stefan Kangas; +Cc: larsi, 53941, gnuhacker > 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.? ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-09-07 5:53 ` Eli Zaretskii @ 2023-09-07 13:25 ` J.P. 2023-09-07 13:47 ` Stefan Kangas 2023-09-08 13:28 ` J.P. 0 siblings, 2 replies; 24+ messages in thread From: J.P. @ 2023-09-07 13:25 UTC (permalink / raw) To: Eli Zaretskii; +Cc: larsi, 53941, Stefan Kangas, gnuhacker [-- 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 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-09-07 13:25 ` J.P. @ 2023-09-07 13:47 ` Stefan Kangas 2023-09-08 2:55 ` J.P. 2023-09-08 13:28 ` J.P. 1 sibling, 1 reply; 24+ messages in thread From: Stefan Kangas @ 2023-09-07 13:47 UTC (permalink / raw) To: J.P., Eli Zaretskii; +Cc: larsi, 53941, gnuhacker "J.P." <jp@neverwas.me> writes: > 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. Thanks. The first two patches do add tests as well, so I can see some value in installing them separately, perhaps even right now. Even more so if it simplifies your work on the tasks you think are more important. ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 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. 0 siblings, 2 replies; 24+ messages in thread From: J.P. @ 2023-09-08 2:55 UTC (permalink / raw) To: Stefan Kangas; +Cc: Eli Zaretskii, 53941, larsi, gnuhacker Stefan Kangas <stefankangas@gmail.com> writes: > "J.P." <jp@neverwas.me> writes: > >> 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. > > Thanks. The first two patches do add tests as well, so I can see some > value in installing them separately, perhaps even right now. Even more > so if it simplifies your work on the tasks you think are more important. OK, nice. I'd also like to add at least one test case that simulates a realistic error condition (and maybe also a NEWS item for v4a, if that's considered a feature). If no one else has thoughts regarding the first two, I'll install them in a few days. (Congrats on your appointment, BTW.) ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-09-08 2:55 ` J.P. @ 2023-09-08 11:04 ` Stefan Kangas 2023-10-18 13:38 ` J.P. 1 sibling, 0 replies; 24+ messages in thread From: Stefan Kangas @ 2023-09-08 11:04 UTC (permalink / raw) To: J.P.; +Cc: Eli Zaretskii, 53941, larsi, gnuhacker "J.P." <jp@neverwas.me> writes: > OK, nice. I'd also like to add at least one test case that simulates a > realistic error condition (and maybe also a NEWS item for v4a, if that's > considered a feature). If no one else has thoughts regarding the first > two, I'll install them in a few days. Sounds good to me. > (Congrats on your appointment, BTW.) Thanks! ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 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. 1 sibling, 1 reply; 24+ messages in thread From: J.P. @ 2023-10-18 13:38 UTC (permalink / raw) To: Stefan Kangas; +Cc: Eli Zaretskii, 53941, larsi, gnuhacker "J.P." <jp@neverwas.me> writes: > Stefan Kangas <stefankangas@gmail.com> writes: > >> "J.P." <jp@neverwas.me> writes: >> >>> 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. >> >> Thanks. The first two patches do add tests as well, so I can see some >> value in installing them separately, perhaps even right now. Even more >> so if it simplifies your work on the tasks you think are more important. > > OK, nice. I'd also like to add at least one test case that simulates a > realistic error condition (and maybe also a NEWS item for v4a, if that's > considered a feature). If no one else has thoughts regarding the first > two, I'll install them in a few days. s/days/fortnights/ (Apologies for the delay. Done now.) ^ permalink raw reply [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-10-18 13:38 ` J.P. @ 2023-12-19 16:29 ` J.P. 0 siblings, 0 replies; 24+ messages in thread From: J.P. @ 2023-12-19 16:29 UTC (permalink / raw) To: 53941; +Cc: larsi, Eli Zaretskii, Stefan Kangas, gnuhacker [-- Attachment #1: Type: text/plain, Size: 5522 bytes --] In light of recent related activity on the development mailing list [1], I think it's worth summarizing where this bug stands, even though that discussion seems to favor other approaches that I personally have little interest in. As a reminder, this bug is about integrating the built-in `socks' and `url' libraries to make proxying specific connections over Tor mostly transparent and hassle free. As it stands, the two biggest blockers I can see are both heavy on the legwork side of things. The first and more daunting involves surveying how the `url' library is used in the wild when it comes to proxies: what interfaces people use and how that compares with what's prescribed in the manual and what was promised in the original design discussions. The goal would be to use these findings to enhance or overhaul the existing interface and behavior and to affirm the result as canon. This will likely involve reworking parts of the existing documentation and saturating affected parts of the library in comprehensive test coverage. It may also require central coordination to ensure interoperability among consuming libraries and continuity of purpose among future contributors. The second and IMO easier (but still labor-intensive) task is fleshing out and fortifying the actual networking implementation. What I propose is that we start by leveraging the built-in logging facility of torsocks itself [2]. By default, the verbose-level output is noisy but tolerable after minimal modifications (e.g., by commenting out the "close" and "fclose" statements). We'd need volunteers with access to the various platforms Emacs supports (capable of running a Tor daemon) to run through some contrived recipes, such as loading a site with `eww' and fetching a package from an ELPA endpoint. $ LD_PRELOAD=/home/me/torsocks/src/lib/.libs/libtorsocks.so \ TORSOCKS_LOG_FILE_PATH=/tmp/torsocks.log \ TORSOCKS_LOG_LEVEL=5 ./src/emacs -Q What we'd be looking for in the output is activity in those libc "GAI" functions shadowed by the program. While this methodology seems hokey, I think it's actually preferable (at least as a starting point) over more traditional tracing solutions because with the latter we'd still have to isolate the set of torsocks-shadowed functions in whatever recording is produced, and then filter out all the false positives from things like connect(2) calls for AF_LOCAL/AF_UNIX, which we don't care about. Moreover, these hand-crafted logs show us other niceties, like parameters of interest (socket type, hint flags, etc.), which makes sense because this program comes from the Tor Project itself and is well written. Anyway, once we have a solid idea of what needs intercepting and/or inhibiting [3], we'll need volunteers yet again, this time to help run packet traces against a prototype both for the proxied connection and for DNS leakage. Obviously, help from those familiar with the Emacs network stack would go a long way here. Anyway, the attached POC implementation is basically just a slightly cleaned up version of the same patch set I've been fiddling with this entire bug thread. WRT to the `url' side, I've done basically zero additional research, and the interface you see is just a "best guess" based on the current documentation and a cursory stroll around the library. As for the `socks' side, everything is based on observations from exactly one Emacs installation on one GNU/Linux machine. That it doesn't leak DNS (for me) should just be a data point. If others want to work on this or take over, please let me know. I encourage anyone with a similar setup (GNU/Linux, x86_64, modern libraries) to try them out. You'll need a Tor service running locally, preferably with the default configuration. The API is pretty basic and could be simplified even further. For now, it's (require 'socks) (require 'url) (setopt url-proxy-services '(("https" . "socks5h://localhost:9050") ("http" . "socks5h://localhost:9050")) socks-server '("tor" "localhost" 9050 5) socks-username "" socks-password "") then something like M-x eww RET https://check.torproject.org RET or M-x list-packages RET. [1] https://lists.gnu.org/archive/html/emacs-devel/2023-12/msg00570.html [2] https://gitlab.torproject.org/tpo/core/torsocks.git [3] Just to clarify a couple things I've personally found confusing, in case others may find them beneficial: If we only decide to support local proxies, we don't have to worry about DNS leakage for the proxy service itself. I've heard folks express concern about calls to getaddrinfo and, in particular, the async `:nowait' variant getaddrinfo_a (because torsocks AFAIK doesn't shadow it). But those won't come into play since our only connections through `make-network-process' are to the local proxy service. IOW, the actual remote lookup is tunneled, so the only calls we'll need to care about intercepting WRT DNS are those from `nsm-check' to `network-lookup-address-info'. (In the attached POC implementation, I simply reroute these through a tor-specific resolver.) The "onion cookie" bookkeeping business performed by torsocks is of no interest to us because we control the means of connection. IOW, at no point should an onion address (or that of a normal remote endpoint) be exposed to the underlying networking machinery. It's all just part of the opaque application data unit (payload). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v5-v6.diff --] [-- Type: text/x-patch, Size: 12515 bytes --] From a32e6d440e38b97090c9ae3fbf607ec71a49277e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Tue, 19 Dec 2023 07:08:36 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [POC] Support SOCKS resolve extension [POC] Simplify network-stream openers in socks.el [POC] Integrate the socks and url libraries lisp/net/nsm.el | 8 +- lisp/net/socks.el | 189 +++++++++++++++++++++++++++++++---- lisp/url/url-gw.el | 8 +- lisp/url/url-http.el | 19 ++-- lisp/url/url-methods.el | 8 +- lisp/url/url-proxy.el | 22 ++-- lisp/url/url-vars.el | 20 +++- test/lisp/net/socks-tests.el | 70 +++++++++++++ 8 files changed, 300 insertions(+), 44 deletions(-) Interdiff: diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 09f7ac52537..234a7c5e74a 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -220,6 +220,10 @@ nsm-network-same-subnet (aref mask i)))))) matches))) +(defvar nsm--network-lookup-address-function nil + "Function to replace `network-lookup-address-info' in nsm check. +It should have the same signature as the original.") + (defun nsm-should-check (host) "Determine whether NSM should check for TLS problems for HOST. @@ -227,7 +231,9 @@ nsm-should-check host address is a localhost address, or in the same subnet as one of the local interfaces, this function returns nil. Non-nil otherwise." - (let ((addresses (network-lookup-address-info host)) + (let ((addresses (if nsm--network-lookup-address-function + (funcall nsm--network-lookup-address-function host) + (network-lookup-address-info host))) (network-interface-list (network-interface-list t)) (off-net t)) (when diff --git a/lisp/net/socks.el b/lisp/net/socks.el index a04f93e0960..8d16db75834 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -554,6 +557,9 @@ socks-proxied-tls-services (process host port &optional save-fingerprint warn-unencrypted)) +(defvar socks-server-name-as-tor-service-regexp (rx bow "tor" eow) + "Regexp to determine if a `socks-server' entry is TOR service.") + ;;;###autoload (defun socks-open-network-stream (name buffer host service &rest params) "Open and return a connection, possibly proxied over SOCKS. @@ -579,17 +585,18 @@ socks-open-network-stream (let* ((url (and (url-p url-using-proxy) (string-prefix-p "socks" (url-type url-using-proxy)) url-using-proxy)) + (server-name (and url (string= (nth 1 socks-server) (url-host url)) + (= (nth 2 socks-server) (url-port url)) + (car socks-server))) (socks-server (if url - (list name (url-host url) (url-port url) + (list server-name (url-host url) (url-port url) (pcase (url-type url) ("socks4" 4) ("socks4a" '4a) (_ 5))) socks-server)) - (socks-username (or (and url (url-user url)) - socks-username)) - (socks-password (or (and url (url-password url)) - socks-password))) + (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) @@ -597,15 +604,20 @@ socks-open-network-stream (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)))) + (when (and (memq port socks-proxied-tls-services) + (gnutls-available-p) + (require 'gnutls nil t) + (require 'nsm nil t)) + (defvar nsm--network-lookup-address-function) + (let ((nsm--network-lookup-address-function + (and (string-match socks-server-name-as-tor-service-regexp + (car socks-server)) + #'socks-tor-resolve))) + (gnutls-negotiate :process proc + :hostname host + :keylist (and certs (list certs))) + (unless (string-suffix-p ".onion" host) + (nsm-verify-connection proc host port)))) proc) (apply socks-connect-function name buffer host service params)))) @@ -724,6 +736,72 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (when-let ((response (process-get proc 'socks-response))) + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (and-let* (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks--tor-resolve (name &optional _family _flags) + (condition-case err + (if-let ((socks-password (or socks-password "")) + (route (socks-find-route name nil)) + (proc (socks-send-command (socks-open-connection route) + socks-resolve-command + socks-address-type-name + name + 0)) + (ip (prog1 (socks--extract-resolve-response proc) + (delete-process proc)))) + (list (vconcat ip [0])) + (error "Failed to resolve %s" name)) + (error + (unless (member (cadr err) + '("SOCKS: Host unreachable" "SOCKS: Rejected or failed")) + (signal (car err) (cdr err)))))) + +(defvar socks--tor-resolve-cache nil) + +(defun socks-tor-resolve (name &optional _family _flags) + "Return list with a single IPv4 address for domain NAME. +Return nil on failure. + +See `network-lookup-address-info' for format of return value. As +of 0.4.8.9, TOR's resolution service does not support IPv6. +SOCKS server must support the Tor RESOLVE command. Note that +this function exists for novelty purposes only. Using it in +place of `network-lookup-address-info' or similar may not prevent +DNS leaks." + (unless (string-match (rx bot (+ ascii) eot) name) + (require 'puny) + (setq name (puny-encode-domain name))) + ;; FIXME use some kind of LRU here. Currently resets at 5 min. + (if socks--tor-resolve-cache + (when (time-less-p (car socks--tor-resolve-cache) (current-time)) + (clrhash (cdr socks--tor-resolve-cache))) + (setq socks--tor-resolve-cache (cons (time-add (* 60 5) (current-time)) + (make-hash-table :test #'equal)))) + (with-memoization (gethash name (cdr socks--tor-resolve-cache)) + (socks--tor-resolve name))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 1a4bac37bf9..cc9f5a385d2 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -327,4 +327,74 @@ socks-override-functions (should-not (advice-member-p #'socks--open-network-stream 'open-network-stream))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-4a-fail () + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should-not (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5-fail () + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "") + (socks-authentication-methods (copy-sequence + socks-authentication-methods)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 0 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 4 0 0 0 0 0 0 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should-not (socks-tor-resolve "example.com"))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.42.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Support-SOCKS-resolve-extension.patch --] [-- Type: text/x-patch, Size: 8387 bytes --] From d7cca6703475b8bcdf523407383a813ec3749fad 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/3] [POC] Support SOCKS resolve extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the RESOLVE command, a nonstandard SOCKS extension from the Tor project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see doc/socks/socks-extensions.txt in the source tree for torsocks. This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. * test/lisp/net/socks-tests.el (tor-resolve-4a, tor-resolve-4a-fail, tor-resolve-5-fail, tor-resolve-5): (Bug#53941.) --- lisp/net/socks.el | 69 +++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 70 ++++++++++++++++++++++++++++++++++++ 2 files changed, 139 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index e572e5c9bdf..4c4eb8cf751 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -655,6 +658,72 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (when-let ((response (process-get proc 'socks-response))) + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (and-let* (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks--tor-resolve (name &optional _family _flags) + (condition-case err + (if-let ((socks-password (or socks-password "")) + (route (socks-find-route name nil)) + (proc (socks-send-command (socks-open-connection route) + socks-resolve-command + socks-address-type-name + name + 0)) + (ip (prog1 (socks--extract-resolve-response proc) + (delete-process proc)))) + (list (vconcat ip [0])) + (error "Failed to resolve %s" name)) + (error + (unless (member (cadr err) + '("SOCKS: Host unreachable" "SOCKS: Rejected or failed")) + (signal (car err) (cdr err)))))) + +(defvar socks--tor-resolve-cache nil) + +(defun socks-tor-resolve (name &optional _family _flags) + "Return list with a single IPv4 address for domain NAME. +Return nil on failure. + +See `network-lookup-address-info' for format of return value. As +of 0.4.8.9, TOR's resolution service does not support IPv6. +SOCKS server must support the Tor RESOLVE command. Note that +this function exists for novelty purposes only. Using it in +place of `network-lookup-address-info' or similar may not prevent +DNS leaks." + (unless (string-match (rx bot (+ ascii) eot) name) + (require 'puny) + (setq name (puny-encode-domain name))) + ;; FIXME use some kind of LRU here. Currently resets at 5 min. + (if socks--tor-resolve-cache + (when (time-less-p (car socks--tor-resolve-cache) (current-time)) + (clrhash (cdr socks--tor-resolve-cache))) + (setq socks--tor-resolve-cache (cons (time-add (* 60 5) (current-time)) + (make-hash-table :test #'equal)))) + (with-memoization (gethash name (cdr socks--tor-resolve-cache)) + (socks--tor-resolve name))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 1a4bac37bf9..cc9f5a385d2 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -327,4 +327,74 @@ socks-override-functions (should-not (advice-member-p #'socks--open-network-stream 'open-network-stream))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-4a-fail () + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should-not (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5-fail () + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "") + (socks-authentication-methods (copy-sequence + socks-authentication-methods)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 0 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 4 0 0 0 0 0 0 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should-not (socks-tor-resolve "example.com"))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.42.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-POC-Simplify-network-stream-openers-in-socks.el.patch --] [-- Type: text/x-patch, Size: 9346 bytes --] From dd72b020f3ceca191f2d18d16253501d16ed582b 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 2/3] [POC] Simplify network-stream openers in socks.el * lisp/net/nsm.el (nsm--network-lookup-address-function): New function-valued variable to override `network-lookup-address-info' during nsm checks. (nsm-should-check): Defer to `nsm--network-lookup-address-function' to resolve hosts when non-nil. * 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/nsm.el | 8 +++- lisp/net/socks.el | 120 ++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 106 insertions(+), 22 deletions(-) diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 09f7ac52537..234a7c5e74a 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -220,6 +220,10 @@ nsm-network-same-subnet (aref mask i)))))) matches))) +(defvar nsm--network-lookup-address-function nil + "Function to replace `network-lookup-address-info' in nsm check. +It should have the same signature as the original.") + (defun nsm-should-check (host) "Determine whether NSM should check for TLS problems for HOST. @@ -227,7 +231,9 @@ nsm-should-check host address is a localhost address, or in the same subnet as one of the local interfaces, this function returns nil. Non-nil otherwise." - (let ((addresses (network-lookup-address-info host)) + (let ((addresses (if nsm--network-lookup-address-function + (funcall nsm--network-lookup-address-function host) + (network-lookup-address-info host))) (network-interface-list (network-interface-list t)) (off-net t)) (when diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 4c4eb8cf751..8d16db75834 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -34,7 +34,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'cl-lib) (require 'url-parse)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Custom widgets @@ -338,14 +338,20 @@ socks-override-functions (when socks-override-functions (advice-add 'open-network-stream :around #'socks--open-network-stream)) -(defun socks-open-connection (server-info) +(defvar socks-connect-function #'open-network-stream + "Function to open a network connection to a SOCKS provider. +Called with arguments suitable for `open-network-stream'.") + +(defun socks-open-connection (server-info &rest stream-params) + "Create and initialize a SOCKS process. +Perform authentication if needed. Expect SERVER-INFO to resemble +`socks-server' and STREAM-PARAMS to be keyword parameters +accepted by `open-network-stream'." (save-excursion (let ((proc (let ((socks-override-functions nil)) - (open-network-stream "socks" - nil - (nth 1 server-info) - (nth 2 server-info)))) + (apply socks-connect-function (nth 0 server-info) nil + (nth 1 server-info) (nth 2 server-info) stream-params))) (authtype nil) version) @@ -531,22 +537,94 @@ socks-find-services-entry (gethash (downcase service) (if udp socks-udp-services socks-tcp-services))) -(defun socks-open-network-stream (name buffer host service) - (let ((socks-override-functions t)) - (socks--open-network-stream - (lambda (&rest args) - (let ((socks-override-functions nil)) - (apply #'open-network-stream args))) - name buffer host service))) - (defun socks--open-network-stream (orig-fun name buffer host service &rest params) - (let ((route (and socks-override-functions - (socks-find-route host service)))) - (if (not route) - (apply orig-fun name buffer host service params) - ;; FIXME: Obey `params'! - (let* ((proc (socks-open-connection route)) - (version (process-get proc 'socks-server-protocol)) + "Call `socks-open-network-stream', falling back to ORIG-FUN. +Expect NAME, BUFFER, HOST, SERVICE, and PARAMS to be compatible +with `open-network-stream'." + (let ((socks-connect-function orig-fun)) + (apply (if socks-override-functions #'socks-open-network-stream orig-fun) + name buffer host service params))) + +(defcustom socks-proxied-tls-services '(443 6697) + "Ports whose connections should use TLS. +Note that the system resolver may be consulted to look up host +names for checking domain validation certs." + :version "30.1" + :type '(repeat number)) + +(declare-function gnutls-negotiate "gnutls" (&rest rest)) +(declare-function nsm-verify-connection "nsm" + (process host port &optional + save-fingerprint warn-unencrypted)) + +(defvar socks-server-name-as-tor-service-regexp (rx bow "tor" eow) + "Regexp to determine if a `socks-server' entry is TOR service.") + +;;;###autoload +(defun socks-open-network-stream (name buffer host service &rest params) + "Open and return a connection, possibly proxied over SOCKS. +Expect PARAMS to contain keyword parameters recognized by +`open-network-stream'. Assume HOST and SERVICE refer to the +proxied remote peer rather than the SOCKS server, but assume the +opposite for PARAMS. That is, if PARAMS contains a `:type' of +`tls', treat the underlying connection to the proxy server as +destined for encryption rather than the tunneled connection (even +though `socks-connect-function' has the final say). For TLS with +proxied connections, see the option `socks-proxied-tls-services'. + +Before connecting, check the HOST against `socks-noproxy'. On +rejection, fall back to a non-SOCKS connection determined by +the variable `socks-connect-function'. + +But, before doing anything, check if `url-using-proxy' is bound +to a `url' struct object, as defined in `url-parse'. If so, +assume it represents the address of the desired SOCKS server +rather than that of the remote peer, and use its fields instead +of `socks-server' for all SOCKS connection details." + (require 'url-parse) + (let* ((url (and (url-p url-using-proxy) + (string-prefix-p "socks" (url-type url-using-proxy)) + url-using-proxy)) + (server-name (and url (string= (nth 1 socks-server) (url-host url)) + (= (nth 2 socks-server) (url-port url)) + (car socks-server))) + (socks-server (if url + (list server-name (url-host url) (url-port url) + (pcase (url-type url) + ("socks4" 4) + ("socks4a" '4a) + (_ 5))) + socks-server)) + (socks-username (or (and url (url-user url)) socks-username)) + (socks-password (or (and url (url-password url)) socks-password))) + (if-let ((route (socks-find-route host service)) + (proc (apply #'socks-open-connection route params))) + (let ((port (if (numberp service) + service + (process-contact proc :service))) + (certs (plist-get params :client-certificate))) + (socks--initiate-command-connect proc buffer host service) + (when (and (memq port socks-proxied-tls-services) + (gnutls-available-p) + (require 'gnutls nil t) + (require 'nsm nil t)) + (defvar nsm--network-lookup-address-function) + (let ((nsm--network-lookup-address-function + (and (string-match socks-server-name-as-tor-service-regexp + (car socks-server)) + #'socks-tor-resolve))) + (gnutls-negotiate :process proc + :hostname host + :keylist (and certs (list certs))) + (unless (string-suffix-p ".onion" host) + (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.42.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-POC-Integrate-the-socks-and-url-libraries.patch --] [-- Type: text/x-patch, Size: 10475 bytes --] From a32e6d440e38b97090c9ae3fbf607ec71a49277e 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 3/3] [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. Current API (only known to work on GNU/Linux): (require 'socks) (require 'url) (setopt url-proxy-services '(("https" . "socks5h://localhost:9050") ("http" . "socks5h://localhost:9050")) socks-server '("tor" "localhost" 9050 5) socks-username "" socks-password "") Then do something like M-x eww https://check.torproject.org RET or M-x list-packages RET. * 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 947c6517ed1..abe2649a474 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -195,12 +195,7 @@ url-http-find-free-connection ;; like authentication. But we use another buffer afterwards. (unwind-protect (let ((proc (url-open-stream host buf - (if url-using-proxy - (url-host url-using-proxy) - host) - (if url-using-proxy - (url-port url-using-proxy) - port) + host port gateway-method))) ;; url-open-stream might return nil. (when (processp proc) @@ -1392,8 +1387,12 @@ url-http (error "Could not create connection to %s:%d" (url-host url) (url-port url))) (_ - (if (and url-http-proxy (string= "https" - (url-type url-current-object))) + (if (and url-http-proxy + ;; Set to "http" by `url-find-proxy-for-url' for + ;; any matching non-blacklisted, non-SOCKS scheme + ;; in `url-proxy-services', including "https". + (equal "http" (url-type url-http-proxy)) + (string= "https" (url-type url-current-object))) (url-https-proxy-connect connection) (set-process-sentinel connection #'url-http-end-of-document-sentinel) @@ -1475,7 +1474,9 @@ url-http-async-sentinel (url-http-end-of-document-sentinel proc why)) ((string= (substring why 0 4) "open") (setq url-http-connection-opened t) - (if (and url-http-proxy (string= "https" (url-type url-current-object))) + (if (and url-http-proxy + (equal "http" (url-type url-http-proxy)) + (string= "https" (url-type url-current-object))) (url-https-proxy-connect proc) (condition-case error (process-send-string proc (url-http-create-request)) diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index 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 6d7d0d3c94c..ba219905fde 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -194,10 +194,24 @@ url-mail-command :type 'function :group 'url) +(defvar url-proxy-full-address-types + '("socks" "socks5" "socks5h" "socks4" "socks4a") + "Schemes for URL types preserved in `url-proxy-services' entries. +When dynamically adding a new `url-proxy-services' entry derived +from the environment, Emacs only retains the host and port +portions unless the URL's scheme appears in this variable's +value.") + (defcustom url-proxy-services nil "An alist of schemes and proxy servers that gateway them. Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up -from the ACCESS_proxy environment variables." +from the ACCESS_proxy environment variables. Certain gateway +types need server values to take the form of full URLs in order +to convey addtional information about for the proxy connection +itself, for example, SCHEME://USER@HOSTNAME:PORTNUMBER, in which +SCHEME is something like \"socks5\". As of Emacs 30.1, this only +applies to SCHEMEs appearing in the variable +`url-proxy-full-address-types'." :type '(repeat (cons :format "%v" (string :tag "Protocol") (string :tag "Proxy"))) @@ -315,7 +329,9 @@ url-show-status (defvar url-using-proxy nil "Either nil or the fully qualified proxy URL in use, e.g. -https://www.example.com/") +https://www.example.com/. 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.42.0 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-09-07 13:25 ` J.P. 2023-09-07 13:47 ` Stefan Kangas @ 2023-09-08 13:28 ` J.P. 2023-09-09 14:05 ` J.P. 1 sibling, 1 reply; 24+ messages in thread From: J.P. @ 2023-09-08 13:28 UTC (permalink / raw) To: 53941; +Cc: larsi, gnuhacker, Eli Zaretskii, Stefan Kangas [-- Attachment #1: Type: text/plain, Size: 823 bytes --] "J.P." <jp@neverwas.me> writes: > 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. Just a tiny update to the POC `url' integration stuff in case anyone ever tries it. Previously, when connecting to a .onion domain over TLS, e.g., https://www.dwnewsgngmhlplxy6o2twtfgjnrnjxbegbwqx6wnotdhkzt562tszfid.onion/en/ you'd get spammed with "name or service unknown" messages in the echo area with every EWW link clicked (at least on GNU Linux, probably from something like GAI EAI_NONAME). Anyway, no longer. Also added a test, a news entry, and some doc tweaks. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v3-v4.diff --] [-- Type: text/x-patch, Size: 9220 bytes --] From 97f2cb52b73d5c0bd7409044fef5469b914a9ec9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 8 Sep 2023 06:06:35 -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 | 16 ++-- lisp/url/url-proxy.el | 18 ++++- lisp/url/url-vars.el | 11 ++- test/lisp/net/socks-tests.el | 84 ++++++++++++++++----- 8 files changed, 231 insertions(+), 62 deletions(-) Interdiff: 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 1bb78113d52..f5820e7968c 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -444,7 +444,7 @@ socks-send-command (ash port -8) ; port, high byte (logand port #xff)) ; port, low byte addr ; address - (user-full-name) ; username + socks-username ; username "\0" ; terminate username trailing))) ; optional host to look up ((equal version 5) @@ -582,8 +582,8 @@ socks-open-network-stream (socks-server (if url (list name (url-host url) (url-port url) (pcase (url-type url) - ("socks4://" 4) - ("socks4a://" '4a) + ("socks4" 4) + ("socks4a" '4a) (_ 5))) socks-server)) (socks-username (or (and url (url-user url)) @@ -604,9 +604,9 @@ 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)) + (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) diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index 1a278bb1673..c9c5a7aacac 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -37,13 +37,11 @@ url-default-find-proxy-for-url host)) (equal "www" (url-type urlobj))) "DIRECT") - ((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) + ((and-let* ((found (assoc (url-type urlobj) url-proxy-services))) + (concat (if (string-match url-proxy--socks-scheme-regexp (cdr found)) "SOCKS " "PROXY ") - found))) + (cdr found)))) ;; ;; Should check for socks ;; @@ -65,8 +63,8 @@ url-find-proxy-for-url ((string-match "^PROXY +" proxy) (concat "http://" (substring proxy (match-end 0)) "/")) ((string-match "^SOCKS +" proxy) - (if-let* ((m (substring proxy (match-end 0))) - ((string-match url-proxy--socks-scheme-regexp m))) + (if-let ((m (substring proxy (match-end 0))) + ((string-match url-proxy--socks-scheme-regexp m))) m (concat "socks://" m))) (t diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index df69fb2f5cf..1a4bac37bf9 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -139,7 +139,7 @@ socks-tests-canned-server-create (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)) @@ -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,23 +206,34 @@ 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") - (cl-letf (((symbol-function 'user-full-name) - (lambda (&optional _) "foo"))) - (socks-tests-perform-hello-world-http-request))))) + (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: @@ -309,12 +321,9 @@ 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))) -- 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: 7651 bytes --] From 97f2cb52b73d5c0bd7409044fef5469b914a9ec9 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, 38 insertions(+), 15 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..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..c9c5a7aacac 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) @@ -34,8 +37,11 @@ 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)))) + ((and-let* ((found (assoc (url-type urlobj) url-proxy-services))) + (concat (if (string-match url-proxy--socks-scheme-regexp (cdr found)) + "SOCKS " + "PROXY ") + (cdr found)))) ;; ;; Should check for socks ;; @@ -57,7 +63,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 +81,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..87dfdb9916c 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 ^ permalink raw reply related [flat|nested] 24+ messages in thread
* bug#53941: 27.2; socks + tor dont work with https 2023-09-08 13:28 ` J.P. @ 2023-09-09 14:05 ` J.P. 0 siblings, 0 replies; 24+ messages in thread From: J.P. @ 2023-09-09 14:05 UTC (permalink / raw) To: 53941; +Cc: larsi, gnuhacker, Eli Zaretskii, Stefan Kangas [-- 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 ^ permalink raw reply related [flat|nested] 24+ messages in thread
end of thread, other threads:[~2023-12-19 16:29 UTC | newest] Thread overview: 24+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 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 ` bug#53941: Last-minute socks.el improvements for Emacs 29? J.P. 2022-11-28 17:12 ` 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.
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.