lisp/net/socks.el

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