From a32e6d440e38b97090c9ae3fbf607ec71a49277e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 19 Dec 2023 07:08:36 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [POC] Support SOCKS resolve extension [POC] Simplify network-stream openers in socks.el [POC] Integrate the socks and url libraries lisp/net/nsm.el | 8 +- lisp/net/socks.el | 189 +++++++++++++++++++++++++++++++---- lisp/url/url-gw.el | 8 +- lisp/url/url-http.el | 19 ++-- lisp/url/url-methods.el | 8 +- lisp/url/url-proxy.el | 22 ++-- lisp/url/url-vars.el | 20 +++- test/lisp/net/socks-tests.el | 70 +++++++++++++ 8 files changed, 300 insertions(+), 44 deletions(-) Interdiff: diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 09f7ac52537..234a7c5e74a 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -220,6 +220,10 @@ nsm-network-same-subnet (aref mask i)))))) matches))) +(defvar nsm--network-lookup-address-function nil + "Function to replace `network-lookup-address-info' in nsm check. +It should have the same signature as the original.") + (defun nsm-should-check (host) "Determine whether NSM should check for TLS problems for HOST. @@ -227,7 +231,9 @@ nsm-should-check host address is a localhost address, or in the same subnet as one of the local interfaces, this function returns nil. Non-nil otherwise." - (let ((addresses (network-lookup-address-info host)) + (let ((addresses (if nsm--network-lookup-address-function + (funcall nsm--network-lookup-address-function host) + (network-lookup-address-info host))) (network-interface-list (network-interface-list t)) (off-net t)) (when diff --git a/lisp/net/socks.el b/lisp/net/socks.el index a04f93e0960..8d16db75834 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -181,6 +181,9 @@ socks-udp-associate-command (defconst socks-authentication-null 0) (defconst socks-authentication-failure 255) +;; Extensions +(defconst socks-resolve-command #xf0) + ;; Response codes (defconst socks-response-success 0) (defconst socks-response-general-failure 1) @@ -554,6 +557,9 @@ socks-proxied-tls-services (process host port &optional save-fingerprint warn-unencrypted)) +(defvar socks-server-name-as-tor-service-regexp (rx bow "tor" eow) + "Regexp to determine if a `socks-server' entry is TOR service.") + ;;;###autoload (defun socks-open-network-stream (name buffer host service &rest params) "Open and return a connection, possibly proxied over SOCKS. @@ -579,17 +585,18 @@ socks-open-network-stream (let* ((url (and (url-p url-using-proxy) (string-prefix-p "socks" (url-type url-using-proxy)) url-using-proxy)) + (server-name (and url (string= (nth 1 socks-server) (url-host url)) + (= (nth 2 socks-server) (url-port url)) + (car socks-server))) (socks-server (if url - (list name (url-host url) (url-port url) + (list server-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))) + (socks-username (or (and url (url-user url)) socks-username)) + (socks-password (or (and url (url-password url)) socks-password))) (if-let ((route (socks-find-route host service)) (proc (apply #'socks-open-connection route params))) (let ((port (if (numberp service) @@ -597,15 +604,20 @@ socks-open-network-stream (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))) - (unless (string-suffix-p ".onion" host) - (nsm-verify-connection proc host port)))) + (when (and (memq port socks-proxied-tls-services) + (gnutls-available-p) + (require 'gnutls nil t) + (require 'nsm nil t)) + (defvar nsm--network-lookup-address-function) + (let ((nsm--network-lookup-address-function + (and (string-match socks-server-name-as-tor-service-regexp + (car socks-server)) + #'socks-tor-resolve))) + (gnutls-negotiate :process proc + :hostname host + :keylist (and certs (list certs))) + (unless (string-suffix-p ".onion" host) + (nsm-verify-connection proc host port)))) proc) (apply socks-connect-function name buffer host service params)))) @@ -724,6 +736,72 @@ socks-nslookup-host res) host)) +(defun socks--extract-resolve-response (proc) + "Parse response for PROC and maybe return destination IP address." + (when-let ((response (process-get proc 'socks-response))) + (pcase (process-get proc 'socks-server-protocol) + (4 ; https://www.openssh.com/txt/socks4a.protocol + (and-let* (((zerop (process-get proc 'socks-reply))) + ((eq (aref response 1) 90)) ; #x5a request granted + (a (substring response 4)) ; ignore port for now + ((not (string-empty-p a))) + ((not (string= a "\0\0\0\0")))) + a)) + (5 ; https://tools.ietf.org/html/rfc1928 + (cl-assert (eq 5 (aref response 0)) t) + (pcase (aref response 3) ; ATYP + (1 (and-let* ((a (substring response 4 8)) + ((not (string= a "\0\0\0\0"))) + a))) + ;; No reason to support RESOLVE_PTR [F1] extension, right? + (3 (let ((len (1- (aref response 4)))) + (substring response 5 (+ 5 len)))) + (4 (substring response 4 20))))))) + +(declare-function puny-encode-domain "puny" (domain)) + +(defun socks--tor-resolve (name &optional _family _flags) + (condition-case err + (if-let ((socks-password (or socks-password "")) + (route (socks-find-route name nil)) + (proc (socks-send-command (socks-open-connection route) + socks-resolve-command + socks-address-type-name + name + 0)) + (ip (prog1 (socks--extract-resolve-response proc) + (delete-process proc)))) + (list (vconcat ip [0])) + (error "Failed to resolve %s" name)) + (error + (unless (member (cadr err) + '("SOCKS: Host unreachable" "SOCKS: Rejected or failed")) + (signal (car err) (cdr err)))))) + +(defvar socks--tor-resolve-cache nil) + +(defun socks-tor-resolve (name &optional _family _flags) + "Return list with a single IPv4 address for domain NAME. +Return nil on failure. + +See `network-lookup-address-info' for format of return value. As +of 0.4.8.9, TOR's resolution service does not support IPv6. +SOCKS server must support the Tor RESOLVE command. Note that +this function exists for novelty purposes only. Using it in +place of `network-lookup-address-info' or similar may not prevent +DNS leaks." + (unless (string-match (rx bot (+ ascii) eot) name) + (require 'puny) + (setq name (puny-encode-domain name))) + ;; FIXME use some kind of LRU here. Currently resets at 5 min. + (if socks--tor-resolve-cache + (when (time-less-p (car socks--tor-resolve-cache) (current-time)) + (clrhash (cdr socks--tor-resolve-cache))) + (setq socks--tor-resolve-cache (cons (time-add (* 60 5) (current-time)) + (make-hash-table :test #'equal)))) + (with-memoization (gethash name (cdr socks--tor-resolve-cache)) + (socks--tor-resolve name))) + (provide 'socks) ;;; socks.el ends here diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 1a4bac37bf9..cc9f5a385d2 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -327,4 +327,74 @@ socks-override-functions (should-not (advice-member-p #'socks--open-network-stream 'open-network-stream))) +(ert-deftest tor-resolve-4a () + "Make request to TOR resolve service over SOCKS4a" + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 90 0 0 93 184 216 34]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should (equal '([93 184 216 34 0]) + (socks-tor-resolve "example.com"))))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-4a-fail () + (let* ((socks-server '("server" "127.0.0.1" t 4a)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-tests-canned-server-patterns + '(([4 #xf0 0 0 0 0 0 1 ?f ?o ?o 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] + . [0 91 0 0 0 0 0 0]))) + (inhibit-message noninteractive) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS4") + (cl-letf (((symbol-function 'user-full-name) + (lambda (&optional _) "foo"))) + (should-not (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5-fail () + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "") + (socks-authentication-methods (copy-sequence + socks-authentication-methods)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 0 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 4 0 0 0 0 0 0 0 0]))) + (server (socks-tests-canned-server-create))) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should-not (socks-tor-resolve "example.com"))) + (kill-buffer (process-buffer server)) + (delete-process server))) + +(ert-deftest tor-resolve-5 () + "Make request to TOR resolve service over SOCKS5" + (let* ((socks-server '("server" "127.0.0.1" t 5)) + (socks-username "foo") + (socks-authentication-methods (append socks-authentication-methods + nil)) + (inhibit-message noninteractive) + (socks-tests-canned-server-patterns + '(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 #xf0 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 0] + . [5 0 0 1 93 184 216 34 0 0]))) + (server (socks-tests-canned-server-create)) + socks--tor-resolve-cache) + (ert-info ("Query TOR RESOLVE service over SOCKS5") + (should (equal '([93 184 216 34 0]) (socks-tor-resolve "example.com")))) + (kill-buffer (process-buffer server)) + (delete-process server))) + ;;; socks-tests.el ends here -- 2.42.0