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: Tue, 01 Mar 2022 06:29:49 -0800 [thread overview]
Message-ID: <87pmn5n3tu.fsf@neverwas.me> (raw)
In-Reply-To: <87k0do5km1.fsf@neverwas.me> (J. P.'s message of "Mon, 21 Feb 2022 07:01:58 -0800")
[-- 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
next prev parent reply other threads:[~2022-03-01 14:29 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. [this message]
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.
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=87pmn5n3tu.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).