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

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