lisp/net/socks.el

   1 ;;; socks.el --- A Socks v5 Client for Emacs
   2
   3 ;; Copyright (C) 1996-2000, 2002, 2007-2011 Free Software Foundation, Inc.
   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
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  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
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  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"
 100   :version "22.2"
 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 ""))
 248     (mapc
 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)
 264   `(while (and (= (gethash 'state ,htable) ,cur-state)
 265                (memq (process-status ,proc) '(run open)))
 266      (accept-process-output ,proc socks-timeout)))
 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
 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
 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)
 389           (error "No acceptable authentication methods found"))
 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
 417                 (error "Unkown address type: %d" atype))))
 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)
 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                       ))))
 448      ((equal version 5)
 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                       ))))
 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
 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))
 497   (clrhash socks-tcp-services)
 498   (clrhash socks-udp-services)
 499   (with-current-buffer (get-buffer-create " *socks-tmp*")
 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)
 551                               (or
 552                                (socks-find-services-entry service)
 553                                (error "Unknown service: %s" service))
 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)
 571   (let ((info (gethash proc socks-connections)))
 572     (or info (error "socks-filter called on non-SOCKS connection %S" proc))
 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)
 632         (with-current-buffer (process-buffer proc)
 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
 648 ;;; socks.el ends here