* lisp/net/net-utils.el: Small improvements.
[emacs.git] / lisp / net / net-utils.el
blobc43d48e514c2855924f736fb7d997a7e9ff3f466
1 ;;; net-utils.el --- network functions
3 ;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
6 ;; Created: Sun Mar 16 1997
7 ;; Keywords: network comm
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
27 ;; There are three main areas of functionality:
29 ;; * Wrap common network utility programs (ping, traceroute, netstat,
30 ;; nslookup, arp, route). Note that these wrappers are of the diagnostic
31 ;; functions of these programs only.
33 ;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
35 ;; * Support connections to HOST/PORT, generally for debugging and the like.
36 ;; In other words, for doing much the same thing as "telnet HOST PORT", and
37 ;; then typing commands.
39 ;;; Code:
41 ;; On some systems, programs like ifconfig are not in normal user
42 ;; path, but rather in /sbin, /usr/sbin, etc (but non-root users can
43 ;; still use them for queries). Actually the trend these
44 ;; day is for /sbin to be a symlink to /usr/sbin, but we still need to
45 ;; search both for older systems.
46 (defun net-utils--executable-find-sbin (command)
47 "Return absolute name of COMMAND if found in an sbin directory."
48 (let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
49 (executable-find command)))
51 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 ;; Customization Variables
53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55 (defgroup net-utils nil
56 "Network utility functions."
57 :prefix "net-utils-"
58 :group 'comm
59 :version "20.3")
61 (defcustom traceroute-program
62 (if (eq system-type 'windows-nt)
63 "tracert"
64 "traceroute")
65 "Program to trace network hops to a destination."
66 :group 'net-utils
67 :type 'string)
69 (defcustom traceroute-program-options nil
70 "Options for the traceroute program."
71 :group 'net-utils
72 :type '(repeat string))
74 (defcustom ping-program "ping"
75 "Program to send network test packets to a host."
76 :group 'net-utils
77 :type 'string)
79 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
80 ;; indefinitely unless told otherwise
81 (defcustom ping-program-options
82 (and (memq system-type '(gnu/linux irix))
83 (list "-c" "4"))
84 "Options for the ping program.
85 These options can be used to limit how many ICMP packets are emitted."
86 :group 'net-utils
87 :type '(repeat string))
89 (define-obsolete-variable-alias 'ipconfig-program 'ifconfig-program "22.2")
91 (defcustom ifconfig-program
92 (cond ((eq system-type 'windows-nt) "ipconfig")
93 ((executable-find "ifconfig") "ifconfig")
94 ((net-utils--executable-find-sbin "ifconfig"))
95 ((net-utils--executable-find-sbin "ip"))
96 (t "ip"))
97 "Program to print network configuration information."
98 :version "25.1" ; add ip
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 (cond ((string-match "ipconfig\\'" ifconfig-program) '("/all"))
107 ((string-match "ifconfig\\'" ifconfig-program) '("-a"))
108 ((string-match "ip\\'" ifconfig-program) '("addr")))
109 "Options for the ifconfig program."
110 :version "25.1"
111 :set-after '(ifconfig-program)
112 :group 'net-utils
113 :type '(repeat string))
115 (defcustom iwconfig-program "iwconfig"
116 "Program to print wireless network configuration information."
117 :group 'net-utils
118 :type 'string
119 :version "23.1")
121 (defcustom iwconfig-program-options nil
122 "Options for the iwconfig program."
123 :group 'net-utils
124 :type '(repeat string)
125 :version "23.1")
127 (defcustom netstat-program "netstat"
128 "Program to print network statistics."
129 :group 'net-utils
130 :type 'string)
132 (defcustom netstat-program-options
133 (list "-a")
134 "Options for the netstat program."
135 :group 'net-utils
136 :type '(repeat string))
138 (defcustom arp-program (or (net-utils--executable-find-sbin "arp") "arp")
139 "Program to print IP to address translation tables."
140 :group 'net-utils
141 :type 'string)
143 (defcustom arp-program-options
144 (list "-a")
145 "Options for the arp program."
146 :group 'net-utils
147 :type '(repeat string))
149 (defcustom route-program
150 (if (eq system-type 'windows-nt)
151 "route"
152 "netstat")
153 "Program to print routing tables."
154 :group 'net-utils
155 :type 'string)
157 (defcustom route-program-options
158 (if (eq system-type 'windows-nt)
159 (list "print")
160 (list "-r"))
161 "Options for the route program."
162 :group 'net-utils
163 :type '(repeat string))
165 (defcustom nslookup-program "nslookup"
166 "Program to interactively query DNS information."
167 :group 'net-utils
168 :type 'string)
170 (defcustom nslookup-program-options nil
171 "Options for the nslookup program."
172 :group 'net-utils
173 :type '(repeat string))
175 (defcustom nslookup-prompt-regexp "^> "
176 "Regexp to match the nslookup prompt.
178 This variable is only used if the variable
179 `comint-use-prompt-regexp' is non-nil."
180 :group 'net-utils
181 :type 'regexp)
183 (defcustom dig-program "dig"
184 "Program to query DNS information."
185 :group 'net-utils
186 :type 'string)
188 (defcustom ftp-program "ftp"
189 "Program to run to do FTP transfers."
190 :group 'net-utils
191 :type 'string)
193 (defcustom ftp-program-options nil
194 "Options for the ftp program."
195 :group 'net-utils
196 :type '(repeat string))
198 (defcustom ftp-prompt-regexp "^ftp>"
199 "Regexp which matches the FTP program's prompt.
201 This variable is only used if the variable
202 `comint-use-prompt-regexp' is non-nil."
203 :group 'net-utils
204 :type 'regexp)
206 (defcustom smbclient-program "smbclient"
207 "Smbclient program."
208 :group 'net-utils
209 :type 'string)
211 (defcustom smbclient-program-options nil
212 "Options for the smbclient program."
213 :group 'net-utils
214 :type '(repeat string))
216 (defcustom smbclient-prompt-regexp "^smb: >"
217 "Regexp which matches the smbclient program's prompt.
219 This variable is only used if the variable
220 `comint-use-prompt-regexp' is non-nil."
221 :group 'net-utils
222 :type 'regexp)
224 (defcustom dns-lookup-program "host"
225 "Program to interactively query DNS information."
226 :group 'net-utils
227 :type 'string)
229 (defcustom dns-lookup-program-options nil
230 "Options for the dns-lookup program."
231 :group 'net-utils
232 :type '(repeat string))
234 ;; Internal variables
235 (defvar network-connection-service nil)
236 (defvar network-connection-host nil)
238 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
239 ;; Nslookup goodies
240 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
242 (defvar nslookup-font-lock-keywords
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))
262 "Expressions to font-lock for nslookup.")
264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
265 ;; General network utilities mode
266 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
268 (defvar net-utils-font-lock-keywords
269 (list
270 ;; Dotted quads
271 (list
272 (mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
273 0 'font-lock-variable-name-face)
274 ;; Simple rfc4291 addresses
275 (list (concat
276 "\\( \\([[:xdigit:]]+\\(:\\|::\\)\\)+[[:xdigit:]]+\\)"
277 "\\|"
278 "\\(::[[:xdigit:]]+\\)")
279 0 'font-lock-variable-name-face)
280 ;; Host names
281 (list
282 (let ((host-expression "[-A-Za-z0-9]+"))
283 (concat
284 (mapconcat 'identity (make-list 2 host-expression) "\\.")
285 "\\(\\." host-expression "\\)*"))
286 0 'font-lock-variable-name-face))
287 "Expressions to font-lock for general network utilities.")
289 (define-derived-mode net-utils-mode special-mode "NetworkUtil"
290 "Major mode for interacting with an external network utility."
291 (set (make-local-variable 'font-lock-defaults)
292 '((net-utils-font-lock-keywords)))
293 (setq-local revert-buffer-function #'net-utils--revert-function))
295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
296 ;; Utility functions
297 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
299 ;; Simplified versions of some at-point functions from ffap.el.
300 ;; It's not worth loading all of ffap just for these.
301 (defun net-utils-machine-at-point ()
302 (let ((pt (point)))
303 (buffer-substring-no-properties
304 (save-excursion
305 (skip-chars-backward "-a-zA-Z0-9.")
306 (point))
307 (save-excursion
308 (skip-chars-forward "-a-zA-Z0-9.")
309 (skip-chars-backward "." pt)
310 (point)))))
312 (defun net-utils-url-at-point ()
313 (let ((pt (point)))
314 (buffer-substring-no-properties
315 (save-excursion
316 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
317 (skip-chars-forward "^A-Za-z0-9" pt)
318 (point))
319 (save-excursion
320 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
321 (skip-chars-backward ":;.,!?" pt)
322 (point)))))
324 (defun net-utils-remove-ctrl-m-filter (process output-string)
325 "Remove trailing control Ms."
326 (with-current-buffer (process-buffer process)
327 (save-excursion
328 (let ((inhibit-read-only t)
329 (filtered-string output-string))
330 (while (string-match "\r" filtered-string)
331 (setq filtered-string
332 (replace-match "" nil nil filtered-string)))
333 ;; Insert the text, moving the process-marker.
334 (goto-char (process-mark process))
335 (insert filtered-string)
336 (set-marker (process-mark process) (point))))))
338 (declare-function w32-get-console-output-codepage "w32proc.c" ())
340 (defun net-utils-run-program (name header program args)
341 "Run a network information program."
342 (let ((buf (get-buffer-create (concat "*" name "*")))
343 (coding-system-for-read
344 ;; MS-Windows versions of network utilities output text
345 ;; encoded in the console (a.k.a. "OEM") codepage, which is
346 ;; different from the default system (a.k.a. "ANSI")
347 ;; codepage.
348 (if (eq system-type 'windows-nt)
349 (intern (format "cp%d" (w32-get-console-output-codepage)))
350 coding-system-for-read)))
351 (set-buffer buf)
352 (erase-buffer)
353 (insert header "\n")
354 (set-process-filter
355 (apply 'start-process name buf program args)
356 'net-utils-remove-ctrl-m-filter)
357 (display-buffer buf)
358 buf))
360 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
361 ;; General network utilities (diagnostic)
362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
364 ;; Todo: This data could be saved in a bookmark.
365 (defvar net-utils--revert-cmd nil)
367 (defun net-utils-run-simple (buffer program-name args &optional nodisplay)
368 "Run a network utility for diagnostic output only."
369 (with-current-buffer (if (stringp buffer) (get-buffer-create buffer) buffer)
370 (let ((proc (get-buffer-process (current-buffer))))
371 (when proc
372 (set-process-filter proc nil)
373 (delete-process proc)))
374 (let ((inhibit-read-only t)
375 (coding-system-for-read
376 ;; MS-Windows versions of network utilities output text
377 ;; encoded in the console (a.k.a. "OEM") codepage, which is
378 ;; different from the default system (a.k.a. "ANSI")
379 ;; codepage.
380 (if (eq system-type 'windows-nt)
381 (intern (format "cp%d" (w32-get-console-output-codepage)))
382 coding-system-for-read)))
383 (erase-buffer))
384 (net-utils-mode)
385 (setq-local net-utils--revert-cmd
386 `(net-utils-run-simple ,(current-buffer)
387 ,program-name ,args nodisplay))
388 (set-process-filter
389 (apply 'start-process program-name
390 (current-buffer) program-name args)
391 'net-utils-remove-ctrl-m-filter)
392 (unless nodisplay (display-buffer (current-buffer)))))
394 (defun net-utils--revert-function (&optional ignore-auto noconfirm)
395 (message "Reverting `%s'..." (buffer-name))
396 (apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
397 (let ((proc (get-buffer-process (current-buffer))))
398 (when proc
399 (set-process-sentinel
400 proc
401 (lambda (process event)
402 (when (string= event "finished\n")
403 (message "Reverting `%s' done" (process-buffer process))))))))
405 ;;;###autoload
406 (defun ifconfig ()
407 "Run ifconfig and display diagnostic output."
408 (interactive)
409 (net-utils-run-simple
410 (format "*%s*" ifconfig-program)
411 ifconfig-program
412 ifconfig-program-options))
414 (defalias 'ipconfig 'ifconfig)
416 ;;;###autoload
417 (defun iwconfig ()
418 "Run iwconfig and display diagnostic output."
419 (interactive)
420 (net-utils-run-simple
421 (format "*%s*" iwconfig-program)
422 iwconfig-program
423 iwconfig-program-options))
425 ;;;###autoload
426 (defun netstat ()
427 "Run netstat and display diagnostic output."
428 (interactive)
429 (net-utils-run-simple
430 (format "*%s*" netstat-program)
431 netstat-program
432 netstat-program-options))
434 ;;;###autoload
435 (defun arp ()
436 "Run arp and display diagnostic output."
437 (interactive)
438 (net-utils-run-simple
439 (format "*%s*" arp-program)
440 arp-program
441 arp-program-options))
443 ;;;###autoload
444 (defun route ()
445 "Run route and display diagnostic output."
446 (interactive)
447 (net-utils-run-simple
448 (format "*%s*" route-program)
449 route-program
450 route-program-options))
452 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
453 ;; Wrappers for external network programs
454 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
456 ;;;###autoload
457 (defun traceroute (target)
458 "Run traceroute program for TARGET."
459 (interactive "sTarget: ")
460 (let ((options
461 (if traceroute-program-options
462 (append traceroute-program-options (list target))
463 (list target))))
464 (net-utils-run-simple
465 (concat "Traceroute" " " target)
466 traceroute-program
467 options)))
469 ;;;###autoload
470 (defun ping (host)
471 "Ping HOST.
472 If your system's ping continues until interrupted, you can try setting
473 `ping-program-options'."
474 (interactive
475 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
476 (let ((options
477 (if ping-program-options
478 (append ping-program-options (list host))
479 (list host))))
480 (net-utils-run-program
481 (concat "Ping" " " host)
482 (concat "** Ping ** " ping-program " ** " host)
483 ping-program
484 options)))
486 ;; FIXME -- Needs to be a process filter
487 ;; (defun netstat-with-filter (filter)
488 ;; "Run netstat program."
489 ;; (interactive "sFilter: ")
490 ;; (netstat)
491 ;; (set-buffer (get-buffer "*Netstat*"))
492 ;; (goto-char (point-min))
493 ;; (delete-matching-lines filter))
495 ;;;###autoload
496 (defun nslookup-host (host)
497 "Lookup the DNS information for HOST."
498 (interactive
499 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
500 (let ((options
501 (if nslookup-program-options
502 (append nslookup-program-options (list host))
503 (list host))))
504 (net-utils-run-program
505 "Nslookup"
506 (concat "** "
507 (mapconcat 'identity
508 (list "Nslookup" host nslookup-program)
509 " ** "))
510 nslookup-program
511 options)))
513 ;;;###autoload
514 (defun nslookup ()
515 "Run nslookup program."
516 (interactive)
517 (switch-to-buffer (make-comint "nslookup" nslookup-program))
518 (nslookup-mode))
520 (defvar comint-prompt-regexp)
521 (defvar comint-input-autoexpand)
523 (autoload 'comint-mode "comint" nil t)
525 (defvar nslookup-mode-map
526 (let ((map (make-sparse-keymap)))
527 (define-key map "\t" 'completion-at-point)
528 map))
530 ;; Using a derived mode gives us keymaps, hooks, etc.
531 (define-derived-mode nslookup-mode comint-mode "Nslookup"
532 "Major mode for interacting with the nslookup program."
533 (set
534 (make-local-variable 'font-lock-defaults)
535 '((nslookup-font-lock-keywords)))
536 (setq comint-prompt-regexp nslookup-prompt-regexp)
537 (setq comint-input-autoexpand t))
539 ;;;###autoload
540 (defun dns-lookup-host (host)
541 "Lookup the DNS information for HOST (name or IP address)."
542 (interactive
543 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
544 (let ((options
545 (if dns-lookup-program-options
546 (append dns-lookup-program-options (list host))
547 (list host))))
548 (net-utils-run-program
549 (concat "DNS Lookup [" host "]")
550 (concat "** "
551 (mapconcat 'identity
552 (list "DNS Lookup" host dns-lookup-program)
553 " ** "))
554 dns-lookup-program
555 options)))
557 (autoload 'ffap-string-at-point "ffap")
559 ;;;###autoload
560 (defun run-dig (host)
561 "Run dig program."
562 (interactive
563 (list
564 (read-from-minibuffer "Lookup host: "
565 (or (ffap-string-at-point 'machine) ""))))
566 (net-utils-run-program
567 "Dig"
568 (concat "** "
569 (mapconcat 'identity
570 (list "Dig" host dig-program)
571 " ** "))
572 dig-program
573 (list host)))
575 (autoload 'comint-exec "comint")
577 ;; This is a lot less than ange-ftp, but much simpler.
578 ;;;###autoload
579 (defun ftp (host)
580 "Run ftp program."
581 (interactive
582 (list
583 (read-from-minibuffer
584 "Ftp to Host: " (net-utils-machine-at-point))))
585 (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
586 (set-buffer buf)
587 (ftp-mode)
588 (comint-exec buf (concat "ftp-" host) ftp-program nil
589 (if ftp-program-options
590 (append (list host) ftp-program-options)
591 (list host)))
592 (pop-to-buffer buf)))
594 (defvar ftp-mode-map
595 (let ((map (make-sparse-keymap)))
596 ;; Occasionally useful
597 (define-key map "\t" 'completion-at-point)
598 map))
600 (define-derived-mode ftp-mode comint-mode "FTP"
601 "Major mode for interacting with the ftp program."
602 (setq comint-prompt-regexp ftp-prompt-regexp)
603 (setq comint-input-autoexpand t)
604 ;; Only add the password-prompting hook if it's not already in the
605 ;; global hook list. This stands a small chance of losing, if it's
606 ;; later removed from the global list (very small, since any
607 ;; password prompts will probably immediately follow the initial
608 ;; connection), but it's better than getting prompted twice for the
609 ;; same password.
610 (unless (memq 'comint-watch-for-password-prompt
611 (default-value 'comint-output-filter-functions))
612 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
613 nil t)))
615 (defun smbclient (host service)
616 "Connect to SERVICE on HOST via SMB."
617 (interactive
618 (list
619 (read-from-minibuffer
620 "Connect to Host: " (net-utils-machine-at-point))
621 (read-from-minibuffer "SMB Service: ")))
622 (let* ((name (format "smbclient [%s\\%s]" host service))
623 (buf (get-buffer-create (concat "*" name "*")))
624 (service-name (concat "\\\\" host "\\" service)))
625 (set-buffer buf)
626 (smbclient-mode)
627 (comint-exec buf name smbclient-program nil
628 (if smbclient-program-options
629 (append (list service-name) smbclient-program-options)
630 (list service-name)))
631 (pop-to-buffer buf)))
633 (defun smbclient-list-shares (host)
634 "List services on HOST."
635 (interactive
636 (list
637 (read-from-minibuffer
638 "Connect to Host: " (net-utils-machine-at-point))))
639 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
640 (set-buffer buf)
641 (smbclient-mode)
642 (comint-exec buf "smbclient-list-shares"
643 smbclient-program nil (list "-L" host))
644 (pop-to-buffer buf)))
646 (define-derived-mode smbclient-mode comint-mode "smbclient"
647 "Major mode for interacting with the smbclient program."
648 (setq comint-prompt-regexp smbclient-prompt-regexp)
649 (setq comint-input-autoexpand t)
650 ;; Only add the password-prompting hook if it's not already in the
651 ;; global hook list. This stands a small chance of losing, if it's
652 ;; later removed from the global list (very small, since any
653 ;; password prompts will probably immediately follow the initial
654 ;; connection), but it's better than getting prompted twice for the
655 ;; same password.
656 (unless (memq 'comint-watch-for-password-prompt
657 (default-value 'comint-output-filter-functions))
658 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
659 nil t)))
662 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
663 ;; Network Connections
664 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
666 ;; Full list is available at:
667 ;; http://www.iana.org/assignments/port-numbers
668 (defvar network-connection-service-alist
669 (list
670 (cons 'echo 7)
671 (cons 'active-users 11)
672 (cons 'daytime 13)
673 (cons 'chargen 19)
674 (cons 'ftp 21)
675 (cons 'telnet 23)
676 (cons 'smtp 25)
677 (cons 'time 37)
678 (cons 'whois 43)
679 (cons 'gopher 70)
680 (cons 'finger 79)
681 (cons 'www 80)
682 (cons 'pop2 109)
683 (cons 'pop3 110)
684 (cons 'sun-rpc 111)
685 (cons 'nntp 119)
686 (cons 'ntp 123)
687 (cons 'netbios-name 137)
688 (cons 'netbios-data 139)
689 (cons 'irc 194)
690 (cons 'https 443)
691 (cons 'rlogin 513))
692 "Alist of services and associated TCP port numbers.
693 This list is not complete.")
695 ;; Workhorse routine
696 (defun run-network-program (process-name host port &optional initial-string)
697 (let ((tcp-connection)
698 (buf))
699 (setq buf (get-buffer-create (concat "*" process-name "*")))
700 (set-buffer buf)
702 (setq tcp-connection
703 (open-network-stream process-name buf host port))
704 (error "Could not open connection to %s" host))
705 (erase-buffer)
706 (set-marker (process-mark tcp-connection) (point-min))
707 (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
708 (and initial-string
709 (process-send-string tcp-connection
710 (concat initial-string "\r\n")))
711 (display-buffer buf)))
713 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
714 ;; Simple protocols
715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
717 (defcustom finger-X.500-host-regexps nil
718 "A list of regular expressions matching host names.
719 If a host name passed to `finger' matches one of these regular
720 expressions, it is assumed to be a host that doesn't accept
721 queries of the form USER@HOST, and wants a query containing USER only."
722 :group 'net-utils
723 :type '(repeat regexp)
724 :version "21.1")
726 ;; Finger protocol
727 ;;;###autoload
728 (defun finger (user host)
729 "Finger USER on HOST."
730 ;; One of those great interactive statements that's actually
731 ;; longer than the function call! The idea is that if the user
732 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
733 ;; host name. If we don't see an "@", we'll prompt for the host.
734 (interactive
735 (let* ((answer (read-from-minibuffer "Finger User: "
736 (net-utils-url-at-point)))
737 (index (string-match (regexp-quote "@") answer)))
738 (if index
739 (list (substring answer 0 index)
740 (substring answer (1+ index)))
741 (list answer
742 (read-from-minibuffer "At Host: "
743 (net-utils-machine-at-point))))))
744 (let* ((user-and-host (concat user "@" host))
745 (process-name (concat "Finger [" user-and-host "]"))
746 (regexps finger-X.500-host-regexps)
747 found)
748 (and regexps
749 (while (not (string-match (car regexps) host))
750 (setq regexps (cdr regexps)))
751 (when regexps
752 (setq user-and-host user)))
753 (run-network-program
754 process-name
755 host
756 (cdr (assoc 'finger network-connection-service-alist))
757 user-and-host)))
759 (defcustom whois-server-name "rs.internic.net"
760 "Default host name for the whois service."
761 :group 'net-utils
762 :type 'string)
764 (defcustom whois-server-list
765 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
766 ("rs.internic.net") ; domain related info
767 ("whois.publicinterestregistry.net")
768 ("whois.abuse.net")
769 ("whois.apnic.net")
770 ("nic.ddn.mil")
771 ("whois.nic.mil")
772 ("whois.nic.gov")
773 ("whois.ripe.net"))
774 "A list of whois servers that can be queried."
775 :group 'net-utils
776 :type '(repeat (list string)))
778 ;; FIXME: modern whois clients include a much better tld <-> whois server
779 ;; list, Emacs should probably avoid specifying the server as the client
780 ;; will DTRT anyway... -rfr
781 (defcustom whois-server-tld
782 '(("rs.internic.net" . "com")
783 ("whois.publicinterestregistry.net" . "org")
784 ("whois.ripe.net" . "be")
785 ("whois.ripe.net" . "de")
786 ("whois.ripe.net" . "dk")
787 ("whois.ripe.net" . "it")
788 ("whois.ripe.net" . "fi")
789 ("whois.ripe.net" . "fr")
790 ("whois.ripe.net" . "uk")
791 ("whois.apnic.net" . "au")
792 ("whois.apnic.net" . "ch")
793 ("whois.apnic.net" . "hk")
794 ("whois.apnic.net" . "jp")
795 ("whois.nic.gov" . "gov")
796 ("whois.nic.mil" . "mil"))
797 "Alist to map top level domains to whois servers."
798 :group 'net-utils
799 :type '(repeat (cons string string)))
801 (defcustom whois-guess-server t
802 "If non-nil then whois will try to deduce the appropriate whois
803 server from the query. If the query doesn't look like a domain or hostname
804 then the server named by `whois-server-name' is used."
805 :group 'net-utils
806 :type 'boolean)
808 (defun whois-get-tld (host)
809 "Return the top level domain of `host', or nil if it isn't a domain name."
810 (let ((i (1- (length host)))
811 (max-len (- (length host) 5)))
812 (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
813 (setq i (1- i)))
814 (if (= i max-len)
816 (substring host (1+ i)))))
818 ;; Whois protocol
819 ;;;###autoload
820 (defun whois (arg search-string)
821 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
822 If `whois-guess-server' is non-nil, then try to deduce the correct server
823 from SEARCH-STRING. With argument, prompt for whois server."
824 (interactive "P\nsWhois: ")
825 (let* ((whois-apropos-host (if whois-guess-server
826 (rassoc (whois-get-tld search-string)
827 whois-server-tld)
828 nil))
829 (server-name (if whois-apropos-host
830 (car whois-apropos-host)
831 whois-server-name))
832 (host
833 (if arg
834 (completing-read "Whois server name: "
835 whois-server-list nil nil "whois.")
836 server-name)))
837 (run-network-program
838 "Whois"
839 host
840 (cdr (assoc 'whois network-connection-service-alist))
841 search-string)))
843 (defcustom whois-reverse-lookup-server "whois.arin.net"
844 "Server which provides inverse DNS mapping."
845 :group 'net-utils
846 :type 'string)
848 ;;;###autoload
849 (defun whois-reverse-lookup ()
850 (interactive)
851 (let ((whois-server-name whois-reverse-lookup-server))
852 (call-interactively 'whois)))
854 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
855 ;;; General Network connection
856 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
858 ;; Using a derived mode gives us keymaps, hooks, etc.
859 (define-derived-mode
860 network-connection-mode comint-mode "Network-Connection"
861 "Major mode for interacting with the network-connection program.")
863 (defun network-connection-mode-setup (host service)
864 (make-local-variable 'network-connection-host)
865 (setq network-connection-host host)
866 (make-local-variable 'network-connection-service)
867 (setq network-connection-service service))
869 ;;;###autoload
870 (defun network-connection-to-service (host service)
871 "Open a network connection to SERVICE on HOST."
872 (interactive
873 (list
874 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
875 (completing-read "Service: "
876 (mapcar
877 (function
878 (lambda (elt)
879 (list (symbol-name (car elt)))))
880 network-connection-service-alist))))
881 (network-connection
882 host
883 (cdr (assoc (intern service) network-connection-service-alist))))
885 ;;;###autoload
886 (defun network-connection (host port)
887 "Open a network connection to HOST on PORT."
888 (interactive "sHost: \nnPort: ")
889 (network-service-connection host (number-to-string port)))
891 (defun network-service-connection (host service)
892 "Open a network connection to SERVICE on HOST."
893 (let* ((process-name (concat "Network Connection [" host " " service "]"))
894 (portnum (string-to-number service))
895 (buf (get-buffer-create (concat "*" process-name "*"))))
896 (or (zerop portnum) (setq service portnum))
897 (make-comint
898 process-name
899 (cons host service))
900 (set-buffer buf)
901 (network-connection-mode)
902 (network-connection-mode-setup host service)
903 (pop-to-buffer buf)))
905 (defvar comint-input-ring)
907 (defun network-connection-reconnect ()
908 "Reconnect a network connection, preserving the old input ring."
909 (interactive)
910 (let ((proc (get-buffer-process (current-buffer)))
911 (old-comint-input-ring comint-input-ring)
912 (host network-connection-host)
913 (service network-connection-service))
914 (if (not (or (not proc)
915 (eq (process-status proc) 'closed)))
916 (message "Still connected")
917 (goto-char (point-max))
918 (insert (format "Reopening connection to %s\n" host))
919 (network-connection host
920 (if (numberp service)
921 service
922 (cdr (assoc service network-connection-service-alist))))
923 (and old-comint-input-ring
924 (setq comint-input-ring old-comint-input-ring)))))
926 (provide 'net-utils)
928 ;;; net-utils.el ends here