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