bug#46342: 28.0.50; socks-send-command munges IP address bytes to UTF-8

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

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

Eli Zaretskii <eliz@gnu.org> writes:

> Thanks.  I wanted to install this, but it failed to apply to the
> master branch.  Could you please rebase on the current master branch
> and resubmit?

Hi Eli, I've gone ahead and rebased atop

  commit c85c8e7d42ae2a5fc95fa7b14257389d8383b34d
  Author: Stefan Kangas <stefan@marxist.se>
  
      Add toolbar for help-mode
  
   lisp/help-mode.el | 28 +++++++++++++++++++++++-----
   1 file changed, 23 insertions(+), 5 deletions(-)

However the src/dest blob hashes (i.e., git-hash-object(1) SHAs in the
diffs' index dead..beef 0644 lines) remain unchanged. Which leads me to
think maybe the failure is related to these being two individual patches
(a "change set"). I've had trouble in the past applying similar sets
using debbugs-gnu-apply-patch, but that might've just been incompetence.

Regardless, I'd be happy to squash these down into a single commit if you
think that'd help. Thanks.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-more-auth-related-tests-for-socks.el.patch --]
[-- Type: text/x-patch, Size: 16142 bytes --]

From 2fba12e3c260c2e11e115cf0e2384e0624103cf5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 5 Feb 2021 05:24:55 -0800
Subject: [PATCH 1/2] Add more auth-related tests for socks.el

* test/lisp/net/socks-tests.el (auth-registration-and-suite-offer)
(filter-response-parsing-v4, filter-response-parsing-v5): Assert
auth-method selection wrangling and socks-filter parsing.
(v5-auth-user-pass, v5-auth-user-pass-blank, v5-auth-none): Show prep
and execution of the SOCKS connect command and proxying of an HTTP
request; simplify fake server.
---
 test/lisp/net/socks-tests.el | 270 ++++++++++++++++++++++++++++-------
 1 file changed, 215 insertions(+), 55 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index b378ed2964e..340a42d79cc 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -21,68 +21,151 @@
 
 ;;; Code:
 
+(require 'ert)
 (require 'socks)
 (require 'url-http)
 
-(defvar socks-tests-canned-server-port nil)
+(ert-deftest socks-tests-auth-registration-and-suite-offer ()
+  (ert-info ("Default favors user/pass auth")
+    (should (equal socks-authentication-methods
+                   '((2 "Username/Password" . socks-username/password-auth)
+                     (0 "No authentication" . identity))))
+    (should (equal "\2\0\2" (socks-build-auth-list)))) ; length [offer ...]
+  (let (socks-authentication-methods)
+    (ert-info ("Empty selection/no methods offered")
+      (should (equal "\0" (socks-build-auth-list))))
+    (ert-info ("Simulate library defaults")
+      (socks-register-authentication-method 0 "No authentication"
+                                            'identity)
+      (should (equal socks-authentication-methods
+                     '((0 "No authentication" . identity))))
+      (should (equal "\1\0" (socks-build-auth-list)))
+      (socks-register-authentication-method 2 "Username/Password"
+                                            'socks-username/password-auth)
+      (should (equal socks-authentication-methods
+                     '((2 "Username/Password" . socks-username/password-auth)
+                       (0 "No authentication" . identity))))
+      (should (equal "\2\0\2" (socks-build-auth-list))))
+    (ert-info ("Removal")
+      (socks-unregister-authentication-method 2)
+      (should (equal socks-authentication-methods
+                     '((0 "No authentication" . identity))))
+      (should (equal "\1\0" (socks-build-auth-list)))
+      (socks-unregister-authentication-method 0)
+      (should-not socks-authentication-methods)
+      (should (equal "\0" (socks-build-auth-list))))))
 
-(defun socks-tests-canned-server-create (verbatim patterns)
-  "Create a fake SOCKS server and return the process.
+(ert-deftest socks-tests-filter-response-parsing-v4 ()
+  "Ensure new chunks added on right (Bug#45162)."
+  (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+         (proc (start-process "test-socks-filter" buf "sleep" "1")))
+    (process-put proc 'socks t)
+    (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
+      (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])
+                         (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])
+                         (process-get proc 'socks-response)))
+        (should (string= (process-get proc 'socks-response)
+                         (process-get proc 'socks-scratch)))))
+    (delete-process proc)
+    (kill-buffer buf)))
 
-`VERBATIM' and `PATTERNS' are dotted alists containing responses.
-Requests are tried in order.  On failure, an error is raised."
-  (let* ((buf (generate-new-buffer "*canned-socks-server*"))
+(ert-deftest socks-tests-filter-response-parsing-v5 ()
+  "Ensure new chunks added on right (Bug#45162)."
+  (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+         (proc (start-process "test-socks-filter" buf "sleep" "1")))
+    (process-put proc 'socks t)
+    (process-put proc 'socks-state socks-state-waiting)
+    (process-put proc 'socks-server-protocol 5)
+    (ert-info ("Receive initial incomplete segment")
+      ;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
+      ;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6)
+      (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
+      (ert-info ("State still waiting and response emtpy")
+        (should (eq (process-get proc 'socks-state) socks-state-waiting))
+        (should-not (process-get proc 'socks-response)))
+      (ert-info ("Scratch field holds partial payload of pending msg")
+        (should (string= "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60"
+                         (process-get proc 'socks-scratch)))))
+    (ert-info ("Middle chunk arrives")
+      (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+      (ert-info ("State and response fields still untouched")
+        (should (eq (process-get proc 'socks-state) socks-state-waiting))
+        (should-not (process-get proc 'socks-response)))
+      (ert-info ("Scratch contains new arrival appended (on RHS)")
+        (should (string=  (concat "\5\0\0\4"
+                                  "\x26\x05\xbc\x80\x30\x10\x00\x60"
+                                  "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+                          (process-get proc 'socks-scratch)))))
+    (ert-info ("Final part arrives (port number)")
+      (socks-filter proc "\0\0")
+      (ert-info ("State transitions to complete")
+        (should (eq (process-get proc 'socks-state) socks-state-connected)))
+      (ert-info ("Scratch and response fields show last chunk appended")
+        (should (string=  (concat "\5\0\0\4"
+                                  "\x26\x05\xbc\x80\x30\x10\x00\x60"
+                                  "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
+                                  "\0\0")
+                          (process-get proc 'socks-scratch)))
+        (should (string= (process-get proc 'socks-response)
+                         (process-get proc 'socks-scratch)))))
+    (delete-process proc)
+    (kill-buffer buf)))
+
+(defvar socks-tests-canned-server-patterns nil
+  "Alist containing request/response cons pairs to be tried in order.
+Vectors must match verbatim. Strings are considered regex patterns.")
+
+(defun socks-tests-canned-server-create ()
+  "Create and return a fake SOCKS server."
+  (let* ((port (nth 2 socks-server))
+         (name (format "socks-server:%d" port))
+         (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
-                 (let ((resp (or (assoc-default line verbatim
-                                                (lambda (k s) ; s is line
-                                                  (string= (concat k) s)))
-                                 (assoc-default line patterns
-                                                (lambda (p s)
-                                                  (string-match-p p s))))))
-                   (unless resp
+                 (pcase-let ((`(,pat . ,resp) (pop pats)))
+                   (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))
-                     (princ (format "<- %s\n" (prin1-to-string line)) buf)
-                     (princ (format "-> %s\n" (prin1-to-string resp)) buf))
+                     (message "[%s] <- %s" name (prin1-to-string line))
+                     (message "[%s] -> %s" name (prin1-to-string resp)))
                    (process-send-string proc (concat resp)))))
-         (srv (make-network-process :server 1
-                                    :buffer buf
-                                    :filter filt
-                                    :name "server"
-                                    :family 'ipv4
-                                    :host 'local
-                                    :service socks-tests-canned-server-port)))
-    (set-process-query-on-exit-flag srv nil)
-    (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
-    srv))
-
-;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
-;; against curl 7.71 with the following options:
-;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
-;;
-;; If later implementing version 4a, try these:
-;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0]
-;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
+         (serv (make-network-process :server 1
+                                     :buffer (get-buffer-create name)
+                                     :filter filt
+                                     :name name
+                                     :family 'ipv4
+                                     :host 'local
+                                     :coding 'binary
+                                     :service port)))
+    (set-process-query-on-exit-flag serv nil)
+    serv))
 
-(ert-deftest socks-tests-auth-filter-url-http ()
-  "Verify correct handling of SOCKS5 user/pass authentication."
-  (let* ((socks-server '("server" "127.0.0.1" 10080 5))
-         (socks-username "foo")
-         (socks-password "bar")
-         (url-gateway-method 'socks)
+(defvar socks-tests--hello-world-http-request-pattern
+  (cons "^GET /" (concat "HTTP/1.1 200 OK\r\n"
+                         "Content-Type: text/plain\r\n"
+                         "Content-Length: 13\r\n\r\n"
+                         "Hello World!\n")))
+
+(defun socks-tests-perform-hello-world-http-request ()
+  "Start canned server, validate hello-world response, and finalize."
+  (let* ((url-gateway-method 'socks)
          (url (url-generic-parse-url "http://example.com"))
-         (verbatim '(([5 2 0 2] . [5 2])
-                     ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
-                     ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
-                      . [5 0 0 1 0 0 0 0 0 0])))
-         (patterns
-          `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
-                                 "Content-Type: text/plain; charset=UTF-8\r\n"
-                                 "Content-Length: 13\r\n\r\n"
-                                 "Hello World!\n"))))
-         (socks-tests-canned-server-port 10080)
-         (server (socks-tests-canned-server-create verbatim patterns))
-         (tries 10)
+         (server (socks-tests-canned-server-create))
          ;;
          done
          ;;
@@ -90,14 +173,91 @@ socks-tests-auth-filter-url-http
                (goto-char (point-min))
                (should (search-forward "Hello World" nil t))
                (setq done t)))
-         (buf (url-http url cb '(nil))))
-    (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
-      (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
-        (sleep-for 0.1)))
+         (buf (url-http url cb '(nil)))
+         (proc (get-buffer-process buf))
+         (attempts 10))
+    (while (and (not done) (< 0 (cl-decf attempts)))
+      (sleep-for 0.1))
     (should done)
     (delete-process server)
+    (delete-process proc) ; otherwise seems client proc is sometimes reused
     (kill-buffer (process-buffer server))
     (kill-buffer buf)
     (ignore url-gateway-method)))
 
+;; 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
+
+(ert-deftest socks-tests-v5-auth-user-pass ()
+  "Verify correct handling of SOCKS5 user/pass authentication."
+  (should (assq 2 socks-authentication-methods))
+  (let ((socks-server '("server" "127.0.0.1" 10080 5))
+        (socks-username "foo")
+        (socks-password "bar")
+        (url-user-agent "Test/auth-user-pass")
+        (socks-tests-canned-server-patterns
+         `(([5 2 0 2] . [5 2])
+           ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
+           ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+            . [5 0 0 1 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+      (socks-tests-perform-hello-world-http-request))))
+
+;; Services (like Tor) may be configured without auth but for some
+;; reason still prefer the user/pass method over none when offered both.
+;; Given this library's defaults, the scenario below is possible.
+;;
+;; FYI: RFC 1929 doesn't say that a username or password is required
+;; but notes that the length of both fields should be at least one.
+;; However, both socks.el and curl send zero-length fields (though
+;; curl drops the user part too when the password is empty).
+;;
+;; From Tor's docs /socks-extensions.txt, 1.1 Extent of support:
+;; > We allow username/password fields of this message to be empty ...
+;; line 41 in blob 5fd1f828f3e9d014f7b65fa3bd1d33c39e4129e2
+;; https://gitweb.torproject.org/torspec.git/tree/socks-extensions.txt
+;;
+;; To verify against curl 7.71, swap out the first two pattern pairs
+;; with ([5 3 0 1 2] . [5 2]) and ([1 0 0] . [1 0]), then run:
+;; $ curl verbose -U "foo:" --proxy socks5h://127.0.0.1:10081 example.com
+
+(ert-deftest socks-tests-v5-auth-user-pass-blank ()
+  "Verify correct SOCKS5 user/pass authentication with empty pass."
+  (should (assq 2 socks-authentication-methods))
+  (let ((socks-server '("server" "127.0.0.1" 10081 5))
+        (socks-username "foo") ; defaults to (user-login-name)
+        (socks-password "") ; simulate user hitting enter when prompted
+        (url-user-agent "Test/auth-user-pass-blank")
+        (socks-tests-canned-server-patterns
+         `(([5 2 0 2] . [5 2])
+           ([1 3 ?f ?o ?o 0] . [1 0])
+           ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+            . [5 0 0 1 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+      (socks-tests-perform-hello-world-http-request))))
+
+;; Swap out ([5 2 0 1] . [5 0]) with the first pattern below to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
+
+(ert-deftest socks-tests-v5-auth-none ()
+  "Verify correct handling of SOCKS5 when auth method 0 requested."
+  (let ((socks-server '("server" "127.0.0.1" 10082 5))
+        (socks-authentication-methods (append socks-authentication-methods
+                                              nil))
+        (url-user-agent "Test/auth-none")
+        (socks-tests-canned-server-patterns
+         `(([5 1 0] . [5 0])
+           ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+            . [5 0 0 1 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (socks-unregister-authentication-method 2)
+    (should-not (assq 2 socks-authentication-methods))
+    (ert-info ("Make HTTP request over SOCKS5 with no auth method")
+      (socks-tests-perform-hello-world-http-request)))
+  (should (assq 2 socks-authentication-methods)))
+
 ;;; socks-tests.el ends here
-- 
2.29.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Use-raw-bytes-for-SOCKS-4-IP-addresses.patch --]
[-- Type: text/x-patch, Size: 2853 bytes --]

From 9c403d1936ccd63e25488615beb4d2fde29d375f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 5 Feb 2021 19:41:04 -0800
Subject: [PATCH 2/2] Use raw bytes for SOCKS 4 IP addresses

* lisp/net/socks.el: (socks--open-network-stream, socks-send-command):
* test/lisp/net/socks-tests.el: (socks-tests-v4-basic): (Bug#46342).
---
 lisp/net/socks.el            |  4 +++-
 test/lisp/net/socks-tests.el | 20 ++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 96fafc826b8..1da1d31d678 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -390,6 +390,8 @@ socks-open-connection
       proc)))
 
 (defun socks-send-command (proc command atype address port)
+  "Send COMMAND to SOCKS service PROC for proxying ADDRESS and PORT.
+When ATYPE indicates an IP, param ADDRESS must be given as raw bytes."
   (let ((addr (cond
 	       ((or (= atype socks-address-type-v4)
 		    (= atype socks-address-type-v6))
@@ -528,7 +530,7 @@ socks--open-network-stream
 	        (setq host (socks-nslookup-host host))
 	        (if (not (listp host))
 	            (error "Could not get IP address for: %s" host))
-	        (setq host (apply #'format "%c%c%c%c" host))
+		(setq host (apply #'unibyte-string host))
                 socks-address-type-v4)
                (t
                 socks-address-type-name))))
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 340a42d79cc..9a2dcba9daf 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -185,6 +185,26 @@ socks-tests-perform-hello-world-http-request
     (kill-buffer buf)
     (ignore url-gateway-method)))
 
+;; Unlike curl, socks.el includes the ID field (but otherwise matches):
+;; $ curl --proxy socks4://127.0.0.1:1080 example.com
+
+(ert-deftest socks-tests-v4-basic ()
+  "Show correct preparation of SOCKS4 connect command (Bug#46342)."
+  (let ((socks-server '("server" "127.0.0.1" 10079 4))
+        (url-user-agent "Test/4-basic")
+        (socks-tests-canned-server-patterns
+         `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern))
+        socks-nslookup-program)
+    (ert-info ("Make HTTP request over SOCKS4")
+      (cl-letf (((symbol-function 'socks-nslookup-host)
+                 (lambda (host)
+                   (should (equal host "example.com"))
+                   (list 93 184 216 34)))
+                ((symbol-function 'user-full-name)
+                 (lambda () "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.29.2