>From 598e8471789bd6e7eb5a7f3ebc1bbed3cf61f4c6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 1 Mar 2022 06:09:00 -0800 Subject: [PATCH 0/5] NOT A PATCH *** BLURB HERE *** F. Jason Park (5): Simplify network-stream opener in socks.el Fix string encoding bug in socks tests Add support for SOCKS 4a Support SOCKS RESOLVE extension [POC] Demo SOCKS RESOLVE over HTTPS lisp/net/socks.el | 130 +++++++++++++++++++++++++++-------- test/lisp/net/socks-tests.el | 113 ++++++++++++++++++++++++++++-- 2 files changed, 208 insertions(+), 35 deletions(-) Interdiff: diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 7201ed8e06..cd026fd163 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -333,24 +333,23 @@ socks-filter (defvar socks-override-functions nil "If non-nil, overwrite `open-network-stream' function with SOCKSified version.") - -(when socks-override-functions - (advice-add 'open-network-stream :around #'socks--open-network-stream)) - -(defun socks-open-connection (server-info) +(make-obsolete-variable 'socks-override-functions + "`socks--open-network-stream' now takes a process arg." + "29.1") + +(defun socks-open-connection (server-info &optional opener) + "Create and initialize a SOCKS process. +Perform authentication if needed. SERVER-INFO should resemble +`socks-server'. OPENER, when present, should be a substitute for +`open-network-stream' and take the same arguments." (interactive) (save-excursion - (let ((proc - (let ((socks-override-functions nil)) - (open-network-stream "socks" - nil - (nth 1 server-info) - (nth 2 server-info)))) + (let ((proc (funcall (or opener #'open-network-stream) + "socks" nil (nth 1 server-info) (nth 2 server-info))) (authtype nil) version) ;; Initialize process and info about the process - (set-process-coding-system proc 'binary 'binary) (set-process-filter proc #'socks-filter) (set-process-query-on-exit-flag proc nil) (process-put proc 'socks t) @@ -530,22 +529,18 @@ 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)) +(defun socks-open-network-stream (name buffer host service &rest params) + (if-let* ((route (socks-find-route host service)) + (proc (socks-open-connection route #'open-network-stream))) + (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 #'open-network-stream 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' + (let* ((version (process-get proc 'socks-server-protocol)) (atype (cond ((equal version 4) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 4963dd7b40..f2600210b0 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))))) @@ -137,10 +137,10 @@ socks-tests-canned-server-create (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) (pcase-let ((`(,pat . ,resp) (pop pats))) - (setq resp (apply #'unibyte-string (append resp nil))) (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))) @@ -374,11 +374,11 @@ test-socks-https-poc #'socks-tor-resolve) (should-not (nsm-host-settings id)) (url-http url cb '(nil)) - (should (nsm-host-settings id)) (ert-info ("Wait for response") (with-timeout (3 (error "Request timed out")) (unless done - (sleep-for 0.1))))) + (sleep-for 0.1)))) + (should (nsm-host-settings id))) (advice-remove 'network-lookup-address-info #'socks-tor-resolve))))))) -- 2.35.1