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