code.delx.au - gnu-emacs/blob - lisp/net/socks.el

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