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

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