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