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