From: "J.P." <jp@neverwas.me>
To: Jacobo <gnuhacker@member.fsf.org>
Cc: 53941@debbugs.gnu.org
Subject: bug#53941: 27.2; socks + tor dont work with https
Date: Thu, 10 Mar 2022 00:58:42 -0800 [thread overview]
Message-ID: <87lexikwu5.fsf@neverwas.me> (raw)
In-Reply-To: <8735ju44sk.fsf@neverwas.me> (J. P.'s message of "Sun, 06 Mar 2022 23:09:47 -0800")
[-- 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
next prev parent reply other threads:[~2022-03-10 8:58 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-02-11 11:09 bug#53941: 27.2; socks + tor dont work with https Jacobo
2022-02-14 12:37 ` J.P.
2022-02-19 21:04 ` Jacobo
2022-02-21 15:01 ` J.P.
2022-03-01 14:29 ` J.P.
2022-03-02 2:37 ` J.P.
2022-03-06 2:40 ` Jacobo
2022-03-06 2:58 ` J.P.
2022-03-07 7:09 ` J.P.
2022-03-10 8:58 ` J.P. [this message]
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.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87lexikwu5.fsf@neverwas.me \
--to=jp@neverwas.me \
--cc=53941@debbugs.gnu.org \
--cc=gnuhacker@member.fsf.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).