/[w3]/w3/lisp/socks.el
ViewVC logotype

Contents of /w3/lisp/socks.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations) (download)
Tue Jan 22 18:58:43 2002 UTC (22 years, 3 months ago) by fx
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +3 -3 lines
Update copyright.

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)

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26