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

@@ -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

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
 
 +++

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))
 
 

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