lisp/net/net-utils.el

   1 ;;; net-utils.el --- network functions
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001  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-instead-of-fields' 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-instead-of-fields' 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-instead-of-fields' 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        (or (ffap-string-at-point 'machine) "")))))
 472   (net-utils-run-program
 473    "Dig"
 474    (concat "** "
 475            (mapconcat 'identity
 476                       (list "Dig" host dig-program)
 477                       " ** "))
 478    dig-program
 479    (list host)))
 480
 481 ;; This is a lot less than ange-ftp, but much simpler.
 482 ;;;###autoload
 483 (defun ftp (host)
 484   "Run ftp program."
 485   (interactive
 486    (list
 487     (read-from-minibuffer
 488      "Ftp to Host: " (net-utils-machine-at-point))))
 489   (require 'comint)
 490   (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
 491     (set-buffer buf)
 492     (ftp-mode)
 493     (comint-exec buf (concat "ftp-" host) ftp-program nil
 494                  (if ftp-program-options
 495                      (append (list host) ftp-program-options)
 496                    (list host)))
 497     (pop-to-buffer buf)))
 498
 499 (define-derived-mode ftp-mode comint-mode "FTP"
 500   "Major mode for interacting with the ftp program."
 501   (setq comint-prompt-regexp ftp-prompt-regexp)
 502   (setq comint-input-autoexpand t)
 503   ;; Only add the password-prompting hook if it's not already in the
 504   ;; global hook list.  This stands a small chance of losing, if it's
 505   ;; later removed from the global list (very small, since any
 506   ;; password prompts will probably immediately follow the initial
 507   ;; connection), but it's better than getting prompted twice for the
 508   ;; same password.
 509   (unless (memq 'comint-watch-for-password-prompt
 510                 (default-value 'comint-output-filter-functions))
 511     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 512               nil t)))
 513
 514 ;; Occasionally useful
 515 (define-key ftp-mode-map "\t" 'comint-dynamic-complete)
 516
 517 (defun smbclient (host service)
 518   "Connect to SERVICE on HOST via SMB."
 519   (interactive
 520    (list
 521     (read-from-minibuffer
 522      "Connect to Host: " (net-utils-machine-at-point))
 523     (read-from-minibuffer "SMB Service: ")))
 524   (require 'comint)
 525   (let* ((name (format "smbclient [%s\\%s]" host service))
 526          (buf (get-buffer-create (concat "*" name "*")))
 527          (service-name (concat "\\\\" host "\\" service)))
 528     (set-buffer buf)
 529     (smbclient-mode)
 530     (comint-exec buf name smbclient-program nil
 531                  (if smbclient-program-options
 532                      (append (list service-name) smbclient-program-options)
 533                    (list service-name)))
 534     (pop-to-buffer buf)))
 535
 536 (defun smbclient-list-shares (host)
 537   "List services on HOST."
 538   (interactive
 539    (list
 540     (read-from-minibuffer
 541      "Connect to Host: " (net-utils-machine-at-point))))
 542   (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
 543     (set-buffer buf)
 544     (smbclient-mode)
 545     (comint-exec buf "smbclient-list-shares"
 546                  smbclient-program nil (list "-L" host))
 547     (pop-to-buffer buf)))
 548
 549 (define-derived-mode smbclient-mode comint-mode "smbclient"
 550   "Major mode for interacting with the smbclient program."
 551   (setq comint-prompt-regexp smbclient-prompt-regexp)
 552   (setq comint-input-autoexpand t)
 553   ;; Only add the password-prompting hook if it's not already in the
 554   ;; global hook list.  This stands a small chance of losing, if it's
 555   ;; later removed from the global list (very small, since any
 556   ;; password prompts will probably immediately follow the initial
 557   ;; connection), but it's better than getting prompted twice for the
 558   ;; same password.
 559   (unless (memq 'comint-watch-for-password-prompt
 560                 (default-value 'comint-output-filter-functions))
 561     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 562               nil t)))
 563
 564
 565 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 566 ;; Network Connections
 567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 568
 569 ;; Full list is available at:
 570 ;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
 571 (defvar network-connection-service-alist
 572   (list
 573     (cons 'echo          7)
 574     (cons 'active-users 11)
 575     (cons 'daytime      13)
 576     (cons 'chargen      19)
 577     (cons 'ftp          21)
 578     (cons 'telnet       23)
 579     (cons 'smtp         25)
 580     (cons 'time         37)
 581     (cons 'whois        43)
 582     (cons 'gopher       70)
 583     (cons 'finger       79)
 584     (cons 'www          80)
 585     (cons 'pop2         109)
 586     (cons 'pop3         110)
 587     (cons 'sun-rpc      111)
 588     (cons 'nntp         119)
 589     (cons 'ntp          123)
 590     (cons 'netbios-name 137)
 591     (cons 'netbios-data 139)
 592     (cons 'irc          194)
 593     (cons 'https        443)
 594     (cons 'rlogin       513))
 595   "Alist of services and associated TCP port numbers.
 596 This list is not complete.")
 597
 598 ;; Workhorse macro
 599 (defmacro run-network-program (process-name host port
 600                                             &optional initial-string)
 601   `(let ((tcp-connection)
 602          (buf))
 603     (setq buf (get-buffer-create (concat "*" ,process-name "*")))
 604     (set-buffer buf)
 605     (or
 606      (setq tcp-connection
 607            (open-network-stream
 608             ,process-name
 609             buf
 610             ,host
 611             ,port))
 612      (error "Could not open connection to %s" ,host))
 613     (erase-buffer)
 614     (set-marker (process-mark tcp-connection) (point-min))
 615     (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
 616     (and ,initial-string
 617          (process-send-string tcp-connection
 618                               (concat ,initial-string "\r\n")))
 619     (display-buffer buf)))
 620
 621 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 622 ;; Simple protocols
 623 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 624
 625 (defcustom finger-X.500-host-regexps nil
 626   "A list of regular expressions matching host names.
 627 If a host name passed to `finger' matches one of these regular
 628 expressions, it is assumed to be a host that doesn't accept
 629 queries of the form USER@HOST, and wants a query containing USER only."
 630   :group 'net-utils
 631   :type '(repeat regexp)
 632   :version "21.1")
 633
 634 ;; Finger protocol
 635 ;;;###autoload
 636 (defun finger (user host)
 637   "Finger USER on HOST."
 638   ;; One of those great interactive statements that's actually
 639   ;; longer than the function call! The idea is that if the user
 640   ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
 641   ;; host name. If we don't see an "@", we'll prompt for the host.
 642   (interactive
 643     (let* ((answer (read-from-minibuffer "Finger User: "
 644                                          (net-utils-url-at-point)))
 645            (index  (string-match (regexp-quote "@") answer)))
 646       (if index
 647           (list (substring answer 0 index)
 648                 (substring answer (1+ index)))
 649         (list answer
 650               (read-from-minibuffer "At Host: "
 651                                     (net-utils-machine-at-point))))))
 652   (let* ((user-and-host (concat user "@" host))
 653          (process-name (concat "Finger [" user-and-host "]"))
 654          (regexps finger-X.500-host-regexps)
 655          found)
 656     (and regexps
 657          (while (not (string-match (car regexps) host))
 658            (setq regexps (cdr regexps)))
 659          (when regexps
 660            (setq user-and-host user)))
 661     (run-network-program
 662      process-name
 663      host
 664      (cdr (assoc 'finger network-connection-service-alist))
 665      user-and-host)))
 666
 667 (defcustom whois-server-name "rs.internic.net"
 668   "Default host name for the whois service."
 669   :group 'net-utils
 670   :type  'string)
 671
 672 (defcustom whois-server-list
 673   '(("whois.arin.net")     ; Networks, ASN's, and related POC's (numbers)
 674     ("rs.internic.net")  ; domain related info
 675     ("whois.abuse.net")
 676     ("whois.apnic.net")
 677     ("nic.ddn.mil")
 678     ("whois.nic.mil")
 679     ("whois.nic.gov")
 680     ("whois.ripe.net"))
 681   "A list of whois servers that can be queried."
 682   :group 'net-utils
 683   :type '(repeat (list string)))
 684
 685 (defcustom whois-server-tld
 686   '(("rs.internic.net" . "com")
 687     ("rs.internic.net" . "org")
 688     ("whois.ripe.net" . "be")
 689     ("whois.ripe.net" . "de")
 690     ("whois.ripe.net" . "dk")
 691     ("whois.ripe.net" . "it")
 692     ("whois.ripe.net" . "fi")
 693     ("whois.ripe.net" . "fr")
 694     ("whois.ripe.net" . "uk")
 695     ("whois.apnic.net" . "au")
 696     ("whois.apnic.net" . "ch")
 697     ("whois.apnic.net" . "hk")
 698     ("whois.apnic.net" . "jp")
 699     ("whois.nic.gov" . "gov")
 700     ("whois.nic.mil" . "mil"))
 701   "Alist to map top level domains to whois servers."
 702   :group 'net-utils
 703   :type '(repeat (cons string string)))
 704
 705 (defcustom whois-guess-server t
 706   "If non-nil then whois will try to deduce the appropriate whois
 707 server from the query.  If the query doesn't look like a domain or hostname
 708 then the server named by whois-server-name is used."
 709   :group 'net-utils
 710   :type 'boolean)
 711
 712 (defun whois-get-tld (host)
 713   "Return the top level domain of `host', or nil if it isn't a domain name."
 714   (let ((i (1- (length host)))
 715         (max-len (- (length host) 5)))
 716     (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
 717       (setq i (1- i)))
 718     (if (= i max-len)
 719         nil
 720       (substring host (1+ i)))))
 721
 722 ;; Whois protocol
 723 ;;;###autoload
 724 (defun whois (arg search-string)
 725   "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
 726 If `whois-guess-server' is non-nil, then try to deduce the correct server
 727 from SEARCH-STRING.  With argument, prompt for whois server."
 728   (interactive "P\nsWhois: ")
 729   (let* ((whois-apropos-host (if whois-guess-server
 730                                  (rassoc (whois-get-tld search-string)
 731                                          whois-server-tld)
 732                                nil))
 733          (server-name (if whois-apropos-host
 734                           (car whois-apropos-host)
 735                         whois-server-name))
 736          (host
 737           (if arg
 738               (completing-read "Whois server name: "
 739                                whois-server-list nil nil "whois.")
 740             server-name)))
 741     (run-network-program
 742      "Whois"
 743      host
 744      (cdr (assoc 'whois network-connection-service-alist))
 745      search-string)))
 746
 747 (defcustom whois-reverse-lookup-server "whois.arin.net"
 748   "Server which provides inverse DNS mapping."
 749   :group 'net-utils
 750   :type  'string)
 751
 752 ;;;###autoload
 753 (defun whois-reverse-lookup ()
 754   (interactive)
 755   (let ((whois-server-name whois-reverse-lookup-server))
 756     (call-interactively 'whois)))
 757
 758 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 759 ;;; General Network connection
 760 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 761
 762 ;; Using a derived mode gives us keymaps, hooks, etc.
 763 (define-derived-mode
 764   network-connection-mode comint-mode "Network-Connection"
 765   "Major mode for interacting with the network-connection program.")
 766
 767 (defun network-connection-mode-setup (host service)
 768   (make-local-variable 'network-connection-host)
 769   (setq network-connection-host host)
 770   (make-local-variable 'network-connection-service)
 771   (setq network-connection-service service))
 772
 773 ;;;###autoload
 774 (defun network-connection-to-service (host service)
 775   "Open a network connection to SERVICE on HOST."
 776   (interactive
 777    (list
 778     (read-from-minibuffer "Host: " (net-utils-machine-at-point))
 779     (completing-read "Service: "
 780                      (mapcar
 781                       (function
 782                        (lambda (elt)
 783                          (list (symbol-name (car elt)))))
 784                       network-connection-service-alist))))
 785   (network-connection
 786    host
 787    (cdr (assoc (intern service) network-connection-service-alist))))
 788
 789 ;;;###autoload
 790 (defun network-connection (host port)
 791   "Open a network connection to HOST on PORT."
 792   (interactive "sHost: \nnPort: ")
 793   (network-service-connection host (number-to-string port)))
 794
 795 (defun network-service-connection (host service)
 796   "Open a network connection to SERVICE on HOST."
 797   (require 'comint)
 798   (let* ((process-name (concat "Network Connection [" host " " service "]"))
 799          (portnum (string-to-number service))
 800          (buf (get-buffer-create (concat "*" process-name "*"))))
 801     (or (zerop portnum) (setq service portnum))
 802     (make-comint
 803      process-name
 804      (cons host service))
 805     (set-buffer buf)
 806     (network-connection-mode)
 807     (network-connection-mode-setup host service)
 808     (pop-to-buffer buf)))
 809
 810 (defun network-connection-reconnect  ()
 811   "Reconnect a network connection, preserving the old input ring."
 812   (interactive)
 813   (let ((proc (get-buffer-process (current-buffer)))
 814         (old-comint-input-ring comint-input-ring)
 815         (host network-connection-host)
 816         (service network-connection-service))
 817     (if (not (or (not proc)
 818                  (eq (process-status proc) 'closed)))
 819         (message "Still connected")
 820       (goto-char (point-max))
 821       (insert (format "Reopening connection to %s\n" host))
 822       (network-connection host
 823                           (if (numberp service)
 824                               service
 825                             (cdr (assoc service network-connection-service-alist))))
 826       (and old-comint-input-ring
 827            (setq comint-input-ring old-comint-input-ring)))))
 828
 829 (provide 'net-utils)
 830
 831 ;;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
 832 ;;; net-utils.el ends here