1 ;;; net-utils.el --- network functions
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2005 Free Software Foundation, Inc.
5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
6 ;; Created: Sun Mar 16 1997
7 ;; Keywords: network comm
9 ;; This file is part of GNU Emacs.
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 2, or (at your option)
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
29 ;; There are three main areas of functionality:
31 ;; * Wrap common network utility programs (ping, traceroute, netstat,
32 ;; nslookup, arp, route). Note that these wrappers are of the diagnostic
33 ;; functions of these programs only.
35 ;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
37 ;; * Support connections to HOST/PORT, generally for debugging and the like.
38 ;; In other words, for doing much the same thing as "telnet HOST PORT", and
39 ;; then typing commands.
43 ;; On some systems, some of these programs are not in normal user path,
44 ;; but rather in /sbin, /usr/sbin, and so on.
51 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 ;; Customization Variables
53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55 (defgroup net-utils nil
56 "Network utility functions."
61 (defcustom net-utils-remove-ctl-m
62 (member system-type
(list 'windows-nt
'msdos
))
63 "If non-nil, remove control-Ms from output."
67 (defcustom traceroute-program
68 (if (eq system-type
'windows-nt
)
71 "Program to trace network hops to a destination."
75 (defcustom traceroute-program-options nil
76 "Options for the traceroute program."
78 :type
'(repeat string
))
80 (defcustom ping-program
"ping"
81 "Program to send network test packets to a host."
85 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
86 ;; indefinitely unless told otherwise
87 (defcustom ping-program-options
88 (and (memq system-type
(list 'linux
'gnu
/linux
'irix
))
90 "Options for the ping program.
91 These options can be used to limit how many ICMP packets are emitted."
93 :type
'(repeat string
))
95 (defcustom ipconfig-program
96 (if (eq system-type
'windows-nt
)
99 "Program to print network configuration information."
103 (defcustom ipconfig-program-options
105 (if (eq system-type
'windows-nt
)
107 "Options for ipconfig-program."
109 :type
'(repeat string
))
111 (defcustom netstat-program
"netstat"
112 "Program to print network statistics."
116 (defcustom netstat-program-options
118 "Options for netstat-program."
120 :type
'(repeat string
))
122 (defcustom arp-program
"arp"
123 "Program to print IP to address translation tables."
127 (defcustom arp-program-options
129 "Options for arp-program."
131 :type
'(repeat string
))
133 (defcustom route-program
134 (if (eq system-type
'windows-nt
)
137 "Program to print routing tables."
141 (defcustom route-program-options
142 (if (eq system-type
'windows-nt
)
145 "Options for route-program."
147 :type
'(repeat string
))
149 (defcustom nslookup-program
"nslookup"
150 "Program to interactively query DNS information."
154 (defcustom nslookup-program-options nil
155 "List of options to pass to the nslookup program."
157 :type
'(repeat string
))
159 (defcustom nslookup-prompt-regexp
"^> "
160 "Regexp to match the nslookup prompt.
162 This variable is only used if the variable
163 `comint-use-prompt-regexp' is non-nil."
167 (defcustom dig-program
"dig"
168 "Program to query DNS information."
172 (defcustom ftp-program
"ftp"
173 "Progam to run to do FTP transfers."
177 (defcustom ftp-program-options nil
178 "List of options to pass to the FTP program."
180 :type
'(repeat string
))
182 (defcustom ftp-prompt-regexp
"^ftp>"
183 "Regexp which matches the FTP program's prompt.
185 This variable is only used if the variable
186 `comint-use-prompt-regexp' is non-nil."
190 (defcustom smbclient-program
"smbclient"
195 (defcustom smbclient-program-options nil
196 "List of options to pass to the smbclient program."
198 :type
'(repeat string
))
200 (defcustom smbclient-prompt-regexp
"^smb: \>"
201 "Regexp which matches the smbclient program's prompt.
203 This variable is only used if the variable
204 `comint-use-prompt-regexp' is non-nil."
208 (defcustom dns-lookup-program
"host"
209 "Program to interactively query DNS information."
214 (defcustom dns-lookup-program-options nil
215 "List of options to pass to the dns-lookup program."
217 :type
'(repeat string
)
220 ;; Internal variables
221 (defvar network-connection-service nil
)
222 (defvar network-connection-host nil
)
224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
228 (defconst nslookup-font-lock-keywords
230 (defvar font-lock-type-face
)
231 (defvar font-lock-keyword-face
)
232 (defvar font-lock-variable-name-face
)
235 (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face
)
236 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
237 1 font-lock-keyword-face
)
241 (make-list 4 "[0-9]+")
243 0 font-lock-variable-name-face
)
246 (let ((host-expression "[-A-Za-z0-9]+"))
249 (make-list 2 host-expression
)
251 "\\(\\." host-expression
"\\)*"))
252 0 font-lock-variable-name-face
)))
253 "Expressions to font-lock for nslookup.")
255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259 ;; Simplified versions of some at-point functions from ffap.el.
260 ;; It's not worth loading all of ffap just for these.
261 (defun net-utils-machine-at-point ()
263 (buffer-substring-no-properties
265 (skip-chars-backward "-a-zA-Z0-9.")
268 (skip-chars-forward "-a-zA-Z0-9.")
269 (skip-chars-backward "." pt
)
272 (defun net-utils-url-at-point ()
274 (buffer-substring-no-properties
276 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
277 (skip-chars-forward "^A-Za-z0-9" pt
)
280 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
281 (skip-chars-backward ":;.,!?" pt
)
285 (defun net-utils-remove-ctrl-m-filter (process output-string
)
286 "Remove trailing control Ms."
287 (let ((old-buffer (current-buffer))
288 (filtered-string output-string
))
291 (set-buffer (process-buffer process
))
292 (setq moving
(= (point) (process-mark process
)))
294 (while (string-match "\r" filtered-string
)
295 (setq filtered-string
296 (replace-match "" nil nil filtered-string
)))
299 ;; Insert the text, moving the process-marker.
300 (goto-char (process-mark process
))
301 (insert filtered-string
)
302 (set-marker (process-mark process
) (point)))
303 (if moving
(goto-char (process-mark process
))))
304 (set-buffer old-buffer
))))
306 (defmacro net-utils-run-program
(name header program
&rest args
)
307 "Run a network information program."
308 ` (let ((buf (get-buffer-create (concat "*" ,name
"*"))))
311 (insert ,header
"\n")
313 (apply 'start-process
,name buf
,program
,@args
)
314 'net-utils-remove-ctrl-m-filter
)
318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
319 ;; Wrappers for external network programs
320 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
323 (defun traceroute (target)
324 "Run traceroute program for TARGET."
325 (interactive "sTarget: ")
327 (if traceroute-program-options
328 (append traceroute-program-options
(list target
))
330 (net-utils-run-program
331 (concat "Traceroute" " " target
)
332 (concat "** Traceroute ** " traceroute-program
" ** " target
)
339 If your system's ping continues until interrupted, you can try setting
340 `ping-program-options'."
342 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
344 (if ping-program-options
345 (append ping-program-options
(list host
))
347 (net-utils-run-program
348 (concat "Ping" " " host
)
349 (concat "** Ping ** " ping-program
" ** " host
)
355 "Run ipconfig program."
357 (net-utils-run-program
359 (concat "** Ipconfig ** " ipconfig-program
" ** ")
361 ipconfig-program-options
))
363 ;; This is the normal name on most Unixes.
365 (defalias 'ifconfig
'ipconfig
)
369 "Run netstat program."
371 (net-utils-run-program
373 (concat "** Netstat ** " netstat-program
" ** ")
375 netstat-program-options
))
379 "Run the arp program."
381 (net-utils-run-program
383 (concat "** Arp ** " arp-program
" ** ")
385 arp-program-options
))
389 "Run the route program."
391 (net-utils-run-program
393 (concat "** Route ** " route-program
" ** ")
395 route-program-options
))
397 ;; FIXME -- Needs to be a process filter
398 ;; (defun netstat-with-filter (filter)
399 ;; "Run netstat program."
400 ;; (interactive "sFilter: ")
402 ;; (set-buffer (get-buffer "*Netstat*"))
403 ;; (goto-char (point-min))
404 ;; (delete-matching-lines filter))
407 (defun nslookup-host (host)
408 "Lookup the DNS information for HOST."
410 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
412 (if nslookup-program-options
413 (append nslookup-program-options
(list host
))
415 (net-utils-run-program
419 (list "Nslookup" host nslookup-program
)
426 "Run nslookup program."
429 (comint-run nslookup-program
)
432 ;; Using a derived mode gives us keymaps, hooks, etc.
433 (define-derived-mode nslookup-mode comint-mode
"Nslookup"
434 "Major mode for interacting with the nslookup program."
436 (make-local-variable 'font-lock-defaults
)
437 '((nslookup-font-lock-keywords)))
438 (setq comint-prompt-regexp nslookup-prompt-regexp
)
439 (setq comint-input-autoexpand t
))
441 (define-key nslookup-mode-map
"\t" 'comint-dynamic-complete
)
444 (defun dns-lookup-host (host)
445 "Lookup the DNS information for HOST (name or IP address)."
447 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
449 (if dns-lookup-program-options
450 (append dns-lookup-program-options
(list host
))
452 (net-utils-run-program
453 (concat "DNS Lookup [" host
"]")
456 (list "DNS Lookup" host dns-lookup-program
)
469 (read-from-minibuffer
472 (or (ffap-string-at-point 'machine
) ""))))))
473 (net-utils-run-program
477 (list "Dig" host dig-program
)
482 ;; This is a lot less than ange-ftp, but much simpler.
488 (read-from-minibuffer
489 "Ftp to Host: " (net-utils-machine-at-point))))
491 (let ((buf (get-buffer-create (concat "*ftp [" host
"]*"))))
494 (comint-exec buf
(concat "ftp-" host
) ftp-program nil
495 (if ftp-program-options
496 (append (list host
) ftp-program-options
)
498 (pop-to-buffer buf
)))
500 (define-derived-mode ftp-mode comint-mode
"FTP"
501 "Major mode for interacting with the ftp program."
502 (setq comint-prompt-regexp ftp-prompt-regexp
)
503 (setq comint-input-autoexpand t
)
504 ;; Only add the password-prompting hook if it's not already in the
505 ;; global hook list. This stands a small chance of losing, if it's
506 ;; later removed from the global list (very small, since any
507 ;; password prompts will probably immediately follow the initial
508 ;; connection), but it's better than getting prompted twice for the
510 (unless (memq 'comint-watch-for-password-prompt
511 (default-value 'comint-output-filter-functions
))
512 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
515 ;; Occasionally useful
516 (define-key ftp-mode-map
"\t" 'comint-dynamic-complete
)
518 (defun smbclient (host service
)
519 "Connect to SERVICE on HOST via SMB."
522 (read-from-minibuffer
523 "Connect to Host: " (net-utils-machine-at-point))
524 (read-from-minibuffer "SMB Service: ")))
526 (let* ((name (format "smbclient [%s\\%s]" host service
))
527 (buf (get-buffer-create (concat "*" name
"*")))
528 (service-name (concat "\\\\" host
"\\" service
)))
531 (comint-exec buf name smbclient-program nil
532 (if smbclient-program-options
533 (append (list service-name
) smbclient-program-options
)
534 (list service-name
)))
535 (pop-to-buffer buf
)))
537 (defun smbclient-list-shares (host)
538 "List services on HOST."
541 (read-from-minibuffer
542 "Connect to Host: " (net-utils-machine-at-point))))
543 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host
))))
546 (comint-exec buf
"smbclient-list-shares"
547 smbclient-program nil
(list "-L" host
))
548 (pop-to-buffer buf
)))
550 (define-derived-mode smbclient-mode comint-mode
"smbclient"
551 "Major mode for interacting with the smbclient program."
552 (setq comint-prompt-regexp smbclient-prompt-regexp
)
553 (setq comint-input-autoexpand t
)
554 ;; Only add the password-prompting hook if it's not already in the
555 ;; global hook list. This stands a small chance of losing, if it's
556 ;; later removed from the global list (very small, since any
557 ;; password prompts will probably immediately follow the initial
558 ;; connection), but it's better than getting prompted twice for the
560 (unless (memq 'comint-watch-for-password-prompt
561 (default-value 'comint-output-filter-functions
))
562 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
566 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
567 ;; Network Connections
568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
570 ;; Full list is available at:
571 ;; http://www.iana.org/assignments/port-numbers
572 (defvar network-connection-service-alist
575 (cons 'active-users
11)
591 (cons 'netbios-name
137)
592 (cons 'netbios-data
139)
596 "Alist of services and associated TCP port numbers.
597 This list is not complete.")
600 (defmacro run-network-program
(process-name host port
601 &optional initial-string
)
602 `(let ((tcp-connection)
604 (setq buf
(get-buffer-create (concat "*" ,process-name
"*")))
613 (error "Could not open connection to %s" ,host
))
615 (set-marker (process-mark tcp-connection
) (point-min))
616 (set-process-filter tcp-connection
'net-utils-remove-ctrl-m-filter
)
618 (process-send-string tcp-connection
619 (concat ,initial-string
"\r\n")))
620 (display-buffer buf
)))
622 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
624 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
626 (defcustom finger-X
.500-host-regexps nil
627 "A list of regular expressions matching host names.
628 If a host name passed to `finger' matches one of these regular
629 expressions, it is assumed to be a host that doesn't accept
630 queries of the form USER@HOST, and wants a query containing USER only."
632 :type
'(repeat regexp
)
637 (defun finger (user host
)
638 "Finger USER on HOST."
639 ;; One of those great interactive statements that's actually
640 ;; longer than the function call! The idea is that if the user
641 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
642 ;; host name. If we don't see an "@", we'll prompt for the host.
644 (let* ((answer (read-from-minibuffer "Finger User: "
645 (net-utils-url-at-point)))
646 (index (string-match (regexp-quote "@") answer
)))
648 (list (substring answer
0 index
)
649 (substring answer
(1+ index
)))
651 (read-from-minibuffer "At Host: "
652 (net-utils-machine-at-point))))))
653 (let* ((user-and-host (concat user
"@" host
))
654 (process-name (concat "Finger [" user-and-host
"]"))
655 (regexps finger-X
.500-host-regexps
)
658 (while (not (string-match (car regexps
) host
))
659 (setq regexps
(cdr regexps
)))
661 (setq user-and-host user
)))
665 (cdr (assoc 'finger network-connection-service-alist
))
668 (defcustom whois-server-name
"rs.internic.net"
669 "Default host name for the whois service."
673 (defcustom whois-server-list
674 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
675 ("rs.internic.net") ; domain related info
682 "A list of whois servers that can be queried."
684 :type
'(repeat (list string
)))
686 (defcustom whois-server-tld
687 '(("rs.internic.net" .
"com")
688 ("rs.internic.net" .
"org")
689 ("whois.ripe.net" .
"be")
690 ("whois.ripe.net" .
"de")
691 ("whois.ripe.net" .
"dk")
692 ("whois.ripe.net" .
"it")
693 ("whois.ripe.net" .
"fi")
694 ("whois.ripe.net" .
"fr")
695 ("whois.ripe.net" .
"uk")
696 ("whois.apnic.net" .
"au")
697 ("whois.apnic.net" .
"ch")
698 ("whois.apnic.net" .
"hk")
699 ("whois.apnic.net" .
"jp")
700 ("whois.nic.gov" .
"gov")
701 ("whois.nic.mil" .
"mil"))
702 "Alist to map top level domains to whois servers."
704 :type
'(repeat (cons string string
)))
706 (defcustom whois-guess-server t
707 "If non-nil then whois will try to deduce the appropriate whois
708 server from the query. If the query doesn't look like a domain or hostname
709 then the server named by whois-server-name is used."
713 (defun whois-get-tld (host)
714 "Return the top level domain of `host', or nil if it isn't a domain name."
715 (let ((i (1- (length host
)))
716 (max-len (- (length host
) 5)))
717 (while (not (or (= i max-len
) (char-equal (aref host i
) ?.
)))
721 (substring host
(1+ i
)))))
725 (defun whois (arg search-string
)
726 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
727 If `whois-guess-server' is non-nil, then try to deduce the correct server
728 from SEARCH-STRING. With argument, prompt for whois server."
729 (interactive "P\nsWhois: ")
730 (let* ((whois-apropos-host (if whois-guess-server
731 (rassoc (whois-get-tld search-string
)
734 (server-name (if whois-apropos-host
735 (car whois-apropos-host
)
739 (completing-read "Whois server name: "
740 whois-server-list nil nil
"whois.")
745 (cdr (assoc 'whois network-connection-service-alist
))
748 (defcustom whois-reverse-lookup-server
"whois.arin.net"
749 "Server which provides inverse DNS mapping."
754 (defun whois-reverse-lookup ()
756 (let ((whois-server-name whois-reverse-lookup-server
))
757 (call-interactively 'whois
)))
759 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
760 ;;; General Network connection
761 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
763 ;; Using a derived mode gives us keymaps, hooks, etc.
765 network-connection-mode comint-mode
"Network-Connection"
766 "Major mode for interacting with the network-connection program.")
768 (defun network-connection-mode-setup (host service
)
769 (make-local-variable 'network-connection-host
)
770 (setq network-connection-host host
)
771 (make-local-variable 'network-connection-service
)
772 (setq network-connection-service service
))
775 (defun network-connection-to-service (host service
)
776 "Open a network connection to SERVICE on HOST."
779 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
780 (completing-read "Service: "
784 (list (symbol-name (car elt
)))))
785 network-connection-service-alist
))))
788 (cdr (assoc (intern service
) network-connection-service-alist
))))
791 (defun network-connection (host port
)
792 "Open a network connection to HOST on PORT."
793 (interactive "sHost: \nnPort: ")
794 (network-service-connection host
(number-to-string port
)))
796 (defun network-service-connection (host service
)
797 "Open a network connection to SERVICE on HOST."
799 (let* ((process-name (concat "Network Connection [" host
" " service
"]"))
800 (portnum (string-to-number service
))
801 (buf (get-buffer-create (concat "*" process-name
"*"))))
802 (or (zerop portnum
) (setq service portnum
))
807 (network-connection-mode)
808 (network-connection-mode-setup host service
)
809 (pop-to-buffer buf
)))
811 (defun network-connection-reconnect ()
812 "Reconnect a network connection, preserving the old input ring."
814 (let ((proc (get-buffer-process (current-buffer)))
815 (old-comint-input-ring comint-input-ring
)
816 (host network-connection-host
)
817 (service network-connection-service
))
818 (if (not (or (not proc
)
819 (eq (process-status proc
) 'closed
)))
820 (message "Still connected")
821 (goto-char (point-max))
822 (insert (format "Reopening connection to %s\n" host
))
823 (network-connection host
824 (if (numberp service
)
826 (cdr (assoc service network-connection-service-alist
))))
827 (and old-comint-input-ring
828 (setq comint-input-ring old-comint-input-ring
)))))
832 ;;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
833 ;;; net-utils.el ends here