mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-25 07:28:20 +00:00
892f8ca389
* lisp/net/socks.el (socks-split-string): Use this rather than split-string. (socks-nslookup-host): Update for above change. (dynamic-choice, s5-dynamic-choice-match) (s5-dynamic-choice-match-inline, s5-widget-value-create): Comment out unused code. Comment out other unused code in a more standard manner, with ";" rather than "'".
663 lines
22 KiB
EmacsLisp
663 lines
22 KiB
EmacsLisp
;;; socks.el --- A Socks v5 Client for Emacs
|
||
|
||
;; Copyright (C) 1996-2000, 2002, 2007-2013 Free Software Foundation,
|
||
;; Inc.
|
||
|
||
;; Author: William M. Perry <wmperry@gnu.org>
|
||
;; Dave Love <fx@gnu.org>
|
||
;; Keywords: comm, firewalls
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This is an implementation of the SOCKS v5 protocol as defined in
|
||
;; RFC 1928.
|
||
|
||
;; TODO
|
||
;; - Finish the redirection rules stuff
|
||
;; - Implement composition of servers. Recursively evaluate the
|
||
;; redirection rules and do SOCKS-over-HTTP and SOCKS-in-SOCKS
|
||
|
||
(eval-when-compile
|
||
(require 'wid-edit))
|
||
(require 'custom)
|
||
|
||
(eval-and-compile
|
||
(if (featurep 'emacs)
|
||
(defalias 'socks-split-string 'split-string) ; since at least 21.1
|
||
(if (fboundp 'split-string)
|
||
(defalias 'socks-split-string 'split-string)
|
||
(defun socks-split-string (string &optional pattern)
|
||
"Return a list of substrings of STRING which are separated by PATTERN.
|
||
If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
|
||
(or pattern
|
||
(setq pattern "[ \f\t\n\r\v]+"))
|
||
(let (parts (start 0))
|
||
(while (string-match pattern string start)
|
||
(setq parts (cons (substring string start
|
||
(match-beginning 0)) parts)
|
||
start (match-end 0)))
|
||
(nreverse (cons (substring string start) parts)))))))
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; Custom widgets
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; (define-widget 'dynamic-choice 'menu-choice
|
||
;;; "A pretty simple dynamic dropdown list"
|
||
;;; :format "%[%t%]: %v"
|
||
;;; :tag "Network"
|
||
;;; :case-fold t
|
||
;;; :void '(item :format "invalid (%t)\n")
|
||
;;; :value-create 's5-widget-value-create
|
||
;;; :value-delete 'widget-children-value-delete
|
||
;;; :value-get 'widget-choice-value-get
|
||
;;; :value-inline 'widget-choice-value-inline
|
||
;;; :mouse-down-action 'widget-choice-mouse-down-action
|
||
;;; :action 'widget-choice-action
|
||
;;; :error "Make a choice"
|
||
;;; :validate 'widget-choice-validate
|
||
;;; :match 's5-dynamic-choice-match
|
||
;;; :match-inline 's5-dynamic-choice-match-inline)
|
||
;;;
|
||
;;; (defun s5-dynamic-choice-match (widget value)
|
||
;;; (let ((choices (funcall (widget-get widget :choice-function)))
|
||
;;; current found)
|
||
;;; (while (and choices (not found))
|
||
;;; (setq current (car choices)
|
||
;;; choices (cdr choices)
|
||
;;; found (widget-apply current :match value)))
|
||
;;; found))
|
||
;;;
|
||
;;; (defun s5-dynamic-choice-match-inline (widget value)
|
||
;;; (let ((choices (funcall (widget-get widget :choice-function)))
|
||
;;; current found)
|
||
;;; (while (and choices (not found))
|
||
;;; (setq current (car choices)
|
||
;;; choices (cdr choices)
|
||
;;; found (widget-match-inline current value)))
|
||
;;; found))
|
||
;;;
|
||
;;; (defun s5-widget-value-create (widget)
|
||
;;; (let ((choices (funcall (widget-get widget :choice-function)))
|
||
;;; (value (widget-get widget :value)))
|
||
;;; (if (not value)
|
||
;;; (widget-put widget :value (widget-value (car choices))))
|
||
;;; (widget-put widget :args choices)
|
||
;;; (widget-choice-value-create widget)))
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; Customization support
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
(defgroup socks nil
|
||
"SOCKS Support"
|
||
:version "22.2"
|
||
:prefix "socks-"
|
||
:group 'processes)
|
||
|
||
;;; (defcustom socks-server-aliases nil
|
||
;;; "A list of server aliases for use in access control and filtering rules."
|
||
;;; :group 'socks
|
||
;;; :type '(repeat (list :format "%v"
|
||
;;; :value ("" "" 1080 5)
|
||
;;; (string :tag "Alias")
|
||
;;; (string :tag "Hostname/IP Address")
|
||
;;; (integer :tag "Port #")
|
||
;;; (choice :tag "SOCKS Version"
|
||
;;; (integer :tag "SOCKS v4" :value 4)
|
||
;;; (integer :tag "SOCKS v5" :value 5)))))
|
||
;;;
|
||
;;; (defcustom socks-network-aliases
|
||
;;; '(("Anywhere" (netmask "0.0.0.0" "0.0.0.0")))
|
||
;;; "A list of network aliases for use in subsequent rules."
|
||
;;; :group 'socks
|
||
;;; :type '(repeat (list :format "%v"
|
||
;;; :value (netmask "" "255.255.255.0")
|
||
;;; (string :tag "Alias")
|
||
;;; (radio-button-choice
|
||
;;; :format "%v"
|
||
;;; (list :tag "IP address range"
|
||
;;; (const :format "" :value range)
|
||
;;; (string :tag "From")
|
||
;;; (string :tag "To"))
|
||
;;; (list :tag "IP address/netmask"
|
||
;;; (const :format "" :value netmask)
|
||
;;; (string :tag "IP Address")
|
||
;;; (string :tag "Netmask"))
|
||
;;; (list :tag "Domain Name"
|
||
;;; (const :format "" :value domain)
|
||
;;; (string :tag "Domain name"))
|
||
;;; (list :tag "Unique hostname/IP address"
|
||
;;; (const :format "" :value exact)
|
||
;;; (string :tag "Hostname/IP Address"))))))
|
||
;;;
|
||
;;; (defun s5-servers-filter ()
|
||
;;; (if socks-server-aliases
|
||
;;; (mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) s5-server-aliases)
|
||
;;; '((const :tag "No aliases defined" :value nil))))
|
||
;;;
|
||
;;; (defun s5-network-aliases-filter ()
|
||
;;; (mapcar (lambda (x) (list 'const :tag (car x) :value (car x)))
|
||
;;; socks-network-aliases))
|
||
;;;
|
||
;;; (defcustom socks-redirection-rules
|
||
;;; nil
|
||
;;; "A list of redirection rules."
|
||
;;; :group 'socks
|
||
;;; :type '(repeat (list :format "%v"
|
||
;;; :value ("Anywhere" nil)
|
||
;;; (dynamic-choice :choice-function s5-network-aliases-filter
|
||
;;; :tag "Destination network")
|
||
;;; (radio-button-choice
|
||
;;; :tag "Connection type"
|
||
;;; (const :tag "Direct connection" :value nil)
|
||
;;; (dynamic-choice :format "%t: %[%v%]"
|
||
;;; :choice-function s5-servers-filter
|
||
;;; :tag "Proxy chain via")))))
|
||
|
||
(defcustom socks-server
|
||
(list "Default server" "socks" 1080 5)
|
||
""
|
||
:group 'socks
|
||
:type '(list
|
||
(string :format "" :value "Default server")
|
||
(string :tag "Server")
|
||
(integer :tag "Port")
|
||
(radio-button-choice :tag "SOCKS Version"
|
||
:format "%t: %v"
|
||
(const :tag "SOCKS v4 " :format "%t" :value 4)
|
||
(const :tag "SOCKS v5" :format "%t" :value 5))))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; Get down to the nitty gritty
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
(defconst socks-version 5)
|
||
(defvar socks-debug nil)
|
||
|
||
;; Common socks v5 commands
|
||
(defconst socks-connect-command 1)
|
||
(defconst socks-bind-command 2)
|
||
(defconst socks-udp-associate-command 3)
|
||
|
||
;; Miscellaneous other socks constants
|
||
(defconst socks-authentication-null 0)
|
||
(defconst socks-authentication-failure 255)
|
||
|
||
;; Response codes
|
||
(defconst socks-response-success 0)
|
||
(defconst socks-response-general-failure 1)
|
||
(defconst socks-response-access-denied 2)
|
||
(defconst socks-response-network-unreachable 3)
|
||
(defconst socks-response-host-unreachable 4)
|
||
(defconst socks-response-connection-refused 5)
|
||
(defconst socks-response-ttl-expired 6)
|
||
(defconst socks-response-cmd-not-supported 7)
|
||
(defconst socks-response-address-not-supported 8)
|
||
|
||
(defvar socks-errors
|
||
'("Succeeded"
|
||
"General SOCKS server failure"
|
||
"Connection not allowed by ruleset"
|
||
"Network unreachable"
|
||
"Host unreachable"
|
||
"Connection refused"
|
||
"Time-to-live expired"
|
||
"Command not supported"
|
||
"Address type not supported"))
|
||
|
||
;; The socks v5 address types
|
||
(defconst socks-address-type-v4 1)
|
||
(defconst socks-address-type-name 3)
|
||
(defconst socks-address-type-v6 4)
|
||
|
||
;; Base variables
|
||
(defvar socks-timeout 5)
|
||
(defvar socks-connections (make-hash-table :size 13))
|
||
|
||
;; Miscellaneous stuff for authentication
|
||
(defvar socks-authentication-methods nil)
|
||
(defvar socks-username (user-login-name))
|
||
(defvar socks-password nil)
|
||
|
||
(defun socks-register-authentication-method (id desc callback)
|
||
(let ((old (assq id socks-authentication-methods)))
|
||
(if old
|
||
(setcdr old (cons desc callback))
|
||
(setq socks-authentication-methods
|
||
(cons (cons id (cons desc callback))
|
||
socks-authentication-methods)))))
|
||
|
||
(defun socks-unregister-authentication-method (id)
|
||
(let ((old (assq id socks-authentication-methods)))
|
||
(if old
|
||
(setq socks-authentication-methods
|
||
(delq old socks-authentication-methods)))))
|
||
|
||
(socks-register-authentication-method 0 "No authentication" 'identity)
|
||
|
||
(defun socks-build-auth-list ()
|
||
(let ((num 0)
|
||
(retval ""))
|
||
(mapc
|
||
(function
|
||
(lambda (x)
|
||
(if (fboundp (cdr (cdr x)))
|
||
(setq retval (format "%s%c" retval (car x))
|
||
num (1+ num)))))
|
||
(reverse socks-authentication-methods))
|
||
(format "%c%s" num retval)))
|
||
|
||
(defconst socks-state-waiting-for-auth 0)
|
||
(defconst socks-state-submethod-negotiation 1)
|
||
(defconst socks-state-authenticated 2)
|
||
(defconst socks-state-waiting 3)
|
||
(defconst socks-state-connected 4)
|
||
|
||
(defmacro socks-wait-for-state-change (proc htable cur-state)
|
||
`(while (and (= (gethash 'state ,htable) ,cur-state)
|
||
(memq (process-status ,proc) '(run open)))
|
||
(accept-process-output ,proc socks-timeout)))
|
||
|
||
(defun socks-filter (proc string)
|
||
(let ((info (gethash proc socks-connections))
|
||
state version desired-len)
|
||
(or info (error "socks-filter called on non-SOCKS connection %S" proc))
|
||
(setq state (gethash 'state info))
|
||
(cond
|
||
((= state socks-state-waiting-for-auth)
|
||
(puthash 'scratch (concat string (gethash 'scratch info)) info)
|
||
(setq string (gethash 'scratch info))
|
||
(if (< (length string) 2)
|
||
nil ; We need to spin some more
|
||
(puthash 'authtype (aref string 1) info)
|
||
(puthash 'scratch (substring string 2 nil) info)
|
||
(puthash 'state socks-state-submethod-negotiation info)))
|
||
((= state socks-state-submethod-negotiation)
|
||
)
|
||
((= state socks-state-authenticated)
|
||
)
|
||
((= state socks-state-waiting)
|
||
(puthash 'scratch (concat string (gethash 'scratch info)) info)
|
||
(setq string (gethash 'scratch info))
|
||
(setq version (gethash 'server-protocol info))
|
||
(cond
|
||
((equal version 'http)
|
||
(if (not (string-match "\r\n\r\n" string))
|
||
nil ; Need to spin some more
|
||
(puthash 'state socks-state-connected info)
|
||
(puthash 'reply 0 info)
|
||
(puthash 'response string info)))
|
||
((equal version 4)
|
||
(if (< (length string) 2)
|
||
nil ; Can't know how much to read yet
|
||
(setq desired-len
|
||
(+ 4 ; address length
|
||
2 ; port
|
||
2 ; initial data
|
||
))
|
||
(if (< (length string) desired-len)
|
||
nil ; need to spin some more
|
||
(let ((response (aref string 1)))
|
||
(if (= response 90)
|
||
(setq response 0))
|
||
(puthash 'state socks-state-connected info)
|
||
(puthash 'reply response info)
|
||
(puthash 'response string info)))))
|
||
((equal version 5)
|
||
(if (< (length string) 4)
|
||
nil
|
||
(setq desired-len
|
||
(+ 6 ; Standard socks header
|
||
(cond
|
||
((= (aref string 3) socks-address-type-v4) 4)
|
||
((= (aref string 3) socks-address-type-v6) 16)
|
||
((= (aref string 3) socks-address-type-name)
|
||
(if (< (length string) 5)
|
||
255
|
||
(+ 1 (aref string 4)))))))
|
||
(if (< (length string) desired-len)
|
||
nil ; Need to spin some more
|
||
(puthash 'state socks-state-connected info)
|
||
(puthash 'reply (aref string 1) info)
|
||
(puthash 'response string info))))))
|
||
((= state socks-state-connected)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
(declare-function socks-original-open-network-stream "socks") ; fset
|
||
|
||
;; FIXME this is a terrible idea.
|
||
;; It is not even compatible with the argument spec of open-network-stream
|
||
;; in 24.1. If this is really necessary, open-network-stream
|
||
;; could get a wrapper hook, or defer to open-network-stream-function.
|
||
|
||
(defvar socks-override-functions nil
|
||
"Whether to overwrite the open-network-stream function with the SOCKSified
|
||
version.")
|
||
|
||
(require 'network-stream)
|
||
|
||
(if (fboundp 'socks-original-open-network-stream)
|
||
nil ; Do nothing, we've been here already
|
||
(defalias 'socks-original-open-network-stream
|
||
(symbol-function 'open-network-stream))
|
||
(if socks-override-functions
|
||
(defalias 'open-network-stream 'socks-open-network-stream)))
|
||
|
||
(defun socks-open-connection (server-info)
|
||
(interactive)
|
||
(save-excursion
|
||
(let ((proc (socks-original-open-network-stream "socks"
|
||
nil
|
||
(nth 1 server-info)
|
||
(nth 2 server-info)))
|
||
(info (make-hash-table :size 13))
|
||
(authtype nil)
|
||
version)
|
||
|
||
;; Initialize process and info about the process
|
||
(set-process-filter proc 'socks-filter)
|
||
(set-process-query-on-exit-flag proc nil)
|
||
(puthash proc info socks-connections)
|
||
(puthash 'state socks-state-waiting-for-auth info)
|
||
(puthash 'authtype socks-authentication-failure info)
|
||
(puthash 'server-protocol (nth 3 server-info) info)
|
||
(puthash 'server-name (nth 1 server-info) info)
|
||
(setq version (nth 3 server-info))
|
||
(cond
|
||
((equal version 'http)
|
||
;; Don't really have to do any connection setup under http
|
||
nil)
|
||
((equal version 4)
|
||
;; Don't really have to do any connection setup under v4
|
||
nil)
|
||
((equal version 5)
|
||
;; Need to handle all the authentication crap under v5
|
||
;; Send what we think we can handle for authentication types
|
||
(process-send-string proc (format "%c%s" socks-version
|
||
(socks-build-auth-list)))
|
||
|
||
;; Basically just do a select() until we change states.
|
||
(socks-wait-for-state-change proc info socks-state-waiting-for-auth)
|
||
(setq authtype (gethash 'authtype info))
|
||
(cond
|
||
((= authtype socks-authentication-null)
|
||
(and socks-debug (message "No authentication necessary")))
|
||
((= authtype socks-authentication-failure)
|
||
(error "No acceptable authentication methods found"))
|
||
(t
|
||
(let* ((auth-type (gethash 'authtype info))
|
||
(auth-handler (assoc auth-type socks-authentication-methods))
|
||
(auth-func (and auth-handler (cdr (cdr auth-handler))))
|
||
(auth-desc (and auth-handler (car (cdr auth-handler)))))
|
||
(set-process-filter proc nil)
|
||
(if (and auth-func (fboundp auth-func)
|
||
(funcall auth-func proc))
|
||
nil ; We succeeded!
|
||
(delete-process proc)
|
||
(error "Failed to use auth method: %s (%d)"
|
||
(or auth-desc "Unknown") auth-type))
|
||
)
|
||
)
|
||
)
|
||
(puthash 'state socks-state-authenticated info)
|
||
(set-process-filter proc 'socks-filter)))
|
||
proc)))
|
||
|
||
(defun socks-send-command (proc command atype address port)
|
||
(let ((addr (cond
|
||
((or (= atype socks-address-type-v4)
|
||
(= atype socks-address-type-v6))
|
||
address)
|
||
((= atype socks-address-type-name)
|
||
(format "%c%s" (length address) address))
|
||
(t
|
||
(error "Unknown address type: %d" atype))))
|
||
(info (gethash proc socks-connections))
|
||
request version)
|
||
(or info (error "socks-send-command called on non-SOCKS connection %S"
|
||
proc))
|
||
(puthash 'state socks-state-waiting info)
|
||
(setq version (gethash 'server-protocol info))
|
||
(cond
|
||
((equal version 'http)
|
||
(setq request (format (eval-when-compile
|
||
(concat
|
||
"CONNECT %s:%d HTTP/1.0\r\n"
|
||
"User-Agent: Emacs/SOCKS v1.0\r\n"
|
||
"\r\n"))
|
||
(cond
|
||
((equal atype socks-address-type-name) address)
|
||
(t
|
||
(error "Unsupported address type for HTTP: %d" atype)))
|
||
port)))
|
||
((equal version 4)
|
||
(setq request (string-make-unibyte
|
||
(format
|
||
"%c%c%c%c%s%s%c"
|
||
version ; version
|
||
command ; command
|
||
(lsh port -8) ; port, high byte
|
||
(- port (lsh (lsh port -8) 8)) ; port, low byte
|
||
addr ; address
|
||
(user-full-name) ; username
|
||
0 ; terminate username
|
||
))))
|
||
((equal version 5)
|
||
(setq request (string-make-unibyte
|
||
(format
|
||
"%c%c%c%c%s%c%c"
|
||
version ; version
|
||
command ; command
|
||
0 ; reserved
|
||
atype ; address type
|
||
addr ; address
|
||
(lsh port -8) ; port, high byte
|
||
(- port (lsh (lsh port -8) 8)) ; port, low byte
|
||
))))
|
||
(t
|
||
(error "Unknown protocol version: %d" version)))
|
||
(process-send-string proc request)
|
||
(socks-wait-for-state-change proc info socks-state-waiting)
|
||
(process-status proc)
|
||
(if (= (or (gethash 'reply info) 1) socks-response-success)
|
||
nil ; Sweet sweet success!
|
||
(delete-process proc)
|
||
(error "SOCKS: %s" (nth (or (gethash 'reply info) 1) socks-errors)))
|
||
proc))
|
||
|
||
|
||
;; Replacement functions for open-network-stream, etc.
|
||
(defvar socks-noproxy nil
|
||
"List of regexps matching hosts that we should not socksify connections to")
|
||
|
||
(defun socks-find-route (host service)
|
||
(let ((route socks-server)
|
||
(noproxy socks-noproxy))
|
||
(while noproxy
|
||
(if (eq ?! (aref (car noproxy) 0))
|
||
(if (string-match (substring (car noproxy) 1) host)
|
||
(setq noproxy nil))
|
||
(if (string-match (car noproxy) host)
|
||
(setq route nil
|
||
noproxy nil)))
|
||
(setq noproxy (cdr noproxy)))
|
||
route))
|
||
|
||
(defvar socks-services-file "/etc/services")
|
||
(defvar socks-tcp-services (make-hash-table :size 13 :test 'equal))
|
||
(defvar socks-udp-services (make-hash-table :size 13 :test 'equal))
|
||
|
||
(defun socks-parse-services ()
|
||
(if (not (and (file-exists-p socks-services-file)
|
||
(file-readable-p socks-services-file)))
|
||
(error "Could not find services file: %s" socks-services-file))
|
||
(clrhash socks-tcp-services)
|
||
(clrhash socks-udp-services)
|
||
(with-current-buffer (get-buffer-create " *socks-tmp*")
|
||
(erase-buffer)
|
||
(insert-file-contents socks-services-file)
|
||
;; Nuke comments
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "#.*" nil t)
|
||
(replace-match ""))
|
||
;; Nuke empty lines
|
||
(goto-char (point-min))
|
||
(while (re-search-forward "^[ \t\n]+" nil t)
|
||
(replace-match ""))
|
||
;; Now find all the lines
|
||
(goto-char (point-min))
|
||
(let (name port type)
|
||
(while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)/\\([a-z]+\\)"
|
||
nil t)
|
||
(setq name (downcase (match-string 1))
|
||
port (string-to-number (match-string 2))
|
||
type (downcase (match-string 3)))
|
||
(puthash name port (if (equal type "udp")
|
||
socks-udp-services
|
||
socks-tcp-services))))))
|
||
|
||
(defun socks-find-services-entry (service &optional udp)
|
||
"Return the port # associated with SERVICE"
|
||
(if (= (hash-table-count socks-tcp-services) 0)
|
||
(socks-parse-services))
|
||
(gethash (downcase service)
|
||
(if udp socks-udp-services socks-tcp-services)))
|
||
|
||
(defun socks-open-network-stream (name buffer host service)
|
||
(let* ((route (socks-find-route host service))
|
||
proc info version atype)
|
||
(if (not route)
|
||
(socks-original-open-network-stream name buffer host service)
|
||
(setq proc (socks-open-connection route)
|
||
info (gethash proc socks-connections)
|
||
version (gethash 'server-protocol info))
|
||
(cond
|
||
((equal version 4)
|
||
(setq host (socks-nslookup-host host))
|
||
(if (not (listp host))
|
||
(error "Could not get IP address for: %s" host))
|
||
(setq host (apply 'format "%c%c%c%c" host))
|
||
(setq atype socks-address-type-v4))
|
||
(t
|
||
(setq atype socks-address-type-name)))
|
||
(socks-send-command proc
|
||
socks-connect-command
|
||
atype
|
||
host
|
||
(if (stringp service)
|
||
(or
|
||
(socks-find-services-entry service)
|
||
(error "Unknown service: %s" service))
|
||
service))
|
||
(puthash 'buffer buffer info)
|
||
(puthash 'host host info)
|
||
(puthash 'service host info)
|
||
(set-process-filter proc nil)
|
||
(set-process-buffer proc (if buffer (get-buffer-create buffer)))
|
||
proc)))
|
||
|
||
;; Authentication modules go here
|
||
|
||
;; Basic username/password authentication, ala RFC 1929
|
||
(socks-register-authentication-method 2 "Username/Password"
|
||
'socks-username/password-auth)
|
||
|
||
(defconst socks-username/password-auth-version 1)
|
||
|
||
(defun socks-username/password-auth-filter (proc str)
|
||
(let ((info (gethash proc socks-connections)))
|
||
(or info (error "socks-filter called on non-SOCKS connection %S" proc))
|
||
(puthash 'scratch (concat (gethash 'scratch info) str) info)
|
||
(if (< (length (gethash 'scratch info)) 2)
|
||
nil
|
||
(puthash 'password-auth-status (aref (gethash 'scratch info) 1) info)
|
||
(puthash 'state socks-state-authenticated info))))
|
||
|
||
(defun socks-username/password-auth (proc)
|
||
(let* ((info (gethash proc socks-connections))
|
||
(state (gethash 'state info)))
|
||
(if (not socks-password)
|
||
(setq socks-password (read-passwd
|
||
(format "Password for %s@%s: "
|
||
socks-username
|
||
(gethash 'server-name info)))))
|
||
(puthash 'scratch "" info)
|
||
(set-process-filter proc 'socks-username/password-auth-filter)
|
||
(process-send-string proc
|
||
(format "%c%c%s%c%s"
|
||
socks-username/password-auth-version
|
||
(length socks-username)
|
||
socks-username
|
||
(length socks-password)
|
||
socks-password))
|
||
(socks-wait-for-state-change proc info state)
|
||
(= (gethash 'password-auth-status info) 0)))
|
||
|
||
|
||
;; More advanced GSS/API stuff, not yet implemented - volunteers?
|
||
;; (socks-register-authentication-method 1 "GSS/API" 'socks-gssapi-auth)
|
||
|
||
(defun socks-gssapi-auth (proc)
|
||
nil)
|
||
|
||
|
||
;; CHAP stuff
|
||
;; (socks-register-authentication-method 3 "CHAP" 'socks-chap-auth)
|
||
(defun socks-chap-auth (proc)
|
||
nil)
|
||
|
||
|
||
;; CRAM stuff
|
||
;; (socks-register-authentication-method 5 "CRAM" 'socks-cram-auth)
|
||
(defun socks-cram-auth (proc)
|
||
nil)
|
||
|
||
|
||
(defcustom socks-nslookup-program "nslookup"
|
||
"If non-NIL then a string naming the nslookup program."
|
||
:type '(choice (const :tag "None" :value nil) string)
|
||
:group 'socks)
|
||
|
||
(defun socks-nslookup-host (host)
|
||
"Attempt to resolve the given HOSTNAME using nslookup if possible."
|
||
(interactive "sHost: ")
|
||
(if socks-nslookup-program
|
||
(let ((proc (start-process " *nslookup*" " *nslookup*"
|
||
socks-nslookup-program host))
|
||
(res host))
|
||
(set-process-query-on-exit-flag proc nil)
|
||
(with-current-buffer (process-buffer proc)
|
||
(while (progn
|
||
(accept-process-output proc)
|
||
(memq (process-status proc) '(run open))))
|
||
(goto-char (point-min))
|
||
(if (re-search-forward "Name:.*\nAddress\\(es\\)?: *\\([0-9.]+\\)$" nil t)
|
||
(progn
|
||
(setq res (buffer-substring (match-beginning 2)
|
||
(match-end 2))
|
||
res (mapcar 'string-to-number
|
||
(socks-split-string res "\\.")))))
|
||
(kill-buffer (current-buffer)))
|
||
res)
|
||
host))
|
||
|
||
(provide 'socks)
|
||
|
||
;;; socks.el ends here
|