1 ;;; net-utils.el --- network functions
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: Peter Breton <pbreton@cs.umb.edu>
7 ;; Created: Sun Mar 16 1997
8 ;; Keywords: network comm
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; There are three main areas of functionality:
30 ;; * Wrap common network utility programs (ping, traceroute, netstat,
31 ;; nslookup, arp, route). Note that these wrappers are of the diagnostic
32 ;; functions of these programs only.
34 ;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
36 ;; * Support connections to HOST/PORT, generally for debugging and the like.
37 ;; In other words, for doing much the same thing as "telnet HOST PORT", and
38 ;; then typing commands.
42 ;; On some systems, some of these programs are not in normal user path,
43 ;; but rather in /sbin, /usr/sbin, and so on.
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 ;; Customization Variables
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 (defgroup net-utils nil
53 "Network utility functions."
58 (defcustom net-utils-remove-ctl-m
59 (member system-type
(list 'windows-nt
'msdos
))
60 "If non-nil, remove control-Ms from output."
64 (defcustom traceroute-program
65 (if (eq system-type
'windows-nt
)
68 "Program to trace network hops to a destination."
72 (defcustom traceroute-program-options nil
73 "Options for the traceroute program."
75 :type
'(repeat string
))
77 (defcustom ping-program
"ping"
78 "Program to send network test packets to a host."
82 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
83 ;; indefinitely unless told otherwise
84 (defcustom ping-program-options
85 (and (memq system-type
(list 'linux
'gnu
/linux
'irix
))
87 "Options for the ping program.
88 These options can be used to limit how many ICMP packets are emitted."
90 :type
'(repeat string
))
92 (define-obsolete-variable-alias 'ipconfig-program
'ifconfig-program
"22.2")
94 (defcustom ifconfig-program
95 (if (eq system-type
'windows-nt
)
98 "Program to print network configuration information."
102 (defcustom ifconfig-program-options
104 (if (eq system-type
'windows-nt
)
106 "Options for the ifconfig program."
108 :type
'(repeat string
))
110 (defcustom iwconfig-program
"iwconfig"
111 "Program to print wireless network configuration information."
116 (define-obsolete-variable-alias 'ipconfig-program-options
117 'ifconfig-program-options
"22.2")
119 (defcustom iwconfig-program-options nil
120 "Options for the iwconfig program."
122 :type
'(repeat string
)
125 (defcustom netstat-program
"netstat"
126 "Program to print network statistics."
130 (defcustom netstat-program-options
132 "Options for the netstat program."
134 :type
'(repeat string
))
136 (defcustom arp-program
"arp"
137 "Program to print IP to address translation tables."
141 (defcustom arp-program-options
143 "Options for the arp program."
145 :type
'(repeat string
))
147 (defcustom route-program
148 (if (eq system-type
'windows-nt
)
151 "Program to print routing tables."
155 (defcustom route-program-options
156 (if (eq system-type
'windows-nt
)
159 "Options for the route program."
161 :type
'(repeat string
))
163 (defcustom nslookup-program
"nslookup"
164 "Program to interactively query DNS information."
168 (defcustom nslookup-program-options nil
169 "Options for the nslookup program."
171 :type
'(repeat string
))
173 (defcustom nslookup-prompt-regexp
"^> "
174 "Regexp to match the nslookup prompt.
176 This variable is only used if the variable
177 `comint-use-prompt-regexp' is non-nil."
181 (defcustom dig-program
"dig"
182 "Program to query DNS information."
186 (defcustom ftp-program
"ftp"
187 "Program to run to do FTP transfers."
191 (defcustom ftp-program-options nil
192 "Options for the ftp program."
194 :type
'(repeat string
))
196 (defcustom ftp-prompt-regexp
"^ftp>"
197 "Regexp which matches the FTP program's prompt.
199 This variable is only used if the variable
200 `comint-use-prompt-regexp' is non-nil."
204 (defcustom smbclient-program
"smbclient"
209 (defcustom smbclient-program-options nil
210 "Options for the smbclient program."
212 :type
'(repeat string
))
214 (defcustom smbclient-prompt-regexp
"^smb: \>"
215 "Regexp which matches the smbclient program's prompt.
217 This variable is only used if the variable
218 `comint-use-prompt-regexp' is non-nil."
222 (defcustom dns-lookup-program
"host"
223 "Program to interactively query DNS information."
227 (defcustom dns-lookup-program-options nil
228 "Options for the dns-lookup program."
230 :type
'(repeat string
))
232 ;; Internal variables
233 (defvar network-connection-service nil
)
234 (defvar network-connection-host nil
)
236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
238 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
240 (defconst nslookup-font-lock-keywords
242 (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face
)
243 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
244 1 'font-lock-keyword-face
)
248 (make-list 4 "[0-9]+")
250 0 'font-lock-variable-name-face
)
253 (let ((host-expression "[-A-Za-z0-9]+"))
256 (make-list 2 host-expression
)
258 "\\(\\." host-expression
"\\)*"))
259 0 'font-lock-variable-name-face
))
260 "Expressions to font-lock for nslookup.")
262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
266 ;; Simplified versions of some at-point functions from ffap.el.
267 ;; It's not worth loading all of ffap just for these.
268 (defun net-utils-machine-at-point ()
270 (buffer-substring-no-properties
272 (skip-chars-backward "-a-zA-Z0-9.")
275 (skip-chars-forward "-a-zA-Z0-9.")
276 (skip-chars-backward "." pt
)
279 (defun net-utils-url-at-point ()
281 (buffer-substring-no-properties
283 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
284 (skip-chars-forward "^A-Za-z0-9" pt
)
287 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
288 (skip-chars-backward ":;.,!?" pt
)
292 (defun net-utils-remove-ctrl-m-filter (process output-string
)
293 "Remove trailing control Ms."
294 (let ((old-buffer (current-buffer))
295 (filtered-string output-string
))
298 (set-buffer (process-buffer process
))
299 (setq moving
(= (point) (process-mark process
)))
301 (while (string-match "\r" filtered-string
)
302 (setq filtered-string
303 (replace-match "" nil nil filtered-string
)))
306 ;; Insert the text, moving the process-marker.
307 (goto-char (process-mark process
))
308 (insert filtered-string
)
309 (set-marker (process-mark process
) (point)))
310 (if moving
(goto-char (process-mark process
))))
311 (set-buffer old-buffer
))))
313 (defun net-utils-run-program (name header program args
)
314 "Run a network information program."
315 (let ((buf (get-buffer-create (concat "*" name
"*"))))
320 (apply 'start-process name buf program args
)
321 'net-utils-remove-ctrl-m-filter
)
325 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
326 ;; Wrappers for external network programs
327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
330 (defun traceroute (target)
331 "Run traceroute program for TARGET."
332 (interactive "sTarget: ")
334 (if traceroute-program-options
335 (append traceroute-program-options
(list target
))
337 (net-utils-run-program
338 (concat "Traceroute" " " target
)
339 (concat "** Traceroute ** " traceroute-program
" ** " target
)
346 If your system's ping continues until interrupted, you can try setting
347 `ping-program-options'."
349 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
351 (if ping-program-options
352 (append ping-program-options
(list host
))
354 (net-utils-run-program
355 (concat "Ping" " " host
)
356 (concat "** Ping ** " ping-program
" ** " host
)
362 "Run ifconfig program."
364 (net-utils-run-program
366 (concat "** Ifconfig ** " ifconfig-program
" ** ")
368 ifconfig-program-options
))
370 ;; Windows uses this name.
372 (defalias 'ipconfig
'ifconfig
)
376 "Run iwconfig program."
378 (net-utils-run-program
380 (concat "** Iwconfig ** " iwconfig-program
" ** ")
382 iwconfig-program-options
))
386 "Run netstat program."
388 (net-utils-run-program
390 (concat "** Netstat ** " netstat-program
" ** ")
392 netstat-program-options
))
398 (net-utils-run-program
400 (concat "** Arp ** " arp-program
" ** ")
402 arp-program-options
))
408 (net-utils-run-program
410 (concat "** Route ** " route-program
" ** ")
412 route-program-options
))
414 ;; FIXME -- Needs to be a process filter
415 ;; (defun netstat-with-filter (filter)
416 ;; "Run netstat program."
417 ;; (interactive "sFilter: ")
419 ;; (set-buffer (get-buffer "*Netstat*"))
420 ;; (goto-char (point-min))
421 ;; (delete-matching-lines filter))
424 (defun nslookup-host (host)
425 "Lookup the DNS information for HOST."
427 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
429 (if nslookup-program-options
430 (append nslookup-program-options
(list host
))
432 (net-utils-run-program
436 (list "Nslookup" host nslookup-program
)
443 "Run nslookup program."
445 (comint-run nslookup-program
)
448 (defvar comint-prompt-regexp
)
449 (defvar comint-input-autoexpand
)
451 (autoload 'comint-mode
"comint" nil t
)
453 ;; Using a derived mode gives us keymaps, hooks, etc.
454 (define-derived-mode nslookup-mode comint-mode
"Nslookup"
455 "Major mode for interacting with the nslookup program."
457 (make-local-variable 'font-lock-defaults
)
458 '((nslookup-font-lock-keywords)))
459 (setq comint-prompt-regexp nslookup-prompt-regexp
)
460 (setq comint-input-autoexpand t
))
462 (define-key nslookup-mode-map
"\t" 'comint-dynamic-complete
)
465 (defun dns-lookup-host (host)
466 "Lookup the DNS information for HOST (name or IP address)."
468 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
470 (if dns-lookup-program-options
471 (append dns-lookup-program-options
(list host
))
473 (net-utils-run-program
474 (concat "DNS Lookup [" host
"]")
477 (list "DNS Lookup" host dns-lookup-program
)
482 (autoload 'ffap-string-at-point
"ffap")
485 (defun run-dig (host)
489 (read-from-minibuffer "Lookup host: "
490 (or (ffap-string-at-point 'machine
) ""))))
491 (net-utils-run-program
495 (list "Dig" host dig-program
)
500 (autoload 'comint-exec
"comint")
502 ;; This is a lot less than ange-ftp, but much simpler.
508 (read-from-minibuffer
509 "Ftp to Host: " (net-utils-machine-at-point))))
510 (let ((buf (get-buffer-create (concat "*ftp [" host
"]*"))))
513 (comint-exec buf
(concat "ftp-" host
) ftp-program nil
514 (if ftp-program-options
515 (append (list host
) ftp-program-options
)
517 (pop-to-buffer buf
)))
519 (define-derived-mode ftp-mode comint-mode
"FTP"
520 "Major mode for interacting with the ftp program."
521 (setq comint-prompt-regexp ftp-prompt-regexp
)
522 (setq comint-input-autoexpand t
)
523 ;; Only add the password-prompting hook if it's not already in the
524 ;; global hook list. This stands a small chance of losing, if it's
525 ;; later removed from the global list (very small, since any
526 ;; password prompts will probably immediately follow the initial
527 ;; connection), but it's better than getting prompted twice for the
529 (unless (memq 'comint-watch-for-password-prompt
530 (default-value 'comint-output-filter-functions
))
531 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
534 ;; Occasionally useful
535 (define-key ftp-mode-map
"\t" 'comint-dynamic-complete
)
537 (defun smbclient (host service
)
538 "Connect to SERVICE on HOST via SMB."
541 (read-from-minibuffer
542 "Connect to Host: " (net-utils-machine-at-point))
543 (read-from-minibuffer "SMB Service: ")))
544 (let* ((name (format "smbclient [%s\\%s]" host service
))
545 (buf (get-buffer-create (concat "*" name
"*")))
546 (service-name (concat "\\\\" host
"\\" service
)))
549 (comint-exec buf name smbclient-program nil
550 (if smbclient-program-options
551 (append (list service-name
) smbclient-program-options
)
552 (list service-name
)))
553 (pop-to-buffer buf
)))
555 (defun smbclient-list-shares (host)
556 "List services on HOST."
559 (read-from-minibuffer
560 "Connect to Host: " (net-utils-machine-at-point))))
561 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host
))))
564 (comint-exec buf
"smbclient-list-shares"
565 smbclient-program nil
(list "-L" host
))
566 (pop-to-buffer buf
)))
568 (define-derived-mode smbclient-mode comint-mode
"smbclient"
569 "Major mode for interacting with the smbclient program."
570 (setq comint-prompt-regexp smbclient-prompt-regexp
)
571 (setq comint-input-autoexpand t
)
572 ;; Only add the password-prompting hook if it's not already in the
573 ;; global hook list. This stands a small chance of losing, if it's
574 ;; later removed from the global list (very small, since any
575 ;; password prompts will probably immediately follow the initial
576 ;; connection), but it's better than getting prompted twice for the
578 (unless (memq 'comint-watch-for-password-prompt
579 (default-value 'comint-output-filter-functions
))
580 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
585 ;; Network Connections
586 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
588 ;; Full list is available at:
589 ;; http://www.iana.org/assignments/port-numbers
590 (defvar network-connection-service-alist
593 (cons 'active-users
11)
609 (cons 'netbios-name
137)
610 (cons 'netbios-data
139)
614 "Alist of services and associated TCP port numbers.
615 This list is not complete.")
618 (defun run-network-program (process-name host port
&optional initial-string
)
619 (let ((tcp-connection)
621 (setq buf
(get-buffer-create (concat "*" process-name
"*")))
625 (open-network-stream process-name buf host port
))
626 (error "Could not open connection to %s" host
))
628 (set-marker (process-mark tcp-connection
) (point-min))
629 (set-process-filter tcp-connection
'net-utils-remove-ctrl-m-filter
)
631 (process-send-string tcp-connection
632 (concat initial-string
"\r\n")))
633 (display-buffer buf
)))
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
639 (defcustom finger-X
.500-host-regexps nil
640 "A list of regular expressions matching host names.
641 If a host name passed to `finger' matches one of these regular
642 expressions, it is assumed to be a host that doesn't accept
643 queries of the form USER@HOST, and wants a query containing USER only."
645 :type
'(repeat regexp
)
650 (defun finger (user host
)
651 "Finger USER on HOST."
652 ;; One of those great interactive statements that's actually
653 ;; longer than the function call! The idea is that if the user
654 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
655 ;; host name. If we don't see an "@", we'll prompt for the host.
657 (let* ((answer (read-from-minibuffer "Finger User: "
658 (net-utils-url-at-point)))
659 (index (string-match (regexp-quote "@") answer
)))
661 (list (substring answer
0 index
)
662 (substring answer
(1+ index
)))
664 (read-from-minibuffer "At Host: "
665 (net-utils-machine-at-point))))))
666 (let* ((user-and-host (concat user
"@" host
))
667 (process-name (concat "Finger [" user-and-host
"]"))
668 (regexps finger-X
.500-host-regexps
)
671 (while (not (string-match (car regexps
) host
))
672 (setq regexps
(cdr regexps
)))
674 (setq user-and-host user
)))
678 (cdr (assoc 'finger network-connection-service-alist
))
681 (defcustom whois-server-name
"rs.internic.net"
682 "Default host name for the whois service."
686 (defcustom whois-server-list
687 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
688 ("rs.internic.net") ; domain related info
689 ("whois.publicinterestregistry.net")
696 "A list of whois servers that can be queried."
698 :type
'(repeat (list string
)))
700 ;; FIXME: modern whois clients include a much better tld <-> whois server
701 ;; list, Emacs should probably avoid specifying the server as the client
702 ;; will DTRT anyway... -rfr
703 (defcustom whois-server-tld
704 '(("rs.internic.net" .
"com")
705 ("whois.publicinterestregistry.net" .
"org")
706 ("whois.ripe.net" .
"be")
707 ("whois.ripe.net" .
"de")
708 ("whois.ripe.net" .
"dk")
709 ("whois.ripe.net" .
"it")
710 ("whois.ripe.net" .
"fi")
711 ("whois.ripe.net" .
"fr")
712 ("whois.ripe.net" .
"uk")
713 ("whois.apnic.net" .
"au")
714 ("whois.apnic.net" .
"ch")
715 ("whois.apnic.net" .
"hk")
716 ("whois.apnic.net" .
"jp")
717 ("whois.nic.gov" .
"gov")
718 ("whois.nic.mil" .
"mil"))
719 "Alist to map top level domains to whois servers."
721 :type
'(repeat (cons string string
)))
723 (defcustom whois-guess-server t
724 "If non-nil then whois will try to deduce the appropriate whois
725 server from the query. If the query doesn't look like a domain or hostname
726 then the server named by `whois-server-name' is used."
730 (defun whois-get-tld (host)
731 "Return the top level domain of `host', or nil if it isn't a domain name."
732 (let ((i (1- (length host
)))
733 (max-len (- (length host
) 5)))
734 (while (not (or (= i max-len
) (char-equal (aref host i
) ?.
)))
738 (substring host
(1+ i
)))))
742 (defun whois (arg search-string
)
743 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
744 If `whois-guess-server' is non-nil, then try to deduce the correct server
745 from SEARCH-STRING. With argument, prompt for whois server."
746 (interactive "P\nsWhois: ")
747 (let* ((whois-apropos-host (if whois-guess-server
748 (rassoc (whois-get-tld search-string
)
751 (server-name (if whois-apropos-host
752 (car whois-apropos-host
)
756 (completing-read "Whois server name: "
757 whois-server-list nil nil
"whois.")
762 (cdr (assoc 'whois network-connection-service-alist
))
765 (defcustom whois-reverse-lookup-server
"whois.arin.net"
766 "Server which provides inverse DNS mapping."
771 (defun whois-reverse-lookup ()
773 (let ((whois-server-name whois-reverse-lookup-server
))
774 (call-interactively 'whois
)))
776 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
777 ;;; General Network connection
778 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
780 ;; Using a derived mode gives us keymaps, hooks, etc.
782 network-connection-mode comint-mode
"Network-Connection"
783 "Major mode for interacting with the network-connection program.")
785 (defun network-connection-mode-setup (host service
)
786 (make-local-variable 'network-connection-host
)
787 (setq network-connection-host host
)
788 (make-local-variable 'network-connection-service
)
789 (setq network-connection-service service
))
792 (defun network-connection-to-service (host service
)
793 "Open a network connection to SERVICE on HOST."
796 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
797 (completing-read "Service: "
801 (list (symbol-name (car elt
)))))
802 network-connection-service-alist
))))
805 (cdr (assoc (intern service
) network-connection-service-alist
))))
808 (defun network-connection (host port
)
809 "Open a network connection to HOST on PORT."
810 (interactive "sHost: \nnPort: ")
811 (network-service-connection host
(number-to-string port
)))
813 (defun network-service-connection (host service
)
814 "Open a network connection to SERVICE on HOST."
815 (let* ((process-name (concat "Network Connection [" host
" " service
"]"))
816 (portnum (string-to-number service
))
817 (buf (get-buffer-create (concat "*" process-name
"*"))))
818 (or (zerop portnum
) (setq service portnum
))
823 (network-connection-mode)
824 (network-connection-mode-setup host service
)
825 (pop-to-buffer buf
)))
827 (defvar comint-input-ring
)
829 (defun network-connection-reconnect ()
830 "Reconnect a network connection, preserving the old input ring."
832 (let ((proc (get-buffer-process (current-buffer)))
833 (old-comint-input-ring comint-input-ring
)
834 (host network-connection-host
)
835 (service network-connection-service
))
836 (if (not (or (not proc
)
837 (eq (process-status proc
) 'closed
)))
838 (message "Still connected")
839 (goto-char (point-max))
840 (insert (format "Reopening connection to %s\n" host
))
841 (network-connection host
842 (if (numberp service
)
844 (cdr (assoc service network-connection-service-alist
))))
845 (and old-comint-input-ring
846 (setq comint-input-ring old-comint-input-ring
)))))
850 ;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
851 ;;; net-utils.el ends here