bug#53941: Last-minute socks.el improvements for Emacs 29?

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

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

Eli Zaretskii <eliz@gnu.org> writes:

> I'm really uncomfortable with installing these changes before the release
> branch is cut.  The changes are hardly trivial, some controversial even to
> my eyes, even though I'm no expert on network connections.

Well, I myself am just about the furthest thing from (an expert), which
certainly doesn't comport well with dropping rash changes at the
eleventh hour. (That was rather disrespectful on my part, so shame on
me.) As such, if it's easier to revisit this once things settle down,
just ignore this email and I'll re-ping you sometime down the road.

> For example:
>
>> +(defun socks-open-connection (server-info &rest stream-params)
>> +  "Create and initialize a SOCKS process.
>> +Perform authentication if needed.  Expect SERVER-INFO to take the
>> +form of `socks-server' and STREAM-PARAMS to be keyword params
>> +accepted by `open-network-stream'."
>>    (interactive)
>> +  (unless (plist-member stream-params :coding)
>> +    (setf (plist-get stream-params :coding) '(binary . binary)))
>
> AFAIU, this constitutes an incompatible change in behavior: the default for
> :coding is was never 'binary' before, it was determined from the locale's
> preferences.  Why are we making this change here?

Just good old fashioned stupidity, I'm afraid. (And also recklessness in
overly trusting the me from eight months ago, surely.) I guess I somehow
assumed that if the caller didn't set :coding explicitly, they would do
so once handed back the process, which is certifiably dumb.

>> @@ -446,7 +474,11 @@ 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) 99)))
>> +               (or (if (eq version 5) ; 99 - 90 >= length(errors)
>> +                       (nth no socks-errors)
>> +                     (nth (- no 90) socks--errors-4))
>> +                   "Unknown error"))))
>
> I don't really understand the semantics here (so maybe comments need to be
> upgraded), but the old and the new versions don't look to me like equivalent
> code -- why the change?

This sets the fallback message to "Unknown error" (made up) rather than
"General SOCKS server failure" (an official error code). At first, I
figured the distinction more faithfully conveyed the nature of the
error, but now I see that it just adds clutter because the fallback path
can only be triggered by a protocol mishap, and that's unlikely, given
that the conversation must progress to its third back-and-forth by the
time this runs.

(BTW, the words "error handling" in the patch's title refer to the added
"(0 0)" `pcase' condition in `socks-filter' and not the snippet above.)

>> -(when socks-override-functions
>> -  (advice-add 'open-network-stream :around #'socks--open-network-stream))
>> +;; Libraries typically offer a "stream opener" option, such as ERC's
>> +;; `erc-server-connect-function'.  These provide a level of
>> +;; flexibility tantamount to what this variable formerly offered.
>> +(make-obsolete-variable
>> + 'socks-override-functions
>> + "see `socks-open-network-stream' and `socks-connect-function'." "29.1")
>
> Why this last-minute obsolescence?

Just my being callous. I now see that obsoleting that variable is
problematic, not least because we continue to honor `socks-noproxy'. But
the two complement each other and are closely coupled, usage-wise.
Getting rid of the one and pretending the other still works as intended
was doubly irresponsible.

>> +(defun socks-open-network-stream (name buffer host service &rest params)
>> +  "Open and return a connection, possibly proxied over SOCKS.
>
> The changes in this public function are so significant that I don't
> understand how they can be suggested so close to the branching.

The old signature was

  (name buffer host service) -> process

and the new &rest arguments would be optional. And since the lone
in-tree call site sticks to the four required positionals, I didn't
think a move from (4 . 4) to (4 . many), in `func-arity' terms, stood to
break any advice in the wild. Still, there are side effects in the new
version that could use more thorough exploring, and further attention
could be paid to its treatment of `socks-override-functions' in terms of
preserving old behavior.

> If it is possible to add support for SOCKS 4a without affecting any
> previously supported versions, I'm fine.  Adding tests is also fine.
> But for the rest, I think you should wait until after the release
> branch is cut and install this on the master branch. Sorry, it really
> is too late for such changes.

You're very gracious, but I think I've learned my lesson and will
refrain from pursuing any of these changes for Emacs 29. Apologies for
abusing your time and maintainerly patience (yet again).


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 7474 bytes --]

From 96a4de741663672e928fd30af6c93b335b346691 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 29 Nov 2022 00:18:42 -0800
Subject: [PATCH 0/4] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (4):
  ; Don't hard code server ports in SOCKS tests
  [30.0.50] Improve SOCKS error handling and add support for 4a
  [WIP/30.0.50] Simplify network-stream openers in socks.el
  [POC/30.0.50] Integrate the socks and url libraries

 lisp/net/socks.el            | 142 +++++++++++++++++++++++++++++------
 lisp/url/url-gw.el           |   8 +-
 lisp/url/url-http.el         |  16 ++--
 lisp/url/url-proxy.el        |  18 ++++-
 lisp/url/url-vars.el         |  13 +++-
 test/lisp/net/socks-tests.el |  39 +++++++---
 6 files changed, 186 insertions(+), 50 deletions(-)

Interdiff:
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index ac732b228b..65436ed047 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -325,20 +325,20 @@ socks-filter
 	    (process-put proc 'socks-response string))))))
      ((= state socks-state-connected)))))
 
+;; FIXME this is a terrible idea.
+;; It is not even compatible with the argument spec of open-network-stream
+;; in 24.1.
+
 (defvar socks-override-functions nil
   "If non-nil, overwrite `open-network-stream' function with SOCKSified version.")
 
-;; Libraries typically offer a "stream opener" option, such as ERC's
-;; `erc-server-connect-function'.  These provide a level of
-;; flexibility tantamount to what this variable formerly offered.
-(make-obsolete-variable
- 'socks-override-functions
- "see `socks-open-network-stream' and `socks-connect-function'." "29.1")
+(when socks-override-functions
+  (advice-add 'open-network-stream :around #'socks--open-network-stream))
 
 (defcustom socks-connect-function 'open-network-stream
   "Function to open a network connection to a SOCKS provider.
 Called with arguments suitable for `open-network-stream'."
-  :version "29.1"
+  :version "30.1"
   :type '(choice (function-item :value open-network-stream)
                  (function :tag "User-provided function")))
 
@@ -348,14 +348,11 @@ socks-open-connection
 form of `socks-server' and STREAM-PARAMS to be keyword params
 accepted by `open-network-stream'."
   (interactive)
-  (unless (plist-member stream-params :coding)
-    (setf (plist-get stream-params :coding) '(binary . binary)))
   (save-excursion
     (let ((proc
-           (with-suppressed-warnings ((obsolete socks-override-functions))
-             (let ((socks-override-functions nil))
-               (apply socks-connect-function (nth 0 server-info) nil
-                      (nth 1 server-info) (nth 2 server-info) stream-params))))
+           (let ((socks-override-functions nil))
+             (apply socks-connect-function (nth 0 server-info) nil
+                    (nth 1 server-info) (nth 2 server-info) stream-params)))
 	  (authtype nil)
 	  version)
 
@@ -474,11 +471,11 @@ socks-send-command
 	nil				; Sweet sweet success!
       (delete-process proc)
       (error "SOCKS: %s"
-             (let ((no (or (process-get proc 'socks-reply) 99)))
-               (or (if (eq version 5) ; 99 - 90 >= length(errors)
-                       (nth no socks-errors)
-                     (nth (- no 90) socks--errors-4))
-                   "Unknown error"))))
+             (let ((err (process-get proc 'socks-reply)))
+               (if (eql version 5)
+                   (nth (or err 1) socks-errors)
+                 (nth (- (if (and err (<= 90 err 93)) err 91) 90)
+                      socks--errors-4)))))
     proc))
 
 \f
@@ -539,16 +536,15 @@ socks-find-services-entry
   (gethash (downcase service)
 	      (if udp socks-udp-services socks-tcp-services)))
 
-(defcustom socks-open-network-stream-fallback nil
-  "Whether `socks-open-network-stream' should fall back to non-SOCKS."
-  :version "29.1"
-  :type 'boolean)
+(defun socks--open-network-stream (orig-fun name buffer host service &rest params)
+  (let ((socks-override-functions orig-fun))
+    (apply #'socks-open-network-stream name buffer host service params)))
 
 (defcustom socks-proxied-tls-services '(443 6697)
   "Ports whose connections should use TLS.
 Note that the system resolver may be consulted to look up host
 names for checking domain validation certs."
-  :version "29.1"
+  :version "30.1"
   :type '(repeat number))
 
 (declare-function gnutls-negotiate "gnutls" (&rest rest))
@@ -568,9 +564,12 @@ socks-open-network-stream
 though `socks-connect-function' has the final say).  For TLS with
 proxied connections, see the option `socks-proxied-tls-services'.
 
-Before connecting, check the host against `socks-noproxy', and on
-rejection either signal an error or fall back to non-SOCKS,
-depending on the value of `socks-open-network-stream-fallback'.
+Before connecting, check the host against `socks-noproxy' and, on
+rejection, fall back to non-SOCKS.  Similarly, when
+`socks-override-functions' is a function, call it directly and
+trust that it's not interested in options defined in this
+library, such as `socks-server'.
+
 But, before doing anything, check if `url-using-proxy' is bound
 to a `url' struct object, as defined in `url-parse'.  If so,
 assume it represents the address of the desired SOCKS server
@@ -591,13 +590,14 @@ socks-open-network-stream
                              socks-username))
          (socks-password (or (and url (url-password url))
                              socks-password)))
-    (if-let* ((route (socks-find-route host service))
+    (if-let* (((booleanp socks-override-functions))
+              (route (socks-find-route host service))
               (proc (apply #'socks-open-connection route params)))
         (let ((port (if (numberp service)
                         service
                       (process-contact proc :service)))
               (certs (plist-get params :client-certificate)))
-          (socks--open-network-stream proc buffer host service)
+          (socks--initiate-command-connect proc buffer host service)
           (if (and (memq port socks-proxied-tls-services)
                    (gnutls-available-p)
                    (require 'gnutls nil t)
@@ -607,16 +607,15 @@ socks-open-network-stream
                                        :keylist (and certs (list certs)))
                      (nsm-verify-connection proc host port))
             proc))
-      ;; Retain legacy behavior and connect anyway without warning
-      (if socks-open-network-stream-fallback
-          (with-suppressed-warnings ((obsolete socks-override-functions))
-            (let (socks-override-functions)
-              (apply #'open-network-stream name buffer host service params)))
-        (error "Connection rejected by `socks-noproxy'")))))
-
-(defun socks--open-network-stream (proc buffer host service)
+      (let ((fn (if (functionp socks-override-functions)
+                    socks-override-functions ; `socks-noproxy' not consulted
+                  #'open-network-stream)) ; `socks-noproxy' is non-nil
+            socks-override-functions)
+        (apply fn name buffer host service params)))))
+
+(defun socks--initiate-command-connect (proc buffer host service)
   (progn ; preserve indentation level for git blame / code review
-    (progn ; could rename to something like `socks--initiate-command-connect'
+    (progn
       (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Don-t-hard-code-server-ports-in-SOCKS-tests.patch --]
[-- Type: text/x-patch, Size: 6197 bytes --]

From 0780339ceee3b0068700f5a3bf6d48aa4023915e 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] ; Don't hard code server ports in SOCKS tests

* test/lisp/net/socks-tests.el (socks-tests-canned-server-create,
socks-tests-filter-response-parsing-v4, socks-tests-v4-basic,
socks-tests-v5-auth-user-pass, socks-tests-v5-auth-user-blank,
socks-tests-v5-auth-none): Fix bug in process filter to prevent
prepared outgoing responses from being implicitly encoded as utf-8.
Fix similar mistake in v4 filter test.  Also allow system to choose
port instead of hard-coding it.
---
 test/lisp/net/socks-tests.el | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index 461796bdf9..f1ecf1630f 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -63,21 +63,21 @@ socks-tests-filter-response-parsing-v4
     (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
+      (socks-filter proc (unibyte-string 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])
+        (should (string= (unibyte-string 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])
+        (should (string= (unibyte-string 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)))))
@@ -133,17 +133,19 @@ socks-tests-canned-server-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))
+         (name (format "socks-server:%s"
+                       (if (numberp port) port (ert-test-name (ert-running-test)))))
          (pats socks-tests-canned-server-patterns)
          (filt (lambda (proc line)
                  (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))
+                   (setq resp (apply #'unibyte-string (append resp nil)))
                    (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
@@ -151,8 +153,10 @@ socks-tests-canned-server-create
                                      :family 'ipv4
                                      :host 'local
                                      :coding 'binary
-                                     :service port)))
+                                     :service (or port t))))
     (set-process-query-on-exit-flag serv nil)
+    (unless (numberp (nth 2 socks-server))
+      (setf (nth 2 socks-server) (process-contact serv :service)))
     serv))
 
 (defvar socks-tests--hello-world-http-request-pattern
@@ -191,7 +195,7 @@ socks-tests-perform-hello-world-http-request
 
 (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))
+  (let ((socks-server '("server" "127.0.0.1" t 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])
@@ -213,7 +217,7 @@ socks-tests-v4-basic
 (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))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-username "foo")
         (socks-password "bar")
         (url-user-agent "Test/auth-user-pass")
@@ -247,7 +251,7 @@ socks-tests-v5-auth-user-pass
 (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))
+  (let ((socks-server '("server" "127.0.0.1" t 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")
@@ -266,7 +270,7 @@ socks-tests-v5-auth-user-pass-blank
 
 (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))
+  (let ((socks-server '("server" "127.0.0.1" t 5))
         (socks-authentication-methods (append socks-authentication-methods
                                               nil))
         (url-user-agent "Test/auth-none")
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-30.0.50-Improve-SOCKS-error-handling-and-add-support.patch --]
[-- Type: text/x-patch, Size: 5195 bytes --]

From 0f199273a45210ba577e958e9b9205f1e4fcc9a7 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] [30.0.50] Improve SOCKS error handling and add support
 for 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
version 4.  The semantics are faithful to the spec, but the exact
wording is adapted.
(socks-filter): Allow for a null "type" field on error with version 5.
In some cases, errors from certain servers were inaccessible.
(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
SOCKS version 4a.  (Bug#53941.)
---
 lisp/net/socks.el            | 26 +++++++++++++++++++++++---
 test/lisp/net/socks-tests.el | 13 +++++++++++++
 2 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 2ba1c20566..0e84a2d594 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)
@@ -309,7 +316,8 @@ socks-filter
 		     ((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)
@@ -400,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))
@@ -416,6 +425,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
@@ -425,7 +440,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
@@ -446,7 +462,11 @@ socks-send-command
 	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)
+                 (nth (- (if (and err (<= 90 err 93)) err 91) 90)
+                      socks--errors-4)))))
     proc))
 
 \f
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index f1ecf1630f..9e341ebd4d 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -210,6 +210,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" t 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.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-WIP-30.0.50-Simplify-network-stream-openers-in-socks.patch --]
[-- Type: text/x-patch, Size: 7667 bytes --]

From cee91dc42dd90bce6faab93bcfe85f2889166ebd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 28 Nov 2022 22:31:50 -0800
Subject: [PATCH 3/4] [WIP/30.0.50] Simplify network-stream openers in socks.el

* lisp/net/socks.el (socks-open-network-stream-tls-services): Add new
custom option for specifying ports whose proxied connections should
use TLS.
(socks-connect-function): New option for specifying an
`open-network-stream'-like connect function.
(socks-open-connection): Accept additional `open-network-stream'
params passed on to opener, now `socks-connect-function'
in place of `open-network-stream'.
(socks-open-network-stream): Recognize additional `url' struct param.
Also prefer parsed URL details when present in `url-using-proxy'.
(socks--initiate-command-connect): New function to house renamed
latter half of the original `socks--open-network-stream'.  Role now
reduced issuing the first command using an existing process.
(socks--open-network-stream): Serve as thin advice-only wrapper for
`socks-open-network-stream'.
---
 lisp/net/socks.el | 116 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 95 insertions(+), 21 deletions(-)

diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 0e84a2d594..65436ed047 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -34,7 +34,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ;;; Custom widgets
@@ -335,15 +335,24 @@ socks-override-functions
 (when socks-override-functions
   (advice-add 'open-network-stream :around #'socks--open-network-stream))
 
-(defun socks-open-connection (server-info)
+(defcustom socks-connect-function 'open-network-stream
+  "Function to open a network connection to a SOCKS provider.
+Called with arguments suitable for `open-network-stream'."
+  :version "30.1"
+  :type '(choice (function-item :value open-network-stream)
+                 (function :tag "User-provided function")))
+
+(defun socks-open-connection (server-info &rest stream-params)
+  "Create and initialize a SOCKS process.
+Perform authentication if needed.  Expect SERVER-INFO to take the
+form of `socks-server' and STREAM-PARAMS to be keyword params
+accepted by `open-network-stream'."
   (interactive)
   (save-excursion
     (let ((proc
            (let ((socks-override-functions nil))
-             (open-network-stream "socks"
-				  nil
-				  (nth 1 server-info)
-				  (nth 2 server-info))))
+             (apply socks-connect-function (nth 0 server-info) nil
+                    (nth 1 server-info) (nth 2 server-info) stream-params)))
 	  (authtype nil)
 	  version)
 
@@ -527,22 +536,87 @@ socks-find-services-entry
   (gethash (downcase service)
 	      (if udp socks-udp-services socks-tcp-services)))
 
-(defun socks-open-network-stream (name buffer host service)
-  (let ((socks-override-functions t))
-    (socks--open-network-stream
-     (lambda (&rest args)
-       (let ((socks-override-functions nil))
-         (apply #'open-network-stream args)))
-     name buffer host service)))
-
 (defun socks--open-network-stream (orig-fun name buffer host service &rest params)
-  (let ((route (and socks-override-functions
-                    (socks-find-route host service))))
-    (if (not route)
-	(apply orig-fun name buffer host service params)
-      ;; FIXME: Obey `params'!
-      (let* ((proc (socks-open-connection route))
-	     (version (process-get proc 'socks-server-protocol))
+  (let ((socks-override-functions orig-fun))
+    (apply #'socks-open-network-stream name buffer host service params)))
+
+(defcustom socks-proxied-tls-services '(443 6697)
+  "Ports whose connections should use TLS.
+Note that the system resolver may be consulted to look up host
+names for checking domain validation certs."
+  :version "30.1"
+  :type '(repeat number))
+
+(declare-function gnutls-negotiate "gnutls" (&rest rest))
+(declare-function nsm-verify-connection "nsm"
+                  (process host port &optional
+                           save-fingerprint warn-unencrypted))
+
+;;;###autoload
+(defun socks-open-network-stream (name buffer host service &rest params)
+  "Open and return a connection, possibly proxied over SOCKS.
+Expect PARAMS to contain keyword parameters recognized by
+`open-network-stream'.  Assume HOST and SERVICE refer to the
+proxied remote peer rather than the SOCKS server, but assume the
+opposite for PARAMS.  That is, if PARAMS contains a `:type' of
+`tls', treat the underlying connection to the proxy server as
+destined for encryption rather than the tunneled connection (even
+though `socks-connect-function' has the final say).  For TLS with
+proxied connections, see the option `socks-proxied-tls-services'.
+
+Before connecting, check the host against `socks-noproxy' and, on
+rejection, fall back to non-SOCKS.  Similarly, when
+`socks-override-functions' is a function, call it directly and
+trust that it's not interested in options defined in this
+library, such as `socks-server'.
+
+But, before doing anything, check if `url-using-proxy' is bound
+to a `url' struct object, as defined in `url-parse'.  If so,
+assume it represents the address of the desired SOCKS server
+rather than that of the remote peer, and use its fields instead
+of `socks-server' for all SOCKS connection details."
+  (require 'url-parse)
+  (let* ((url (and (url-p url-using-proxy)
+                   (string-prefix-p "socks" (url-type url-using-proxy))
+                   url-using-proxy))
+         (socks-server (if url
+                           (list name (url-host url) (url-port url)
+                                 (pcase (url-type url)
+                                   ("socks4://" 4)
+                                   ("socks4a://" '4a)
+                                   (_ 5)))
+                         socks-server))
+         (socks-username (or (and url (url-user url))
+                             socks-username))
+         (socks-password (or (and url (url-password url))
+                             socks-password)))
+    (if-let* (((booleanp socks-override-functions))
+              (route (socks-find-route host service))
+              (proc (apply #'socks-open-connection route params)))
+        (let ((port (if (numberp service)
+                        service
+                      (process-contact proc :service)))
+              (certs (plist-get params :client-certificate)))
+          (socks--initiate-command-connect proc buffer host service)
+          (if (and (memq port socks-proxied-tls-services)
+                   (gnutls-available-p)
+                   (require 'gnutls nil t)
+                   (require 'nsm nil t))
+              (progn (gnutls-negotiate :process proc
+                                       :hostname host
+                                       :keylist (and certs (list certs)))
+                     (nsm-verify-connection proc host port))
+            proc))
+      (let ((fn (if (functionp socks-override-functions)
+                    socks-override-functions ; `socks-noproxy' not consulted
+                  #'open-network-stream)) ; `socks-noproxy' is non-nil
+            socks-override-functions)
+        (apply fn name buffer host service params)))))
+
+(defun socks--initiate-command-connect (proc buffer host service)
+  (progn ; preserve indentation level for git blame / code review
+    (progn
+      (let* ((version (process-get proc 'socks-server-protocol))
              (atype
               (cond
                ((equal version 4)
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-POC-30.0.50-Integrate-the-socks-and-url-libraries.patch --]
[-- Type: text/x-patch, Size: 7709 bytes --]

From 96a4de741663672e928fd30af6c93b335b346691 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 1 Mar 2022 01:38:33 -0800
Subject: [PATCH 4/4] [POC/30.0.50] Integrate the socks and url libraries

* lisp/url/url-gw.el (url-open-stream): Use presence and type of
`url-using-proxy' to detect caller and massage input values according
to legacy practices.

* lisp/url/url-http.el: (url-http-find-free-connection): Don't call
`url-open-stream' with host and port from active proxy.
(url-http, url-http-async-sentinel): Only open
`url-https-proxy-connect' for non-SOCKS proxies.

* lisp/url/url-proxy.el (url-proxy--socks-scheme-regexp): Add new
const.
(url-default-find-proxy-for-url): Accommodate SOCKS entries but defy
original design somewhat by requiring a URL scheme in the host value
for detection.
(url-find-proxy-for-url): Recognize modified host/address value for
socks entries of `url-proxy-services' and deal accordingly.
(url-proxy): Handle a SOCKS proxy for http(s) connections only.

* lisp/url/url-vars.el (url-proxy-services): Explain that values for
certain gateways may need a leading scheme:// portion.
(url-using-proxy): Add warning regarding expected type.
---
 lisp/url/url-gw.el    |  8 +++++++-
 lisp/url/url-http.el  | 16 +++++++---------
 lisp/url/url-proxy.el | 18 ++++++++++++++++--
 lisp/url/url-vars.el  | 13 ++++++++++---
 4 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index e4d1ca72a0..c93edc0d4e 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -28,7 +28,7 @@
 (require 'url-vars)
 (require 'url-parse)
 
-(autoload 'socks-open-network-stream "socks")
+(autoload 'socks-open-network-stream "socks") ; FIXME remove this
 
 (defgroup url-gateway nil
   "URL gateway variables."
@@ -220,6 +220,12 @@ url-open-stream
 Optional arg GATEWAY-METHOD specifies the gateway to be used,
 overriding the value of `url-gateway-method'."
   (unless url-gateway-unplugged
+    (when (url-p url-using-proxy)
+      (if (or (eq 'socks url-gateway-method)
+              (string-prefix-p "socks" (url-type url-using-proxy)))
+          (setq gateway-method 'socks)
+        (setq host (url-host url-using-proxy)
+              service (url-port url-using-proxy))))
     (let* ((gwm (or gateway-method url-gateway-method))
            (gw-method (if (and url-gateway-local-host-regexp
                                (not (eq 'tls gwm))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 94ef156108..864048a73c 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -195,12 +195,7 @@ url-http-find-free-connection
 	;; like authentication.  But we use another buffer afterwards.
 	(unwind-protect
             (let ((proc (url-open-stream host buf
-                                         (if url-using-proxy
-                                             (url-host url-using-proxy)
-                                           host)
-                                         (if url-using-proxy
-                                             (url-port url-using-proxy)
-                                           port)
+                                         host port
                                          gateway-method)))
 	      ;; url-open-stream might return nil.
 	      (when (processp proc)
@@ -1396,8 +1391,9 @@ url-http
            (error "Could not create connection to %s:%d" (url-host url)
                   (url-port url)))
           (_
-           (if (and url-http-proxy (string= "https"
-                                            (url-type url-current-object)))
+           (if (and url-http-proxy
+                    (not (string-prefix-p "socks" (url-type url-http-proxy)))
+                    (string= "https" (url-type url-current-object)))
                (url-https-proxy-connect connection)
              (set-process-sentinel connection
                                    #'url-http-end-of-document-sentinel)
@@ -1479,7 +1475,9 @@ url-http-async-sentinel
 	(url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
 	(setq url-http-connection-opened t)
-        (if (and url-http-proxy (string= "https" (url-type url-current-object)))
+        (if (and url-http-proxy
+                 (not (string-prefix-p "socks" (url-type url-http-proxy)))
+                 (string= "https" (url-type url-current-object)))
             (url-https-proxy-connect proc)
           (condition-case error
               (process-send-string proc (url-http-create-request))
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index c72e459a4e..f4ddd639f6 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -25,6 +25,9 @@
 
 (require 'url-parse)
 
+(defconst url-proxy--socks-scheme-regexp
+  (rx bot "socks" (? (or "4" "4a" "5" "5h")) "://"))
+
 (defun url-default-find-proxy-for-url (urlobj host)
   (cond
    ((or (and (assoc "no_proxy" url-proxy-services)
@@ -35,7 +38,12 @@ url-default-find-proxy-for-url
 	(equal "www" (url-type urlobj)))
     "DIRECT")
    ((cdr (assoc (url-type urlobj) url-proxy-services))
-    (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
+    (let ((found (alist-get (url-type urlobj) url-proxy-services
+                            nil nil #'equal)))
+      (concat (if (string-match url-proxy--socks-scheme-regexp found)
+                  "SOCKS "
+                "PROXY ")
+              found)))
    ;;
    ;; Should check for socks
    ;;
@@ -57,7 +65,10 @@ url-find-proxy-for-url
      ((string-match "^PROXY +" proxy)
       (concat "http://" (substring proxy (match-end 0)) "/"))
      ((string-match "^SOCKS +" proxy)
-      (concat "socks://" (substring proxy (match-end 0))))
+      (if-let* ((m (substring proxy (match-end 0)))
+                ((string-match url-proxy--socks-scheme-regexp m)))
+          m
+        (concat "socks://" m)))
      (t
       (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
       nil))))
@@ -72,6 +83,9 @@ url-proxy
   (cond
    ((string= (url-type url-using-proxy) "http")
     (url-http url callback cbargs))
+   ((and (string-prefix-p "socks" (url-type url-using-proxy))
+         (string-prefix-p "http" (url-type url)))
+    (url-http url callback cbargs))
    (t
     (error "Don't know how to use proxy `%s'" url-using-proxy))))
 
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 4cdca05554..209d387ea7 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -191,11 +191,16 @@ url-mail-command
 
 (defcustom url-proxy-services nil
   "An alist of schemes and proxy servers that gateway them.
-Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is set up
-from the ACCESS_proxy environment variables."
+Looks like ((\"http\" . \"hostname:portnumber\") ...).  This is
+set up from the ACCESS_proxy environment variables.  Depending on
+the gateway type, values may instead be expected to look like
+\"proxyscheme://hostname:portnumber\" where \"proxyscheme\" is
+something like \"socks5\".  As of Emacs 30.1, this only applies
+to SOCKS servers."
   :type '(repeat (cons :format "%v"
 		       (string :tag "Protocol")
 		       (string :tag "Proxy")))
+  :version "30.1"
   :group 'url)
 
 (defcustom url-standalone-mode nil
@@ -310,7 +315,9 @@ url-show-status
 
 (defvar url-using-proxy nil
   "Either nil or the fully qualified proxy URL in use, e.g.
-https://www.example.com/")
+https://www.example.com/.  Beware that some functions, such as
+`url-proxy' and `url-http-end-of-document-sentinel', set this to
+a `url' struct.")
 
 (defcustom url-news-server nil
   "The default news server from which to get newsgroups/articles.
-- 
2.38.1