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

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