1 ;;; net-utils.el --- network functions
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 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, or (at your option)
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; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
30 ;; There are three main areas of functionality:
32 ;; * Wrap common network utility programs (ping, traceroute, netstat,
33 ;; nslookup, arp, route). Note that these wrappers are of the diagnostic
34 ;; functions of these programs only.
36 ;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
38 ;; * Support connections to HOST/PORT, generally for debugging and the like.
39 ;; In other words, for doing much the same thing as "telnet HOST PORT", and
40 ;; then typing commands.
44 ;; On some systems, some of these programs are not in normal user path,
45 ;; but rather in /sbin, /usr/sbin, and so on.
52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 ;; Customization Variables
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 (defgroup net-utils nil
57 "Network utility functions."
62 (defcustom net-utils-remove-ctl-m
63 (member system-type
(list 'windows-nt
'msdos
))
64 "If non-nil, remove control-Ms from output."
68 (defcustom traceroute-program
69 (if (eq system-type
'windows-nt
)
72 "Program to trace network hops to a destination."
76 (defcustom traceroute-program-options nil
77 "Options for the traceroute program."
79 :type
'(repeat string
))
81 (defcustom ping-program
"ping"
82 "Program to send network test packets to a host."
86 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
87 ;; indefinitely unless told otherwise
88 (defcustom ping-program-options
89 (and (memq system-type
(list 'linux
'gnu
/linux
'irix
))
91 "Options for the ping program.
92 These options can be used to limit how many ICMP packets are emitted."
94 :type
'(repeat string
))
96 (defcustom ifconfig-program
97 (if (eq system-type
'windows-nt
)
100 "Program to print network configuration information."
104 (define-obsolete-variable-alias 'ipconfig-program
'ifconfig-program
"22.2")
106 (defcustom ifconfig-program-options
108 (if (eq system-type
'windows-nt
)
110 "Options for the ifconfig program."
112 :type
'(repeat string
))
114 (define-obsolete-variable-alias 'ipconfig-program-options
115 'ifconfig-program-options
"22.2")
117 (defcustom netstat-program
"netstat"
118 "Program to print network statistics."
122 (defcustom netstat-program-options
124 "Options for the netstat program."
126 :type
'(repeat string
))
128 (defcustom arp-program
"arp"
129 "Program to print IP to address translation tables."
133 (defcustom arp-program-options
135 "Options for the arp program."
137 :type
'(repeat string
))
139 (defcustom route-program
140 (if (eq system-type
'windows-nt
)
143 "Program to print routing tables."
147 (defcustom route-program-options
148 (if (eq system-type
'windows-nt
)
151 "Options for the route program."
153 :type
'(repeat string
))
155 (defcustom nslookup-program
"nslookup"
156 "Program to interactively query DNS information."
160 (defcustom nslookup-program-options nil
161 "Options for the nslookup program."
163 :type
'(repeat string
))
165 (defcustom nslookup-prompt-regexp
"^> "
166 "Regexp to match the nslookup prompt.
168 This variable is only used if the variable
169 `comint-use-prompt-regexp' is non-nil."
173 (defcustom dig-program
"dig"
174 "Program to query DNS information."
178 (defcustom ftp-program
"ftp"
179 "Program to run to do FTP transfers."
183 (defcustom ftp-program-options nil
184 "Options for the ftp program."
186 :type
'(repeat string
))
188 (defcustom ftp-prompt-regexp
"^ftp>"
189 "Regexp which matches the FTP program's prompt.
191 This variable is only used if the variable
192 `comint-use-prompt-regexp' is non-nil."
196 (defcustom smbclient-program
"smbclient"
201 (defcustom smbclient-program-options nil
202 "Options for the smbclient program."
204 :type
'(repeat string
))
206 (defcustom smbclient-prompt-regexp
"^smb: \>"
207 "Regexp which matches the smbclient program's prompt.
209 This variable is only used if the variable
210 `comint-use-prompt-regexp' is non-nil."
214 (defcustom dns-lookup-program
"host"
215 "Program to interactively query DNS information."
219 (defcustom dns-lookup-program-options nil
220 "Options for the dns-lookup program."
222 :type
'(repeat string
))
224 ;; Internal variables
225 (defvar network-connection-service nil
)
226 (defvar network-connection-host nil
)
228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
232 (defconst nslookup-font-lock-keywords
234 (defvar font-lock-type-face
)
235 (defvar font-lock-keyword-face
)
236 (defvar font-lock-variable-name-face
)
239 (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face
)
240 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
241 1 font-lock-keyword-face
)
245 (make-list 4 "[0-9]+")
247 0 font-lock-variable-name-face
)
250 (let ((host-expression "[-A-Za-z0-9]+"))
253 (make-list 2 host-expression
)
255 "\\(\\." host-expression
"\\)*"))
256 0 font-lock-variable-name-face
)))
257 "Expressions to font-lock for nslookup.")
259 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
263 ;; Simplified versions of some at-point functions from ffap.el.
264 ;; It's not worth loading all of ffap just for these.
265 (defun net-utils-machine-at-point ()
267 (buffer-substring-no-properties
269 (skip-chars-backward "-a-zA-Z0-9.")
272 (skip-chars-forward "-a-zA-Z0-9.")
273 (skip-chars-backward "." pt
)
276 (defun net-utils-url-at-point ()
278 (buffer-substring-no-properties
280 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
281 (skip-chars-forward "^A-Za-z0-9" pt
)
284 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
285 (skip-chars-backward ":;.,!?" pt
)
289 (defun net-utils-remove-ctrl-m-filter (process output-string
)
290 "Remove trailing control Ms."
291 (let ((old-buffer (current-buffer))
292 (filtered-string output-string
))
295 (set-buffer (process-buffer process
))
296 (setq moving
(= (point) (process-mark process
)))
298 (while (string-match "\r" filtered-string
)
299 (setq filtered-string
300 (replace-match "" nil nil filtered-string
)))
303 ;; Insert the text, moving the process-marker.
304 (goto-char (process-mark process
))
305 (insert filtered-string
)
306 (set-marker (process-mark process
) (point)))
307 (if moving
(goto-char (process-mark process
))))
308 (set-buffer old-buffer
))))
310 (defmacro net-utils-run-program
(name header program
&rest args
)
311 "Run a network information program."
312 ` (let ((buf (get-buffer-create (concat "*" ,name
"*"))))
315 (insert ,header
"\n")
317 (apply 'start-process
,name buf
,program
,@args
)
318 'net-utils-remove-ctrl-m-filter
)
322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
323 ;; Wrappers for external network programs
324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
327 (defun traceroute (target)
328 "Run traceroute program for TARGET."
329 (interactive "sTarget: ")
331 (if traceroute-program-options
332 (append traceroute-program-options
(list target
))
334 (net-utils-run-program
335 (concat "Traceroute" " " target
)
336 (concat "** Traceroute ** " traceroute-program
" ** " target
)
343 If your system's ping continues until interrupted, you can try setting
344 `ping-program-options'."
346 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
348 (if ping-program-options
349 (append ping-program-options
(list host
))
351 (net-utils-run-program
352 (concat "Ping" " " host
)
353 (concat "** Ping ** " ping-program
" ** " host
)
359 "Run ifconfig program."
361 (net-utils-run-program
363 (concat "** Ifconfig ** " ifconfig-program
" ** ")
365 ifconfig-program-options
))
367 ;; Windows uses this name.
369 (defalias 'ipconfig
'ifconfig
)
373 "Run netstat program."
375 (net-utils-run-program
377 (concat "** Netstat ** " netstat-program
" ** ")
379 netstat-program-options
))
385 (net-utils-run-program
387 (concat "** Arp ** " arp-program
" ** ")
389 arp-program-options
))
395 (net-utils-run-program
397 (concat "** Route ** " route-program
" ** ")
399 route-program-options
))
401 ;; FIXME -- Needs to be a process filter
402 ;; (defun netstat-with-filter (filter)
403 ;; "Run netstat program."
404 ;; (interactive "sFilter: ")
406 ;; (set-buffer (get-buffer "*Netstat*"))
407 ;; (goto-char (point-min))
408 ;; (delete-matching-lines filter))
411 (defun nslookup-host (host)
412 "Lookup the DNS information for HOST."
414 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
416 (if nslookup-program-options
417 (append nslookup-program-options
(list host
))
419 (net-utils-run-program
423 (list "Nslookup" host nslookup-program
)
430 "Run nslookup program."
433 (comint-run nslookup-program
)
436 ;; Using a derived mode gives us keymaps, hooks, etc.
437 (define-derived-mode nslookup-mode comint-mode
"Nslookup"
438 "Major mode for interacting with the nslookup program."
440 (make-local-variable 'font-lock-defaults
)
441 '((nslookup-font-lock-keywords)))
442 (setq comint-prompt-regexp nslookup-prompt-regexp
)
443 (setq comint-input-autoexpand t
))
445 (define-key nslookup-mode-map
"\t" 'comint-dynamic-complete
)
448 (defun dns-lookup-host (host)
449 "Lookup the DNS information for HOST (name or IP address)."
451 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
453 (if dns-lookup-program-options
454 (append dns-lookup-program-options
(list host
))
456 (net-utils-run-program
457 (concat "DNS Lookup [" host
"]")
460 (list "DNS Lookup" host dns-lookup-program
)
466 (defun run-dig (host)
472 (read-from-minibuffer
475 (or (ffap-string-at-point 'machine
) ""))))))
476 (net-utils-run-program
480 (list "Dig" host dig-program
)
485 ;; This is a lot less than ange-ftp, but much simpler.
491 (read-from-minibuffer
492 "Ftp to Host: " (net-utils-machine-at-point))))
494 (let ((buf (get-buffer-create (concat "*ftp [" host
"]*"))))
497 (comint-exec buf
(concat "ftp-" host
) ftp-program nil
498 (if ftp-program-options
499 (append (list host
) ftp-program-options
)
501 (pop-to-buffer buf
)))
503 (define-derived-mode ftp-mode comint-mode
"FTP"
504 "Major mode for interacting with the ftp program."
505 (setq comint-prompt-regexp ftp-prompt-regexp
)
506 (setq comint-input-autoexpand t
)
507 ;; Only add the password-prompting hook if it's not already in the
508 ;; global hook list. This stands a small chance of losing, if it's
509 ;; later removed from the global list (very small, since any
510 ;; password prompts will probably immediately follow the initial
511 ;; connection), but it's better than getting prompted twice for the
513 (unless (memq 'comint-watch-for-password-prompt
514 (default-value 'comint-output-filter-functions
))
515 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
518 ;; Occasionally useful
519 (define-key ftp-mode-map
"\t" 'comint-dynamic-complete
)
521 (defun smbclient (host service
)
522 "Connect to SERVICE on HOST via SMB."
525 (read-from-minibuffer
526 "Connect to Host: " (net-utils-machine-at-point))
527 (read-from-minibuffer "SMB Service: ")))
529 (let* ((name (format "smbclient [%s\\%s]" host service
))
530 (buf (get-buffer-create (concat "*" name
"*")))
531 (service-name (concat "\\\\" host
"\\" service
)))
534 (comint-exec buf name smbclient-program nil
535 (if smbclient-program-options
536 (append (list service-name
) smbclient-program-options
)
537 (list service-name
)))
538 (pop-to-buffer buf
)))
540 (defun smbclient-list-shares (host)
541 "List services on HOST."
544 (read-from-minibuffer
545 "Connect to Host: " (net-utils-machine-at-point))))
546 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host
))))
549 (comint-exec buf
"smbclient-list-shares"
550 smbclient-program nil
(list "-L" host
))
551 (pop-to-buffer buf
)))
553 (define-derived-mode smbclient-mode comint-mode
"smbclient"
554 "Major mode for interacting with the smbclient program."
555 (setq comint-prompt-regexp smbclient-prompt-regexp
)
556 (setq comint-input-autoexpand t
)
557 ;; Only add the password-prompting hook if it's not already in the
558 ;; global hook list. This stands a small chance of losing, if it's
559 ;; later removed from the global list (very small, since any
560 ;; password prompts will probably immediately follow the initial
561 ;; connection), but it's better than getting prompted twice for the
563 (unless (memq 'comint-watch-for-password-prompt
564 (default-value 'comint-output-filter-functions
))
565 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
570 ;; Network Connections
571 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
573 ;; Full list is available at:
574 ;; http://www.iana.org/assignments/port-numbers
575 (defvar network-connection-service-alist
578 (cons 'active-users
11)
594 (cons 'netbios-name
137)
595 (cons 'netbios-data
139)
599 "Alist of services and associated TCP port numbers.
600 This list is not complete.")
603 (defmacro run-network-program
(process-name host port
604 &optional initial-string
)
605 `(let ((tcp-connection)
607 (setq buf
(get-buffer-create (concat "*" ,process-name
"*")))
616 (error "Could not open connection to %s" ,host
))
618 (set-marker (process-mark tcp-connection
) (point-min))
619 (set-process-filter tcp-connection
'net-utils-remove-ctrl-m-filter
)
621 (process-send-string tcp-connection
622 (concat ,initial-string
"\r\n")))
623 (display-buffer buf
)))
625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
629 (defcustom finger-X
.500-host-regexps nil
630 "A list of regular expressions matching host names.
631 If a host name passed to `finger' matches one of these regular
632 expressions, it is assumed to be a host that doesn't accept
633 queries of the form USER@HOST, and wants a query containing USER only."
635 :type
'(repeat regexp
)
640 (defun finger (user host
)
641 "Finger USER on HOST."
642 ;; One of those great interactive statements that's actually
643 ;; longer than the function call! The idea is that if the user
644 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
645 ;; host name. If we don't see an "@", we'll prompt for the host.
647 (let* ((answer (read-from-minibuffer "Finger User: "
648 (net-utils-url-at-point)))
649 (index (string-match (regexp-quote "@") answer
)))
651 (list (substring answer
0 index
)
652 (substring answer
(1+ index
)))
654 (read-from-minibuffer "At Host: "
655 (net-utils-machine-at-point))))))
656 (let* ((user-and-host (concat user
"@" host
))
657 (process-name (concat "Finger [" user-and-host
"]"))
658 (regexps finger-X
.500-host-regexps
)
661 (while (not (string-match (car regexps
) host
))
662 (setq regexps
(cdr regexps
)))
664 (setq user-and-host user
)))
668 (cdr (assoc 'finger network-connection-service-alist
))
671 (defcustom whois-server-name
"rs.internic.net"
672 "Default host name for the whois service."
676 (defcustom whois-server-list
677 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
678 ("rs.internic.net") ; domain related info
679 ("whois.publicinterestregistry.net")
686 "A list of whois servers that can be queried."
688 :type
'(repeat (list string
)))
690 ;; FIXME: modern whois clients include a much better tld <-> whois server
691 ;; list, Emacs should probably avoid specifying the server as the client
692 ;; will DTRT anyway... -rfr
693 (defcustom whois-server-tld
694 '(("rs.internic.net" .
"com")
695 ("whois.publicinterestregistry.net" .
"org")
696 ("whois.ripe.net" .
"be")
697 ("whois.ripe.net" .
"de")
698 ("whois.ripe.net" .
"dk")
699 ("whois.ripe.net" .
"it")
700 ("whois.ripe.net" .
"fi")
701 ("whois.ripe.net" .
"fr")
702 ("whois.ripe.net" .
"uk")
703 ("whois.apnic.net" .
"au")
704 ("whois.apnic.net" .
"ch")
705 ("whois.apnic.net" .
"hk")
706 ("whois.apnic.net" .
"jp")
707 ("whois.nic.gov" .
"gov")
708 ("whois.nic.mil" .
"mil"))
709 "Alist to map top level domains to whois servers."
711 :type
'(repeat (cons string string
)))
713 (defcustom whois-guess-server t
714 "If non-nil then whois will try to deduce the appropriate whois
715 server from the query. If the query doesn't look like a domain or hostname
716 then the server named by `whois-server-name' is used."
720 (defun whois-get-tld (host)
721 "Return the top level domain of `host', or nil if it isn't a domain name."
722 (let ((i (1- (length host
)))
723 (max-len (- (length host
) 5)))
724 (while (not (or (= i max-len
) (char-equal (aref host i
) ?.
)))
728 (substring host
(1+ i
)))))
732 (defun whois (arg search-string
)
733 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
734 If `whois-guess-server' is non-nil, then try to deduce the correct server
735 from SEARCH-STRING. With argument, prompt for whois server."
736 (interactive "P\nsWhois: ")
737 (let* ((whois-apropos-host (if whois-guess-server
738 (rassoc (whois-get-tld search-string
)
741 (server-name (if whois-apropos-host
742 (car whois-apropos-host
)
746 (completing-read "Whois server name: "
747 whois-server-list nil nil
"whois.")
752 (cdr (assoc 'whois network-connection-service-alist
))
755 (defcustom whois-reverse-lookup-server
"whois.arin.net"
756 "Server which provides inverse DNS mapping."
761 (defun whois-reverse-lookup ()
763 (let ((whois-server-name whois-reverse-lookup-server
))
764 (call-interactively 'whois
)))
766 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
767 ;;; General Network connection
768 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
770 ;; Using a derived mode gives us keymaps, hooks, etc.
772 network-connection-mode comint-mode
"Network-Connection"
773 "Major mode for interacting with the network-connection program.")
775 (defun network-connection-mode-setup (host service
)
776 (make-local-variable 'network-connection-host
)
777 (setq network-connection-host host
)
778 (make-local-variable 'network-connection-service
)
779 (setq network-connection-service service
))
782 (defun network-connection-to-service (host service
)
783 "Open a network connection to SERVICE on HOST."
786 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
787 (completing-read "Service: "
791 (list (symbol-name (car elt
)))))
792 network-connection-service-alist
))))
795 (cdr (assoc (intern service
) network-connection-service-alist
))))
798 (defun network-connection (host port
)
799 "Open a network connection to HOST on PORT."
800 (interactive "sHost: \nnPort: ")
801 (network-service-connection host
(number-to-string port
)))
803 (defun network-service-connection (host service
)
804 "Open a network connection to SERVICE on HOST."
806 (let* ((process-name (concat "Network Connection [" host
" " service
"]"))
807 (portnum (string-to-number service
))
808 (buf (get-buffer-create (concat "*" process-name
"*"))))
809 (or (zerop portnum
) (setq service portnum
))
814 (network-connection-mode)
815 (network-connection-mode-setup host service
)
816 (pop-to-buffer buf
)))
818 (defun network-connection-reconnect ()
819 "Reconnect a network connection, preserving the old input ring."
821 (let ((proc (get-buffer-process (current-buffer)))
822 (old-comint-input-ring comint-input-ring
)
823 (host network-connection-host
)
824 (service network-connection-service
))
825 (if (not (or (not proc
)
826 (eq (process-status proc
) 'closed
)))
827 (message "Still connected")
828 (goto-char (point-max))
829 (insert (format "Reopening connection to %s\n" host
))
830 (network-connection host
831 (if (numberp service
)
833 (cdr (assoc service network-connection-service-alist
))))
834 (and old-comint-input-ring
835 (setq comint-input-ring old-comint-input-ring
)))))
839 ;;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
840 ;;; net-utils.el ends here