;;; socks.el --- A Socks v5 Client for Emacs
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002,
-;; 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2000, 2002, 2007-2013 Free Software Foundation,
+;; Inc.
;; Author: William M. Perry <wmperry@gnu.org>
;; Dave Love <fx@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'wid-edit))
(require 'custom)
-(if (not (fboundp 'split-string))
- (defun split-string (string &optional pattern)
- "Return a list of substrings of STRING which are separated by PATTERN.
+(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)))))
+ (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)))
+;;; (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
: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-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)
(defun socks-build-auth-list ()
(let ((num 0)
(retval ""))
- (mapcar
+ (mapc
(function
(lambda (x)
(if (fboundp (cdr (cdr x)))
)
)
+(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
((= authtype socks-authentication-null)
(and socks-debug (message "No authentication necessary")))
((= authtype socks-authentication-failure)
- (error "No acceptable authentication methods found."))
+ (error "No acceptable authentication methods found"))
(t
(let* ((auth-type (gethash 'authtype info))
(auth-handler (assoc auth-type socks-authentication-methods))
((= atype socks-address-type-name)
(format "%c%s" (length address) address))
(t
- (error "Unkown address type: %d" atype))))
+ (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"
(error "Unsupported address type for HTTP: %d" atype)))
port)))
((equal version 4)
- (setq request (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
- )))
+ (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 (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
- )))
+ (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)
\f
;; Replacement functions for open-network-stream, etc.
(defvar socks-noproxy nil
- "*List of regexps matching hosts that we should not socksify connections to")
+ "List of regexps matching hosts that we should not socksify connections to")
(defun socks-find-route (host service)
(let ((route socks-server)
(setq noproxy (cdr noproxy)))
route))
-(defvar socks-override-functions nil
- "*Whether to overwrite the open-network-stream function with the SOCKSified
-version.")
-
-(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)))
-
(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))
atype
host
(if (stringp service)
- (socks-find-services-entry service)
+ (or
+ (socks-find-services-entry service)
+ (error "Unknown service: %s" service))
service))
(puthash 'buffer buffer info)
(puthash 'host host info)
\f
(defcustom socks-nslookup-program "nslookup"
- "*If non-NIL then a string naming the nslookup program."
+ "If non-NIL then a string naming the nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'socks)
(progn
(setq res (buffer-substring (match-beginning 2)
(match-end 2))
- res (mapcar 'string-to-int (split-string res "\\.")))))
+ res (mapcar 'string-to-number
+ (socks-split-string res "\\.")))))
(kill-buffer (current-buffer)))
res)
host))
(provide 'socks)
-;; arch-tag: 67aef0d9-f4f7-4056-89c3-b4c9bf93ce7f
;;; socks.el ends here
HCoop / bpt / emacs.git / blobdiff