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

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