bug#45162: 28.0.50; Messages scrambled by socks-filter

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

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

Severity: minor
Tags: patch

Hi,

If this is indeed a bug, I'm guessing it's a pretty minor one because in
most cases, the bulk of a SOCKS reply doesn't seem to matter, so long as
the status code portion is correctly interpreted. But in rarer cases, for
example when using Tor's RESOLVE command, which is part of a nonstandard
extension suite, a response may need to be preserved intact.

Rather than try to explain, I've included a throwaway before/after test
showing current and expected behavior, as well as a small patch that
seems to fix the issue. If this is all nonsense, please forgive me. I am
no expert, just a grateful end user.

Thanks,
J.P.

In GNU Emacs 28.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.23, cairo version 1.16.0)
 of 2020-12-09 built on pc
Repository revision: 4f352ad6f1759ae6dcff6ba43847273491bf9c30
Repository branch: socks
Windowing system distributor 'Fedora Project', version 11.0.12010000
System Description: Fedora 33 (Workstation Edition)

Configured using:
 'configure --with-dbus --with-gif --with-jpeg --with-png --with-rsvg
 --with-tiff --with-xft --with-xpm --with-x-toolkit=gtk3 --with-gpm=no
 --with-xwidgets --with-modules --with-harfbuzz --with-cairo --with-json
 CC=gcc 'CFLAGS=-DMAIL_USE_LOCKF -O0 -g3 -Wall' LDFLAGS=-Wl,-z,relro
 PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'

Configured features:
XPM JPEG TIFF GIF PNG RSVG CAIRO SOUND DBUS GSETTINGS GLIB NOTIFY
INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT LIBOTF
ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM MODULES THREADS XWIDGETS
LIBSYSTEMD JSON PDUMPER LCMS2

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  transient-mark-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message rmc puny dired dired-loaddefs
rfc822 mml easymenu mml-sec epa derived epg epg-config gnus-util rmail
rmail-loaddefs auth-source cl-seq eieio eieio-core cl-macs
eieio-loaddefs password-cache json map text-property-search time-date
subr-x seq byte-opt gv bytecomp byte-compile cconv mm-decode mm-bodies
mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-loaddefs
cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils
iso-transl tooltip eldoc electric uniquify ediff-hook vc-hooks
lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar
dnd fontset image regexp-opt fringe tabulated-list replace newcomment
text-mode elisp-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch timer select scroll-bar mouse jit-lock font-lock
syntax facemenu font-core term/tty-colors frame minibuffer cl-generic
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite charscript charprop
case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice button loaddefs faces cus-face macroexp files
window text-properties overlay sha1 md5 base64 format env code-pages
mule custom widget hashtable-print-readable backquote threads
xwidget-internal dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit
x multi-tty make-network-process emacs)

Memory information:
((conses 16 51710 8248)
 (symbols 48 6739 1)
 (strings 32 18249 1932)
 (string-bytes 1 610727)
 (vectors 16 12311)
 (vector-slots 8 170737 6932)
 (floats 8 21 45)
 (intervals 56 219 0)
 (buffers 984 10))


[-- Attachment #2: 0001-DROP-ME-add-test-explaining-existing-bug.patch --]
[-- Type: text/x-patch, Size: 5345 bytes --]

From da49cec6391f282ff998e5ace022c74805dabcf8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 10 Dec 2020 03:04:48 -0800
Subject: [PATCH 1/3] DROP ME: add test explaining existing bug

This is file is meant to demonstrate existing behavior. It is not
meant for inclusion in the test suite.
---
 test/lisp/net/socks-tests.el | 85 ++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 test/lisp/net/socks-tests.el

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
new file mode 100644
index 00000000000..601da494a26
--- /dev/null
+++ b/test/lisp/net/socks-tests.el
@@ -0,0 +1,85 @@
+;;; socks-tests.el --- tests for SOCKS -*- coding: utf-8; lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; This file is supposed to describe (what's believed to be) an existing bug.
+;;
+;; | (let ((default-directory (expand-file-name "../..")))
+;; |   (compile "make lisp/net/socks-tests.log"))
+
+(require 'socks)
+
+(ert-deftest socks-filter-test-existing-behavior-v4 ()
+  (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")
+      (should (equal (string-to-vector "\0Z\0\0]¸Ø") [0 90 0 0 93 184 216]))
+      ;; An IPv4 address from example.com     OK status ^      ^ msg start
+      (socks-filter proc "\0Z\0\0]¸Ø")
+      (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= "\0Z\0\0]¸Ø" (process-get proc 'socks-scratch)))))
+    (ert-info ("Last part arrives")
+      (socks-filter proc "\42") ; ?\" 34
+      (ert-info ("State transitions to complete (proto length check passes)")
+        (should (eq (process-get proc 'socks-state) socks-state-connected)))
+      (ert-info ("Response field holds last scratch with new segment prepended")
+        (should (string= "\"\0Z\0\0]¸Ø" (process-get proc 'socks-response))))
+      (ert-info ("Scratch remains populated, matches response field")
+        (should (string= "\"\0Z\0\0]¸Ø" (process-get proc 'socks-scratch)))))
+    (should (equal (string-to-vector "\"\0Z\0\0]¸Ø") [34 0 90 0 0 93 184 216]))
+    (delete-process proc)
+    (set-process-query-on-exit-flag proc nil)
+    (kill-buffer buf)))
+
+(ert-deftest socks-filter-test-existing-behavior-v5 ()
+  (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")
+      ;; An Ipv6 addr for fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
+      (should (equal (string-to-vector (concat
+                                        "\5\0\0\4"
+                                        "\x26\x05\xbc\x80\x30\x10\x00\x60"
+                                        "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
+                                        "\0\0"))
+                     (vconcat
+                      [5 0 0 4] ; version status (OK) noop addr-type (4 -> 6!)
+                      [#x26 #x05 #xbc #x80 #x30 #x10 #x00 #x60]
+                      [#xde #xad #xbe #xef #xca #xfe #xfe #xd9]
+                      [0 0])))
+      (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
+      (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 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 ("Last part arrives")
+      (ert-info ("Error raised because parsing logic expects appended bytes")
+        (let ((err (should-error (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"))))
+          (should (equal err '(wrong-type-argument number-or-marker-p nil)))))
+      (ert-info ("State untouched (still waiting)")
+        (should (eq (process-get proc 'socks-state) socks-state-waiting)))
+      (ert-info ("Response field untouched")
+        (should-not (process-get proc 'socks-response)))
+      (ert-info ("Scratch contains new arrival prepended")
+        (should (string=  (concat "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
+                                  "\5\0\0\4"
+                                  "\x26\x05\xbc\x80\x30\x10\x00\x60")
+                          (process-get proc 'socks-scratch)))))
+    (delete-process proc)
+    (set-process-query-on-exit-flag proc nil)
+    (kill-buffer buf)))
+
+
+;;; socks-tests.el ends here
-- 
2.28.0


[-- Attachment #3: 0002-DROP-ME-update-test-to-reflect-expected-behavior.patch --]
[-- Type: text/x-patch, Size: 4096 bytes --]

From b8467e34275f371e8e6381b929498fac7864f4a7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 10 Dec 2020 03:11:38 -0800
Subject: [PATCH 2/3] DROP ME: update test to reflect expected behavior

The tests now show SOCKS v4 and v5 messages successfully received.
---
 test/lisp/net/socks-tests.el | 37 +++++++++++++++++++++++-------------
 1 file changed, 24 insertions(+), 13 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 601da494a26..af310b8e6e9 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -29,11 +29,11 @@ socks-filter-test-existing-behavior-v4
       (socks-filter proc "\42") ; ?\" 34
       (ert-info ("State transitions to complete (proto length check passes)")
         (should (eq (process-get proc 'socks-state) socks-state-connected)))
-      (ert-info ("Response field holds last scratch with new segment prepended")
-        (should (string= "\"\0Z\0\0]¸Ø" (process-get proc 'socks-response))))
+      (ert-info ("Response field holds last scratch with new segment appended")
+        (should (string= "\0Z\0\0]¸Ø\"" (process-get proc 'socks-response))))
       (ert-info ("Scratch remains populated, matches response field")
-        (should (string= "\"\0Z\0\0]¸Ø" (process-get proc 'socks-scratch)))))
-    (should (equal (string-to-vector "\"\0Z\0\0]¸Ø") [34 0 90 0 0 93 184 216]))
+        (should (string= "\0Z\0\0]¸Ø\"" (process-get proc 'socks-scratch)))))
+    (should (equal (string-to-vector "\0Z\0\0]¸Ø\"") [0 90 0 0 93 184 216 34]))
     (delete-process proc)
     (set-process-query-on-exit-flag proc nil)
     (kill-buffer buf)))
@@ -64,19 +64,30 @@ socks-filter-test-existing-behavior-v5
       (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 ("Last part arrives")
-      (ert-info ("Error raised because parsing logic expects appended bytes")
-        (let ((err (should-error (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"))))
-          (should (equal err '(wrong-type-argument number-or-marker-p nil)))))
-      (ert-info ("State untouched (still waiting)")
+    (ert-info ("Second part arrives")
+      (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+      (ert-info ("State untouched")
         (should (eq (process-get proc 'socks-state) socks-state-waiting)))
       (ert-info ("Response field untouched")
         (should-not (process-get proc 'socks-response)))
-      (ert-info ("Scratch contains new arrival prepended")
-        (should (string=  (concat "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
-                                  "\5\0\0\4"
-                                  "\x26\x05\xbc\x80\x30\x10\x00\x60")
+      (ert-info ("Scratch contains new arrival appended")
+        (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 contains final part 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))))
+      (ert-info ("Response field updated with final message")
+        (should (string= (process-get proc 'socks-response)
+                         (process-get proc 'socks-scratch)))))
     (delete-process proc)
     (set-process-query-on-exit-flag proc nil)
     (kill-buffer buf)))
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Append-incremental-message-segments-in-socks-filter.patch --]
[-- Type: text/x-patch, Size: 1881 bytes --]

From ae5b7b4c19ebdf53f84e0bf4750a734ae1fe908d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 10 Dec 2020 03:12:49 -0800
Subject: [PATCH 3/3] Append incremental message segments in socks-filter

Prior to this, arriving segments were prepended, resulting in a
scrambled message being stored in the socks-response property for the
network process.

This also fixes a bug in socks--open-network-stream involving the
socks-service property being set to the host instead of the port.
---
 lisp/net/socks.el | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 9b22a5083fb..cb50a0adbea 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -260,7 +260,7 @@ socks-filter
     (setq state (process-get proc 'socks-state))
     (cond
      ((= state socks-state-waiting-for-auth)
-      (cl-callf (lambda (s) (setq string (concat string s)))
+      (cl-callf (lambda (s) (setq string (concat s string)))
           (process-get proc 'socks-scratch))
       (if (< (length string) 2)
 	  nil				; We need to spin some more
@@ -272,7 +272,7 @@ socks-filter
      ((= state socks-state-authenticated)
       )
      ((= state socks-state-waiting)
-      (cl-callf (lambda (s) (setq string (concat string s)))
+      (cl-callf (lambda (s) (setq string (concat s string)))
           (process-get proc 'socks-scratch))
       (setq version (process-get proc 'socks-server-protocol))
       (cond
@@ -542,7 +542,7 @@ socks--open-network-stream
 			      service))
         (process-put proc 'socks-buffer buffer)
         (process-put proc 'socks-host host)
-        (process-put proc 'socks-service host)
+        (process-put proc 'socks-service service)
         (set-process-filter proc nil)
         (set-process-buffer proc (if buffer (get-buffer-create buffer)))
         proc))))
-- 
2.28.0