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