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

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