>From 62062472fd14dc9911a105016badcc921d63ae95 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 6 Mar 2022 21:21:49 -0800 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): Simplify network-stream opener in socks.el ; * lisp/url/url-gw.el (url-open-stream): Honor socks gateway-method Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS resolve extension [POC] Demo SOCKS resolve with HTTPS lisp/net/socks.el | 145 ++++++++++++++++++++++++++++------- lisp/url/url-gw.el | 2 + test/lisp/net/socks-tests.el | 113 +++++++++++++++++++++++++-- 3 files changed, 225 insertions(+), 35 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 02edd95328..9285cbf805 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -334,22 +334,19 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") (make-obsolete-variable 'socks-override-functions - "use custom opener with `socks-open-stream-function'." + "see `socks-open-network-stream-function'." "29.1") -(defvar socks-open-stream-function #'open-network-stream - "Function called to open a network stream connection.") - -(defun socks-open-connection (server-info &rest params) +(defun socks-open-connection (server-info &rest kw-args) "Create and initialize a SOCKS process. Perform authentication if needed. SERVER-INFO should resemble -`socks-server'. PARAMS are those accepted by `make-network-process'." +`socks-server'. KW-ARGS are those accepted by `open-network-stream'." (interactive) - (unless (plist-member params :coding) - (setf (plist-get params :coding) '(binary . binary))) + (unless (plist-member kw-args :coding) + (setf (plist-get kw-args :coding) '(binary . binary))) (save-excursion - (let ((proc (apply socks-open-stream-function "socks" nil - (nth 1 server-info) (nth 2 server-info) params)) + (let ((proc (apply #'open-network-stream "socks" nil + (nth 1 server-info) (nth 2 server-info) kw-args)) (authtype nil) version) @@ -533,17 +530,31 @@ socks-find-services-entry (gethash (downcase service) (if udp socks-udp-services socks-tcp-services))) -(defun socks-open-network-stream (name buffer host service &rest params) +(defcustom socks-open-network-stream-function + #'socks-open-network-stream-legacy + "Function to open a SOCKS connection. +Called with NAME, BUFFER, HOST, and SERVICE, for compatibility with +similar functions in the url-gw framework. May also be passed +additional keyword args suitable for `make-network-process'." + :type '(choice (const :tag "Default fallback-oriented opener.") + (function :tag "User-provided function"))) + +(defun socks-open-network-stream-legacy (name buffer host service &rest params) + "Open a SOCKS connection for a valid route. +Fall back to non-SOCKS connections for unknown or undesired routes." (if-let* ((route (socks-find-route host service)) (proc (apply #'socks-open-connection route params))) (socks--open-network-stream proc buffer host service) - (message "Warning: no SOCKS route found for %s:%s" host service) - ;; Support legacy behavior (likely undesirable in most cases) - (apply socks-open-stream-function name buffer host service params))) + ;; Retain legacy behavior and connect anyway without warning + (apply #'open-network-stream name buffer host service params))) + +(defun socks-open-network-stream (name buffer host service &rest params) + "Open a SOCKS connection. PARAMS are passed to `open-network-stream'." + (apply socks-open-network-stream-function name buffer host service params)) (defun socks--open-network-stream (proc buffer host service) (progn ; temporarily preserve git blame for easier reviewing - (progn ; could rename to something like `socks--initiate-command-sequence' + (progn ; could rename to something like `socks--initiate-command-connect' (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond @@ -685,34 +696,31 @@ socks-tor-resolve "Return list of one vector IPv4 address for domain NAME. Or return nil on failure. See `network-lookup-address-info' for format of return value. Server must support the Tor RESOLVE command." - (let ((socks-password (or socks-password "")) - host - (port 80) ; unused for now - route - proc - ip) - (unless (string-suffix-p ".onion" name) - (setq host (if (string-match "\\`[[:ascii:]]+\\'" name) - name - (require 'puny) - (puny-encode-domain name)) - route (socks-find-route host port)) - (cl-assert route) - ;; "Host unreachable" may be raised when the lookup fails - (unwind-protect - (progn - (setq proc (socks-open-connection route)) - (socks-send-command proc - socks-resolve-command - socks-address-type-name - host - port) - (cl-assert (eq (process-get proc 'socks-state) - socks-state-connected)) - (setq ip (socks--extract-resolve-response proc))) - (when proc - (delete-process proc))) - (list (vconcat ip [0]))))) + (let* ((socks-password (or socks-password "")) + (host (if (string-match "\\`[[:ascii:]]+\\'" name) + name + (require 'puny) + (puny-encode-domain name))) + (port 80) ; unused for now + (route (socks-find-route host nil)) + proc + ip) + (cl-assert route) + ;; "Host unreachable" may be raised when the lookup fails + (unwind-protect + (progn + (setq proc (socks-open-connection route)) + (socks-send-command proc + socks-resolve-command + socks-address-type-name + host + port) + (cl-assert (eq (process-get proc 'socks-state) + socks-state-connected)) + (setq ip (socks--extract-resolve-response proc))) + (when proc + (delete-process proc))) + (list (vconcat ip [0])))) (provide 'socks) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index c4a41f56b3..822cbcb64e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -215,6 +215,8 @@ 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 (eq url-gateway-method 'socks) + (setq gateway-method nil)) (let* ((gwm (or gateway-method url-gateway-method)) (gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls gwm)) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index f2600210b0..402ccf979d 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -348,6 +348,7 @@ test-socks-https-poc (ert-with-temp-file tempfile :prefix "emacs-test-socks-network-security-" (let* ((socks-server `("tor" ,@test-socks-service 5)) + (socks-username "user") (socks-password "") (nsm-settings-file tempfile) (url-gateway-method 'socks) @@ -361,25 +362,24 @@ test-socks-https-poc (goto-char (point-min)) (should (search-forward "Congratulations" nil t)) (setq done t))) - (orig (symbol-function #'socks--open-network-stream))) - (cl-letf (((symbol-function 'socks--open-network-stream) - (lambda (&rest rest) - (let ((proc (apply orig rest))) - (gnutls-negotiate :process proc :hostname host) - (should (nsm-verify-connection proc host 443 t)))))) - (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") - (unwind-protect - (progn - (advice-add 'network-lookup-address-info :override - #'socks-tor-resolve) - (should-not (nsm-host-settings id)) - (url-http url cb '(nil)) - (ert-info ("Wait for response") - (with-timeout (3 (error "Request timed out")) - (unless done - (sleep-for 0.1)))) - (should (nsm-host-settings id))) - (advice-remove 'network-lookup-address-info - #'socks-tor-resolve))))))) + (socks-open-network-stream-function + (lambda (&rest rest) + (let ((proc (apply #'socks-open-network-stream-legacy rest))) + (gnutls-negotiate :process proc :hostname host) + (should (nsm-verify-connection proc host 443 t)))))) + (ert-info ("Connect to HTTPS endpoint over Tor SOCKS proxy") + (unwind-protect + (progn + (advice-add 'network-lookup-address-info :override + #'socks-tor-resolve) + (should-not (nsm-host-settings id)) + (url-https url cb '(nil)) + (ert-info ("Wait for response") + (with-timeout (3 (error "Request timed out")) + (unless done + (sleep-for 0.1)))) + (should (nsm-host-settings id))) + (advice-remove 'network-lookup-address-info + #'socks-tor-resolve)))))) ;;; socks-tests.el ends here -- 2.35.1