Some copyright header fixes for grammar files.
[emacs.git] / lisp / net / net-utils.el
blob9e8ba62c56544cfa4528e0e4908fbbc3686e2084
1 ;;; net-utils.el --- network functions
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010, 2011, 2012 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/>.
25 ;;; Commentary:
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.
40 ;; PATHS
42 ;; On some systems, some of these programs are not in normal user path,
43 ;; but rather in /sbin, /usr/sbin, and so on.
46 ;;; Code:
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 ;; Customization Variables
50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 (defgroup net-utils nil
53 "Network utility functions."
54 :prefix "net-utils-"
55 :group 'comm
56 :version "20.3")
58 (defcustom net-utils-remove-ctl-m
59 (member system-type (list 'windows-nt 'msdos))
60 "If non-nil, remove control-Ms from output."
61 :group 'net-utils
62 :type 'boolean)
64 (defcustom traceroute-program
65 (if (eq system-type 'windows-nt)
66 "tracert"
67 "traceroute")
68 "Program to trace network hops to a destination."
69 :group 'net-utils
70 :type 'string)
72 (defcustom traceroute-program-options nil
73 "Options for the traceroute program."
74 :group 'net-utils
75 :type '(repeat string))
77 (defcustom ping-program "ping"
78 "Program to send network test packets to a host."
79 :group 'net-utils
80 :type 'string)
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))
86 (list "-c" "4"))
87 "Options for the ping program.
88 These options can be used to limit how many ICMP packets are emitted."
89 :group 'net-utils
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)
96 "ipconfig"
97 "ifconfig")
98 "Program to print network configuration information."
99 :group 'net-utils
100 :type 'string)
102 (define-obsolete-variable-alias 'ipconfig-program-options
103 'ifconfig-program-options "22.2")
105 (defcustom ifconfig-program-options
106 (list
107 (if (eq system-type 'windows-nt)
108 "/all" "-a"))
109 "Options for the ifconfig program."
110 :group 'net-utils
111 :type '(repeat string))
113 (defcustom iwconfig-program "iwconfig"
114 "Program to print wireless network configuration information."
115 :group 'net-utils
116 :type 'string
117 :version "23.1")
119 (defcustom iwconfig-program-options nil
120 "Options for the iwconfig program."
121 :group 'net-utils
122 :type '(repeat string)
123 :version "23.1")
125 (defcustom netstat-program "netstat"
126 "Program to print network statistics."
127 :group 'net-utils
128 :type 'string)
130 (defcustom netstat-program-options
131 (list "-a")
132 "Options for the netstat program."
133 :group 'net-utils
134 :type '(repeat string))
136 (defcustom arp-program "arp"
137 "Program to print IP to address translation tables."
138 :group 'net-utils
139 :type 'string)
141 (defcustom arp-program-options
142 (list "-a")
143 "Options for the arp program."
144 :group 'net-utils
145 :type '(repeat string))
147 (defcustom route-program
148 (if (eq system-type 'windows-nt)
149 "route"
150 "netstat")
151 "Program to print routing tables."
152 :group 'net-utils
153 :type 'string)
155 (defcustom route-program-options
156 (if (eq system-type 'windows-nt)
157 (list "print")
158 (list "-r"))
159 "Options for the route program."
160 :group 'net-utils
161 :type '(repeat string))
163 (defcustom nslookup-program "nslookup"
164 "Program to interactively query DNS information."
165 :group 'net-utils
166 :type 'string)
168 (defcustom nslookup-program-options nil
169 "Options for the nslookup program."
170 :group 'net-utils
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."
178 :group 'net-utils
179 :type 'regexp)
181 (defcustom dig-program "dig"
182 "Program to query DNS information."
183 :group 'net-utils
184 :type 'string)
186 (defcustom ftp-program "ftp"
187 "Program to run to do FTP transfers."
188 :group 'net-utils
189 :type 'string)
191 (defcustom ftp-program-options nil
192 "Options for the ftp program."
193 :group 'net-utils
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."
201 :group 'net-utils
202 :type 'regexp)
204 (defcustom smbclient-program "smbclient"
205 "Smbclient program."
206 :group 'net-utils
207 :type 'string)
209 (defcustom smbclient-program-options nil
210 "Options for the smbclient program."
211 :group 'net-utils
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."
219 :group 'net-utils
220 :type 'regexp)
222 (defcustom dns-lookup-program "host"
223 "Program to interactively query DNS information."
224 :group 'net-utils
225 :type 'string)
227 (defcustom dns-lookup-program-options nil
228 "Options for the dns-lookup program."
229 :group 'net-utils
230 :type '(repeat string))
232 ;; Internal variables
233 (defvar network-connection-service nil)
234 (defvar network-connection-host nil)
236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
237 ;; Nslookup goodies
238 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
240 (defvar nslookup-font-lock-keywords
241 (list
242 (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face)
243 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
244 1 'font-lock-keyword-face)
245 ;; Dotted quads
246 (list
247 (mapconcat 'identity
248 (make-list 4 "[0-9]+")
249 "\\.")
250 0 'font-lock-variable-name-face)
251 ;; Host names
252 (list
253 (let ((host-expression "[-A-Za-z0-9]+"))
254 (concat
255 (mapconcat 'identity
256 (make-list 2 host-expression)
257 "\\.")
258 "\\(\\." host-expression "\\)*"))
259 0 'font-lock-variable-name-face))
260 "Expressions to font-lock for nslookup.")
262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
263 ;; General network utilities mode
264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
266 (defvar net-utils-font-lock-keywords
267 (list
268 ;; Dotted quads
269 (list
270 (mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
271 0 'font-lock-variable-name-face)
272 ;; Simple rfc4291 addresses
273 (list (concat
274 "\\( \\([[:xdigit:]]+\\(:\\|::\\)\\)+[[:xdigit:]]+\\)"
275 "\\|"
276 "\\(::[[:xdigit:]]+\\)")
277 0 'font-lock-variable-name-face)
278 ;; Host names
279 (list
280 (let ((host-expression "[-A-Za-z0-9]+"))
281 (concat
282 (mapconcat 'identity (make-list 2 host-expression) "\\.")
283 "\\(\\." host-expression "\\)*"))
284 0 'font-lock-variable-name-face))
285 "Expressions to font-lock for general network utilities.")
287 (define-derived-mode net-utils-mode special-mode "NetworkUtil"
288 "Major mode for interacting with an external network utility."
289 (set (make-local-variable 'font-lock-defaults)
290 '((net-utils-font-lock-keywords))))
292 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
293 ;; Utility functions
294 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
296 ;; Simplified versions of some at-point functions from ffap.el.
297 ;; It's not worth loading all of ffap just for these.
298 (defun net-utils-machine-at-point ()
299 (let ((pt (point)))
300 (buffer-substring-no-properties
301 (save-excursion
302 (skip-chars-backward "-a-zA-Z0-9.")
303 (point))
304 (save-excursion
305 (skip-chars-forward "-a-zA-Z0-9.")
306 (skip-chars-backward "." pt)
307 (point)))))
309 (defun net-utils-url-at-point ()
310 (let ((pt (point)))
311 (buffer-substring-no-properties
312 (save-excursion
313 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
314 (skip-chars-forward "^A-Za-z0-9" pt)
315 (point))
316 (save-excursion
317 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
318 (skip-chars-backward ":;.,!?" pt)
319 (point)))))
321 (defun net-utils-remove-ctrl-m-filter (process output-string)
322 "Remove trailing control Ms."
323 (let ((old-buffer (current-buffer))
324 (filtered-string output-string))
325 (unwind-protect
326 (let ((moving))
327 (set-buffer (process-buffer process))
328 (let ((inhibit-read-only t))
329 (setq moving (= (point) (process-mark process)))
331 (while (string-match "\r" filtered-string)
332 (setq filtered-string
333 (replace-match "" nil nil filtered-string)))
335 (save-excursion
336 ;; Insert the text, moving the process-marker.
337 (goto-char (process-mark process))
338 (insert filtered-string)
339 (set-marker (process-mark process) (point))))
340 (if moving (goto-char (process-mark process))))
341 (set-buffer old-buffer))))
343 (defun net-utils-run-program (name header program args)
344 "Run a network information program."
345 (let ((buf (get-buffer-create (concat "*" name "*"))))
346 (set-buffer buf)
347 (erase-buffer)
348 (insert header "\n")
349 (set-process-filter
350 (apply 'start-process name buf program args)
351 'net-utils-remove-ctrl-m-filter)
352 (display-buffer buf)
353 buf))
355 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
356 ;; General network utilities (diagnostic)
357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
359 (defun net-utils-run-simple (buffer-name program-name args)
360 "Run a network utility for diagnostic output only."
361 (interactive)
362 (when (get-buffer buffer-name)
363 (kill-buffer buffer-name))
364 (get-buffer-create buffer-name)
365 (with-current-buffer buffer-name
366 (net-utils-mode)
367 (set-process-filter
368 (apply 'start-process (format "%s" program-name)
369 buffer-name program-name args)
370 'net-utils-remove-ctrl-m-filter)
371 (goto-char (point-min)))
372 (display-buffer buffer-name))
374 ;;;###autoload
375 (defun ifconfig ()
376 "Run ifconfig and display diagnostic output."
377 (interactive)
378 (net-utils-run-simple
379 (format "*%s*" ifconfig-program)
380 ifconfig-program
381 ifconfig-program-options))
383 (defalias 'ipconfig 'ifconfig)
385 ;;;###autoload
386 (defun iwconfig ()
387 "Run iwconfig and display diagnostic output."
388 (interactive)
389 (net-utils-run-simple
390 (format "*%s*" iwconfig-program)
391 iwconfig-program
392 iwconfig-program-options))
394 ;;;###autoload
395 (defun netstat ()
396 "Run netstat and display diagnostic output."
397 (interactive)
398 (net-utils-run-simple
399 (format "*%s*" netstat-program)
400 netstat-program
401 netstat-program-options))
403 ;;;###autoload
404 (defun arp ()
405 "Run arp and display diagnostic output."
406 (interactive)
407 (net-utils-run-simple
408 (format "*%s*" arp-program)
409 arp-program
410 arp-program-options))
412 ;;;###autoload
413 (defun route ()
414 "Run route and display diagnostic output."
415 (interactive)
416 (net-utils-run-simple
417 (format "*%s*" route-program)
418 route-program
419 route-program-options))
421 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
422 ;; Wrappers for external network programs
423 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
425 ;;;###autoload
426 (defun traceroute (target)
427 "Run traceroute program for TARGET."
428 (interactive "sTarget: ")
429 (let ((options
430 (if traceroute-program-options
431 (append traceroute-program-options (list target))
432 (list target))))
433 (net-utils-run-program
434 (concat "Traceroute" " " target)
435 (concat "** Traceroute ** " traceroute-program " ** " target)
436 traceroute-program
437 options)))
439 ;;;###autoload
440 (defun ping (host)
441 "Ping HOST.
442 If your system's ping continues until interrupted, you can try setting
443 `ping-program-options'."
444 (interactive
445 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
446 (let ((options
447 (if ping-program-options
448 (append ping-program-options (list host))
449 (list host))))
450 (net-utils-run-program
451 (concat "Ping" " " host)
452 (concat "** Ping ** " ping-program " ** " host)
453 ping-program
454 options)))
456 ;; FIXME -- Needs to be a process filter
457 ;; (defun netstat-with-filter (filter)
458 ;; "Run netstat program."
459 ;; (interactive "sFilter: ")
460 ;; (netstat)
461 ;; (set-buffer (get-buffer "*Netstat*"))
462 ;; (goto-char (point-min))
463 ;; (delete-matching-lines filter))
465 ;;;###autoload
466 (defun nslookup-host (host)
467 "Lookup the DNS information for HOST."
468 (interactive
469 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
470 (let ((options
471 (if nslookup-program-options
472 (append nslookup-program-options (list host))
473 (list host))))
474 (net-utils-run-program
475 "Nslookup"
476 (concat "** "
477 (mapconcat 'identity
478 (list "Nslookup" host nslookup-program)
479 " ** "))
480 nslookup-program
481 options)))
483 ;;;###autoload
484 (defun nslookup ()
485 "Run nslookup program."
486 (interactive)
487 (switch-to-buffer (make-comint "nslookup" nslookup-program))
488 (nslookup-mode))
490 (defvar comint-prompt-regexp)
491 (defvar comint-input-autoexpand)
493 (autoload 'comint-mode "comint" nil t)
495 ;; Using a derived mode gives us keymaps, hooks, etc.
496 (define-derived-mode nslookup-mode comint-mode "Nslookup"
497 "Major mode for interacting with the nslookup program."
498 (set
499 (make-local-variable 'font-lock-defaults)
500 '((nslookup-font-lock-keywords)))
501 (setq comint-prompt-regexp nslookup-prompt-regexp)
502 (setq comint-input-autoexpand t))
504 (define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
506 ;;;###autoload
507 (defun dns-lookup-host (host)
508 "Lookup the DNS information for HOST (name or IP address)."
509 (interactive
510 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
511 (let ((options
512 (if dns-lookup-program-options
513 (append dns-lookup-program-options (list host))
514 (list host))))
515 (net-utils-run-program
516 (concat "DNS Lookup [" host "]")
517 (concat "** "
518 (mapconcat 'identity
519 (list "DNS Lookup" host dns-lookup-program)
520 " ** "))
521 dns-lookup-program
522 options)))
524 (autoload 'ffap-string-at-point "ffap")
526 ;;;###autoload
527 (defun run-dig (host)
528 "Run dig program."
529 (interactive
530 (list
531 (read-from-minibuffer "Lookup host: "
532 (or (ffap-string-at-point 'machine) ""))))
533 (net-utils-run-program
534 "Dig"
535 (concat "** "
536 (mapconcat 'identity
537 (list "Dig" host dig-program)
538 " ** "))
539 dig-program
540 (list host)))
542 (autoload 'comint-exec "comint")
544 ;; This is a lot less than ange-ftp, but much simpler.
545 ;;;###autoload
546 (defun ftp (host)
547 "Run ftp program."
548 (interactive
549 (list
550 (read-from-minibuffer
551 "Ftp to Host: " (net-utils-machine-at-point))))
552 (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
553 (set-buffer buf)
554 (ftp-mode)
555 (comint-exec buf (concat "ftp-" host) ftp-program nil
556 (if ftp-program-options
557 (append (list host) ftp-program-options)
558 (list host)))
559 (pop-to-buffer buf)))
561 (define-derived-mode ftp-mode comint-mode "FTP"
562 "Major mode for interacting with the ftp program."
563 (setq comint-prompt-regexp ftp-prompt-regexp)
564 (setq comint-input-autoexpand t)
565 ;; Only add the password-prompting hook if it's not already in the
566 ;; global hook list. This stands a small chance of losing, if it's
567 ;; later removed from the global list (very small, since any
568 ;; password prompts will probably immediately follow the initial
569 ;; connection), but it's better than getting prompted twice for the
570 ;; same password.
571 (unless (memq 'comint-watch-for-password-prompt
572 (default-value 'comint-output-filter-functions))
573 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
574 nil t)))
576 ;; Occasionally useful
577 (define-key ftp-mode-map "\t" 'comint-dynamic-complete)
579 (defun smbclient (host service)
580 "Connect to SERVICE on HOST via SMB."
581 (interactive
582 (list
583 (read-from-minibuffer
584 "Connect to Host: " (net-utils-machine-at-point))
585 (read-from-minibuffer "SMB Service: ")))
586 (let* ((name (format "smbclient [%s\\%s]" host service))
587 (buf (get-buffer-create (concat "*" name "*")))
588 (service-name (concat "\\\\" host "\\" service)))
589 (set-buffer buf)
590 (smbclient-mode)
591 (comint-exec buf name smbclient-program nil
592 (if smbclient-program-options
593 (append (list service-name) smbclient-program-options)
594 (list service-name)))
595 (pop-to-buffer buf)))
597 (defun smbclient-list-shares (host)
598 "List services on HOST."
599 (interactive
600 (list
601 (read-from-minibuffer
602 "Connect to Host: " (net-utils-machine-at-point))))
603 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
604 (set-buffer buf)
605 (smbclient-mode)
606 (comint-exec buf "smbclient-list-shares"
607 smbclient-program nil (list "-L" host))
608 (pop-to-buffer buf)))
610 (define-derived-mode smbclient-mode comint-mode "smbclient"
611 "Major mode for interacting with the smbclient program."
612 (setq comint-prompt-regexp smbclient-prompt-regexp)
613 (setq comint-input-autoexpand t)
614 ;; Only add the password-prompting hook if it's not already in the
615 ;; global hook list. This stands a small chance of losing, if it's
616 ;; later removed from the global list (very small, since any
617 ;; password prompts will probably immediately follow the initial
618 ;; connection), but it's better than getting prompted twice for the
619 ;; same password.
620 (unless (memq 'comint-watch-for-password-prompt
621 (default-value 'comint-output-filter-functions))
622 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
623 nil t)))
626 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
627 ;; Network Connections
628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
630 ;; Full list is available at:
631 ;; http://www.iana.org/assignments/port-numbers
632 (defvar network-connection-service-alist
633 (list
634 (cons 'echo 7)
635 (cons 'active-users 11)
636 (cons 'daytime 13)
637 (cons 'chargen 19)
638 (cons 'ftp 21)
639 (cons 'telnet 23)
640 (cons 'smtp 25)
641 (cons 'time 37)
642 (cons 'whois 43)
643 (cons 'gopher 70)
644 (cons 'finger 79)
645 (cons 'www 80)
646 (cons 'pop2 109)
647 (cons 'pop3 110)
648 (cons 'sun-rpc 111)
649 (cons 'nntp 119)
650 (cons 'ntp 123)
651 (cons 'netbios-name 137)
652 (cons 'netbios-data 139)
653 (cons 'irc 194)
654 (cons 'https 443)
655 (cons 'rlogin 513))
656 "Alist of services and associated TCP port numbers.
657 This list is not complete.")
659 ;; Workhorse routine
660 (defun run-network-program (process-name host port &optional initial-string)
661 (let ((tcp-connection)
662 (buf))
663 (setq buf (get-buffer-create (concat "*" process-name "*")))
664 (set-buffer buf)
666 (setq tcp-connection
667 (open-network-stream process-name buf host port))
668 (error "Could not open connection to %s" host))
669 (erase-buffer)
670 (set-marker (process-mark tcp-connection) (point-min))
671 (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
672 (and initial-string
673 (process-send-string tcp-connection
674 (concat initial-string "\r\n")))
675 (display-buffer buf)))
677 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
678 ;; Simple protocols
679 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
681 (defcustom finger-X.500-host-regexps nil
682 "A list of regular expressions matching host names.
683 If a host name passed to `finger' matches one of these regular
684 expressions, it is assumed to be a host that doesn't accept
685 queries of the form USER@HOST, and wants a query containing USER only."
686 :group 'net-utils
687 :type '(repeat regexp)
688 :version "21.1")
690 ;; Finger protocol
691 ;;;###autoload
692 (defun finger (user host)
693 "Finger USER on HOST."
694 ;; One of those great interactive statements that's actually
695 ;; longer than the function call! The idea is that if the user
696 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
697 ;; host name. If we don't see an "@", we'll prompt for the host.
698 (interactive
699 (let* ((answer (read-from-minibuffer "Finger User: "
700 (net-utils-url-at-point)))
701 (index (string-match (regexp-quote "@") answer)))
702 (if index
703 (list (substring answer 0 index)
704 (substring answer (1+ index)))
705 (list answer
706 (read-from-minibuffer "At Host: "
707 (net-utils-machine-at-point))))))
708 (let* ((user-and-host (concat user "@" host))
709 (process-name (concat "Finger [" user-and-host "]"))
710 (regexps finger-X.500-host-regexps)
711 found)
712 (and regexps
713 (while (not (string-match (car regexps) host))
714 (setq regexps (cdr regexps)))
715 (when regexps
716 (setq user-and-host user)))
717 (run-network-program
718 process-name
719 host
720 (cdr (assoc 'finger network-connection-service-alist))
721 user-and-host)))
723 (defcustom whois-server-name "rs.internic.net"
724 "Default host name for the whois service."
725 :group 'net-utils
726 :type 'string)
728 (defcustom whois-server-list
729 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
730 ("rs.internic.net") ; domain related info
731 ("whois.publicinterestregistry.net")
732 ("whois.abuse.net")
733 ("whois.apnic.net")
734 ("nic.ddn.mil")
735 ("whois.nic.mil")
736 ("whois.nic.gov")
737 ("whois.ripe.net"))
738 "A list of whois servers that can be queried."
739 :group 'net-utils
740 :type '(repeat (list string)))
742 ;; FIXME: modern whois clients include a much better tld <-> whois server
743 ;; list, Emacs should probably avoid specifying the server as the client
744 ;; will DTRT anyway... -rfr
745 (defcustom whois-server-tld
746 '(("rs.internic.net" . "com")
747 ("whois.publicinterestregistry.net" . "org")
748 ("whois.ripe.net" . "be")
749 ("whois.ripe.net" . "de")
750 ("whois.ripe.net" . "dk")
751 ("whois.ripe.net" . "it")
752 ("whois.ripe.net" . "fi")
753 ("whois.ripe.net" . "fr")
754 ("whois.ripe.net" . "uk")
755 ("whois.apnic.net" . "au")
756 ("whois.apnic.net" . "ch")
757 ("whois.apnic.net" . "hk")
758 ("whois.apnic.net" . "jp")
759 ("whois.nic.gov" . "gov")
760 ("whois.nic.mil" . "mil"))
761 "Alist to map top level domains to whois servers."
762 :group 'net-utils
763 :type '(repeat (cons string string)))
765 (defcustom whois-guess-server t
766 "If non-nil then whois will try to deduce the appropriate whois
767 server from the query. If the query doesn't look like a domain or hostname
768 then the server named by `whois-server-name' is used."
769 :group 'net-utils
770 :type 'boolean)
772 (defun whois-get-tld (host)
773 "Return the top level domain of `host', or nil if it isn't a domain name."
774 (let ((i (1- (length host)))
775 (max-len (- (length host) 5)))
776 (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
777 (setq i (1- i)))
778 (if (= i max-len)
780 (substring host (1+ i)))))
782 ;; Whois protocol
783 ;;;###autoload
784 (defun whois (arg search-string)
785 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
786 If `whois-guess-server' is non-nil, then try to deduce the correct server
787 from SEARCH-STRING. With argument, prompt for whois server."
788 (interactive "P\nsWhois: ")
789 (let* ((whois-apropos-host (if whois-guess-server
790 (rassoc (whois-get-tld search-string)
791 whois-server-tld)
792 nil))
793 (server-name (if whois-apropos-host
794 (car whois-apropos-host)
795 whois-server-name))
796 (host
797 (if arg
798 (completing-read "Whois server name: "
799 whois-server-list nil nil "whois.")
800 server-name)))
801 (run-network-program
802 "Whois"
803 host
804 (cdr (assoc 'whois network-connection-service-alist))
805 search-string)))
807 (defcustom whois-reverse-lookup-server "whois.arin.net"
808 "Server which provides inverse DNS mapping."
809 :group 'net-utils
810 :type 'string)
812 ;;;###autoload
813 (defun whois-reverse-lookup ()
814 (interactive)
815 (let ((whois-server-name whois-reverse-lookup-server))
816 (call-interactively 'whois)))
818 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
819 ;;; General Network connection
820 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
822 ;; Using a derived mode gives us keymaps, hooks, etc.
823 (define-derived-mode
824 network-connection-mode comint-mode "Network-Connection"
825 "Major mode for interacting with the network-connection program.")
827 (defun network-connection-mode-setup (host service)
828 (make-local-variable 'network-connection-host)
829 (setq network-connection-host host)
830 (make-local-variable 'network-connection-service)
831 (setq network-connection-service service))
833 ;;;###autoload
834 (defun network-connection-to-service (host service)
835 "Open a network connection to SERVICE on HOST."
836 (interactive
837 (list
838 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
839 (completing-read "Service: "
840 (mapcar
841 (function
842 (lambda (elt)
843 (list (symbol-name (car elt)))))
844 network-connection-service-alist))))
845 (network-connection
846 host
847 (cdr (assoc (intern service) network-connection-service-alist))))
849 ;;;###autoload
850 (defun network-connection (host port)
851 "Open a network connection to HOST on PORT."
852 (interactive "sHost: \nnPort: ")
853 (network-service-connection host (number-to-string port)))
855 (defun network-service-connection (host service)
856 "Open a network connection to SERVICE on HOST."
857 (let* ((process-name (concat "Network Connection [" host " " service "]"))
858 (portnum (string-to-number service))
859 (buf (get-buffer-create (concat "*" process-name "*"))))
860 (or (zerop portnum) (setq service portnum))
861 (make-comint
862 process-name
863 (cons host service))
864 (set-buffer buf)
865 (network-connection-mode)
866 (network-connection-mode-setup host service)
867 (pop-to-buffer buf)))
869 (defvar comint-input-ring)
871 (defun network-connection-reconnect ()
872 "Reconnect a network connection, preserving the old input ring."
873 (interactive)
874 (let ((proc (get-buffer-process (current-buffer)))
875 (old-comint-input-ring comint-input-ring)
876 (host network-connection-host)
877 (service network-connection-service))
878 (if (not (or (not proc)
879 (eq (process-status proc) 'closed)))
880 (message "Still connected")
881 (goto-char (point-max))
882 (insert (format "Reopening connection to %s\n" host))
883 (network-connection host
884 (if (numberp service)
885 service
886 (cdr (assoc service network-connection-service-alist))))
887 (and old-comint-input-ring
888 (setq comint-input-ring old-comint-input-ring)))))
890 (provide 'net-utils)
892 ;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
893 ;;; net-utils.el ends here