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