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: Sun, 06 Mar 2022 23:09:47 -0800 Message-ID: <8735ju44sk.fsf@neverwas.me> References: <87pmntfym7.fsf@example.com> <8735kl1v58.fsf@neverwas.me> <87a6emftzx.fsf@example.com> <87k0do5km1.fsf@neverwas.me> <87pmn5n3tu.fsf@neverwas.me> <87mti99j1f.fsf@neverwas.me> <87wnh7hkgi.fsf@gnu.org> <87pmmz947k.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="38292"; 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 Mon Mar 07 08:17:31 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 1nR7cX-0009jF-TR for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 07 Mar 2022 08:17:30 +0100 Original-Received: from localhost ([::1]:50198 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nR7cW-0000nY-Tq for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 07 Mar 2022 02:17:28 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:33462) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nR7WK-0001NF-EH for bug-gnu-emacs@gnu.org; Mon, 07 Mar 2022 02:11:05 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58412) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nR7WJ-0001rp-1t for bug-gnu-emacs@gnu.org; Mon, 07 Mar 2022 02:11:04 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nR7WI-0007Ic-LI for bug-gnu-emacs@gnu.org; Mon, 07 Mar 2022 02:11: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: Mon, 07 Mar 2022 07:11: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.164663700327982 (code B ref 53941); Mon, 07 Mar 2022 07:11:02 +0000 Original-Received: (at 53941) by debbugs.gnu.org; 7 Mar 2022 07:10:03 +0000 Original-Received: from localhost ([127.0.0.1]:52309 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nR7VH-0007Gp-Pd for submit@debbugs.gnu.org; Mon, 07 Mar 2022 02:10:03 -0500 Original-Received: from mail-108-mta39.mxroute.com ([136.175.108.39]:36187) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nR7VE-0007Gb-J6 for 53941@debbugs.gnu.org; Mon, 07 Mar 2022 02:09:58 -0500 Original-Received: from filter006.mxroute.com ([140.82.40.27] 140.82.40.27.vultr.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta39.mxroute.com (ZoneMTA) with ESMTPSA id 17f63367f5e000763e.001 for <53941@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Mon, 07 Mar 2022 07:09:50 +0000 X-Zone-Loop: a370af079bc3f99dec2512fd261ef6f3cf6a4ca08cee 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=tRomcL8oFkO2u8/kq+xXxgM4ohDhRdaBq7krMZKUF5M=; b=IQKhQuZuC6Ex4rX9QvIzWTO8ZK /BLUXWQUbrc0hmsKGrON+CJxDmC2dO58bY6N5v5Zjrzxfi7s+FeEDouuHscC8RrxowuH/9IKcIPg9 Yt5AUvPEAgo3akvNmwqF0dRQsNhEZD1gyznSP7TzOH4klmFcKpUvcTOuNeGjI+sj8LpiAq9GntHcy G/ceyCbskKf0avg3uS1Nub6k0dPUjAm6uLLngEzEibk5aizTVIhBsshQvC/k43yxPzg41kaMu+ImB Gm5v4LXxbrSTC7DMt07QQMXFosl4aXc8sie/7JDvNbATbMPTxisBOEoSqFh5p+r0Kl8zQeSmHlVjy Yk4cYeMA==; In-Reply-To: <87pmmz947k.fsf@neverwas.me> (J. P.'s message of "Sat, 05 Mar 2022 18:58:55 -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:228094 Archived-At: --=-=-= Content-Type: text/plain v4. Include a minimal (hacky[1]) url-gw integration. I'm now slightly of the opinion that offering no interface whatsoever is probably too stark an approach. Ignoring the three Tor-related patches for now, it seems that even without proper url.el integration[2], we can still try to ensure that for most use cases, no unnecessary hackery need apply. Another issue is whether to address the questionable top-level advising going on with `open-network-streams', since we're already refactoring all the functions it affects. Assuming users exist who still have `socks-override-functions' non-nil at load time, would it make sense to warn them more fervently than would be done for a normal deprecation? The thinking is that folks may be relying on this for things like bypassing firewalls at work (and could therefore get dinged more than usual just for upgrading Emacs). As a start, I figured we could try and determine exactly why this (perhaps somewhat ill-considered) top-level advising was ever instituted in the first place[3]. AFAICT, it was mainly intended to 1. allow libraries calling `open-network-stream' (and unaware of `socks-open-network-stream') to proxy transparently[4] 2. guard the tunneled protocol from being accidentally subject to a recommencing of the SOCKS dialog If anyone has better ideas, please share. Thanks. Notes ~~~~~ [1] The second patch is new and a bit of an ugly hack. It has to do with this change from a while back: Do not set `url-gateway-method' in `url-https' commit 98c58df832975b01287ef749dd5235199d4cd431 Sun Sep 28 20:00:54 2014 +0200 which made it impossible for `url-gateway-method' to be respected by `url-open-stream' when called by `url-https'. But rather than undoing the offending portions out of hand, it might be nicer to first figure out how url-proxy.el is supposed to work and maybe get it and `url-retrieve-internal' (and `url-https') more in sync and sensitive to `url-gateway-method'. [2] If we do end up with a proper url.el solution, it might then make more sense to emphasize the fact that `socks-open-network-stream' is really mostly about catering to url-gw (which it is). If that's agreeable, we could rename the following like so: socks-open-network-stream -> socks-url-open socks-open-network-stream-legacy -> socks-open-network-stream socks-open-network-stream-function -> socks-url-open-function [3] A summary of the advice-based behavior triggered by `socks-override-functions', assuming `socks-find-route' returns non-nil: | topmost function invoked | o-n-s advised | s-o-f | proxied | |---------------------------+---------------+-------+---------| | socks-open-network-stream | nil | t | yes | | socks-open-network-stream | nil | nil | yes | | socks-open-network-stream | t | t | yes | | socks-open-network-stream | t | nil | yes | | open-network-stream | nil | t | no | | open-network-stream | nil | nil | no | | open-network-stream | t | nil | no | | open-network-stream | t | t | yes | o-n-s: open-network-stream s-o-f: socks-override-functions [4] It could be argued that the 2014 commit in [1] converted gw into one such library insofar as `url-https' is concerned. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-NOT-A-PATCH-v3-v4.diff >From 62062472fd14dc9911a105016badcc921d63ae95 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 6 Mar 2022 21:21:49 -0800 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): Simplify network-stream opener in socks.el ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS resolve extension [POC] Demo SOCKS resolve with HTTPS lisp/net/socks.el | 145 ++++++++++++++++++++++++++++------- lisp/url/url-gw.el | 2 + test/lisp/net/socks-tests.el | 113 +++++++++++++++++++++++++-- 3 files changed, 225 insertions(+), 35 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 02edd95328..9285cbf805 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -334,22 +334,19 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") (make-obsolete-variable 'socks-override-functions - "use custom opener with `socks-open-stream-function'." + "see `socks-open-network-stream-function'." "29.1") -(defvar socks-open-stream-function #'open-network-stream - "Function called to open a network stream connection.") - -(defun socks-open-connection (server-info &rest params) +(defun socks-open-connection (server-info &rest kw-args) "Create and initialize a SOCKS process. Perform authentication if needed. SERVER-INFO should resemble -`socks-server'. PARAMS are those accepted by `make-network-process'." +`socks-server'. KW-ARGS are those accepted by `open-network-stream'." (interactive) - (unless (plist-member params :coding) - (setf (plist-get params :coding) '(binary . binary))) + (unless (plist-member kw-args :coding) + (setf (plist-get kw-args :coding) '(binary . binary))) (save-excursion - (let ((proc (apply socks-open-stream-function "socks" nil - (nth 1 server-info) (nth 2 server-info) params)) + (let ((proc (apply #'open-network-stream "socks" nil + (nth 1 server-info) (nth 2 server-info) kw-args)) (authtype nil) version) @@ -533,17 +530,31 @@ socks-find-services-entry (gethash (downcase service) (if udp socks-udp-services socks-tcp-services))) -(defun socks-open-network-stream (name buffer host service &rest params) +(defcustom socks-open-network-stream-function + #'socks-open-network-stream-legacy + "Function to open a SOCKS connection. +Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with +similar functions in the url-gw framework. May also be passed +additional keyword args suitable for `make-network-process'." + :type '(choice (const :tag "Default fallback-oriented opener.") + (function :tag "User-provided function"))) + +(defun socks-open-network-stream-legacy (name buffer host service &rest params) + "Open a SOCKS connection for a valid route. +Fall back to non-SOCKS connections for unknown or undesired routes." (if-let* ((route (socks-find-route host service)) (proc (apply #'socks-open-connection route params))) (socks--open-network-stream proc buffer host service) - (message "Warning: no SOCKS route found for %s:%s" host service) - ;; Support legacy behavior (likely undesirable in most cases) - (apply socks-open-stream-function name buffer host service params))) + ;; Retain legacy behavior and connect anyway without warning + (apply #'open-network-stream name buffer host service params))) + +(defun socks-open-network-stream (name buffer host service &rest params) + "Open a SOCKS connection. PARAMS are passed to `open-network-stream'." + (apply socks-open-network-stream-function name buffer host service params)) (defun socks--open-network-stream (proc buffer host service) (progn ; temporarily preserve git blame for easier reviewing - (progn ; could rename to something like `socks--initiate-command-sequence' + (progn ; could rename to something like `socks--initiate-command-connect' (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond @@ -685,34 +696,31 @@ socks-tor-resolve "Return list of one vector IPv4 address for domain NAME. Or return nil on failure. See `network-lookup-address-info' for format of return value. Server must support the Tor RESOLVE command." - (let ((socks-password (or socks-password "")) - host - (port 80) ; unused for now - route - proc - ip) - (unless (string-suffix-p ".onion" name) - (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) - name - (require 'puny) - (puny-encode-domain name)) - route (socks-find-route host port)) - (cl-assert route) - ;; "Host unreachable" may be raised when the lookup fails - (unwind-protect - (progn - (setq proc (socks-open-connection route)) - (socks-send-command proc - socks-resolve-command - socks-address-type-name - host - port) - (cl-assert (eq (process-get proc 'socks-state) - socks-state-connected)) - (setq ip (socks--extract-resolve-response proc))) - (when proc - (delete-process proc))) - (list (vconcat ip [0]))))) + (let* ((socks-password (or socks-password "")) + (host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + (port 80) ; unused for now + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0])))) (provide 'socks) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index c4a41f56b3..822cbcb64e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -215,6 +215,8 @@ url-open-stream Optional arg GATEWAY-METHOD specifies the gateway to be used, overriding the value of `url-gateway-method'." (unless url-gateway-unplugged + (when (eq url-gateway-method 'socks) + (setq gateway-method nil)) (let* ((gwm (or gateway-method url-gateway-method)) (gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls gwm)) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index f2600210b0..402ccf979d 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -348,6 +348,7 @@ test-socks-https-poc (ert-with-temp-file tempfile :prefix "emacs-test-socks-network-security-" (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") (socks-password "") (nsm-settings-file tempfile) (url-gateway-method 'socks) @@ -361,25 +362,24 @@ test-socks-https-poc (goto-char (point-min)) (should (search-forward "Congratulations" nil t)) (setq done t))) - (orig (symbol-function #'socks--open-network-stream))) - (cl-letf (((symbol-function 'socks--open-network-stream) - (lambda (&rest rest) - (let ((proc (apply orig rest))) - (gnutls-negotiate :process proc :hostname host) - (should (nsm-verify-connection proc host 443 t)))))) - (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") - (unwind-protect - (progn - (advice-add 'network-lookup-address-info :override - #'socks-tor-resolve) - (should-not (nsm-host-settings id)) - (url-http url cb '(nil)) - (ert-info ("Wait for response") - (with-timeout (3 (error "Request timed out")) - (unless done - (sleep-for 0.1)))) - (should (nsm-host-settings id))) - (advice-remove 'network-lookup-address-info - #'socks-tor-resolve))))))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) ;;; socks-tests.el ends here -- 2.35.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Simplify-network-stream-opener-in-socks.el.patch >From ed93ee2fdc8d6b920a44ddaa2b0571948cf77c88 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-lisp-url-url-gw.el-url-open-stream-Honor-socks-gatew.patch >From a8bc5fe336356528dd0ebca86ec18ca541cb4b27 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Fix-string-encoding-bug-in-socks-tests.patch >From e365303eeced26d5fc901e623eb44b3f6c2515cb Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 14 Feb 2022 02:36:57 -0800 Subject: [PATCH 3/6] Fix string encoding bug in socks tests * test/lisp/net/socks-tests.el (socks-tests-canned-server-create, socks-tests-filter-response-parsing-v4): Fix bug in process filter to prevent prepared outgoing responses from being implicitly encoded as utf-8. Fix similar mistake in v4 filter test. --- test/lisp/net/socks-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 461796bdf9..d9ef53ae35 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4 (process-put proc 'socks-state socks-state-waiting) (process-put proc 'socks-server-protocol 4) (ert-info ("Receive initial incomplete segment") - (socks-filter proc (concat [0 90 0 0 93 184 216])) - ;; From example.com: OK status ^ ^ msg start + (socks-filter proc (unibyte-string 0 90 0 0 93 184 216)) + ;; From example.com: OK status ^ ^ msg start (ert-info ("State still set to waiting") (should (eq (process-get proc 'socks-state) socks-state-waiting))) (ert-info ("Response field is nil because processing incomplete") (should-not (process-get proc 'socks-response))) (ert-info ("Scratch field holds stashed partial payload") - (should (string= (concat [0 90 0 0 93 184 216]) + (should (string= (unibyte-string 0 90 0 0 93 184 216) (process-get proc 'socks-scratch))))) (ert-info ("Last part arrives") (socks-filter proc "\42") ; ?\" 34 (ert-info ("State transitions to complete (length check passes)") (should (eq (process-get proc 'socks-state) socks-state-connected))) (ert-info ("Scratch and response fields hold stash w. last chunk") - (should (string= (concat [0 90 0 0 93 184 216 34]) + (should (string= (unibyte-string 0 90 0 0 93 184 216 34) (process-get proc 'socks-response))) (should (string= (process-get proc 'socks-response) (process-get proc 'socks-scratch))))) @@ -140,10 +140,11 @@ socks-tests-canned-server-create (unless (or (and (vectorp pat) (equal pat (vconcat line))) (string-match-p pat line)) (error "Unknown request: %s" line)) + (setq resp (apply #'unibyte-string (append resp nil))) (let ((print-escape-control-characters t)) (message "[%s] <- %s" name (prin1-to-string line)) (message "[%s] -> %s" name (prin1-to-string resp))) - (process-send-string proc (concat resp))))) + (process-send-string proc resp)))) (serv (make-network-process :server 1 :buffer (get-buffer-create name) :filter filt -- 2.35.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Add-support-for-SOCKS-4a.patch >From bb2187da12d88e8b32f9fd005926342e116970c3 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 14 Feb 2022 02:36:57 -0800 Subject: [PATCH 4/6] Add support for SOCKS 4a * lisp/net/socks.el (socks-server): Add new choice `4a' to version field of option. This may appear to change the type of the field from a number to a union of symbols and numbers. However, `socks-send-command' and `socks-filter' already expect a possible `http' value for this field (also a symbol). (socks--errors-4): Add new constant containing error messages for socks version 4. The semantics are faithful, but the wording is ad-libbed. (socks-send-command): Massage existing handling for version 4 to accommodate 4a. * test/lisp/net/socks-tests.el (socks-tests-v4a-basic): add test for 4a. Bug#53941 --- lisp/net/socks.el | 22 ++++++++++++++++++++-- test/lisp/net/socks-tests.el | 13 +++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index fe66a94d18..9f60ecbf36 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -162,6 +162,7 @@ socks-server (radio-button-choice :tag "SOCKS Version" :format "%t: %v" (const :tag "SOCKS v4 " :format "%t" :value 4) + (const :tag "SOCKS v4a" :format "%t" :value 4a) (const :tag "SOCKS v5" :format "%t" :value 5)))) @@ -202,6 +203,12 @@ socks-errors "Command not supported" "Address type not supported")) +(defconst socks--errors-4 + '("Granted" + "Rejected or failed" + "Cannot connect to identd on the client" + "Client and identd report differing user IDs")) + ;; The socks v5 address types (defconst socks-address-type-v4 1) (defconst socks-address-type-name 3) @@ -401,6 +408,7 @@ socks-send-command (format "%c%s" (length address) address)) (t (error "Unknown address type: %d" atype)))) + trailing request version) (or (process-get proc 'socks) (error "socks-send-command called on non-SOCKS connection %S" proc)) @@ -418,6 +426,12 @@ socks-send-command (t (error "Unsupported address type for HTTP: %d" atype))) port))) + ((when (eq version '4a) + (setf addr "\0\0\0\1" + trailing (concat address "\0") + version 4 ; done with the "a" part + (process-get proc 'socks-server-protocol) 4) + nil)) ; fall through ((equal version 4) (setq request (concat (unibyte-string @@ -427,7 +441,8 @@ socks-send-command (logand port #xff)) ; port, low byte addr ; address (user-full-name) ; username - "\0"))) ; terminate username + "\0" ; terminate username + trailing))) ; optional host to look up ((equal version 5) (setq request (concat (unibyte-string @@ -448,7 +463,10 @@ socks-send-command nil ; Sweet sweet success! (delete-process proc) (error "SOCKS: %s" - (nth (or (process-get proc 'socks-reply) 1) socks-errors))) + (let ((no (or (process-get proc 'socks-reply) 1))) + (if (eq version 5) + (nth no socks-errors) + (nth (+ 90 no) socks--errors-4))))) proc)) 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=0005-Support-SOCKS-resolve-extension.patch >From a33717db1379a661ba8007f924dc937feeb2ad1b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 14 Feb 2022 02:36:57 -0800 Subject: [PATCH 5/6] Support SOCKS resolve extension * lisp/net/socks.el (socks-resolve-command): Add new constant for the SOCKS command RESOLVE, which comes by way of a nonstandard extension from the TOR project. It mirrors CONNECT in most respects but asks the server to RESOLVE a host name and return its IP. For details, see https://github.com/torproject/torspec/blob/master/socks-extensions.txt This shouldn't be confused with 5h/5-hostname, which is used to by clients like cURL to allow users to bypass attempts to resolve a name locally. (socks--extract-resolve-response, socks-tor-resolve): Add utility functions to query a SOCKS service supporting the RESOLVE extension. Bug#53941 --- lisp/net/socks.el | 58 ++++++++++++++++++++++++++++++++++++ test/lisp/net/socks-tests.el | 34 +++++++++++++++++++++ 2 files changed, 92 insertions(+) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 9f60ecbf36..9285cbf805 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -664,6 +667,61 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (let ((response (process-get proc 'socks-response))) + (cl-assert response) ; otherwise, msg not received in its entirety + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (when-let (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks-tor-resolve (name &optional _family) + "Return list of one vector IPv4 address for domain NAME. +Or return nil on failure. See `network-lookup-address-info' for format +of return value. Server must support the Tor RESOLVE command." + (let* ((socks-password (or socks-password "")) + (host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + (port 80) ; unused for now + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0])))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4e990ffdba..3d1aca9af4 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -295,4 +295,38 @@ socks-tests-v5-auth-none (socks-tests-perform-hello-world-http-request))) (should (assq 2 socks-authentication-methods))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" 19050 4a)) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 80 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" 19051 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.35.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-POC-Demo-SOCKS-resolve-with-HTTPS.patch >From 62062472fd14dc9911a105016badcc921d63ae95 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 14 Feb 2022 02:36:57 -0800 Subject: [PATCH 6/6] [POC] Demo SOCKS resolve with HTTPS * test/lisp/net/socks-test.el (test-socks-https-poc): Provide throwaway test demoing an HTTPS connection over a TOR proxy service. --- test/lisp/net/socks-tests.el | 55 +++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 3d1aca9af4..402ccf979d 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'socks) (require 'url-http) @@ -329,4 +329,57 @@ tor-resolve-5 (kill-buffer (process-buffer server)) (delete-process server))) +(defvar test-socks-service ; "127.0.0.1:1080" -> ("127.0.0.1", 1080) + (when-let ((present (getenv "TEST_SOCKS_SERVICE")) + (parts (split-string present ":"))) + (list (car parts) (string-to-number (cadr parts))))) + +(declare-function gnutls-negotiate "gnutls" + (&rest spec + &key process type hostname priority-string + trustfiles crlfiles keylist min-prime-bits + verify-flags verify-error verify-hostname-error + &allow-other-keys)) + +(ert-deftest test-socks-https-poc () + :tags '(:unstable) + (unless test-socks-service (ert-skip "SOCKS service missing")) + (unless (gnutls-available-p) (ert-skip "SOCKS resolve test needs GNUTLS")) + (ert-with-temp-file tempfile + :prefix "emacs-test-socks-network-security-" + (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") + (socks-password "") + (nsm-settings-file tempfile) + (url-gateway-method 'socks) + (id "sha1:df77269389e537fcc9a5fe61667133b5bb97d42e") + (host "check.torproject.org") + (url (url-generic-parse-url "https://check.torproject.org")) + ;; + done + ;; + (cb (lambda (&rest _r) + (goto-char (point-min)) + (should (search-forward "Congratulations" nil t)) + (setq done t))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) + ;;; socks-tests.el ends here -- 2.35.1 --=-=-=--