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

   1 ;;; net-utils.el --- network functions
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author:  Peter Breton <pbreton@cs.umb.edu>
   7 ;; Created: Sun Mar 16 1997
   8 ;; Keywords: network comm
   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 ;;
  30 ;; There are three main areas of functionality:
  31 ;;
  32 ;; * Wrap common network utility programs (ping, traceroute, netstat,
  33 ;; nslookup, arp, route). Note that these wrappers are of the diagnostic
  34 ;; functions of these programs only.
  35 ;;
  36 ;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
  37 ;;
  38 ;; * Support connections to HOST/PORT, generally for debugging and the like.
  39 ;; In other words, for doing much the same thing as "telnet HOST PORT", and
  40 ;; then typing commands.
  41 ;;
  42 ;; PATHS
  43 ;;
  44 ;; On some systems, some of these programs are not in normal user path,
  45 ;; but rather in /sbin, /usr/sbin, and so on.
  46
  47
  48 ;;; Code:
  49 (eval-when-compile
  50   (require 'comint))
  51
  52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53 ;; Customization Variables
  54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55
  56 (defgroup net-utils nil
  57   "Network utility functions."
  58   :prefix "net-utils-"
  59   :group 'comm
  60   :version "20.3")
  61
  62 (defcustom net-utils-remove-ctl-m
  63   (member system-type (list 'windows-nt 'msdos))
  64   "If non-nil, remove control-Ms from output."
  65   :group 'net-utils
  66   :type  'boolean)
  67
  68 (defcustom traceroute-program
  69   (if (eq system-type 'windows-nt)
  70       "tracert"
  71     "traceroute")
  72   "Program to trace network hops to a destination."
  73   :group 'net-utils
  74   :type  'string)
  75
  76 (defcustom traceroute-program-options nil
  77   "Options for the traceroute program."
  78   :group 'net-utils
  79   :type  '(repeat string))
  80
  81 (defcustom ping-program "ping"
  82   "Program to send network test packets to a host."
  83   :group 'net-utils
  84   :type  'string)
  85
  86 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
  87 ;; indefinitely unless told otherwise
  88 (defcustom ping-program-options
  89   (and (memq system-type (list 'linux 'gnu/linux 'irix))
  90        (list "-c" "4"))
  91   "Options for the ping program.
  92 These options can be used to limit how many ICMP packets are emitted."
  93   :group 'net-utils
  94   :type  '(repeat string))
  95
  96 (defcustom ifconfig-program
  97   (if (eq system-type 'windows-nt)
  98       "ipconfig"
  99     "ifconfig")
 100   "Program to print network configuration information."
 101   :group 'net-utils
 102   :type  'string)
 103
 104 (define-obsolete-variable-alias 'ipconfig-program 'ifconfig-program "22.2")
 105
 106 (defcustom ifconfig-program-options
 107   (list
 108    (if (eq system-type 'windows-nt)
 109        "/all" "-a"))
 110   "Options for the ifconfig program."
 111   :group 'net-utils
 112   :type  '(repeat string))
 113
 114 (define-obsolete-variable-alias 'ipconfig-program-options
 115   'ifconfig-program-options "22.2")
 116
 117 (defcustom netstat-program "netstat"
 118   "Program to print network statistics."
 119   :group 'net-utils
 120   :type  'string)
 121
 122 (defcustom netstat-program-options
 123   (list "-a")
 124   "Options for the netstat program."
 125   :group 'net-utils
 126   :type  '(repeat string))
 127
 128 (defcustom arp-program "arp"
 129   "Program to print IP to address translation tables."
 130   :group 'net-utils
 131   :type  'string)
 132
 133 (defcustom arp-program-options
 134   (list "-a")
 135   "Options for the arp program."
 136   :group 'net-utils
 137   :type  '(repeat string))
 138
 139 (defcustom route-program
 140   (if (eq system-type 'windows-nt)
 141       "route"
 142     "netstat")
 143   "Program to print routing tables."
 144   :group 'net-utils
 145   :type  'string)
 146
 147 (defcustom route-program-options
 148   (if (eq system-type 'windows-nt)
 149       (list "print")
 150     (list "-r"))
 151   "Options for the route program."
 152   :group 'net-utils
 153   :type  '(repeat string))
 154
 155 (defcustom nslookup-program "nslookup"
 156   "Program to interactively query DNS information."
 157   :group 'net-utils
 158   :type  'string)
 159
 160 (defcustom nslookup-program-options nil
 161   "Options for the nslookup program."
 162   :group 'net-utils
 163   :type  '(repeat string))
 164
 165 (defcustom nslookup-prompt-regexp "^> "
 166   "Regexp to match the nslookup prompt.
 167
 168 This variable is only used if the variable
 169 `comint-use-prompt-regexp' is non-nil."
 170   :group 'net-utils
 171   :type  'regexp)
 172
 173 (defcustom dig-program "dig"
 174   "Program to query DNS information."
 175   :group 'net-utils
 176   :type  'string)
 177
 178 (defcustom ftp-program "ftp"
 179   "Program to run to do FTP transfers."
 180   :group 'net-utils
 181   :type  'string)
 182
 183 (defcustom ftp-program-options nil
 184   "Options for the ftp program."
 185   :group 'net-utils
 186   :type  '(repeat string))
 187
 188 (defcustom ftp-prompt-regexp "^ftp>"
 189   "Regexp which matches the FTP program's prompt.
 190
 191 This variable is only used if the variable
 192 `comint-use-prompt-regexp' is non-nil."
 193   :group 'net-utils
 194   :type  'regexp)
 195
 196 (defcustom smbclient-program "smbclient"
 197   "Smbclient program."
 198   :group 'net-utils
 199   :type  'string)
 200
 201 (defcustom smbclient-program-options nil
 202   "Options for the smbclient program."
 203   :group 'net-utils
 204   :type  '(repeat string))
 205
 206 (defcustom smbclient-prompt-regexp "^smb: \>"
 207   "Regexp which matches the smbclient program's prompt.
 208
 209 This variable is only used if the variable
 210 `comint-use-prompt-regexp' is non-nil."
 211   :group 'net-utils
 212   :type  'regexp)
 213
 214 (defcustom dns-lookup-program "host"
 215   "Program to interactively query DNS information."
 216   :group 'net-utils
 217   :type  'string)
 218
 219 (defcustom dns-lookup-program-options nil
 220   "Options for the dns-lookup program."
 221   :group 'net-utils
 222   :type  '(repeat string))
 223
 224 ;; Internal variables
 225 (defvar network-connection-service nil)
 226 (defvar network-connection-host    nil)
 227
 228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 229 ;; Nslookup goodies
 230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 231
 232 (defconst nslookup-font-lock-keywords
 233   (progn
 234     (defvar font-lock-type-face)
 235     (defvar font-lock-keyword-face)
 236     (defvar font-lock-variable-name-face)
 237     (require 'font-lock)
 238     (list
 239      (list "^[A-Za-z0-9 _]+:"     0 font-lock-type-face)
 240      (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
 241            1 font-lock-keyword-face)
 242      ;; Dotted quads
 243      (list
 244       (mapconcat 'identity
 245                  (make-list 4 "[0-9]+")
 246                  "\\.")
 247       0 font-lock-variable-name-face)
 248      ;; Host names
 249      (list
 250       (let ((host-expression "[-A-Za-z0-9]+"))
 251         (concat
 252          (mapconcat 'identity
 253                     (make-list 2 host-expression)
 254                     "\\.")
 255          "\\(\\." host-expression "\\)*"))
 256       0 font-lock-variable-name-face)))
 257   "Expressions to font-lock for nslookup.")
 258
 259 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 260 ;; Utility functions
 261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262
 263 ;; Simplified versions of some at-point functions from ffap.el.
 264 ;; It's not worth loading all of ffap just for these.
 265 (defun net-utils-machine-at-point ()
 266   (let ((pt (point)))
 267     (buffer-substring-no-properties
 268      (save-excursion
 269        (skip-chars-backward "-a-zA-Z0-9.")
 270        (point))
 271      (save-excursion
 272        (skip-chars-forward "-a-zA-Z0-9.")
 273        (skip-chars-backward "." pt)
 274        (point)))))
 275
 276 (defun net-utils-url-at-point ()
 277   (let ((pt (point)))
 278     (buffer-substring-no-properties
 279      (save-excursion
 280        (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
 281        (skip-chars-forward "^A-Za-z0-9" pt)
 282        (point))
 283      (save-excursion
 284        (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
 285        (skip-chars-backward ":;.,!?" pt)
 286        (point)))))
 287
 288
 289 (defun net-utils-remove-ctrl-m-filter (process output-string)
 290   "Remove trailing control Ms."
 291   (let ((old-buffer (current-buffer))
 292         (filtered-string output-string))
 293     (unwind-protect
 294         (let ((moving))
 295           (set-buffer (process-buffer process))
 296           (setq moving (= (point) (process-mark process)))
 297
 298           (while (string-match "\r" filtered-string)
 299                (setq filtered-string
 300                      (replace-match "" nil nil filtered-string)))
 301
 302           (save-excursion
 303             ;; Insert the text, moving the process-marker.
 304             (goto-char (process-mark process))
 305             (insert filtered-string)
 306             (set-marker (process-mark process) (point)))
 307           (if moving (goto-char (process-mark process))))
 308       (set-buffer old-buffer))))
 309
 310 (defmacro net-utils-run-program (name header program &rest args)
 311   "Run a network information program."
 312   ` (let ((buf (get-buffer-create (concat "*" ,name "*"))))
 313       (set-buffer buf)
 314       (erase-buffer)
 315       (insert ,header "\n")
 316       (set-process-filter
 317        (apply 'start-process ,name buf ,program ,@args)
 318        'net-utils-remove-ctrl-m-filter)
 319       (display-buffer buf)
 320       buf))
 321
 322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 323 ;; Wrappers for external network programs
 324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 325
 326 ;;;###autoload
 327 (defun traceroute (target)
 328   "Run traceroute program for TARGET."
 329   (interactive "sTarget: ")
 330   (let ((options
 331          (if traceroute-program-options
 332              (append traceroute-program-options (list target))
 333            (list target))))
 334     (net-utils-run-program
 335      (concat "Traceroute" " " target)
 336      (concat "** Traceroute ** " traceroute-program " ** " target)
 337      traceroute-program
 338      options)))
 339
 340 ;;;###autoload
 341 (defun ping (host)
 342   "Ping HOST.
 343 If your system's ping continues until interrupted, you can try setting
 344 `ping-program-options'."
 345   (interactive
 346    (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
 347   (let ((options
 348          (if ping-program-options
 349              (append ping-program-options (list host))
 350            (list host))))
 351     (net-utils-run-program
 352      (concat "Ping" " " host)
 353      (concat "** Ping ** " ping-program " ** " host)
 354      ping-program
 355      options)))
 356
 357 ;;;###autoload
 358 (defun ifconfig ()
 359   "Run ifconfig program."
 360   (interactive)
 361   (net-utils-run-program
 362    "Ifconfig"
 363    (concat "** Ifconfig ** " ifconfig-program " ** ")
 364    ifconfig-program
 365    ifconfig-program-options))
 366
 367 ;; Windows uses this name.
 368 ;;;###autoload
 369 (defalias 'ipconfig 'ifconfig)
 370
 371 ;;;###autoload
 372 (defun netstat ()
 373   "Run netstat program."
 374   (interactive)
 375   (net-utils-run-program
 376    "Netstat"
 377    (concat "** Netstat ** " netstat-program " ** ")
 378    netstat-program
 379    netstat-program-options))
 380
 381 ;;;###autoload
 382 (defun arp ()
 383   "Run arp program."
 384   (interactive)
 385   (net-utils-run-program
 386    "Arp"
 387    (concat "** Arp ** " arp-program " ** ")
 388    arp-program
 389    arp-program-options))
 390
 391 ;;;###autoload
 392 (defun route ()
 393   "Run route program."
 394   (interactive)
 395   (net-utils-run-program
 396    "Route"
 397    (concat "** Route ** " route-program " ** ")
 398    route-program
 399    route-program-options))
 400
 401 ;; FIXME -- Needs to be a process filter
 402 ;; (defun netstat-with-filter (filter)
 403 ;;   "Run netstat program."
 404 ;;   (interactive "sFilter: ")
 405 ;;   (netstat)
 406 ;;   (set-buffer (get-buffer "*Netstat*"))
 407 ;;   (goto-char (point-min))
 408 ;;   (delete-matching-lines filter))
 409
 410 ;;;###autoload
 411 (defun nslookup-host (host)
 412   "Lookup the DNS information for HOST."
 413   (interactive
 414    (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
 415   (let ((options
 416          (if nslookup-program-options
 417              (append nslookup-program-options (list host))
 418            (list host))))
 419     (net-utils-run-program
 420      "Nslookup"
 421      (concat "** "
 422       (mapconcat 'identity
 423                 (list "Nslookup" host nslookup-program)
 424                 " ** "))
 425      nslookup-program
 426      options)))
 427
 428 ;;;###autoload
 429 (defun nslookup ()
 430   "Run nslookup program."
 431   (interactive)
 432   (require 'comint)
 433   (comint-run nslookup-program)
 434   (nslookup-mode))
 435
 436 ;; Using a derived mode gives us keymaps, hooks, etc.
 437 (define-derived-mode nslookup-mode comint-mode "Nslookup"
 438   "Major mode for interacting with the nslookup program."
 439   (set
 440    (make-local-variable 'font-lock-defaults)
 441    '((nslookup-font-lock-keywords)))
 442   (setq comint-prompt-regexp nslookup-prompt-regexp)
 443   (setq comint-input-autoexpand t))
 444
 445 (define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
 446
 447 ;;;###autoload
 448 (defun dns-lookup-host (host)
 449   "Lookup the DNS information for HOST (name or IP address)."
 450   (interactive
 451    (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
 452   (let ((options
 453          (if dns-lookup-program-options
 454              (append dns-lookup-program-options (list host))
 455            (list host))))
 456     (net-utils-run-program
 457      (concat "DNS Lookup [" host "]")
 458      (concat "** "
 459       (mapconcat 'identity
 460                 (list "DNS Lookup" host dns-lookup-program)
 461                 " ** "))
 462      dns-lookup-program
 463      options)))
 464
 465 ;;;###autoload
 466 (defun run-dig (host)
 467   "Run dig program."
 468   (interactive
 469    (list
 470     (progn
 471       (require 'ffap)
 472       (read-from-minibuffer
 473        "Lookup host: "
 474        (with-no-warnings
 475          (or (ffap-string-at-point 'machine) ""))))))
 476   (net-utils-run-program
 477    "Dig"
 478    (concat "** "
 479            (mapconcat 'identity
 480                       (list "Dig" host dig-program)
 481                       " ** "))
 482    dig-program
 483    (list host)))
 484
 485 ;; This is a lot less than ange-ftp, but much simpler.
 486 ;;;###autoload
 487 (defun ftp (host)
 488   "Run ftp program."
 489   (interactive
 490    (list
 491     (read-from-minibuffer
 492      "Ftp to Host: " (net-utils-machine-at-point))))
 493   (require 'comint)
 494   (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
 495     (set-buffer buf)
 496     (ftp-mode)
 497     (comint-exec buf (concat "ftp-" host) ftp-program nil
 498                  (if ftp-program-options
 499                      (append (list host) ftp-program-options)
 500                    (list host)))
 501     (pop-to-buffer buf)))
 502
 503 (define-derived-mode ftp-mode comint-mode "FTP"
 504   "Major mode for interacting with the ftp program."
 505   (setq comint-prompt-regexp ftp-prompt-regexp)
 506   (setq comint-input-autoexpand t)
 507   ;; Only add the password-prompting hook if it's not already in the
 508   ;; global hook list.  This stands a small chance of losing, if it's
 509   ;; later removed from the global list (very small, since any
 510   ;; password prompts will probably immediately follow the initial
 511   ;; connection), but it's better than getting prompted twice for the
 512   ;; same password.
 513   (unless (memq 'comint-watch-for-password-prompt
 514                 (default-value 'comint-output-filter-functions))
 515     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 516               nil t)))
 517
 518 ;; Occasionally useful
 519 (define-key ftp-mode-map "\t" 'comint-dynamic-complete)
 520
 521 (defun smbclient (host service)
 522   "Connect to SERVICE on HOST via SMB."
 523   (interactive
 524    (list
 525     (read-from-minibuffer
 526      "Connect to Host: " (net-utils-machine-at-point))
 527     (read-from-minibuffer "SMB Service: ")))
 528   (require 'comint)
 529   (let* ((name (format "smbclient [%s\\%s]" host service))
 530          (buf (get-buffer-create (concat "*" name "*")))
 531          (service-name (concat "\\\\" host "\\" service)))
 532     (set-buffer buf)
 533     (smbclient-mode)
 534     (comint-exec buf name smbclient-program nil
 535                  (if smbclient-program-options
 536                      (append (list service-name) smbclient-program-options)
 537                    (list service-name)))
 538     (pop-to-buffer buf)))
 539
 540 (defun smbclient-list-shares (host)
 541   "List services on HOST."
 542   (interactive
 543    (list
 544     (read-from-minibuffer
 545      "Connect to Host: " (net-utils-machine-at-point))))
 546   (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
 547     (set-buffer buf)
 548     (smbclient-mode)
 549     (comint-exec buf "smbclient-list-shares"
 550                  smbclient-program nil (list "-L" host))
 551     (pop-to-buffer buf)))
 552
 553 (define-derived-mode smbclient-mode comint-mode "smbclient"
 554   "Major mode for interacting with the smbclient program."
 555   (setq comint-prompt-regexp smbclient-prompt-regexp)
 556   (setq comint-input-autoexpand t)
 557   ;; Only add the password-prompting hook if it's not already in the
 558   ;; global hook list.  This stands a small chance of losing, if it's
 559   ;; later removed from the global list (very small, since any
 560   ;; password prompts will probably immediately follow the initial
 561   ;; connection), but it's better than getting prompted twice for the
 562   ;; same password.
 563   (unless (memq 'comint-watch-for-password-prompt
 564                 (default-value 'comint-output-filter-functions))
 565     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 566               nil t)))
 567
 568
 569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 570 ;; Network Connections
 571 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 572
 573 ;; Full list is available at:
 574 ;; http://www.iana.org/assignments/port-numbers
 575 (defvar network-connection-service-alist
 576   (list
 577     (cons 'echo          7)
 578     (cons 'active-users 11)
 579     (cons 'daytime      13)
 580     (cons 'chargen      19)
 581     (cons 'ftp          21)
 582     (cons 'telnet       23)
 583     (cons 'smtp         25)
 584     (cons 'time         37)
 585     (cons 'whois        43)
 586     (cons 'gopher       70)
 587     (cons 'finger       79)
 588     (cons 'www          80)
 589     (cons 'pop2         109)
 590     (cons 'pop3         110)
 591     (cons 'sun-rpc      111)
 592     (cons 'nntp         119)
 593     (cons 'ntp          123)
 594     (cons 'netbios-name 137)
 595     (cons 'netbios-data 139)
 596     (cons 'irc          194)
 597     (cons 'https        443)
 598     (cons 'rlogin       513))
 599   "Alist of services and associated TCP port numbers.
 600 This list is not complete.")
 601
 602 ;; Workhorse macro
 603 (defmacro run-network-program (process-name host port
 604                                             &optional initial-string)
 605   `(let ((tcp-connection)
 606          (buf))
 607     (setq buf (get-buffer-create (concat "*" ,process-name "*")))
 608     (set-buffer buf)
 609     (or
 610      (setq tcp-connection
 611            (open-network-stream
 612             ,process-name
 613             buf
 614             ,host
 615             ,port))
 616      (error "Could not open connection to %s" ,host))
 617     (erase-buffer)
 618     (set-marker (process-mark tcp-connection) (point-min))
 619     (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
 620     (and ,initial-string
 621          (process-send-string tcp-connection
 622                               (concat ,initial-string "\r\n")))
 623     (display-buffer buf)))
 624
 625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 626 ;; Simple protocols
 627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 628
 629 (defcustom finger-X.500-host-regexps nil
 630   "A list of regular expressions matching host names.
 631 If a host name passed to `finger' matches one of these regular
 632 expressions, it is assumed to be a host that doesn't accept
 633 queries of the form USER@HOST, and wants a query containing USER only."
 634   :group 'net-utils
 635   :type '(repeat regexp)
 636   :version "21.1")
 637
 638 ;; Finger protocol
 639 ;;;###autoload
 640 (defun finger (user host)
 641   "Finger USER on HOST."
 642   ;; One of those great interactive statements that's actually
 643   ;; longer than the function call! The idea is that if the user
 644   ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
 645   ;; host name. If we don't see an "@", we'll prompt for the host.
 646   (interactive
 647     (let* ((answer (read-from-minibuffer "Finger User: "
 648                                          (net-utils-url-at-point)))
 649            (index  (string-match (regexp-quote "@") answer)))
 650       (if index
 651           (list (substring answer 0 index)
 652                 (substring answer (1+ index)))
 653         (list answer
 654               (read-from-minibuffer "At Host: "
 655                                     (net-utils-machine-at-point))))))
 656   (let* ((user-and-host (concat user "@" host))
 657          (process-name (concat "Finger [" user-and-host "]"))
 658          (regexps finger-X.500-host-regexps)
 659          found)
 660     (and regexps
 661          (while (not (string-match (car regexps) host))
 662            (setq regexps (cdr regexps)))
 663          (when regexps
 664            (setq user-and-host user)))
 665     (run-network-program
 666      process-name
 667      host
 668      (cdr (assoc 'finger network-connection-service-alist))
 669      user-and-host)))
 670
 671 (defcustom whois-server-name "rs.internic.net"
 672   "Default host name for the whois service."
 673   :group 'net-utils
 674   :type  'string)
 675
 676 (defcustom whois-server-list
 677   '(("whois.arin.net")     ; Networks, ASN's, and related POC's (numbers)
 678     ("rs.internic.net")  ; domain related info
 679     ("whois.publicinterestregistry.net")
 680     ("whois.abuse.net")
 681     ("whois.apnic.net")
 682     ("nic.ddn.mil")
 683     ("whois.nic.mil")
 684     ("whois.nic.gov")
 685     ("whois.ripe.net"))
 686   "A list of whois servers that can be queried."
 687   :group 'net-utils
 688   :type '(repeat (list string)))
 689
 690 ;; FIXME: modern whois clients include a much better tld <-> whois server
 691 ;; list, Emacs should probably avoid specifying the server as the client
 692 ;; will DTRT anyway... -rfr
 693 (defcustom whois-server-tld
 694   '(("rs.internic.net" . "com")
 695     ("whois.publicinterestregistry.net" . "org")
 696     ("whois.ripe.net" . "be")
 697     ("whois.ripe.net" . "de")
 698     ("whois.ripe.net" . "dk")
 699     ("whois.ripe.net" . "it")
 700     ("whois.ripe.net" . "fi")
 701     ("whois.ripe.net" . "fr")
 702     ("whois.ripe.net" . "uk")
 703     ("whois.apnic.net" . "au")
 704     ("whois.apnic.net" . "ch")
 705     ("whois.apnic.net" . "hk")
 706     ("whois.apnic.net" . "jp")
 707     ("whois.nic.gov" . "gov")
 708     ("whois.nic.mil" . "mil"))
 709   "Alist to map top level domains to whois servers."
 710   :group 'net-utils
 711   :type '(repeat (cons string string)))
 712
 713 (defcustom whois-guess-server t
 714   "If non-nil then whois will try to deduce the appropriate whois
 715 server from the query.  If the query doesn't look like a domain or hostname
 716 then the server named by `whois-server-name' is used."
 717   :group 'net-utils
 718   :type 'boolean)
 719
 720 (defun whois-get-tld (host)
 721   "Return the top level domain of `host', or nil if it isn't a domain name."
 722   (let ((i (1- (length host)))
 723         (max-len (- (length host) 5)))
 724     (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
 725       (setq i (1- i)))
 726     (if (= i max-len)
 727         nil
 728       (substring host (1+ i)))))
 729
 730 ;; Whois protocol
 731 ;;;###autoload
 732 (defun whois (arg search-string)
 733   "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
 734 If `whois-guess-server' is non-nil, then try to deduce the correct server
 735 from SEARCH-STRING.  With argument, prompt for whois server."
 736   (interactive "P\nsWhois: ")
 737   (let* ((whois-apropos-host (if whois-guess-server
 738                                  (rassoc (whois-get-tld search-string)
 739                                          whois-server-tld)
 740                                nil))
 741          (server-name (if whois-apropos-host
 742                           (car whois-apropos-host)
 743                         whois-server-name))
 744          (host
 745           (if arg
 746               (completing-read "Whois server name: "
 747                                whois-server-list nil nil "whois.")
 748             server-name)))
 749     (run-network-program
 750      "Whois"
 751      host
 752      (cdr (assoc 'whois network-connection-service-alist))
 753      search-string)))
 754
 755 (defcustom whois-reverse-lookup-server "whois.arin.net"
 756   "Server which provides inverse DNS mapping."
 757   :group 'net-utils
 758   :type  'string)
 759
 760 ;;;###autoload
 761 (defun whois-reverse-lookup ()
 762   (interactive)
 763   (let ((whois-server-name whois-reverse-lookup-server))
 764     (call-interactively 'whois)))
 765
 766 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 767 ;;; General Network connection
 768 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 769
 770 ;; Using a derived mode gives us keymaps, hooks, etc.
 771 (define-derived-mode
 772   network-connection-mode comint-mode "Network-Connection"
 773   "Major mode for interacting with the network-connection program.")
 774
 775 (defun network-connection-mode-setup (host service)
 776   (make-local-variable 'network-connection-host)
 777   (setq network-connection-host host)
 778   (make-local-variable 'network-connection-service)
 779   (setq network-connection-service service))
 780
 781 ;;;###autoload
 782 (defun network-connection-to-service (host service)
 783   "Open a network connection to SERVICE on HOST."
 784   (interactive
 785    (list
 786     (read-from-minibuffer "Host: " (net-utils-machine-at-point))
 787     (completing-read "Service: "
 788                      (mapcar
 789                       (function
 790                        (lambda (elt)
 791                          (list (symbol-name (car elt)))))
 792                       network-connection-service-alist))))
 793   (network-connection
 794    host
 795    (cdr (assoc (intern service) network-connection-service-alist))))
 796
 797 ;;;###autoload
 798 (defun network-connection (host port)
 799   "Open a network connection to HOST on PORT."
 800   (interactive "sHost: \nnPort: ")
 801   (network-service-connection host (number-to-string port)))
 802
 803 (defun network-service-connection (host service)
 804   "Open a network connection to SERVICE on HOST."
 805   (require 'comint)
 806   (let* ((process-name (concat "Network Connection [" host " " service "]"))
 807          (portnum (string-to-number service))
 808          (buf (get-buffer-create (concat "*" process-name "*"))))
 809     (or (zerop portnum) (setq service portnum))
 810     (make-comint
 811      process-name
 812      (cons host service))
 813     (set-buffer buf)
 814     (network-connection-mode)
 815     (network-connection-mode-setup host service)
 816     (pop-to-buffer buf)))
 817
 818 (defun network-connection-reconnect  ()
 819   "Reconnect a network connection, preserving the old input ring."
 820   (interactive)
 821   (let ((proc (get-buffer-process (current-buffer)))
 822         (old-comint-input-ring comint-input-ring)
 823         (host network-connection-host)
 824         (service network-connection-service))
 825     (if (not (or (not proc)
 826                  (eq (process-status proc) 'closed)))
 827         (message "Still connected")
 828       (goto-char (point-max))
 829       (insert (format "Reopening connection to %s\n" host))
 830       (network-connection host
 831                           (if (numberp service)
 832                               service
 833                             (cdr (assoc service network-connection-service-alist))))
 834       (and old-comint-input-ring
 835            (setq comint-input-ring old-comint-input-ring)))))
 836
 837 (provide 'net-utils)
 838
 839 ;;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
 840 ;;; net-utils.el ends here