1 |
;;; socks.el --- A Socks v5 Client for Emacs |
2 |
;; Author: $Author: fx $ |
3 |
;; Created: $Date: 2002/01/22 18:57:48 $ |
4 |
;; Version: $Revision: 1.6 $ |
5 |
;; Keywords: comm, firewalls |
6 |
|
7 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
8 |
;;; Copyright (c) 1996 - 1998 by William M. Perry <wmperry@cs.indiana.edu> |
9 |
;;; Copyright (c) 1996, 97, 98, 1999, 2000 Free Software Foundation, Inc. |
10 |
;;; |
11 |
;;; This file is part of GNU Emacs. |
12 |
;;; |
13 |
;;; GNU Emacs is free software; you can redistribute it and/or modify |
14 |
;;; it under the terms of the GNU General Public License as published by |
15 |
;;; the Free Software Foundation; either version 2, or (at your option) |
16 |
;;; any later version. |
17 |
;;; |
18 |
;;; GNU Emacs is distributed in the hope that it will be useful, |
19 |
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 |
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
21 |
;;; GNU General Public License for more details. |
22 |
;;; |
23 |
;;; You should have received a copy of the GNU General Public License |
24 |
;;; along with GNU Emacs; see the file COPYING. If not, write to |
25 |
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
26 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
27 |
;;; |
28 |
;;; This is an implementation of the SOCKS v5 protocol as defined in |
29 |
;;; RFC 1928. |
30 |
;;; |
31 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
32 |
|
33 |
;; TODO |
34 |
;; - Finish the redirection rules stuff |
35 |
;; - Implement composition of servers. Recursively evaluate the |
36 |
;; redirection rules and do SOCKS-over-HTTP and SOCKS-in-SOCKS |
37 |
|
38 |
(eval-when-compile |
39 |
(require 'cl) |
40 |
(require 'wid-edit)) |
41 |
(require 'custom) |
42 |
|
43 |
;; For non-XEmacs-MULE |
44 |
(if (fboundp 'char-int) |
45 |
(defalias 'socks-char-int 'char-int) |
46 |
(defalias 'socks-char-int 'identity)) |
47 |
|
48 |
(if (not (fboundp 'split-string)) |
49 |
(defun split-string (string &optional pattern) |
50 |
"Return a list of substrings of STRING which are separated by PATTERN. |
51 |
If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." |
52 |
(or pattern |
53 |
(setq pattern "[ \f\t\n\r\v]+")) |
54 |
(let (parts (start 0)) |
55 |
(while (string-match pattern string start) |
56 |
(setq parts (cons (substring string start (match-beginning 0)) parts) |
57 |
start (match-end 0))) |
58 |
(nreverse (cons (substring string start) parts))))) |
59 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
60 |
;;; Custom widgets |
61 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
62 |
(define-widget 'dynamic-choice 'menu-choice |
63 |
"A pretty simple dynamic dropdown list" |
64 |
:format "%[%t%]: %v" |
65 |
:tag "Network" |
66 |
:case-fold t |
67 |
:void '(item :format "invalid (%t)\n") |
68 |
:value-create 's5-widget-value-create |
69 |
:value-delete 'widget-children-value-delete |
70 |
:value-get 'widget-choice-value-get |
71 |
:value-inline 'widget-choice-value-inline |
72 |
:mouse-down-action 'widget-choice-mouse-down-action |
73 |
:action 'widget-choice-action |
74 |
:error "Make a choice" |
75 |
:validate 'widget-choice-validate |
76 |
:match 's5-dynamic-choice-match |
77 |
:match-inline 's5-dynamic-choice-match-inline) |
78 |
|
79 |
(defun s5-dynamic-choice-match (widget value) |
80 |
(let ((choices (funcall (widget-get widget :choice-function))) |
81 |
current found) |
82 |
(while (and choices (not found)) |
83 |
(setq current (car choices) |
84 |
choices (cdr choices) |
85 |
found (widget-apply current :match value))) |
86 |
found)) |
87 |
|
88 |
(defun s5-dynamic-choice-match-inline (widget value) |
89 |
(let ((choices (funcall (widget-get widget :choice-function))) |
90 |
current found) |
91 |
(while (and choices (not found)) |
92 |
(setq current (car choices) |
93 |
choices (cdr choices) |
94 |
found (widget-match-inline current value))) |
95 |
found)) |
96 |
|
97 |
(defun s5-widget-value-create (widget) |
98 |
(let ((choices (funcall (widget-get widget :choice-function))) |
99 |
(value (widget-get widget :value))) |
100 |
(if (not value) |
101 |
(widget-put widget :value (widget-value (car choices)))) |
102 |
(widget-put widget :args choices) |
103 |
(widget-choice-value-create widget))) |
104 |
|
105 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
106 |
;;; Customization support |
107 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
108 |
(defgroup socks nil |
109 |
"SOCKS Support" |
110 |
:prefix "socks-" |
111 |
:group 'processes) |
112 |
|
113 |
'(defcustom socks-server-aliases nil |
114 |
"A list of server aliases for use in access control and filtering rules." |
115 |
:group 'socks |
116 |
:type '(repeat (list :format "%v" |
117 |
:value ("" "" 1080 5) |
118 |
(string :tag "Alias") |
119 |
(string :tag "Hostname/IP Address") |
120 |
(integer :tag "Port #") |
121 |
(choice :tag "SOCKS Version" |
122 |
(integer :tag "SOCKS v4" :value 4) |
123 |
(integer :tag "SOCKS v5" :value 5))))) |
124 |
|
125 |
'(defcustom socks-network-aliases |
126 |
'(("Anywhere" (netmask "0.0.0.0" "0.0.0.0"))) |
127 |
"A list of network aliases for use in subsequent rules." |
128 |
:group 'socks |
129 |
:type '(repeat (list :format "%v" |
130 |
:value (netmask "" "255.255.255.0") |
131 |
(string :tag "Alias") |
132 |
(radio-button-choice |
133 |
:format "%v" |
134 |
(list :tag "IP address range" |
135 |
(const :format "" :value range) |
136 |
(string :tag "From") |
137 |
(string :tag "To")) |
138 |
(list :tag "IP address/netmask" |
139 |
(const :format "" :value netmask) |
140 |
(string :tag "IP Address") |
141 |
(string :tag "Netmask")) |
142 |
(list :tag "Domain Name" |
143 |
(const :format "" :value domain) |
144 |
(string :tag "Domain name")) |
145 |
(list :tag "Unique hostname/IP address" |
146 |
(const :format "" :value exact) |
147 |
(string :tag "Hostname/IP Address")))))) |
148 |
|
149 |
'(defun s5-servers-filter () |
150 |
(if socks-server-aliases |
151 |
(mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) s5-server-aliases) |
152 |
'((const :tag "No aliases defined" :value nil)))) |
153 |
|
154 |
'(defun s5-network-aliases-filter () |
155 |
(mapcar (lambda (x) (list 'const :tag (car x) :value (car x))) |
156 |
socks-network-aliases)) |
157 |
|
158 |
'(defcustom socks-redirection-rules |
159 |
nil |
160 |
"A list of redirection rules." |
161 |
:group 'socks |
162 |
:type '(repeat (list :format "%v" |
163 |
:value ("Anywhere" nil) |
164 |
(dynamic-choice :choice-function s5-network-aliases-filter |
165 |
:tag "Destination network") |
166 |
(radio-button-choice |
167 |
:tag "Connection type" |
168 |
(const :tag "Direct connection" :value nil) |
169 |
(dynamic-choice :format "%t: %[%v%]" |
170 |
:choice-function s5-servers-filter |
171 |
:tag "Proxy chain via"))))) |
172 |
|
173 |
(defcustom socks-server |
174 |
(list "Default server" "socks" 1080 5) |
175 |
"" |
176 |
:group 'socks |
177 |
:type '(list |
178 |
(string :format "" :value "Default server") |
179 |
(string :tag "Server") |
180 |
(integer :tag "Port") |
181 |
(radio-button-choice :tag "SOCKS Version" |
182 |
:format "%t: %v" |
183 |
(const :tag "SOCKS v4 " :format "%t" :value 4) |
184 |
(const :tag "SOCKS v5" :format "%t" :value 5)))) |
185 |
|
186 |
|
187 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
188 |
;;; Get down to the nitty gritty |
189 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
190 |
(defconst socks-version 5) |
191 |
(defvar socks-debug nil) |
192 |
|
193 |
;; Common socks v5 commands |
194 |
(defconst socks-connect-command 1) |
195 |
(defconst socks-bind-command 2) |
196 |
(defconst socks-udp-associate-command 3) |
197 |
|
198 |
;; Miscellaneous other socks constants |
199 |
(defconst socks-authentication-null 0) |
200 |
(defconst socks-authentication-failure 255) |
201 |
|
202 |
;; Response codes |
203 |
(defconst socks-response-success 0) |
204 |
(defconst socks-response-general-failure 1) |
205 |
(defconst socks-response-access-denied 2) |
206 |
(defconst socks-response-network-unreachable 3) |
207 |
(defconst socks-response-host-unreachable 4) |
208 |
(defconst socks-response-connection-refused 5) |
209 |
(defconst socks-response-ttl-expired 6) |
210 |
(defconst socks-response-cmd-not-supported 7) |
211 |
(defconst socks-response-address-not-supported 8) |
212 |
|
213 |
(defvar socks-errors |
214 |
'("Succeeded" |
215 |
"General SOCKS server failure" |
216 |
"Connection not allowed by ruleset" |
217 |
"Network unreachable" |
218 |
"Host unreachable" |
219 |
"Connection refused" |
220 |
"Time-to-live expired" |
221 |
"Command not supported" |
222 |
"Address type not supported")) |
223 |
|
224 |
;; The socks v5 address types |
225 |
(defconst socks-address-type-v4 1) |
226 |
(defconst socks-address-type-name 3) |
227 |
(defconst socks-address-type-v6 4) |
228 |
|
229 |
;; Base variables |
230 |
(defvar socks-timeout 5) |
231 |
(defvar socks-connections (make-hash-table :size 13)) |
232 |
|
233 |
;; Miscellaneous stuff for authentication |
234 |
(defvar socks-authentication-methods nil) |
235 |
(defvar socks-username (user-login-name)) |
236 |
(defvar socks-password nil) |
237 |
|
238 |
(defun socks-register-authentication-method (id desc callback) |
239 |
(let ((old (assq id socks-authentication-methods))) |
240 |
(if old |
241 |
(setcdr old (cons desc callback)) |
242 |
(setq socks-authentication-methods |
243 |
(cons (cons id (cons desc callback)) |
244 |
socks-authentication-methods))))) |
245 |
|
246 |
(defun socks-unregister-authentication-method (id) |
247 |
(let ((old (assq id socks-authentication-methods))) |
248 |
(if old |
249 |
(setq socks-authentication-methods |
250 |
(delq old socks-authentication-methods))))) |
251 |
|
252 |
(socks-register-authentication-method 0 "No authentication" 'identity) |
253 |
|
254 |
(defun socks-build-auth-list () |
255 |
(let ((num 0) |
256 |
(retval "")) |
257 |
(mapcar |
258 |
(function |
259 |
(lambda (x) |
260 |
(if (fboundp (cdr (cdr x))) |
261 |
(setq retval (format "%s%c" retval (car x)) |
262 |
num (1+ num))))) |
263 |
(reverse socks-authentication-methods)) |
264 |
(format "%c%s" num retval))) |
265 |
|
266 |
(defconst socks-state-waiting-for-auth 0) |
267 |
(defconst socks-state-submethod-negotiation 1) |
268 |
(defconst socks-state-authenticated 2) |
269 |
(defconst socks-state-waiting 3) |
270 |
(defconst socks-state-connected 4) |
271 |
|
272 |
(defmacro socks-wait-for-state-change (proc htable cur-state) |
273 |
(` |
274 |
(while (and (= (gethash 'state (, htable)) (, cur-state)) |
275 |
(memq (process-status (, proc)) '(run open))) |
276 |
(accept-process-output (, proc) socks-timeout)))) |
277 |
|
278 |
(defun socks-filter (proc string) |
279 |
(let ((info (gethash proc socks-connections)) |
280 |
state desired-len) |
281 |
(or info (error "socks-filter called on non-SOCKS connection %S" proc)) |
282 |
(setq state (gethash 'state info)) |
283 |
(cond |
284 |
((= state socks-state-waiting-for-auth) |
285 |
(puthash 'scratch (concat string (gethash 'scratch info)) info) |
286 |
(setq string (gethash 'scratch info)) |
287 |
(if (< (length string) 2) |
288 |
nil ; We need to spin some more |
289 |
(puthash 'authtype (socks-char-int (aref string 1)) info) |
290 |
(puthash 'scratch (substring string 2 nil) info) |
291 |
(puthash 'state socks-state-submethod-negotiation info))) |
292 |
((= state socks-state-submethod-negotiation) |
293 |
) |
294 |
((= state socks-state-authenticated) |
295 |
) |
296 |
((= state socks-state-waiting) |
297 |
(puthash 'scratch (concat string (gethash 'scratch info)) info) |
298 |
(setq string (gethash 'scratch info)) |
299 |
(case (gethash 'server-protocol info) |
300 |
(http |
301 |
(if (not (string-match "\r\n\r\n" string)) |
302 |
nil ; Need to spin some more |
303 |
(debug) |
304 |
(puthash 'state socks-state-connected info) |
305 |
(puthash 'reply 0 info) |
306 |
(puthash 'response string info))) |
307 |
(4 |
308 |
(if (< (length string) 2) |
309 |
nil ; Can't know how much to read yet |
310 |
(setq desired-len |
311 |
(+ 4 ; address length |
312 |
2 ; port |
313 |
2 ; initial data |
314 |
)) |
315 |
(if (< (length string) desired-len) |
316 |
nil ; need to spin some more |
317 |
(let ((response (socks-char-int (aref string 1)))) |
318 |
(if (= response 90) |
319 |
(setq response 0)) |
320 |
(puthash 'state socks-state-connected info) |
321 |
(puthash 'reply response info) |
322 |
(puthash 'response string info))))) |
323 |
(5 |
324 |
(if (< (length string) 4) |
325 |
nil |
326 |
(setq desired-len |
327 |
(+ 6 ; Standard socks header |
328 |
(cond |
329 |
((= (socks-char-int (aref string 3)) socks-address-type-v4) 4) |
330 |
((= (socks-char-int (aref string 3)) socks-address-type-v6) 16) |
331 |
((= (socks-char-int (aref string 3)) socks-address-type-name) |
332 |
(if (< (length string) 5) |
333 |
255 |
334 |
(+ 1 (socks-char-int (aref string 4)))))))) |
335 |
(if (< (length string) desired-len) |
336 |
nil ; Need to spin some more |
337 |
(puthash 'state socks-state-connected info) |
338 |
(puthash 'reply (socks-char-int (aref string 1)) info) |
339 |
(puthash 'response string info)))))) |
340 |
((= state socks-state-connected) |
341 |
) |
342 |
) |
343 |
) |
344 |
) |
345 |
|
346 |
(defun socks-open-connection (server-info) |
347 |
(interactive) |
348 |
(save-excursion |
349 |
(let ((proc (socks-original-open-network-stream "socks" |
350 |
nil |
351 |
(nth 1 server-info) |
352 |
(nth 2 server-info))) |
353 |
(info (make-hash-table :size 13)) |
354 |
(authtype nil)) |
355 |
|
356 |
;; Initialize process and info about the process |
357 |
(set-process-filter proc 'socks-filter) |
358 |
(process-kill-without-query proc) |
359 |
(puthash proc info socks-connections) |
360 |
(puthash 'state socks-state-waiting-for-auth info) |
361 |
(puthash 'authtype socks-authentication-failure info) |
362 |
(puthash 'server-protocol (nth 3 server-info) info) |
363 |
(puthash 'server-name (nth 1 server-info) info) |
364 |
(case (nth 3 server-info) |
365 |
(http |
366 |
;; Don't really have to do any connection setup under http |
367 |
nil) |
368 |
(4 |
369 |
;; Don't really have to do any connection setup under v4 |
370 |
nil) |
371 |
(5 |
372 |
;; Need to handle all the authentication crap under v5 |
373 |
;; Send what we think we can handle for authentication types |
374 |
(process-send-string proc (format "%c%s" socks-version |
375 |
(socks-build-auth-list))) |
376 |
|
377 |
;; Basically just do a select() until we change states. |
378 |
(socks-wait-for-state-change proc info socks-state-waiting-for-auth) |
379 |
(setq authtype (gethash 'authtype info)) |
380 |
(cond |
381 |
((= authtype socks-authentication-null) |
382 |
(and socks-debug (message "No authentication necessary"))) |
383 |
((= authtype socks-authentication-failure) |
384 |
(error "No acceptable authentication methods found.")) |
385 |
(t |
386 |
(let* ((auth-type (gethash 'authtype info)) |
387 |
(auth-handler (assoc auth-type socks-authentication-methods)) |
388 |
(auth-func (and auth-handler (cdr (cdr auth-handler)))) |
389 |
(auth-desc (and auth-handler (car (cdr auth-handler))))) |
390 |
(set-process-filter proc nil) |
391 |
(if (and auth-func (fboundp auth-func) |
392 |
(funcall auth-func proc)) |
393 |
nil ; We succeeded! |
394 |
(delete-process proc) |
395 |
(error "Failed to use auth method: %s (%d)" |
396 |
(or auth-desc "Unknown") auth-type)) |
397 |
) |
398 |
) |
399 |
) |
400 |
(puthash 'state socks-state-authenticated info) |
401 |
(set-process-filter proc 'socks-filter))) |
402 |
proc))) |
403 |
|
404 |
(defun socks-send-command (proc command atype address port) |
405 |
(let ((addr (cond |
406 |
((or (= atype socks-address-type-v4) |
407 |
(= atype socks-address-type-v6)) |
408 |
address) |
409 |
((= atype socks-address-type-name) |
410 |
(format "%c%s" (length address) address)) |
411 |
(t |
412 |
(error "Unkown address type: %d" atype)))) |
413 |
(info (gethash proc socks-connections)) |
414 |
request version) |
415 |
(or info (error "socks-send-command called on non-SOCKS connection %S" |
416 |
proc)) |
417 |
(puthash 'state socks-state-waiting info) |
418 |
(setq version (gethash 'server-protocol info)) |
419 |
(case version |
420 |
(http |
421 |
(setq request (format (eval-when-compile |
422 |
(concat |
423 |
"CONNECT %s:%d HTTP/1.0\r\n" |
424 |
"User-Agent: Emacs/SOCKS v1.0\r\n" |
425 |
"\r\n")) |
426 |
(case atype |
427 |
(socks-address-type-name address) |
428 |
(otherwise |
429 |
(error "Unsupported address type for HTTP: %d" atype))) |
430 |
port))) |
431 |
(4 |
432 |
(setq request (format |
433 |
"%c%c%c%c%s%s%c" |
434 |
version ; version |
435 |
command ; command |
436 |
(lsh port -8) ; port, high byte |
437 |
(- port (lsh (lsh port -8) 8)) ; port, low byte |
438 |
addr ; address |
439 |
(user-full-name) ; username |
440 |
0 ; terminate username |
441 |
))) |
442 |
(5 |
443 |
(setq request (format |
444 |
"%c%c%c%c%s%c%c" |
445 |
version ; version |
446 |
command ; command |
447 |
0 ; reserved |
448 |
atype ; address type |
449 |
addr ; address |
450 |
(lsh port -8) ; port, high byte |
451 |
(- port (lsh (lsh port -8) 8)) ; port, low byte |
452 |
))) |
453 |
(otherwise |
454 |
(error "Unknown protocol version: %d" version))) |
455 |
(process-send-string proc request) |
456 |
(socks-wait-for-state-change proc info socks-state-waiting) |
457 |
(process-status proc) |
458 |
(if (= (or (gethash 'reply info) 1) socks-response-success) |
459 |
nil ; Sweet sweet success! |
460 |
(delete-process proc) |
461 |
(error "SOCKS: %s" (nth (or (gethash 'reply info) 1) socks-errors))) |
462 |
proc)) |
463 |
|
464 |
|
465 |
;; Replacement functions for open-network-stream, etc. |
466 |
(defvar socks-noproxy nil |
467 |
"*List of regexps matching hosts that we should not socksify connections to") |
468 |
|
469 |
(defun socks-find-route (host service) |
470 |
(let ((route socks-server) |
471 |
(noproxy socks-noproxy)) |
472 |
(while noproxy |
473 |
(if (eq ?! (aref (car noproxy) 0)) |
474 |
(if (string-match (substring (car noproxy) 1) host) |
475 |
(setq noproxy nil)) |
476 |
(if (string-match (car noproxy) host) |
477 |
(setq route nil |
478 |
noproxy nil))) |
479 |
(setq noproxy (cdr noproxy))) |
480 |
route)) |
481 |
|
482 |
(defvar socks-override-functions nil |
483 |
"*Whether to overwrite the open-network-stream function with the SOCKSified |
484 |
version.") |
485 |
|
486 |
(if (fboundp 'socks-original-open-network-stream) |
487 |
nil ; Do nothing, we've been here already |
488 |
(defalias 'socks-original-open-network-stream |
489 |
(symbol-function 'open-network-stream)) |
490 |
(if socks-override-functions |
491 |
(defalias 'open-network-stream 'socks-open-network-stream))) |
492 |
|
493 |
(defvar socks-services-file "/etc/services") |
494 |
(defvar socks-tcp-services (make-hash-table :size 13 :test 'equal)) |
495 |
(defvar socks-udp-services (make-hash-table :size 13 :test 'equal)) |
496 |
|
497 |
(defun socks-parse-services () |
498 |
(if (not (and (file-exists-p socks-services-file) |
499 |
(file-readable-p socks-services-file))) |
500 |
(error "Could not find services file: %s" socks-services-file)) |
501 |
(save-excursion |
502 |
(clrhash socks-tcp-services) |
503 |
(clrhash socks-udp-services) |
504 |
(set-buffer (get-buffer-create " *socks-tmp*")) |
505 |
(erase-buffer) |
506 |
(insert-file-contents socks-services-file) |
507 |
;; Nuke comments |
508 |
(goto-char (point-min)) |
509 |
(while (re-search-forward "#.*" nil t) |
510 |
(replace-match "")) |
511 |
;; Nuke empty lines |
512 |
(goto-char (point-min)) |
513 |
(while (re-search-forward "^[ \t\n]+" nil t) |
514 |
(replace-match "")) |
515 |
;; Now find all the lines |
516 |
(goto-char (point-min)) |
517 |
(let (name port type) |
518 |
(while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)/\\([a-z]+\\)" |
519 |
nil t) |
520 |
(setq name (downcase (match-string 1)) |
521 |
port (string-to-int (match-string 2)) |
522 |
type (downcase (match-string 3))) |
523 |
(puthash name port (if (equal type "udp") |
524 |
socks-udp-services |
525 |
socks-tcp-services)))))) |
526 |
|
527 |
(defun socks-find-services-entry (service &optional udp) |
528 |
"Return the port # associated with SERVICE" |
529 |
(if (= (hash-table-count socks-tcp-services) 0) |
530 |
(socks-parse-services)) |
531 |
(gethash (downcase service) |
532 |
(if udp socks-udp-services socks-tcp-services))) |
533 |
|
534 |
(defun socks-open-network-stream (name buffer host service) |
535 |
(let* ((route (socks-find-route host service)) |
536 |
proc info version atype) |
537 |
(if (not route) |
538 |
(socks-original-open-network-stream name buffer host service) |
539 |
(setq proc (socks-open-connection route) |
540 |
info (gethash proc socks-connections) |
541 |
version (gethash 'server-protocol info)) |
542 |
(case version |
543 |
(4 |
544 |
(setq host (socks-nslookup-host host)) |
545 |
(if (not (listp host)) |
546 |
(error "Could not get IP address for: %s" host)) |
547 |
(setq host (apply 'format "%c%c%c%c" host)) |
548 |
(setq atype socks-address-type-v4)) |
549 |
(otherwise |
550 |
(setq atype socks-address-type-name))) |
551 |
(socks-send-command proc |
552 |
socks-connect-command |
553 |
atype |
554 |
host |
555 |
(if (stringp service) |
556 |
(socks-find-services-entry service) |
557 |
service)) |
558 |
(puthash 'buffer buffer info) |
559 |
(puthash 'host host info) |
560 |
(puthash 'service host info) |
561 |
(set-process-filter proc nil) |
562 |
(set-process-buffer proc (if buffer (get-buffer-create buffer))) |
563 |
proc))) |
564 |
|
565 |
;; Authentication modules go here |
566 |
|
567 |
;; Basic username/password authentication, ala RFC 1929 |
568 |
(socks-register-authentication-method 2 "Username/Password" |
569 |
'socks-username/password-auth) |
570 |
|
571 |
(defconst socks-username/password-auth-version 1) |
572 |
|
573 |
(defun socks-username/password-auth-filter (proc str) |
574 |
(let ((info (gethash proc socks-connections)) |
575 |
state desired-len) |
576 |
(or info (error "socks-filter called on non-SOCKS connection %S" proc)) |
577 |
(setq state (gethash 'state info)) |
578 |
(puthash 'scratch (concat (gethash 'scratch info) str) info) |
579 |
(if (< (length (gethash 'scratch info)) 2) |
580 |
nil |
581 |
(puthash 'password-auth-status (socks-char-int |
582 |
(aref (gethash 'scratch info) 1)) |
583 |
info) |
584 |
(puthash 'state socks-state-authenticated info)))) |
585 |
|
586 |
(defun socks-username/password-auth (proc) |
587 |
(let* ((info (gethash proc socks-connections)) |
588 |
(state (gethash 'state info))) |
589 |
(if (not socks-password) |
590 |
(setq socks-password (read-passwd |
591 |
(format "Password for %s@%s: " |
592 |
socks-username |
593 |
(gethash 'server-name info))))) |
594 |
(puthash 'scratch "" info) |
595 |
(set-process-filter proc 'socks-username/password-auth-filter) |
596 |
(process-send-string proc |
597 |
(format "%c%c%s%c%s" |
598 |
socks-username/password-auth-version |
599 |
(length socks-username) |
600 |
socks-username |
601 |
(length socks-password) |
602 |
socks-password)) |
603 |
(socks-wait-for-state-change proc info state) |
604 |
(= (gethash 'password-auth-status info) 0))) |
605 |
|
606 |
|
607 |
;; More advanced GSS/API stuff, not yet implemented - volunteers? |
608 |
;; (socks-register-authentication-method 1 "GSS/API" 'socks-gssapi-auth) |
609 |
|
610 |
(defun socks-gssapi-auth (proc) |
611 |
nil) |
612 |
|
613 |
|
614 |
;; CHAP stuff |
615 |
;; (socks-register-authentication-method 3 "CHAP" 'socks-chap-auth) |
616 |
(defun socks-chap-auth (proc) |
617 |
nil) |
618 |
|
619 |
|
620 |
;; CRAM stuff |
621 |
;; (socks-register-authentication-method 5 "CRAM" 'socks-cram-auth) |
622 |
(defun socks-cram-auth (proc) |
623 |
nil) |
624 |
|
625 |
|
626 |
(defcustom socks-nslookup-program "nslookup" |
627 |
"*If non-NIL then a string naming the nslookup program." |
628 |
:type '(choice (const :tag "None" :value nil) string) |
629 |
:group 'socks) |
630 |
|
631 |
(defun socks-nslookup-host (host) |
632 |
"Attempt to resolve the given HOSTNAME using nslookup if possible." |
633 |
(interactive "sHost: ") |
634 |
(if socks-nslookup-program |
635 |
(let ((proc (start-process " *nslookup*" " *nslookup*" |
636 |
socks-nslookup-program host)) |
637 |
(res host)) |
638 |
(process-kill-without-query proc) |
639 |
(save-excursion |
640 |
(set-buffer (process-buffer proc)) |
641 |
(while (progn |
642 |
(accept-process-output proc) |
643 |
(memq (process-status proc) '(run open)))) |
644 |
(goto-char (point-min)) |
645 |
(if (re-search-forward "Name:.*\nAddress\\(es\\)?: *\\([0-9.]+\\)$" nil t) |
646 |
(progn |
647 |
(setq res (buffer-substring (match-beginning 2) |
648 |
(match-end 2)) |
649 |
res (mapcar 'string-to-int (split-string res "\\."))))) |
650 |
(kill-buffer (current-buffer))) |
651 |
res) |
652 |
host)) |
653 |
|
654 |
(provide 'socks) |