|
14
|
1 ;;; socks.el --- A Socks v5 Client for Emacs
|
|
|
2 ;; Author: wmperry
|
|
16
|
3 ;; Created: 1997/01/10 00:13:05
|
|
|
4 ;; Version: 1.3
|
|
14
|
5 ;; Keywords: comm, firewalls
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
16
|
8 ;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@cs.indiana.edu)
|
|
14
|
9 ;;;
|
|
|
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
11 ;;;
|
|
|
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; You should have received a copy of the GNU General Public License
|
|
|
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
26 ;;;
|
|
|
27 ;;; This is an implementation of the SOCKS v5 protocol as defined in
|
|
|
28 ;;; RFC 1928.
|
|
|
29 ;;;
|
|
|
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
31 (require 'cl)
|
|
|
32
|
|
|
33 (defconst socks-version 5)
|
|
|
34 (defvar socks-debug nil)
|
|
|
35
|
|
|
36 ;; Common socks v5 commands
|
|
|
37 (defconst socks-connect-command 1)
|
|
|
38 (defconst socks-bind-command 2)
|
|
|
39 (defconst socks-udp-associate-command 3)
|
|
|
40
|
|
|
41 ;; Miscellaneous other socks constants
|
|
|
42 (defconst socks-authentication-null 0)
|
|
|
43 (defconst socks-authentication-failure 255)
|
|
|
44
|
|
|
45 ;; Response codes
|
|
|
46 (defconst socks-response-success 0)
|
|
|
47 (defconst socks-response-general-failure 1)
|
|
|
48 (defconst socks-response-access-denied 2)
|
|
|
49 (defconst socks-response-network-unreachable 3)
|
|
|
50 (defconst socks-response-host-unreachable 4)
|
|
|
51 (defconst socks-response-connection-refused 5)
|
|
|
52 (defconst socks-response-ttl-expired 6)
|
|
|
53 (defconst socks-response-cmd-not-supported 7)
|
|
|
54 (defconst socks-response-address-not-supported 8)
|
|
|
55
|
|
|
56 (defvar socks-errors
|
|
|
57 '("Succeeded"
|
|
|
58 "General SOCKS server failure"
|
|
|
59 "Connection not allowed by ruleset"
|
|
|
60 "Network unreachable"
|
|
|
61 "Host unreachable"
|
|
|
62 "Connection refused"
|
|
|
63 "Time-to-live expired"
|
|
|
64 "Command not supported"
|
|
|
65 "Address type not supported"))
|
|
|
66
|
|
|
67 ;; The socks v5 address types
|
|
|
68 (defconst socks-address-type-v4 1)
|
|
|
69 (defconst socks-address-type-name 3)
|
|
|
70 (defconst socks-address-type-v6 4)
|
|
|
71
|
|
|
72 ;; Base variables
|
|
|
73 (defvar socks-host (or (getenv "SOCKS5_SERVER") "socks"))
|
|
|
74 (defvar socks-port (or (getenv "SOCKS5_PORT") 1080))
|
|
|
75 (defvar socks-timeout 5)
|
|
|
76 (defvar socks-connections (make-hash-table :size 13))
|
|
|
77
|
|
|
78 ;; Miscellaneous stuff for authentication
|
|
|
79 (defvar socks-authentication-methods nil)
|
|
|
80 (defvar socks-username (user-login-name))
|
|
|
81 (defvar socks-password nil)
|
|
|
82
|
|
|
83 (defun socks-register-authentication-method (id desc callback)
|
|
|
84 (let ((old (assq id socks-authentication-methods)))
|
|
|
85 (if old
|
|
|
86 (setcdr old (cons desc callback))
|
|
|
87 (setq socks-authentication-methods
|
|
|
88 (cons (cons id (cons desc callback))
|
|
|
89 socks-authentication-methods)))))
|
|
|
90
|
|
|
91 (defun socks-unregister-authentication-method (id)
|
|
|
92 (let ((old (assq id socks-authentication-methods)))
|
|
|
93 (if old
|
|
|
94 (setq socks-authentication-methods
|
|
|
95 (delq old socks-authentication-methods)))))
|
|
|
96
|
|
|
97 (socks-register-authentication-method 0 "No authentication" 'identity)
|
|
|
98
|
|
|
99 (defun socks-build-auth-list ()
|
|
|
100 (let ((num 0)
|
|
|
101 (retval ""))
|
|
|
102 (mapcar
|
|
|
103 (function
|
|
|
104 (lambda (x)
|
|
|
105 (if (fboundp (cdr (cdr x)))
|
|
|
106 (setq retval (format "%s%c" retval (car x))
|
|
|
107 num (1+ num)))))
|
|
|
108 socks-authentication-methods)
|
|
|
109 (format "%c%s" num retval)))
|
|
|
110
|
|
|
111 (defconst socks-state-waiting-for-auth 0)
|
|
|
112 (defconst socks-state-submethod-negotiation 1)
|
|
|
113 (defconst socks-state-authenticated 2)
|
|
|
114 (defconst socks-state-waiting 3)
|
|
|
115 (defconst socks-state-connected 4)
|
|
|
116
|
|
|
117 (defmacro socks-wait-for-state-change (proc htable cur-state)
|
|
|
118 (`
|
|
|
119 (while (and (= (cl-gethash 'state (, htable)) (, cur-state))
|
|
|
120 (memq (process-status (, proc)) '(run open)))
|
|
|
121 (accept-process-output (, proc) socks-timeout))))
|
|
|
122
|
|
|
123 (defun socks-filter (proc string)
|
|
|
124 (let ((info (cl-gethash proc socks-connections))
|
|
|
125 state desired-len)
|
|
|
126 (or info (error "socks-filter called on non-SOCKS connection %S" proc))
|
|
|
127 (setq state (cl-gethash 'state info))
|
|
|
128 (cond
|
|
|
129 ((= state socks-state-waiting-for-auth)
|
|
|
130 (cl-puthash 'scratch (concat string (cl-gethash 'scratch info)) info)
|
|
|
131 (setq string (cl-gethash 'scratch info))
|
|
|
132 (if (< (length string) 2)
|
|
|
133 nil ; We need to spin some more
|
|
|
134 (cl-puthash 'authtype (aref string 1) info)
|
|
|
135 (cl-puthash 'scratch (substring string 2 nil) info)
|
|
|
136 (cl-puthash 'state socks-state-submethod-negotiation info)))
|
|
|
137 ((= state socks-state-submethod-negotiation)
|
|
|
138 )
|
|
|
139 ((= state socks-state-authenticated)
|
|
|
140 )
|
|
|
141 ((= state socks-state-waiting)
|
|
|
142 (cl-puthash 'scratch (concat string (cl-gethash 'scratch info)) info)
|
|
|
143 (setq string (cl-gethash 'scratch info))
|
|
|
144 (if (< (length string) 4)
|
|
|
145 nil
|
|
|
146 (setq desired-len
|
|
|
147 (+ 6 ; Standard socks header
|
|
|
148 (cond
|
|
|
149 ((= (aref string 3) socks-address-type-v4) 4)
|
|
|
150 ((= (aref string 3) socks-address-type-v6) 16)
|
|
|
151 ((= (aref string 3) socks-address-type-name)
|
|
|
152 (if (< (length string) 5)
|
|
|
153 255
|
|
|
154 (+ 1 (aref string 4)))))))
|
|
|
155 (if (< (length string) desired-len)
|
|
|
156 nil ; Need to spin some more
|
|
|
157 (cl-puthash 'state socks-state-connected info)
|
|
|
158 (cl-puthash 'reply (aref string 1) info)
|
|
|
159 (cl-puthash 'response string info))))
|
|
|
160 ((= state socks-state-connected)
|
|
|
161 )
|
|
|
162 )
|
|
|
163 )
|
|
|
164 )
|
|
|
165
|
|
|
166 (defun socks-open-connection (&optional host port)
|
|
|
167 (interactive)
|
|
|
168 (setq host (or host socks-host)
|
|
|
169 port (or port socks-port))
|
|
|
170 (save-excursion
|
|
|
171 (let ((proc (socks-original-open-network-stream "socks"
|
|
|
172 nil
|
|
|
173 host port))
|
|
|
174 (info (make-hash-table :size 13))
|
|
|
175 (authtype nil))
|
|
|
176
|
|
|
177 ;; Initialize process and info about the process
|
|
|
178 (set-process-filter proc 'socks-filter)
|
|
|
179 (process-kill-without-query proc)
|
|
|
180 (cl-puthash proc info socks-connections)
|
|
|
181 (cl-puthash 'state socks-state-waiting-for-auth info)
|
|
|
182 (cl-puthash 'authtype socks-authentication-failure info)
|
|
|
183
|
|
|
184 ;; Send what we think we can handle for authentication types
|
|
|
185 (process-send-string proc (format "%c%s" socks-version
|
|
|
186 (socks-build-auth-list)))
|
|
|
187
|
|
|
188 ;; Basically just do a select() until we change states.
|
|
|
189 (socks-wait-for-state-change proc info socks-state-waiting-for-auth)
|
|
|
190 (setq authtype (cl-gethash 'authtype info))
|
|
|
191 (cond
|
|
|
192 ((= authtype socks-authentication-null)
|
|
|
193 (and socks-debug (message "No authentication necessary")))
|
|
|
194 ((= authtype socks-authentication-failure)
|
|
|
195 (error "No acceptable authentication methods found."))
|
|
|
196 (t
|
|
|
197 (let* ((auth-type (char-int (cl-gethash 'authtype info)))
|
|
|
198 (auth-handler (assoc auth-type socks-authentication-methods))
|
|
|
199 (auth-func (and auth-handler (cdr (cdr auth-handler))))
|
|
|
200 (auth-desc (and auth-handler (car (cdr auth-handler)))))
|
|
|
201 (set-process-filter proc nil)
|
|
|
202 (if (and auth-func (fboundp auth-func)
|
|
|
203 (funcall auth-func proc))
|
|
|
204 (message "Successfully authenticated using: %s" auth-desc)
|
|
|
205 (delete-process proc)
|
|
|
206 (error "Failed to use auth method: %s (%d)"
|
|
|
207 (or auth-desc "Unknown") auth-type))
|
|
|
208 )
|
|
|
209 )
|
|
|
210 )
|
|
|
211 (cl-puthash 'state socks-state-authenticated info)
|
|
|
212 (set-process-filter proc 'socks-filter)
|
|
|
213 proc)))
|
|
|
214
|
|
|
215 (defun socks-send-command (proc command atype address port)
|
|
|
216 (let ((addr (case atype
|
|
|
217 (socks-address-type-v4 address)
|
|
|
218 (socks-address-type-v6 address)
|
|
|
219 (t
|
|
|
220 (format "%c%s" (length address) address))))
|
|
|
221 (info (cl-gethash proc socks-connections)))
|
|
|
222 (or info (error "socks-send-command called on non-SOCKS connection %S"
|
|
|
223 proc))
|
|
|
224 (cl-puthash 'state socks-state-waiting info)
|
|
|
225 (process-send-string proc
|
|
|
226 (format
|
|
|
227 "%c%c%c%c%s%c%c"
|
|
|
228 socks-version ; version
|
|
|
229 command ; command
|
|
|
230 0 ; reserved
|
|
|
231 atype ; address type
|
|
|
232 addr ; address
|
|
|
233 (lsh port -8) ; port, high byte
|
|
|
234 (- port (lsh (lsh port -8) 8)) ; port, low byte
|
|
|
235 ))
|
|
|
236 (socks-wait-for-state-change proc info socks-state-waiting)
|
|
|
237 (if (= (cl-gethash 'reply info) socks-response-success)
|
|
|
238 nil ; Sweet sweet success!
|
|
|
239 (delete-process proc)
|
|
|
240 (error "%s" (nth (cl-gethash 'reply info) socks-errors)))
|
|
|
241 proc))
|
|
|
242
|
|
|
243
|
|
|
244 ;; Replacement functions for open-network-stream, etc.
|
|
|
245 (defvar socks-noproxy nil
|
|
|
246 "*List of regexps matching hosts that we should not socksify connections to")
|
|
|
247
|
|
|
248 (defun socks-find-route (host service)
|
|
|
249 (let ((route (cons socks-host socks-port))
|
|
|
250 (noproxy socks-noproxy))
|
|
|
251 (while noproxy
|
|
|
252 (if (string-match (car noproxy) host)
|
|
|
253 (setq route nil
|
|
|
254 noproxy nil))
|
|
|
255 (setq noproxy (cdr noproxy)))
|
|
|
256 route))
|
|
|
257
|
|
|
258 (if (fboundp 'socks-original-open-network-stream)
|
|
|
259 nil ; Do nothing, we've been here already
|
|
|
260 (fset 'socks-original-open-network-stream
|
|
|
261 (symbol-function 'open-network-stream))
|
|
|
262 (fset 'open-network-stream 'socks-open-network-stream))
|
|
|
263
|
|
|
264 (defvar socks-services-file "/etc/services")
|
|
|
265 (defvar socks-tcp-services (make-hash-table :size 13 :test 'equal))
|
|
|
266 (defvar socks-udp-services (make-hash-table :size 13 :test 'equal))
|
|
|
267
|
|
|
268 (defun socks-parse-services ()
|
|
|
269 (if (not (and (file-exists-p socks-services-file)
|
|
|
270 (file-readable-p socks-services-file)))
|
|
|
271 (error "Could not find services file: %s" socks-services-file))
|
|
|
272 (save-excursion
|
|
|
273 (clrhash socks-tcp-services)
|
|
|
274 (clrhash socks-udp-services)
|
|
|
275 (set-buffer (get-buffer-create " *socks-tmp*"))
|
|
|
276 (erase-buffer)
|
|
|
277 (insert-file-contents socks-services-file)
|
|
|
278 ;; Nuke comments
|
|
|
279 (goto-char (point-min))
|
|
|
280 (while (re-search-forward "#.*" nil t)
|
|
|
281 (replace-match ""))
|
|
|
282 ;; Nuke empty lines
|
|
|
283 (goto-char (point-min))
|
|
|
284 (while (re-search-forward "^[ \t\n]+" nil t)
|
|
|
285 (replace-match ""))
|
|
|
286 ;; Now find all the lines
|
|
|
287 (goto-char (point-min))
|
|
|
288 (let (name port type)
|
|
|
289 (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)/\\([a-z]+\\)"
|
|
|
290 nil t)
|
|
|
291 (setq name (downcase (match-string 1))
|
|
|
292 port (string-to-int (match-string 2))
|
|
|
293 type (downcase (match-string 3)))
|
|
|
294 (cl-puthash name port (if (equal type "udp")
|
|
|
295 socks-udp-services
|
|
|
296 socks-tcp-services))))))
|
|
|
297
|
|
|
298 (defun socks-find-services-entry (service &optional udp)
|
|
|
299 "Return the port # associated with SERVICE"
|
|
|
300 (if (= (hash-table-count socks-tcp-services) 0)
|
|
|
301 (socks-parse-services))
|
|
|
302 (cl-gethash (downcase service)
|
|
|
303 (if udp socks-udp-services socks-tcp-services)))
|
|
|
304
|
|
|
305 (defun socks-open-network-stream (name buffer host service)
|
|
|
306 (let* ((route (socks-find-route host service))
|
|
|
307 proc info)
|
|
|
308 (if (not route)
|
|
|
309 (socks-original-open-network-stream name buffer host service)
|
|
|
310 (setq proc (socks-open-connection (car route) (cdr route))
|
|
|
311 info (cl-gethash proc socks-connections))
|
|
|
312 (socks-send-command proc socks-connect-command
|
|
|
313 socks-address-type-name
|
|
|
314 host
|
|
|
315 (if (stringp service)
|
|
|
316 (socks-find-services-entry service)
|
|
|
317 service))
|
|
|
318 (cl-puthash 'buffer buffer info)
|
|
|
319 (cl-puthash 'host host info)
|
|
|
320 (cl-puthash 'service host info)
|
|
|
321 (set-process-filter proc nil)
|
|
|
322 (set-process-buffer proc (if buffer (get-buffer-create buffer)))
|
|
|
323 proc)))
|
|
|
324
|
|
|
325 ;; Authentication modules go here
|
|
|
326
|
|
|
327 ;; Basic username/password authentication, ala RFC 1929
|
|
|
328 ;; To enable username/password authentication, uncomment the following
|
|
|
329 ;; lines:
|
|
|
330 ;;
|
|
|
331 ;; (socks-register-authentication-method 2 "Username/Password"
|
|
|
332 ;; 'socks-username/password-auth)
|
|
|
333
|
|
|
334 (defconst socks-username/password-auth-version 1)
|
|
|
335
|
|
|
336 (if (not (fboundp 'char-int))
|
|
|
337 (fset 'char-int 'identity))
|
|
|
338
|
|
|
339 (defun socks-username/password-auth-filter (proc str)
|
|
|
340 (let ((info (cl-gethash proc socks-connections))
|
|
|
341 state desired-len)
|
|
|
342 (or info (error "socks-filter called on non-SOCKS connection %S" proc))
|
|
|
343 (setq state (cl-gethash 'state info))
|
|
|
344 (cl-puthash 'scratch (concat (cl-gethash 'scratch info) str) info)
|
|
|
345 (if (< (length (cl-gethash 'scratch info)) 2)
|
|
|
346 nil
|
|
|
347 (cl-puthash 'password-auth-status (char-int
|
|
|
348 (aref (cl-gethash 'scratch info) 1))
|
|
|
349 info)
|
|
|
350 (cl-puthash 'state socks-state-authenticated info))))
|
|
|
351
|
|
|
352 (defun socks-username/password-auth (proc)
|
|
|
353 (if (not socks-password)
|
|
|
354 (setq socks-password (read-passwd
|
|
|
355 (format "Password for %s@%s: "
|
|
|
356 socks-username socks-host))))
|
|
|
357 (let* ((info (cl-gethash proc socks-connections))
|
|
|
358 (state (cl-gethash 'state info)))
|
|
|
359 (cl-puthash 'scratch "" info)
|
|
|
360 (set-process-filter proc 'socks-username/password-auth-filter)
|
|
|
361 (process-send-string proc
|
|
|
362 (format "%c%c%s%c%s"
|
|
|
363 socks-username/password-auth-version
|
|
|
364 (length socks-username)
|
|
|
365 socks-username
|
|
|
366 (length socks-password)
|
|
|
367 socks-password))
|
|
|
368 (socks-wait-for-state-change proc info state)
|
|
|
369 (= (cl-gethash 'password-auth-status info) 0)))
|
|
|
370
|
|
|
371
|
|
|
372 ;; More advanced GSS/API stuff, not yet implemented - volunteers?
|
|
|
373 ;; (socks-register-authentication-method 1 "GSS/API" 'socks-gssapi-auth)
|
|
|
374
|
|
|
375 (defun socks-gssapi-auth (proc)
|
|
|
376 nil)
|
|
|
377
|
|
|
378
|
|
|
379 ;; CHAP stuff
|
|
|
380 ;; (socks-register-authentication-method 3 "CHAP" 'socks-chap-auth)
|
|
|
381 (defun socks-chap-auth (proc)
|
|
|
382 nil)
|
|
|
383
|
|
|
384 (provide 'socks)
|
