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