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

   1 ;;; net-utils.el --- Network functions
   2
   3 ;; Author:  Peter Breton <pbreton@cs.umb.edu>
   4 ;; Created: Sun Mar 16 1997
   5 ;; Keywords: network communications
   6 ;; Time-stamp: <1998-06-13 06:19:01 pbreton>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  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 (eval-when-compile
  47   (require 'comint)
  48   (require 'ffap))
  49
  50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51 ;; Customization Variables
  52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53
  54 (defgroup net-utils nil
  55   "Network utility functions."
  56   :prefix "net-utils-"
  57   :group 'comm
  58   :version "20.3"
  59   )
  60
  61 (defcustom net-utils-remove-ctl-m
  62   (member system-type (list 'windows-nt 'msdos))
  63   "If non-nil, remove control-Ms from output."
  64   :group 'net-utils
  65   :type  'boolean
  66   )
  67
  68 (defcustom traceroute-program
  69   (if (eq system-type 'windows-nt)
  70       "tracert"
  71     "traceroute")
  72   "Program to trace network hops to a destination."
  73   :group 'net-utils
  74   :type  'string
  75   )
  76
  77 (defcustom traceroute-program-options nil
  78   "Options for the traceroute program."
  79   :group 'net-utils
  80   :type  '(repeat 'string)
  81   )
  82
  83 (defcustom ping-program "ping"
  84   "Program to send network test packets to a host."
  85   :group 'net-utils
  86   :type  'string
  87   )
  88
  89 ;; On Linux and Irix, the system's ping program seems to send packets
  90 ;; indefinitely unless told otherwise
  91 (defcustom ping-program-options
  92   (and (memq system-type (list 'linux 'gnu/linux 'irix))
  93        (list "-c" "4"))
  94   "Options for the ping program.
  95 These options can be used to limit how many ICMP packets are emitted."
  96   :group 'net-utils
  97   :type  '(repeat 'string)
  98   )
  99
 100 (defcustom ipconfig-program
 101   (if (eq system-type 'windows-nt)
 102       "ipconfig"
 103     "ifconfig")
 104   "Program to print network configuration information."
 105   :group 'net-utils
 106   :type  'string
 107   )
 108
 109 (defcustom ipconfig-program-options
 110    (list
 111     (if (eq system-type 'windows-nt)
 112         "/all" "-a"))
 113   "Options for ipconfig-program."
 114   :group 'net-utils
 115   :type  '(repeat 'string)
 116   )
 117
 118 (defcustom netstat-program  "netstat"
 119   "Program to print network statistics."
 120   :group 'net-utils
 121   :type  'string
 122   )
 123
 124 (defcustom netstat-program-options nil
 125   "Options for netstat-program."
 126   :group 'net-utils
 127   :type  '(repeat 'string)
 128   )
 129
 130 (defcustom arp-program  "arp"
 131   "Program to print IP to address translation tables."
 132   :group 'net-utils
 133   :type  'string
 134   )
 135
 136 (defcustom arp-program-options
 137   (list "-a")
 138   "Options for arp-program."
 139   :group 'net-utils
 140   :type  '(repeat 'string)
 141   )
 142
 143 (defcustom route-program
 144   (if (eq system-type 'windows-nt)
 145       "route"
 146     "netstat")
 147   "Program to print routing tables."
 148   :group 'net-utils
 149   :type  'string
 150   )
 151
 152 (defcustom route-program-options
 153   (if (eq system-type 'windows-nt)
 154       (list "print")
 155     (list "-r"))
 156   "Options for route-program."
 157   :group 'net-utils
 158   :type  '(repeat 'string)
 159   )
 160
 161 (defcustom nslookup-program  "nslookup"
 162   "Program to interactively query DNS information."
 163   :group 'net-utils
 164   :type  'string
 165   )
 166
 167 (defcustom nslookup-program-options  nil
 168   "List of options to pass to the nslookup program."
 169   :group 'net-utils
 170   :type  '(repeat 'string)
 171   )
 172
 173 (defcustom nslookup-prompt-regexp "^> "
 174   "Regexp to match the nslookup prompt."
 175   :group 'net-utils
 176   :type  'regexp
 177   )
 178
 179 (defcustom ftp-program "ftp"
 180   "Progam to run to do FTP transfers."
 181   :group 'net-utils
 182   :type  'string
 183   )
 184
 185 (defcustom ftp-program-options nil
 186   "List of options to pass to the FTP program."
 187   :group 'net-utils
 188   :type  '(repeat 'string)
 189   )
 190
 191 (defcustom ftp-prompt-regexp "^ftp>"
 192   "Regexp which matches the FTP program's prompt."
 193   :group 'net-utils
 194   :type  'regexp
 195   )
 196
 197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 198 ;; Nslookup goodies
 199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 200
 201 (defconst nslookup-font-lock-keywords
 202   (and window-system
 203        (progn
 204          (require 'font-lock)
 205          (list
 206           (list nslookup-prompt-regexp 0 font-lock-reference-face)
 207           (list "^[A-Za-z0-9 _]+:"     0 font-lock-type-face)
 208           (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
 209                 1 font-lock-keyword-face)
 210           ;; Dotted quads
 211           (list
 212            (mapconcat 'identity
 213                       (make-list 4 "[0-9]+")
 214                       "\\.")
 215            0 font-lock-variable-name-face)
 216           ;; Host names
 217           (list
 218            (let ((host-expression "[-A-Za-z0-9]+"))
 219              (concat
 220               (mapconcat 'identity
 221                          (make-list 2 host-expression)
 222                          "\\.")
 223               "\\(\\." host-expression "\\)*")
 224              )
 225            0 font-lock-variable-name-face)
 226           )))
 227          "Expressions to font-lock for nslookup.")
 228
 229 (defvar nslookup-abbrev-table (make-abbrev-table)
 230   "Abbrev table for nslookup.")
 231
 232 (define-abbrev nslookup-abbrev-table "e"   "exit")
 233 (define-abbrev nslookup-abbrev-table "f"   "finger")
 234 (define-abbrev nslookup-abbrev-table "h"   "help")
 235 (define-abbrev nslookup-abbrev-table "lse" "lserver")
 236 (define-abbrev nslookup-abbrev-table "r"   "root")
 237 (define-abbrev nslookup-abbrev-table "s"   "set")
 238 (define-abbrev nslookup-abbrev-table "se"  "server")
 239 (define-abbrev nslookup-abbrev-table "v"   "viewer")
 240
 241 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 242 ;; FTP goodies
 243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 244
 245 (defvar ftp-abbrev-table (make-abbrev-table)
 246   "Abbrev table for ftp.")
 247
 248 (define-abbrev ftp-abbrev-table "q"    "quit")
 249 (define-abbrev ftp-abbrev-table "g"    "get")
 250 (define-abbrev ftp-abbrev-table "p"    "prompt")
 251 (define-abbrev ftp-abbrev-table "anon" "anonymous")
 252
 253 (defconst ftp-font-lock-keywords
 254   (and window-system
 255        (progn
 256          (require 'font-lock)
 257          (list
 258           (list ftp-prompt-regexp 0 font-lock-reference-face)))))
 259
 260
 261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262 ;; Utility functions
 263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 264
 265 (defun net-utils-remove-ctrl-m-filter (process output-string)
 266   "Remove trailing control Ms."
 267   (let ((old-buffer (current-buffer))
 268         (filtered-string output-string))
 269     (unwind-protect
 270         (let ((moving))
 271           (set-buffer (process-buffer process))
 272           (setq moving (= (point) (process-mark process)))
 273
 274           (while (string-match "\r" filtered-string)
 275                (setq filtered-string
 276                      (replace-match "" nil nil filtered-string)))
 277
 278           (save-excursion
 279             ;; Insert the text, moving the process-marker.
 280             (goto-char (process-mark process))
 281             (insert filtered-string)
 282             (set-marker (process-mark process) (point)))
 283           (if moving (goto-char (process-mark process))))
 284       (set-buffer old-buffer))))
 285
 286 (defmacro net-utils-run-program (name header program &rest args)
 287   "Run a network information program."
 288   (`
 289    (let ((buf (get-buffer-create (concat "*" (, name) "*"))))
 290      (set-buffer buf)
 291      (erase-buffer)
 292      (insert (, header) "\n")
 293      (set-process-filter
 294       (apply 'start-process (, name) buf (, program) (,@ args))
 295       'net-utils-remove-ctrl-m-filter)
 296      (display-buffer buf))))
 297
 298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 299 ;; Wrappers for external network programs
 300 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 301
 302 ;;;###autoload
 303 (defun traceroute (target)
 304   "Run traceroute program for TARGET."
 305   (interactive "sTarget: ")
 306   (let ((options
 307          (if traceroute-program-options
 308              (append traceroute-program-options (list target))
 309            (list target))))
 310     (net-utils-run-program
 311      (concat "Traceroute" " " target)
 312      (concat "** Traceroute ** " traceroute-program " ** " target)
 313      traceroute-program
 314      options
 315      )))
 316
 317 ;;;###autoload
 318 (defun ping (host)
 319   "Ping HOST.
 320 If your system's ping continues until interrupted, you can try setting
 321 `ping-program-options'."
 322   (interactive
 323    (list
 324     (progn
 325       (require 'ffap)
 326       (read-from-minibuffer
 327        "Ping host: "
 328        (or (ffap-string-at-point 'machine) "")))))
 329   (let ((options
 330          (if ping-program-options
 331              (append ping-program-options (list host))
 332            (list host))))
 333     (net-utils-run-program
 334      (concat "Ping" " " host)
 335      (concat "** Ping ** " ping-program " ** " host)
 336      ping-program
 337      options
 338      )))
 339
 340 ;;;###autoload
 341 (defun ipconfig ()
 342   "Run ipconfig program."
 343   (interactive)
 344   (net-utils-run-program
 345    "Ipconfig"
 346    (concat "** Ipconfig ** " ipconfig-program " ** ")
 347    ipconfig-program
 348    ipconfig-program-options
 349    ))
 350
 351 ;; This is the normal name on most Unixes.
 352 ;;;###autoload
 353 (defalias 'ifconfig 'ipconfig)
 354
 355 ;;;###autoload
 356 (defun netstat ()
 357   "Run netstat program."
 358   (interactive)
 359   (net-utils-run-program
 360    "Netstat"
 361    (concat "** Netstat ** " netstat-program " ** ")
 362    netstat-program
 363    netstat-program-options
 364    ))
 365
 366 ;;;###autoload
 367 (defun arp ()
 368   "Run the arp program."
 369   (interactive)
 370   (net-utils-run-program
 371    "Arp"
 372    (concat "** Arp ** " arp-program " ** ")
 373    arp-program
 374    arp-program-options
 375    ))
 376
 377 ;;;###autoload
 378 (defun route ()
 379   "Run the route program."
 380   (interactive)
 381   (net-utils-run-program
 382    "Route"
 383    (concat "** Route ** " route-program " ** ")
 384    route-program
 385    route-program-options
 386    ))
 387
 388 ;; FIXME -- Needs to be a process filter
 389 ;; (defun netstat-with-filter (filter)
 390 ;;   "Run netstat program."
 391 ;;   (interactive "sFilter: ")
 392 ;;   (netstat)
 393 ;;   (set-buffer (get-buffer "*Netstat*"))
 394 ;;   (goto-char (point-min))
 395 ;;   (delete-matching-lines filter)
 396 ;;   )
 397
 398 ;;;###autoload
 399 (defun nslookup-host (host)
 400   "Lookup the DNS information for HOST."
 401   (interactive
 402    (list
 403     (read-from-minibuffer
 404      "Lookup host: "
 405      (or (ffap-string-at-point 'machine) ""))))
 406   (let ((options
 407          (if nslookup-program-options
 408              (append nslookup-program-options (list host))
 409            (list host))))
 410     (net-utils-run-program
 411      "Nslookup"
 412      (concat "** "
 413       (mapconcat 'identity
 414                 (list "Nslookup" host nslookup-program)
 415                 " ** "))
 416      nslookup-program
 417      options
 418      )))
 419
 420
 421 ;;;###autoload
 422 (defun nslookup ()
 423   "Run nslookup program."
 424   (interactive)
 425   (comint-run nslookup-program)
 426   (set-process-filter (get-buffer-process "*nslookup*")
 427    'net-utils-remove-ctrl-m-filter)
 428   (set
 429    (make-local-variable 'font-lock-defaults)
 430    '((nslookup-font-lock-keywords)))
 431   (set
 432    (make-local-variable 'local-abbrev-table)
 433    nslookup-abbrev-table)
 434   (abbrev-mode t)
 435   (make-local-variable 'comint-prompt-regexp)
 436   (setq comint-prompt-regexp nslookup-prompt-regexp)
 437   )
 438
 439 ;; This is a lot less than ange-ftp, but much simpler.
 440 ;;;###autoload
 441 (defun ftp (host)
 442   "Run ftp program."
 443   (interactive "sFtp to Host: ")
 444   (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
 445     (set-buffer buf)
 446     (comint-mode)
 447     (comint-exec buf (concat "ftp-" host) ftp-program nil
 448                  (if ftp-program-options
 449                      (append (list host) ftp-program-options)
 450                    (list host)))
 451     (set
 452      (make-local-variable 'font-lock-defaults)
 453      '((ftp-font-lock-keywords)))
 454
 455     (make-local-variable 'comint-prompt-regexp)
 456     (setq comint-prompt-regexp ftp-prompt-regexp)
 457
 458     ;; Already buffer local!
 459     (setq comint-output-filter-functions
 460           (list 'comint-watch-for-password-prompt))
 461     (set
 462      (make-local-variable 'local-abbrev-table)
 463      ftp-abbrev-table)
 464     (abbrev-mode t)
 465     (switch-to-buffer-other-window buf)
 466     ))
 467
 468 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 469 ;; Network Connections
 470 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 471
 472 ;; Full list is available at:
 473 ;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
 474 (defvar network-connection-service-alist
 475   (list
 476     (cons 'echo          7)
 477     (cons 'active-users 11)
 478     (cons 'daytime      13)
 479     (cons 'chargen      19)
 480     (cons 'ftp          21)
 481     (cons 'telnet       23)
 482     (cons 'smtp         25)
 483     (cons 'time         37)
 484     (cons 'whois        43)
 485     (cons 'gopher       70)
 486     (cons 'finger       79)
 487     (cons 'www          80)
 488     (cons 'pop2         109)
 489     (cons 'pop3         110)
 490     (cons 'sun-rpc      111)
 491     (cons 'nntp         119)
 492     (cons 'ntp          123)
 493     (cons 'netbios-name 137)
 494     (cons 'netbios-data 139)
 495     (cons 'irc          194)
 496     (cons 'https        443)
 497     (cons 'rlogin       513)
 498     )
 499   "Alist of services and associated TCP port numbers.
 500 This list in not complete.")
 501
 502 ;; Workhorse macro
 503 (defmacro run-network-program (process-name host port
 504                                             &optional initial-string)
 505   (`
 506    (let ((tcp-connection)
 507          (buf)
 508          )
 509     (setq buf (get-buffer-create (concat "*" (, process-name) "*")))
 510     (set-buffer buf)
 511     (or
 512      (setq tcp-connection
 513            (open-network-stream
 514             (, process-name)
 515             buf
 516             (, host)
 517             (, port)
 518             ))
 519      (error "Could not open connection to %s" (, host)))
 520     (erase-buffer)
 521     (set-marker (process-mark tcp-connection) (point-min))
 522     (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
 523     (and (, initial-string)
 524          (process-send-string tcp-connection
 525                               (concat (, initial-string) "\r\n")))
 526     (display-buffer buf))))
 527
 528 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 529 ;; Simple protocols
 530 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 531
 532 ;; Finger protocol
 533 ;;;###autoload
 534 (defun finger (user host)
 535   "Finger USER on HOST."
 536   ;; One of those great interactive statements that's actually
 537   ;; longer than the function call! The idea is that if the user
 538   ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
 539   ;; host name. If we don't see an "@", we'll prompt for the host.
 540   (interactive
 541     (progn
 542       (require 'ffap)
 543       (let* ((answer (read-from-minibuffer "Finger User: "
 544                                            (ffap-string-at-point 'url)))
 545              (index  (string-match (regexp-quote "@") answer))
 546              )
 547         (if index
 548             (list
 549              (substring answer 0 index)
 550              (substring answer (1+ index)))
 551           (list
 552            answer
 553            (read-from-minibuffer
 554             "At Host: "
 555             (or (ffap-string-at-point 'machine) "")))))))
 556   (let* (
 557          (user-and-host (concat user "@" host))
 558          (process-name
 559           (concat "Finger [" user-and-host "]"))
 560          )
 561     (run-network-program
 562      process-name
 563      host
 564      (cdr (assoc 'finger network-connection-service-alist))
 565      user-and-host
 566      )))
 567
 568 (defcustom whois-server-name "whois.internic.net"
 569   "Host name for the whois service."
 570   :group 'net-utils
 571   :type  'string
 572   )
 573
 574 ;; Whois protocol
 575 ;;;###autoload
 576 (defun whois (arg search-string)
 577   "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
 578 With argument, prompt for whois server."
 579   (interactive "P\nsWhois: ")
 580   (let ((host
 581          (if arg
 582              (read-from-minibuffer "Whois server name: ")
 583            whois-server-name))
 584         )
 585     (run-network-program
 586      "Whois"
 587      host
 588      (cdr (assoc 'whois network-connection-service-alist))
 589      search-string
 590      )))
 591
 592 (defcustom whois-reverse-lookup-server "whois.arin.net"
 593   "Server which provides inverse DNS mapping."
 594   :group 'net-utils
 595   :type  'string
 596   )
 597
 598 ;;;###autoload
 599 (defun whois-reverse-lookup ()
 600   (interactive)
 601   (let ((whois-server-name whois-reverse-lookup-server))
 602     (call-interactively 'whois)))
 603
 604 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 605 ;;; General Network connection
 606 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 607
 608 ;;;###autoload
 609 (defun network-connection-to-service (host service)
 610   "Open a network connection to SERVICE on HOST."
 611   (interactive
 612    (list
 613     (progn
 614       (require 'ffap)
 615       (read-from-minibuffer "Host: "
 616                             (ffap-string-at-point 'machine)))
 617     (completing-read "Service: "
 618                      (mapcar
 619                       (function
 620                        (lambda (elt)
 621                          (list (symbol-name (car elt)))))
 622                       network-connection-service-alist))))
 623   (network-connection
 624    host
 625    (cdr (assoc (intern service) network-connection-service-alist)))
 626   )
 627
 628 ;;;###autoload
 629 (defun network-connection (host port)
 630   "Open a network connection to HOST on PORT."
 631   (interactive "sHost: \nnPort: ")
 632   (network-service-connection host (number-to-string port)))
 633
 634 (defun network-service-connection (host service)
 635   "Open a network connection to SERVICE on HOST."
 636   (let (
 637         (process-name (concat "Network Connection [" host " " service "]"))
 638         (portnum (string-to-number service))
 639         )
 640     (or (zerop portnum) (setq service portnum))
 641     (make-comint
 642      process-name
 643      (cons host service))
 644     (pop-to-buffer (get-buffer (concat "*" process-name "*")))
 645     ))
 646
 647 (provide 'net-utils)
 648
 649 ;;; net-utils.el ends here