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