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 06:29:49 -0800 Message-ID: <87pmn5n3tu.fsf@neverwas.me> References: <87pmntfym7.fsf@example.com> <8735kl1v58.fsf@neverwas.me> <87a6emftzx.fsf@example.com> <87k0do5km1.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="21301"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: 53941@debbugs.gnu.org To: Jacobo Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Mar 01 15:38:21 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 1nP3dt-0005MF-O8 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 01 Mar 2022 15:38:21 +0100 Original-Received: from localhost ([::1]:57330 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nP3ds-0004N0-S2 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 01 Mar 2022 09:38:20 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:43014) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nP3Wp-0007gn-4O for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 09:31:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:42022) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nP3Wo-0001so-R0 for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 09:31:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nP3Wo-0003pI-JG for bug-gnu-emacs@gnu.org; Tue, 01 Mar 2022 09:31: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: Tue, 01 Mar 2022 14:31: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.164614500914568 (code B ref 53941); Tue, 01 Mar 2022 14:31:02 +0000 Original-Received: (at 53941) by debbugs.gnu.org; 1 Mar 2022 14:30:09 +0000 Original-Received: from localhost ([127.0.0.1]:35918 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nP3Vu-0003mq-3N for submit@debbugs.gnu.org; Tue, 01 Mar 2022 09:30:09 -0500 Original-Received: from mail-108-mta15.mxroute.com ([136.175.108.15]:39339) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nP3Vq-0003ly-03 for 53941@debbugs.gnu.org; Tue, 01 Mar 2022 09:30:05 -0500 Original-Received: from filter006.mxroute.com ([140.82.40.27] 140.82.40.27.vultr.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta15.mxroute.com (ZoneMTA) with ESMTPSA id 17f45e338e00005a20.001 for <53941@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Tue, 01 Mar 2022 14:29:53 +0000 X-Zone-Loop: 79703327aa60909ab55ae994c6fa01a522f9c1064320 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=woorlDzlTwh0zTEf0re8lScUuF36Ls4pYn9sbPnEJZk=; b=ZtsPCdeDutK87cD+dSAXKFDy3G VyQazXoR65gED0ag1WUaEI15UOuHfb1WowRRcRIGDwYJRk6ojrrlG6fHks4ZacDf5IZeCvhT9+Y4g X6XG3xbYvypm7/EiUjfjRk2USMTTps+MlbdNwskFpom4dBCHWR+rJn3MBP+UYgNaD62QkfITrI8PK csKjTdFEd3OhmkB1SlYhtH1+XLJZlkQksWvoaWM9WZb4TqqElXaYV4vonzJXxGGglOlG7k/XLfuCN mtjte7ZWEERFey2x+MC76VPQPXrbHj6AJ5ZuD9P+sKM8aQ7FaZqkDDJq8lLshj4RWNmwCff/AgEnF uAmEEc2Q==; In-Reply-To: <87k0do5km1.fsf@neverwas.me> (J. P.'s message of "Mon, 21 Feb 2022 07:01:58 -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:227866 Archived-At: --=-=-= Content-Type: text/plain v2. Minor corrections (another bug in existing test, etc.). --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-NOT-A-PATCH-v1-v2.diff >From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Simplify-network-stream-opener-in-socks.el.patch >From e1b377ee054f95a4f2064eef6972d350f69767f3 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): 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Fix-string-encoding-bug-in-socks-tests.patch >From 8f33588517c7333d3bd08375c406cd46726b51d6 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 b90a6474b6edb4dd33cffa0e05f1a7f1a3e1c9be 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 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)) 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 23a430c6d7fb2707dba7e217f279ba293ae2fce6 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 | 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-POC-Demo-SOCKS-RESOLVE-over-HTTPS.patch >From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 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 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 --=-=-=--