From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#53941: 27.2; socks + tor dont work with https Date: Tue, 01 Mar 2022 18:37:16 -0800 Message-ID: <87mti99j1f.fsf@neverwas.me> References: <87pmntfym7.fsf@example.com> <8735kl1v58.fsf@neverwas.me> <87a6emftzx.fsf@example.com> <87k0do5km1.fsf@neverwas.me> <87pmn5n3tu.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="17045"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: Jacobo To: 53941@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Mar 02 03:38:18 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nPEsb-0004EW-HB for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 02 Mar 2022 03:38:17 +0100 Original-Received: from localhost ([::1]:45026 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nPEsa-0007v5-3W for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 01 Mar 2022 21:38:16 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:43928) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nPEsM-0007ur-Rd for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 21:38:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:44823) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nPEsM-0004BO-I5 for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 21:38:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nPEsM-0001T2-8a for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 21:38:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 02 Mar 2022 02:38:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53941 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 53941-submit@debbugs.gnu.org id=B53941.16461886575602 (code B ref 53941); Wed, 02 Mar 2022 02:38:02 +0000 Original-Received: (at 53941) by debbugs.gnu.org; 2 Mar 2022 02:37:37 +0000 Original-Received: from localhost ([127.0.0.1]:38720 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nPErt-0001SC-Pe for submit@debbugs.gnu.org; Tue, 01 Mar 2022 21:37:37 -0500 Original-Received: from mail-108-mta130.mxroute.com ([136.175.108.130]:35873) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nPErr-0001Rx-HI for 53941@debbugs.gnu.org; Tue, 01 Mar 2022 21:37:32 -0500 Original-Received: from filter006.mxroute.com ([140.82.40.27] 140.82.40.27.vultr.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta130.mxroute.com (ZoneMTA) with ESMTPSA id 17f487d3c7d0005a20.001 for <53941@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Wed, 02 Mar 2022 02:37:21 +0000 X-Zone-Loop: f59c6fe4143e200293f5a4d0b1fa812f35b3a50cf18c X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=Z5Z6pLBgpsbZfN4oq1RpXEKLQC+TYkRMfKTvniQYR4s=; b=nJqFmZbBm5htBMzLCsoqPiTNX5 7vjCP1peDxKOskhXLWmdq32gDGNGXVozJC+riaXJ7tjtl4ndVNjxMDLddzBd2aFA5OD9E82dSTvOY YWRypC5OwOsC8n9PHMEpQ6BFKGKQ490SwrDs1kVRDK3JU9vghSPle5T80Rg51n6qBmehUaSFOKYLy cLhQwgPpJnqrcs7kUSLp6nXej1TCG12y7kzGl/piYwAYa1O8M0DheP947O9xOF9Yx/sp2aKIv5DZg ZBb7iQ0DcqEV8SWVQTnjlxkT+4xBgAXdeW6aCfu7vQhmgrgMxpvW/YgItdtZU2K3XSKtsZ/VxGNP4 5GxAixRA==; In-Reply-To: <87pmn5n3tu.fsf@neverwas.me> (J. P.'s message of "Tue, 01 Mar 2022 06:29:49 -0800") X-AuthUser: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:227903 Archived-At: --=-=-= Content-Type: text/plain 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}'). --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-NOT-A-PATCH-v2-v3.diff >From 45be9bbb941e91efe9dacf1b3c34d4d362593d53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Simplify-network-stream-opener-in-socks.el.patch >From 90247189d5fe90619f00ef3319012df0f6f6688e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Fix-string-encoding-bug-in-socks-tests.patch >From 181548ce7f931fedd66e243632c42c5c51af640e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Add-support-for-SOCKS-4a.patch >From db601f1fcbaf5cf088b280966cbac2808a773ee0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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)) 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Support-SOCKS-resolve-extension.patch >From 67ba3f6e6fcb12b99757fcc49f86f951ad59c02b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-POC-Demo-SOCKS-resolve-with-HTTPS.patch >From 45be9bbb941e91efe9dacf1b3c34d4d362593d53 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-=--