lisp/net/net-utils.el

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