;;; net-utils.el --- network functions
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Mar 16 1997
:group 'comm
:version "20.3")
-(defcustom net-utils-remove-ctl-m
- (member system-type (list 'windows-nt 'msdos))
+(defcustom net-utils-remove-ctl-m (memq system-type '(windows-nt msdos))
"If non-nil, remove control-Ms from output."
:group 'net-utils
:type 'boolean)
;; On GNU/Linux and Irix, the system's ping program seems to send packets
;; indefinitely unless told otherwise
(defcustom ping-program-options
- (and (memq system-type (list 'linux 'gnu/linux 'irix))
+ (and (memq system-type '(gnu/linux irix))
(list "-c" "4"))
"Options for the ping program.
These options can be used to limit how many ICMP packets are emitted."
:group 'net-utils
:type 'string)
+(define-obsolete-variable-alias 'ipconfig-program-options
+ 'ifconfig-program-options "22.2")
+
(defcustom ifconfig-program-options
(list
(if (eq system-type 'windows-nt)
:type 'string
:version "23.1")
-(define-obsolete-variable-alias 'ipconfig-program-options
- 'ifconfig-program-options "22.2")
-
(defcustom iwconfig-program-options nil
"Options for the iwconfig program."
:group 'net-utils
;; Nslookup goodies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst nslookup-font-lock-keywords
+(defvar nslookup-font-lock-keywords
(list
(list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face)
(list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
0 'font-lock-variable-name-face))
"Expressions to font-lock for nslookup.")
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; General network utilities mode
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar net-utils-font-lock-keywords
+ (list
+ ;; Dotted quads
+ (list
+ (mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
+ 0 'font-lock-variable-name-face)
+ ;; Simple rfc4291 addresses
+ (list (concat
+ "\\( \\([[:xdigit:]]+\\(:\\|::\\)\\)+[[:xdigit:]]+\\)"
+ "\\|"
+ "\\(::[[:xdigit:]]+\\)")
+ 0 'font-lock-variable-name-face)
+ ;; Host names
+ (list
+ (let ((host-expression "[-A-Za-z0-9]+"))
+ (concat
+ (mapconcat 'identity (make-list 2 host-expression) "\\.")
+ "\\(\\." host-expression "\\)*"))
+ 0 'font-lock-variable-name-face))
+ "Expressions to font-lock for general network utilities.")
+
+(define-derived-mode net-utils-mode special-mode "NetworkUtil"
+ "Major mode for interacting with an external network utility."
+ (set (make-local-variable 'font-lock-defaults)
+ '((net-utils-font-lock-keywords))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(skip-chars-backward ":;.,!?" pt)
(point)))))
-
(defun net-utils-remove-ctrl-m-filter (process output-string)
"Remove trailing control Ms."
(let ((old-buffer (current-buffer))
(unwind-protect
(let ((moving))
(set-buffer (process-buffer process))
- (setq moving (= (point) (process-mark process)))
-
- (while (string-match "\r" filtered-string)
- (setq filtered-string
- (replace-match "" nil nil filtered-string)))
-
- (save-excursion
- ;; Insert the text, moving the process-marker.
- (goto-char (process-mark process))
- (insert filtered-string)
- (set-marker (process-mark process) (point)))
+ (let ((inhibit-read-only t))
+ (setq moving (= (point) (process-mark process)))
+
+ (while (string-match "\r" filtered-string)
+ (setq filtered-string
+ (replace-match "" nil nil filtered-string)))
+
+ (save-excursion
+ ;; Insert the text, moving the process-marker.
+ (goto-char (process-mark process))
+ (insert filtered-string)
+ (set-marker (process-mark process) (point))))
(if moving (goto-char (process-mark process))))
(set-buffer old-buffer))))
buf))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Wrappers for external network programs
+;; General network utilities (diagnostic)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;###autoload
-(defun traceroute (target)
- "Run traceroute program for TARGET."
- (interactive "sTarget: ")
- (let ((options
- (if traceroute-program-options
- (append traceroute-program-options (list target))
- (list target))))
- (net-utils-run-program
- (concat "Traceroute" " " target)
- (concat "** Traceroute ** " traceroute-program " ** " target)
- traceroute-program
- options)))
-
-;;;###autoload
-(defun ping (host)
- "Ping HOST.
-If your system's ping continues until interrupted, you can try setting
-`ping-program-options'."
- (interactive
- (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
- (let ((options
- (if ping-program-options
- (append ping-program-options (list host))
- (list host))))
- (net-utils-run-program
- (concat "Ping" " " host)
- (concat "** Ping ** " ping-program " ** " host)
- ping-program
- options)))
+(defun net-utils-run-simple (buffer-name program-name args)
+ "Run a network utility for diagnostic output only."
+ (interactive)
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name))
+ (get-buffer-create buffer-name)
+ (with-current-buffer buffer-name
+ (net-utils-mode)
+ (set-process-filter
+ (apply 'start-process (format "%s" program-name)
+ buffer-name program-name args)
+ 'net-utils-remove-ctrl-m-filter)
+ (goto-char (point-min)))
+ (display-buffer buffer-name))
;;;###autoload
(defun ifconfig ()
- "Run ifconfig program."
+ "Run ifconfig and display diagnostic output."
(interactive)
- (net-utils-run-program
- "Ifconfig"
- (concat "** Ifconfig ** " ifconfig-program " ** ")
+ (net-utils-run-simple
+ (format "*%s*" ifconfig-program)
ifconfig-program
ifconfig-program-options))
-;; Windows uses this name.
-;;;###autoload
(defalias 'ipconfig 'ifconfig)
;;;###autoload
(defun iwconfig ()
- "Run iwconfig program."
+ "Run iwconfig and display diagnostic output."
(interactive)
- (net-utils-run-program
- "Iwconfig"
- (concat "** Iwconfig ** " iwconfig-program " ** ")
+ (net-utils-run-simple
+ (format "*%s*" iwconfig-program)
iwconfig-program
iwconfig-program-options))
;;;###autoload
(defun netstat ()
- "Run netstat program."
+ "Run netstat and display diagnostic output."
(interactive)
- (net-utils-run-program
- "Netstat"
- (concat "** Netstat ** " netstat-program " ** ")
+ (net-utils-run-simple
+ (format "*%s*" netstat-program)
netstat-program
netstat-program-options))
;;;###autoload
(defun arp ()
- "Run arp program."
+ "Run arp and display diagnostic output."
(interactive)
- (net-utils-run-program
- "Arp"
- (concat "** Arp ** " arp-program " ** ")
+ (net-utils-run-simple
+ (format "*%s*" arp-program)
arp-program
arp-program-options))
;;;###autoload
(defun route ()
- "Run route program."
+ "Run route and display diagnostic output."
(interactive)
- (net-utils-run-program
- "Route"
- (concat "** Route ** " route-program " ** ")
+ (net-utils-run-simple
+ (format "*%s*" route-program)
route-program
route-program-options))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wrappers for external network programs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun traceroute (target)
+ "Run traceroute program for TARGET."
+ (interactive "sTarget: ")
+ (let ((options
+ (if traceroute-program-options
+ (append traceroute-program-options (list target))
+ (list target))))
+ (net-utils-run-program
+ (concat "Traceroute" " " target)
+ (concat "** Traceroute ** " traceroute-program " ** " target)
+ traceroute-program
+ options)))
+
+;;;###autoload
+(defun ping (host)
+ "Ping HOST.
+If your system's ping continues until interrupted, you can try setting
+`ping-program-options'."
+ (interactive
+ (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
+ (let ((options
+ (if ping-program-options
+ (append ping-program-options (list host))
+ (list host))))
+ (net-utils-run-program
+ (concat "Ping" " " host)
+ (concat "** Ping ** " ping-program " ** " host)
+ ping-program
+ options)))
+
;; FIXME -- Needs to be a process filter
;; (defun netstat-with-filter (filter)
;; "Run netstat program."
(defun nslookup ()
"Run nslookup program."
(interactive)
- (comint-run nslookup-program)
+ (switch-to-buffer (make-comint "nslookup" nslookup-program))
(nslookup-mode))
(defvar comint-prompt-regexp)
(autoload 'comint-mode "comint" nil t)
+(defvar nslookup-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\t" 'comint-dynamic-complete)
+ map))
+
;; Using a derived mode gives us keymaps, hooks, etc.
(define-derived-mode nslookup-mode comint-mode "Nslookup"
"Major mode for interacting with the nslookup program."
(setq comint-prompt-regexp nslookup-prompt-regexp)
(setq comint-input-autoexpand t))
-(define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
-
;;;###autoload
(defun dns-lookup-host (host)
"Lookup the DNS information for HOST (name or IP address)."
(list host)))
(pop-to-buffer buf)))
+(defvar ftp-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; Occasionally useful
+ (define-key map "\t" 'comint-dynamic-complete)
+ map))
+
(define-derived-mode ftp-mode comint-mode "FTP"
"Major mode for interacting with the ftp program."
(setq comint-prompt-regexp ftp-prompt-regexp)
(add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
nil t)))
-;; Occasionally useful
-(define-key ftp-mode-map "\t" 'comint-dynamic-complete)
-
(defun smbclient (host service)
"Connect to SERVICE on HOST via SMB."
(interactive
(provide 'net-utils)
-;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
;;; net-utils.el ends here