master b4b4b5f4315 2/2: Improve SOCKS error handling and support version 4a

[F. Jason Park]

branch: master
commit b4b4b5f43158a4281d583a6dc573465533f4bf48
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Improve SOCKS error handling and support version 4a
    
    * doc/misc/url.texi: Mention version 4a in SOCKS portion of "Gateways
    in general" node.
    * etc/NEWS: Mention version 4a support in new `socks' section.
    * lisp/net/socks.el (socks-server): Add new Custom choice `4a' for
    version field.  This change does not further overload the field in
    terms of expected type because `socks-send-command' and `socks-filter'
    already accommodate the symbol `http'.
    (socks--errors-4): Add new constant containing error messages for
    version 4.  The semantics are faithful to the de facto spec, but the
    exact wording is slightly adapted.
    (socks-filter): Allow for a null "type" field on error with version 5.
    Previously, certain errors would not propagate because a wrong-type
    signal would get in the way.
    (socks-send-command): Massage existing version 4 protocol parsing to
    accommodate 4a, and add error handling for version 4.  Use variable
    `socks-username' for v4 variable-length ID field instead of calling
    `user-full-name', which has potential privacy implications.
    * test/lisp/net/socks-tests.el (socks-tests-v4-basic): Don't mock
    `user-full-name' because `socks-send-command' no longer calls it to
    determine the ID.
    (socks-tests-v4a-basic, socks-tests-v4a-error): Add a couple tests for
    SOCKS version 4a.  (Bug#53941)
---
 doc/misc/url.texi            |  8 +++++---
 etc/NEWS                     |  7 +++++++
 lisp/net/socks.el            | 30 ++++++++++++++++++++++++++----
 test/lisp/net/socks-tests.el | 31 ++++++++++++++++++++++++++++---
 4 files changed, 66 insertions(+), 10 deletions(-)

diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index e6636e32507..6517f858324 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -1083,16 +1083,18 @@ This is a regular expression that matches the shell 
prompt.
 @defopt socks-server
 This specifies the default server, it takes the form
 @w{@code{("Default server" @var{server} @var{port} @var{version})}}
-where @var{version} can be either 4 or 5.
+where @var{version} can be 4, 4a, or 5.
 @end defopt
 @defvar socks-password
 If this is @code{nil} then you will be asked for the password,
 otherwise it will be used as the password for authenticating you to
-the @sc{socks} server.
+the @sc{socks} server.  You can often set this to @code{""} for
+servers on your local network.
 @end defvar
 @defvar socks-username
 This is the username to use when authenticating yourself to the
-@sc{socks} server.  By default this is your login name.
+@sc{socks} server.  By default, this is your login name.  In versions
+4 and 4a, ERC uses this for the @samp{ID} field.
 @end defvar
 @defvar socks-timeout
 This controls how long, in seconds, to wait for responses from the
diff --git a/etc/NEWS b/etc/NEWS
index c8c37f43284..129017f7dbe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -871,6 +871,13 @@ neither of which have been supported by Emacs since 
version 23.1.
 The user option 'url-gateway-nslookup-program' and the function
 'url-gateway-nslookup-host' are consequently also obsolete.
 
+** socks
+
++++
+*** SOCKS supports version 4a.
+The 'socks-server' option accepts '4a' as a value for its version
+field.
+
 ** Edmacro
 
 +++
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 968a28d2be8..e572e5c9bdf 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -162,6 +162,7 @@
          (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 @@
     "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)
@@ -309,7 +316,8 @@
                     ((pred (= socks-address-type-name))
                      (if (< (length string) 5)
                          255
-                       (+ 1 (aref string 4)))))))
+                        (+ 1 (aref string 4))))
+                     (0 0))))
          (if (< (length string) desired-len)
              nil                       ; Need to spin some more
            (process-put proc 'socks-state socks-state-connected)
@@ -399,6 +407,7 @@ When ATYPE indicates an IP, param ADDRESS must be given as 
raw bytes."
                (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))
@@ -415,6 +424,12 @@ When ATYPE indicates an IP, param ADDRESS must be given as 
raw bytes."
                             (t
                              (error "Unsupported address type for HTTP: %d" 
atype)))
                            port)))
+     ((and (eq version '4a)
+           (setf addr "\0\0\0\1"
+                 trailing (concat address "\0")
+                 version 4 ; become version 4
+                 (process-get proc 'socks-server-protocol) 4)
+           nil)) ; fall through
      ((equal version 4)
       (setq request (concat
                     (unibyte-string
@@ -423,8 +438,9 @@ When ATYPE indicates an IP, param ADDRESS must be given as 
raw bytes."
                      (ash port -8)       ; port, high byte
                      (logand port #xff)) ; port, low byte
                     addr                 ; address
-                    (user-full-name)     ; username
-                    "\0")))              ; terminate username
+                     socks-username       ; username
+                     "\0"                 ; terminate username
+                     trailing)))          ; optional host to look up
      ((equal version 5)
       (setq request (concat
                     (unibyte-string
@@ -445,7 +461,13 @@ When ATYPE indicates an IP, param ADDRESS must be given as 
raw bytes."
        nil                             ; Sweet sweet success!
       (delete-process proc)
       (error "SOCKS: %s"
-             (nth (or (process-get proc 'socks-reply) 1) socks-errors)))
+             (let ((err (process-get proc 'socks-reply)))
+               (if (eql version 5)
+                   (nth (or err 1) socks-errors)
+                 ;; The defined error codes for v4 range from
+                 ;; 90-93, but we store them in a simple list.
+                 (nth (pcase err (90 0) (92 2) (93 3) (_ 1))
+                      socks--errors-4)))))
     proc))
 
 
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 0890ace826f..1a4bac37bf9 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -197,6 +197,7 @@ Vectors must match verbatim.  Strings are considered regex 
patterns.")
   "Show correct preparation of SOCKS4 connect command (Bug#46342)."
   (let ((socks-server '("server" "127.0.0.1" t 4))
         (url-user-agent "Test/4-basic")
+        (socks-username "foo")
         (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))
@@ -205,11 +206,35 @@ Vectors must match verbatim.  Strings are considered 
regex patterns.")
       (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 (&optional _) "foo")))
+                   (list 93 184 216 34))))
         (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" t 4a))
+        (socks-username "foo")
+        (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")
+      (socks-tests-perform-hello-world-http-request))))
+
+(ert-deftest socks-tests-v4a-error ()
+  "Show error signaled when destination address rejected."
+  (let ((socks-server '("server" "127.0.0.1" t 4a))
+        (url-user-agent "Test/4a-basic")
+        (socks-username "")
+        (socks-tests-canned-server-patterns
+         `(([4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0]
+            . [0 91 0 0 0 0 0 0])
+           ,socks-tests--hello-world-http-request-pattern)))
+    (ert-info ("Make HTTP request over SOCKS4A")
+      (let ((err (should-error
+                  (socks-tests-perform-hello-world-http-request))))
+        (should (equal err '(error "SOCKS: Rejected or failed")))))))
+
 ;; 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