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