bug#53941: 27.2; socks + tor dont work with https

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 1541 bytes --]

Hi Jacobo,

Jacobo <gnuhacker@member.fsf.org> writes:

> Emacs can not resolve domains when it is https if you are using a
> socks proxy (socks.el) [...] It works, load http://gnu.org (HTTP in
> plain) Also work with .onion domains in HTTP plain No problems with
> HTTP but When I try: M-x eww RET https://gnu.org RET
>
> Return an error: Bad Request

It's certainly possible (see attached). But can it be done responsibly?

In this day and age, when processes and services resolve host names in
all manner of ways, how can we be confident there won't be any leaks? At
present, the main interfaces to various protocol stacks (for example,
url-gw.el and friends) don't seem geared toward making those kinds of
assurances. (Not that they ought to be.)

That said, providing the building blocks on the SOCKS side doesn't seem
like the crime of the century. I've been sitting on what became the
basis for these patches for a while now, but these here were hastily
adapted and might come with some warts. Still, I believe them
straightforward enough to illustrate a basic means of achieving what
you're after.

> In GNU Emacs 27.2 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.30,

I also have some examples with shims for 27 running periodically in CI.
These include a demo of using ERC to connect to Libera.Chat via SOCKS
over TLS. (But that requires an IRCv3 library, which is still a work in
progress.) If you're interested in experimenting with any of this stuff,
please let me know. That goes for anyone else out there as well. Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Set-coding-system-for-SOCKS-connections-to-binary.patch --]
[-- Type: text/x-patch, Size: 2226 bytes --]

From 1cf058fe106e01d55e9269503994e2e9b274b07a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 1/4] Set coding system for SOCKS connections to binary

* lisp/net/socks.el (socks-opens-connection): Don't perform
conversions when receiving and sending text.

* test/lisp/net/socks-tests.el (socks-tests-canned-server-create): Fix
bug in process filter to prevent prepared outgoing responses from
being implicitly encoded as utf-8.
---
 lisp/net/socks.el            | 1 +
 test/lisp/net/socks-tests.el | 3 ++-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 8df0773e1d..c15b323c9c 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -340,6 +340,7 @@ socks-open-connection
 	  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)
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 461796bdf9..708b964020 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -137,13 +137,14 @@ 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))
                    (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.34.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-support-for-SOCKS-4a.patch --]
[-- Type: text/x-patch, Size: 4547 bytes --]

From 84299e3e9dac1e3620a83cf807b564ee276f0cdf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 2/4] 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.
---
 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 c15b323c9c..0d5ef307e7 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))
 
 \f
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 708b964020..b81923fc56 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.34.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Support-SOCKS-RESOLVE-extension.patch --]
[-- Type: text/x-patch, Size: 6017 bytes --]

From ffda45081444e14ca687a505f1fc697b8ef59e0f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 3/4] 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.
---
 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 0d5ef307e7..7201ed8e06 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)
@@ -654,6 +657,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 b81923fc56..51e2e40631 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.34.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-POC-Demo-SOCKS-RESOLVE-over-HTTPS.patch --]
[-- Type: text/x-patch, Size: 3390 bytes --]

From efe0b1bff206efb6f6559154a560a71239aaa78e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 14 Feb 2022 02:36:57 -0800
Subject: [PATCH 4/4] [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 51e2e40631..4963dd7b40 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))
+                (should (nsm-host-settings id))
+                (ert-info ("Wait for response")
+                  (with-timeout (3 (error "Request timed out"))
+                    (unless done
+                      (sleep-for 0.1)))))
+            (advice-remove 'network-lookup-address-info
+                           #'socks-tor-resolve)))))))
+
 ;;; socks-tests.el ends here
-- 
2.34.1