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

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