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