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 (declare-function w32-get-console-output-codepage "w32proc.c" ())
 330
 331 (defun net-utils-run-program (name header program args)
 332   "Run a network information program."
 333   (let ((buf (get-buffer-create (concat "*" name "*")))
 334         (coding-system-for-read
 335          ;; MS-Windows versions of network utilities output text
 336          ;; encoded in the console (a.k.a. "OEM") codepage, which is
 337          ;; different from the default system (a.k.a. "ANSI")
 338          ;; codepage.
 339          (if (eq system-type 'windows-nt)
 340              (intern (format "cp%d" (w32-get-console-output-codepage)))
 341            coding-system-for-read)))
 342     (set-buffer buf)
 343     (erase-buffer)
 344     (insert header "\n")
 345     (set-process-filter
 346      (apply 'start-process name buf program args)
 347      'net-utils-remove-ctrl-m-filter)
 348     (display-buffer buf)
 349     buf))
 350
 351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 352 ;; General network utilities (diagnostic)
 353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 354
 355 ;; Todo: This data could be saved in a bookmark.
 356 (defvar net-utils--revert-cmd nil)
 357
 358 (defun net-utils-run-simple (buffer program-name args &optional nodisplay)
 359   "Run a network utility for diagnostic output only."
 360   (with-current-buffer (if (stringp buffer) (get-buffer-create buffer) buffer)
 361     (let ((proc (get-buffer-process (current-buffer))))
 362       (when proc
 363         (set-process-filter proc nil)
 364         (delete-process proc)))
 365     (let ((inhibit-read-only t)
 366         (coding-system-for-read
 367          ;; MS-Windows versions of network utilities output text
 368          ;; encoded in the console (a.k.a. "OEM") codepage, which is
 369          ;; different from the default system (a.k.a. "ANSI")
 370          ;; codepage.
 371          (if (eq system-type 'windows-nt)
 372              (intern (format "cp%d" (w32-get-console-output-codepage)))
 373            coding-system-for-read)))
 374       (erase-buffer))
 375     (net-utils-mode)
 376     (setq-local net-utils--revert-cmd
 377                 `(net-utils-run-simple ,(current-buffer)
 378                                        ,program-name ,args nodisplay))
 379     (set-process-filter
 380          (apply 'start-process program-name
 381                 (current-buffer) program-name args)
 382          'net-utils-remove-ctrl-m-filter)
 383     (unless nodisplay (display-buffer (current-buffer)))))
 384
 385 (defun net-utils--revert-function (&optional ignore-auto noconfirm)
 386   (message "Reverting `%s'..." (buffer-name))
 387   (apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
 388   (let ((proc (get-buffer-process (current-buffer))))
 389     (when proc
 390       (set-process-sentinel
 391        proc
 392        (lambda (process event)
 393          (when (string= event "finished\n")
 394            (message "Reverting `%s' done" (process-buffer process))))))))
 395
 396 ;;;###autoload
 397 (defun ifconfig ()
 398   "Run ifconfig and display diagnostic output."
 399   (interactive)
 400   (net-utils-run-simple
 401    (format "*%s*" ifconfig-program)
 402    ifconfig-program
 403    ifconfig-program-options))
 404
 405 (defalias 'ipconfig 'ifconfig)
 406
 407 ;;;###autoload
 408 (defun iwconfig ()
 409   "Run iwconfig and display diagnostic output."
 410   (interactive)
 411   (net-utils-run-simple
 412    (format "*%s*" iwconfig-program)
 413    iwconfig-program
 414    iwconfig-program-options))
 415
 416 ;;;###autoload
 417 (defun netstat ()
 418   "Run netstat and display diagnostic output."
 419   (interactive)
 420   (net-utils-run-simple
 421    (format "*%s*" netstat-program)
 422    netstat-program
 423    netstat-program-options))
 424
 425 ;;;###autoload
 426 (defun arp ()
 427   "Run arp and display diagnostic output."
 428   (interactive)
 429   (net-utils-run-simple
 430    (format "*%s*" arp-program)
 431    arp-program
 432    arp-program-options))
 433
 434 ;;;###autoload
 435 (defun route ()
 436   "Run route and display diagnostic output."
 437   (interactive)
 438   (net-utils-run-simple
 439    (format "*%s*" route-program)
 440    route-program
 441    route-program-options))
 442
 443 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 444 ;; Wrappers for external network programs
 445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 446
 447 ;;;###autoload
 448 (defun traceroute (target)
 449   "Run traceroute program for TARGET."
 450   (interactive "sTarget: ")
 451   (let ((options
 452          (if traceroute-program-options
 453              (append traceroute-program-options (list target))
 454            (list target))))
 455     (net-utils-run-simple
 456      (concat "Traceroute" " " target)
 457      traceroute-program
 458      options)))
 459
 460 ;;;###autoload
 461 (defun ping (host)
 462   "Ping HOST.
 463 If your system's ping continues until interrupted, you can try setting
 464 `ping-program-options'."
 465   (interactive
 466    (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
 467   (let ((options
 468          (if ping-program-options
 469              (append ping-program-options (list host))
 470            (list host))))
 471     (net-utils-run-program
 472      (concat "Ping" " " host)
 473      (concat "** Ping ** " ping-program " ** " host)
 474      ping-program
 475      options)))
 476
 477 ;; FIXME -- Needs to be a process filter
 478 ;; (defun netstat-with-filter (filter)
 479 ;;   "Run netstat program."
 480 ;;   (interactive "sFilter: ")
 481 ;;   (netstat)
 482 ;;   (set-buffer (get-buffer "*Netstat*"))
 483 ;;   (goto-char (point-min))
 484 ;;   (delete-matching-lines filter))
 485
 486 ;;;###autoload
 487 (defun nslookup-host (host)
 488   "Lookup the DNS information for HOST."
 489   (interactive
 490    (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
 491   (let ((options
 492          (if nslookup-program-options
 493              (append nslookup-program-options (list host))
 494            (list host))))
 495     (net-utils-run-program
 496      "Nslookup"
 497      (concat "** "
 498       (mapconcat 'identity
 499                 (list "Nslookup" host nslookup-program)
 500                 " ** "))
 501      nslookup-program
 502      options)))
 503
 504 ;;;###autoload
 505 (defun nslookup ()
 506   "Run nslookup program."
 507   (interactive)
 508   (switch-to-buffer (make-comint "nslookup" nslookup-program))
 509   (nslookup-mode))
 510
 511 (defvar comint-prompt-regexp)
 512 (defvar comint-input-autoexpand)
 513
 514 (autoload 'comint-mode "comint" nil t)
 515
 516 (defvar nslookup-mode-map
 517   (let ((map (make-sparse-keymap)))
 518     (define-key map "\t" 'completion-at-point)
 519     map))
 520
 521 ;; Using a derived mode gives us keymaps, hooks, etc.
 522 (define-derived-mode nslookup-mode comint-mode "Nslookup"
 523   "Major mode for interacting with the nslookup program."
 524   (set
 525    (make-local-variable 'font-lock-defaults)
 526    '((nslookup-font-lock-keywords)))
 527   (setq comint-prompt-regexp nslookup-prompt-regexp)
 528   (setq comint-input-autoexpand t))
 529
 530 ;;;###autoload
 531 (defun dns-lookup-host (host)
 532   "Lookup the DNS information for HOST (name or IP address)."
 533   (interactive
 534    (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
 535   (let ((options
 536          (if dns-lookup-program-options
 537              (append dns-lookup-program-options (list host))
 538            (list host))))
 539     (net-utils-run-program
 540      (concat "DNS Lookup [" host "]")
 541      (concat "** "
 542       (mapconcat 'identity
 543                 (list "DNS Lookup" host dns-lookup-program)
 544                 " ** "))
 545      dns-lookup-program
 546      options)))
 547
 548 (autoload 'ffap-string-at-point "ffap")
 549
 550 ;;;###autoload
 551 (defun run-dig (host)
 552   "Run dig program."
 553   (interactive
 554    (list
 555     (read-from-minibuffer "Lookup host: "
 556                           (or (ffap-string-at-point 'machine) ""))))
 557   (net-utils-run-program
 558    "Dig"
 559    (concat "** "
 560            (mapconcat 'identity
 561                       (list "Dig" host dig-program)
 562                       " ** "))
 563    dig-program
 564    (list host)))
 565
 566 (autoload 'comint-exec "comint")
 567
 568 ;; This is a lot less than ange-ftp, but much simpler.
 569 ;;;###autoload
 570 (defun ftp (host)
 571   "Run ftp program."
 572   (interactive
 573    (list
 574     (read-from-minibuffer
 575      "Ftp to Host: " (net-utils-machine-at-point))))
 576   (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
 577     (set-buffer buf)
 578     (ftp-mode)
 579     (comint-exec buf (concat "ftp-" host) ftp-program nil
 580                  (if ftp-program-options
 581                      (append (list host) ftp-program-options)
 582                    (list host)))
 583     (pop-to-buffer buf)))
 584
 585 (defvar ftp-mode-map
 586   (let ((map (make-sparse-keymap)))
 587     ;; Occasionally useful
 588     (define-key map "\t" 'completion-at-point)
 589     map))
 590
 591 (define-derived-mode ftp-mode comint-mode "FTP"
 592   "Major mode for interacting with the ftp program."
 593   (setq comint-prompt-regexp ftp-prompt-regexp)
 594   (setq comint-input-autoexpand t)
 595   ;; Only add the password-prompting hook if it's not already in the
 596   ;; global hook list.  This stands a small chance of losing, if it's
 597   ;; later removed from the global list (very small, since any
 598   ;; password prompts will probably immediately follow the initial
 599   ;; connection), but it's better than getting prompted twice for the
 600   ;; same password.
 601   (unless (memq 'comint-watch-for-password-prompt
 602                 (default-value 'comint-output-filter-functions))
 603     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 604               nil t)))
 605
 606 (defun smbclient (host service)
 607   "Connect to SERVICE on HOST via SMB."
 608   (interactive
 609    (list
 610     (read-from-minibuffer
 611      "Connect to Host: " (net-utils-machine-at-point))
 612     (read-from-minibuffer "SMB Service: ")))
 613   (let* ((name (format "smbclient [%s\\%s]" host service))
 614          (buf (get-buffer-create (concat "*" name "*")))
 615          (service-name (concat "\\\\" host "\\" service)))
 616     (set-buffer buf)
 617     (smbclient-mode)
 618     (comint-exec buf name smbclient-program nil
 619                  (if smbclient-program-options
 620                      (append (list service-name) smbclient-program-options)
 621                    (list service-name)))
 622     (pop-to-buffer buf)))
 623
 624 (defun smbclient-list-shares (host)
 625   "List services on HOST."
 626   (interactive
 627    (list
 628     (read-from-minibuffer
 629      "Connect to Host: " (net-utils-machine-at-point))))
 630   (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
 631     (set-buffer buf)
 632     (smbclient-mode)
 633     (comint-exec buf "smbclient-list-shares"
 634                  smbclient-program nil (list "-L" host))
 635     (pop-to-buffer buf)))
 636
 637 (define-derived-mode smbclient-mode comint-mode "smbclient"
 638   "Major mode for interacting with the smbclient program."
 639   (setq comint-prompt-regexp smbclient-prompt-regexp)
 640   (setq comint-input-autoexpand t)
 641   ;; Only add the password-prompting hook if it's not already in the
 642   ;; global hook list.  This stands a small chance of losing, if it's
 643   ;; later removed from the global list (very small, since any
 644   ;; password prompts will probably immediately follow the initial
 645   ;; connection), but it's better than getting prompted twice for the
 646   ;; same password.
 647   (unless (memq 'comint-watch-for-password-prompt
 648                 (default-value 'comint-output-filter-functions))
 649     (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
 650               nil t)))
 651
 652
 653 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 654 ;; Network Connections
 655 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 656
 657 ;; Full list is available at:
 658 ;; http://www.iana.org/assignments/port-numbers
 659 (defvar network-connection-service-alist
 660   (list
 661     (cons 'echo          7)
 662     (cons 'active-users 11)
 663     (cons 'daytime      13)
 664     (cons 'chargen      19)
 665     (cons 'ftp          21)
 666     (cons 'telnet       23)
 667     (cons 'smtp         25)
 668     (cons 'time         37)
 669     (cons 'whois        43)
 670     (cons 'gopher       70)
 671     (cons 'finger       79)
 672     (cons 'www          80)
 673     (cons 'pop2         109)
 674     (cons 'pop3         110)
 675     (cons 'sun-rpc      111)
 676     (cons 'nntp         119)
 677     (cons 'ntp          123)
 678     (cons 'netbios-name 137)
 679     (cons 'netbios-data 139)
 680     (cons 'irc          194)
 681     (cons 'https        443)
 682     (cons 'rlogin       513))
 683   "Alist of services and associated TCP port numbers.
 684 This list is not complete.")
 685
 686 ;; Workhorse routine
 687 (defun run-network-program (process-name host port &optional initial-string)
 688   (let ((tcp-connection)
 689         (buf))
 690     (setq buf (get-buffer-create (concat "*" process-name "*")))
 691     (set-buffer buf)
 692     (or
 693      (setq tcp-connection
 694            (open-network-stream process-name buf host port))
 695      (error "Could not open connection to %s" host))
 696     (erase-buffer)
 697     (set-marker (process-mark tcp-connection) (point-min))
 698     (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
 699     (and initial-string
 700          (process-send-string tcp-connection
 701                               (concat initial-string "\r\n")))
 702     (display-buffer buf)))
 703
 704 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 705 ;; Simple protocols
 706 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 707
 708 (defcustom finger-X.500-host-regexps nil
 709   "A list of regular expressions matching host names.
 710 If a host name passed to `finger' matches one of these regular
 711 expressions, it is assumed to be a host that doesn't accept
 712 queries of the form USER@HOST, and wants a query containing USER only."
 713   :group 'net-utils
 714   :type '(repeat regexp)
 715   :version "21.1")
 716
 717 ;; Finger protocol
 718 ;;;###autoload
 719 (defun finger (user host)
 720   "Finger USER on HOST."
 721   ;; One of those great interactive statements that's actually
 722   ;; longer than the function call! The idea is that if the user
 723   ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
 724   ;; host name. If we don't see an "@", we'll prompt for the host.
 725   (interactive
 726     (let* ((answer (read-from-minibuffer "Finger User: "
 727                                          (net-utils-url-at-point)))
 728            (index  (string-match (regexp-quote "@") answer)))
 729       (if index
 730           (list (substring answer 0 index)
 731                 (substring answer (1+ index)))
 732         (list answer
 733               (read-from-minibuffer "At Host: "
 734                                     (net-utils-machine-at-point))))))
 735   (let* ((user-and-host (concat user "@" host))
 736          (process-name (concat "Finger [" user-and-host "]"))
 737          (regexps finger-X.500-host-regexps)
 738          found)
 739     (and regexps
 740          (while (not (string-match (car regexps) host))
 741            (setq regexps (cdr regexps)))
 742          (when regexps
 743            (setq user-and-host user)))
 744     (run-network-program
 745      process-name
 746      host
 747      (cdr (assoc 'finger network-connection-service-alist))
 748      user-and-host)))
 749
 750 (defcustom whois-server-name "rs.internic.net"
 751   "Default host name for the whois service."
 752   :group 'net-utils
 753   :type  'string)
 754
 755 (defcustom whois-server-list
 756   '(("whois.arin.net")     ; Networks, ASN's, and related POC's (numbers)
 757     ("rs.internic.net")  ; domain related info
 758     ("whois.publicinterestregistry.net")
 759     ("whois.abuse.net")
 760     ("whois.apnic.net")
 761     ("nic.ddn.mil")
 762     ("whois.nic.mil")
 763     ("whois.nic.gov")
 764     ("whois.ripe.net"))
 765   "A list of whois servers that can be queried."
 766   :group 'net-utils
 767   :type '(repeat (list string)))
 768
 769 ;; FIXME: modern whois clients include a much better tld <-> whois server
 770 ;; list, Emacs should probably avoid specifying the server as the client
 771 ;; will DTRT anyway... -rfr
 772 (defcustom whois-server-tld
 773   '(("rs.internic.net" . "com")
 774     ("whois.publicinterestregistry.net" . "org")
 775     ("whois.ripe.net" . "be")
 776     ("whois.ripe.net" . "de")
 777     ("whois.ripe.net" . "dk")
 778     ("whois.ripe.net" . "it")
 779     ("whois.ripe.net" . "fi")
 780     ("whois.ripe.net" . "fr")
 781     ("whois.ripe.net" . "uk")
 782     ("whois.apnic.net" . "au")
 783     ("whois.apnic.net" . "ch")
 784     ("whois.apnic.net" . "hk")
 785     ("whois.apnic.net" . "jp")
 786     ("whois.nic.gov" . "gov")
 787     ("whois.nic.mil" . "mil"))
 788   "Alist to map top level domains to whois servers."
 789   :group 'net-utils
 790   :type '(repeat (cons string string)))
 791
 792 (defcustom whois-guess-server t
 793   "If non-nil then whois will try to deduce the appropriate whois
 794 server from the query.  If the query doesn't look like a domain or hostname
 795 then the server named by `whois-server-name' is used."
 796   :group 'net-utils
 797   :type 'boolean)
 798
 799 (defun whois-get-tld (host)
 800   "Return the top level domain of `host', or nil if it isn't a domain name."
 801   (let ((i (1- (length host)))
 802         (max-len (- (length host) 5)))
 803     (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
 804       (setq i (1- i)))
 805     (if (= i max-len)
 806         nil
 807       (substring host (1+ i)))))
 808
 809 ;; Whois protocol
 810 ;;;###autoload
 811 (defun whois (arg search-string)
 812   "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
 813 If `whois-guess-server' is non-nil, then try to deduce the correct server
 814 from SEARCH-STRING.  With argument, prompt for whois server."
 815   (interactive "P\nsWhois: ")
 816   (let* ((whois-apropos-host (if whois-guess-server
 817                                  (rassoc (whois-get-tld search-string)
 818                                          whois-server-tld)
 819                                nil))
 820          (server-name (if whois-apropos-host
 821                           (car whois-apropos-host)
 822                         whois-server-name))
 823          (host
 824           (if arg
 825               (completing-read "Whois server name: "
 826                                whois-server-list nil nil "whois.")
 827             server-name)))
 828     (run-network-program
 829      "Whois"
 830      host
 831      (cdr (assoc 'whois network-connection-service-alist))
 832      search-string)))
 833
 834 (defcustom whois-reverse-lookup-server "whois.arin.net"
 835   "Server which provides inverse DNS mapping."
 836   :group 'net-utils
 837   :type  'string)
 838
 839 ;;;###autoload
 840 (defun whois-reverse-lookup ()
 841   (interactive)
 842   (let ((whois-server-name whois-reverse-lookup-server))
 843     (call-interactively 'whois)))
 844
 845 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 846 ;;; General Network connection
 847 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 848
 849 ;; Using a derived mode gives us keymaps, hooks, etc.
 850 (define-derived-mode
 851   network-connection-mode comint-mode "Network-Connection"
 852   "Major mode for interacting with the network-connection program.")
 853
 854 (defun network-connection-mode-setup (host service)
 855   (make-local-variable 'network-connection-host)
 856   (setq network-connection-host host)
 857   (make-local-variable 'network-connection-service)
 858   (setq network-connection-service service))
 859
 860 ;;;###autoload
 861 (defun network-connection-to-service (host service)
 862   "Open a network connection to SERVICE on HOST."
 863   (interactive
 864    (list
 865     (read-from-minibuffer "Host: " (net-utils-machine-at-point))
 866     (completing-read "Service: "
 867                      (mapcar
 868                       (function
 869                        (lambda (elt)
 870                          (list (symbol-name (car elt)))))
 871                       network-connection-service-alist))))
 872   (network-connection
 873    host
 874    (cdr (assoc (intern service) network-connection-service-alist))))
 875
 876 ;;;###autoload
 877 (defun network-connection (host port)
 878   "Open a network connection to HOST on PORT."
 879   (interactive "sHost: \nnPort: ")
 880   (network-service-connection host (number-to-string port)))
 881
 882 (defun network-service-connection (host service)
 883   "Open a network connection to SERVICE on HOST."
 884   (let* ((process-name (concat "Network Connection [" host " " service "]"))
 885          (portnum (string-to-number service))
 886          (buf (get-buffer-create (concat "*" process-name "*"))))
 887     (or (zerop portnum) (setq service portnum))
 888     (make-comint
 889      process-name
 890      (cons host service))
 891     (set-buffer buf)
 892     (network-connection-mode)
 893     (network-connection-mode-setup host service)
 894     (pop-to-buffer buf)))
 895
 896 (defvar comint-input-ring)
 897
 898 (defun network-connection-reconnect  ()
 899   "Reconnect a network connection, preserving the old input ring."
 900   (interactive)
 901   (let ((proc (get-buffer-process (current-buffer)))
 902         (old-comint-input-ring comint-input-ring)
 903         (host network-connection-host)
 904         (service network-connection-service))
 905     (if (not (or (not proc)
 906                  (eq (process-status proc) 'closed)))
 907         (message "Still connected")
 908       (goto-char (point-max))
 909       (insert (format "Reopening connection to %s\n" host))
 910       (network-connection host
 911                           (if (numberp service)
 912                               service
 913                             (cdr (assoc service network-connection-service-alist))))
 914       (and old-comint-input-ring
 915            (setq comint-input-ring old-comint-input-ring)))))
 916
 917 (provide 'net-utils)
 918
 919 ;;; net-utils.el ends here