Crunch some deleted functions.
[emacs.git] / lisp / net / net-utils.el
blob7e7e5cd1bbf6a08a653f99f18410c5b36dab1763
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/>.
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 (defcustom ifconfig-program-options
103 (list
104 (if (eq system-type 'windows-nt)
105 "/all" "-a"))
106 "Options for the ifconfig program."
107 :group 'net-utils
108 :type '(repeat string))
110 (defcustom iwconfig-program "iwconfig"
111 "Program to print wireless network configuration information."
112 :group 'net-utils
113 :type 'string
114 :version "23.1")
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."
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 (defconst 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 ;; Utility functions
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 ()
269 (let ((pt (point)))
270 (buffer-substring-no-properties
271 (save-excursion
272 (skip-chars-backward "-a-zA-Z0-9.")
273 (point))
274 (save-excursion
275 (skip-chars-forward "-a-zA-Z0-9.")
276 (skip-chars-backward "." pt)
277 (point)))))
279 (defun net-utils-url-at-point ()
280 (let ((pt (point)))
281 (buffer-substring-no-properties
282 (save-excursion
283 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
284 (skip-chars-forward "^A-Za-z0-9" pt)
285 (point))
286 (save-excursion
287 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
288 (skip-chars-backward ":;.,!?" pt)
289 (point)))))
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))
296 (unwind-protect
297 (let ((moving))
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)))
305 (save-excursion
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 "*"))))
316 (set-buffer buf)
317 (erase-buffer)
318 (insert header "\n")
319 (set-process-filter
320 (apply 'start-process name buf program args)
321 'net-utils-remove-ctrl-m-filter)
322 (display-buffer buf)
323 buf))
325 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
326 ;; Wrappers for external network programs
327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
329 ;;;###autoload
330 (defun traceroute (target)
331 "Run traceroute program for TARGET."
332 (interactive "sTarget: ")
333 (let ((options
334 (if traceroute-program-options
335 (append traceroute-program-options (list target))
336 (list target))))
337 (net-utils-run-program
338 (concat "Traceroute" " " target)
339 (concat "** Traceroute ** " traceroute-program " ** " target)
340 traceroute-program
341 options)))
343 ;;;###autoload
344 (defun ping (host)
345 "Ping HOST.
346 If your system's ping continues until interrupted, you can try setting
347 `ping-program-options'."
348 (interactive
349 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
350 (let ((options
351 (if ping-program-options
352 (append ping-program-options (list host))
353 (list host))))
354 (net-utils-run-program
355 (concat "Ping" " " host)
356 (concat "** Ping ** " ping-program " ** " host)
357 ping-program
358 options)))
360 ;;;###autoload
361 (defun ifconfig ()
362 "Run ifconfig program."
363 (interactive)
364 (net-utils-run-program
365 "Ifconfig"
366 (concat "** Ifconfig ** " ifconfig-program " ** ")
367 ifconfig-program
368 ifconfig-program-options))
370 ;; Windows uses this name.
371 ;;;###autoload
372 (defalias 'ipconfig 'ifconfig)
374 ;;;###autoload
375 (defun iwconfig ()
376 "Run iwconfig program."
377 (interactive)
378 (net-utils-run-program
379 "Iwconfig"
380 (concat "** Iwconfig ** " iwconfig-program " ** ")
381 iwconfig-program
382 iwconfig-program-options))
384 ;;;###autoload
385 (defun netstat ()
386 "Run netstat program."
387 (interactive)
388 (net-utils-run-program
389 "Netstat"
390 (concat "** Netstat ** " netstat-program " ** ")
391 netstat-program
392 netstat-program-options))
394 ;;;###autoload
395 (defun arp ()
396 "Run arp program."
397 (interactive)
398 (net-utils-run-program
399 "Arp"
400 (concat "** Arp ** " arp-program " ** ")
401 arp-program
402 arp-program-options))
404 ;;;###autoload
405 (defun route ()
406 "Run route program."
407 (interactive)
408 (net-utils-run-program
409 "Route"
410 (concat "** Route ** " route-program " ** ")
411 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: ")
418 ;; (netstat)
419 ;; (set-buffer (get-buffer "*Netstat*"))
420 ;; (goto-char (point-min))
421 ;; (delete-matching-lines filter))
423 ;;;###autoload
424 (defun nslookup-host (host)
425 "Lookup the DNS information for HOST."
426 (interactive
427 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
428 (let ((options
429 (if nslookup-program-options
430 (append nslookup-program-options (list host))
431 (list host))))
432 (net-utils-run-program
433 "Nslookup"
434 (concat "** "
435 (mapconcat 'identity
436 (list "Nslookup" host nslookup-program)
437 " ** "))
438 nslookup-program
439 options)))
441 ;;;###autoload
442 (defun nslookup ()
443 "Run nslookup program."
444 (interactive)
445 (comint-run nslookup-program)
446 (nslookup-mode))
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."
456 (set
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)
464 ;;;###autoload
465 (defun dns-lookup-host (host)
466 "Lookup the DNS information for HOST (name or IP address)."
467 (interactive
468 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
469 (let ((options
470 (if dns-lookup-program-options
471 (append dns-lookup-program-options (list host))
472 (list host))))
473 (net-utils-run-program
474 (concat "DNS Lookup [" host "]")
475 (concat "** "
476 (mapconcat 'identity
477 (list "DNS Lookup" host dns-lookup-program)
478 " ** "))
479 dns-lookup-program
480 options)))
482 (autoload 'ffap-string-at-point "ffap")
484 ;;;###autoload
485 (defun run-dig (host)
486 "Run dig program."
487 (interactive
488 (list
489 (read-from-minibuffer "Lookup host: "
490 (or (ffap-string-at-point 'machine) ""))))
491 (net-utils-run-program
492 "Dig"
493 (concat "** "
494 (mapconcat 'identity
495 (list "Dig" host dig-program)
496 " ** "))
497 dig-program
498 (list host)))
500 (autoload 'comint-exec "comint")
502 ;; This is a lot less than ange-ftp, but much simpler.
503 ;;;###autoload
504 (defun ftp (host)
505 "Run ftp program."
506 (interactive
507 (list
508 (read-from-minibuffer
509 "Ftp to Host: " (net-utils-machine-at-point))))
510 (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
511 (set-buffer buf)
512 (ftp-mode)
513 (comint-exec buf (concat "ftp-" host) ftp-program nil
514 (if ftp-program-options
515 (append (list host) ftp-program-options)
516 (list host)))
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
528 ;; same password.
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
532 nil t)))
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."
539 (interactive
540 (list
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)))
547 (set-buffer buf)
548 (smbclient-mode)
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."
557 (interactive
558 (list
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))))
562 (set-buffer buf)
563 (smbclient-mode)
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
577 ;; same password.
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
581 nil t)))
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
591 (list
592 (cons 'echo 7)
593 (cons 'active-users 11)
594 (cons 'daytime 13)
595 (cons 'chargen 19)
596 (cons 'ftp 21)
597 (cons 'telnet 23)
598 (cons 'smtp 25)
599 (cons 'time 37)
600 (cons 'whois 43)
601 (cons 'gopher 70)
602 (cons 'finger 79)
603 (cons 'www 80)
604 (cons 'pop2 109)
605 (cons 'pop3 110)
606 (cons 'sun-rpc 111)
607 (cons 'nntp 119)
608 (cons 'ntp 123)
609 (cons 'netbios-name 137)
610 (cons 'netbios-data 139)
611 (cons 'irc 194)
612 (cons 'https 443)
613 (cons 'rlogin 513))
614 "Alist of services and associated TCP port numbers.
615 This list is not complete.")
617 ;; Workhorse routine
618 (defun run-network-program (process-name host port &optional initial-string)
619 (let ((tcp-connection)
620 (buf))
621 (setq buf (get-buffer-create (concat "*" process-name "*")))
622 (set-buffer buf)
624 (setq tcp-connection
625 (open-network-stream process-name buf host port))
626 (error "Could not open connection to %s" host))
627 (erase-buffer)
628 (set-marker (process-mark tcp-connection) (point-min))
629 (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
630 (and initial-string
631 (process-send-string tcp-connection
632 (concat initial-string "\r\n")))
633 (display-buffer buf)))
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;; Simple protocols
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."
644 :group 'net-utils
645 :type '(repeat regexp)
646 :version "21.1")
648 ;; Finger protocol
649 ;;;###autoload
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.
656 (interactive
657 (let* ((answer (read-from-minibuffer "Finger User: "
658 (net-utils-url-at-point)))
659 (index (string-match (regexp-quote "@") answer)))
660 (if index
661 (list (substring answer 0 index)
662 (substring answer (1+ index)))
663 (list answer
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)
669 found)
670 (and regexps
671 (while (not (string-match (car regexps) host))
672 (setq regexps (cdr regexps)))
673 (when regexps
674 (setq user-and-host user)))
675 (run-network-program
676 process-name
677 host
678 (cdr (assoc 'finger network-connection-service-alist))
679 user-and-host)))
681 (defcustom whois-server-name "rs.internic.net"
682 "Default host name for the whois service."
683 :group 'net-utils
684 :type 'string)
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")
690 ("whois.abuse.net")
691 ("whois.apnic.net")
692 ("nic.ddn.mil")
693 ("whois.nic.mil")
694 ("whois.nic.gov")
695 ("whois.ripe.net"))
696 "A list of whois servers that can be queried."
697 :group 'net-utils
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."
720 :group 'net-utils
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."
727 :group 'net-utils
728 :type 'boolean)
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) ?.)))
735 (setq i (1- i)))
736 (if (= i max-len)
738 (substring host (1+ i)))))
740 ;; Whois protocol
741 ;;;###autoload
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)
749 whois-server-tld)
750 nil))
751 (server-name (if whois-apropos-host
752 (car whois-apropos-host)
753 whois-server-name))
754 (host
755 (if arg
756 (completing-read "Whois server name: "
757 whois-server-list nil nil "whois.")
758 server-name)))
759 (run-network-program
760 "Whois"
761 host
762 (cdr (assoc 'whois network-connection-service-alist))
763 search-string)))
765 (defcustom whois-reverse-lookup-server "whois.arin.net"
766 "Server which provides inverse DNS mapping."
767 :group 'net-utils
768 :type 'string)
770 ;;;###autoload
771 (defun whois-reverse-lookup ()
772 (interactive)
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.
781 (define-derived-mode
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))
791 ;;;###autoload
792 (defun network-connection-to-service (host service)
793 "Open a network connection to SERVICE on HOST."
794 (interactive
795 (list
796 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
797 (completing-read "Service: "
798 (mapcar
799 (function
800 (lambda (elt)
801 (list (symbol-name (car elt)))))
802 network-connection-service-alist))))
803 (network-connection
804 host
805 (cdr (assoc (intern service) network-connection-service-alist))))
807 ;;;###autoload
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))
819 (make-comint
820 process-name
821 (cons host service))
822 (set-buffer buf)
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."
831 (interactive)
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)
843 service
844 (cdr (assoc service network-connection-service-alist))))
845 (and old-comint-input-ring
846 (setq comint-input-ring old-comint-input-ring)))))
848 (provide 'net-utils)
850 ;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
851 ;;; net-utils.el ends here