net-utils.el 25 KB
Newer Older
1
;;; net-utils.el --- network functions
Gerd Moellmann's avatar
Gerd Moellmann committed
2

3
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
5

Gerd Moellmann's avatar
Gerd Moellmann committed
6 7
;; Author:  Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Mar 16 1997
8
;; Keywords: network comm
Gerd Moellmann's avatar
Gerd Moellmann committed
9 10 11 12 13

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
14
;; the Free Software Foundation; either version 3, or (at your option)
Gerd Moellmann's avatar
Gerd Moellmann committed
15 16 17 18 19 20 21 22 23
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Gerd Moellmann's avatar
Gerd Moellmann committed
26 27

;;; Commentary:
28

Gerd Moellmann's avatar
Gerd Moellmann committed
29 30
;;
;; There are three main areas of functionality:
31
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
32 33 34
;; * Wrap common network utility programs (ping, traceroute, netstat,
;; nslookup, arp, route). Note that these wrappers are of the diagnostic
;; functions of these programs only.
35
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
36
;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
37
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
38 39 40 41 42 43 44
;; * Support connections to HOST/PORT, generally for debugging and the like.
;; In other words, for doing much the same thing as "telnet HOST PORT", and
;; then typing commands.
;;
;; PATHS
;;
;; On some systems, some of these programs are not in normal user path,
45
;; but rather in /sbin, /usr/sbin, and so on.
Gerd Moellmann's avatar
Gerd Moellmann committed
46 47 48 49 50 51 52 53 54 55 56 57


;;; Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup net-utils nil
  "Network utility functions."
  :prefix "net-utils-"
  :group 'comm
58
  :version "20.3")
Gerd Moellmann's avatar
Gerd Moellmann committed
59

60
(defcustom net-utils-remove-ctl-m
Gerd Moellmann's avatar
Gerd Moellmann committed
61 62 63
  (member system-type (list 'windows-nt 'msdos))
  "If non-nil, remove control-Ms from output."
  :group 'net-utils
64
  :type  'boolean)
Gerd Moellmann's avatar
Gerd Moellmann committed
65

66 67
(defcustom traceroute-program
  (if (eq system-type 'windows-nt)
Gerd Moellmann's avatar
Gerd Moellmann committed
68 69 70 71
      "tracert"
    "traceroute")
  "Program to trace network hops to a destination."
  :group 'net-utils
72
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
73 74 75 76

(defcustom traceroute-program-options nil
  "Options for the traceroute program."
  :group 'net-utils
77
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
78 79 80 81

(defcustom ping-program "ping"
  "Program to send network test packets to a host."
  :group 'net-utils
82
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
83

84
;; On GNU/Linux and Irix, the system's ping program seems to send packets
Gerd Moellmann's avatar
Gerd Moellmann committed
85
;; indefinitely unless told otherwise
86
(defcustom ping-program-options
Gerd Moellmann's avatar
Gerd Moellmann committed
87 88 89 90 91
  (and (memq system-type (list 'linux 'gnu/linux 'irix))
       (list "-c" "4"))
  "Options for the ping program.
These options can be used to limit how many ICMP packets are emitted."
  :group 'net-utils
92
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
93

94 95
(define-obsolete-variable-alias 'ipconfig-program 'ifconfig-program "22.2")

96
(defcustom ifconfig-program
Gerd Moellmann's avatar
Gerd Moellmann committed
97 98 99 100 101
  (if (eq system-type 'windows-nt)
      "ipconfig"
    "ifconfig")
  "Program to print network configuration information."
  :group 'net-utils
102
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
103

104
(defcustom ifconfig-program-options
105 106 107
  (list
   (if (eq system-type 'windows-nt)
       "/all" "-a"))
108
  "Options for the ifconfig program."
Gerd Moellmann's avatar
Gerd Moellmann committed
109
  :group 'net-utils
110
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
111

112 113 114
(defcustom iwconfig-program "iwconfig"
  "Program to print wireless network configuration information."
  :group 'net-utils
115 116
  :type 'string
  :version "23.1")
117

118 119 120
(define-obsolete-variable-alias 'ipconfig-program-options
  'ifconfig-program-options "22.2")

121
(defcustom iwconfig-program-options nil
122
 "Options for the iwconfig program."
123
 :group 'net-utils
124 125
 :type '(repeat string)
 :version "23.1")
126

127
(defcustom netstat-program "netstat"
Gerd Moellmann's avatar
Gerd Moellmann committed
128 129
  "Program to print network statistics."
  :group 'net-utils
130
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
131

132
(defcustom netstat-program-options
Gerd Moellmann's avatar
Gerd Moellmann committed
133
  (list "-a")
134
  "Options for the netstat program."
Gerd Moellmann's avatar
Gerd Moellmann committed
135
  :group 'net-utils
136
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
137

138
(defcustom arp-program "arp"
Gerd Moellmann's avatar
Gerd Moellmann committed
139 140
  "Program to print IP to address translation tables."
  :group 'net-utils
141
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
142

143
(defcustom arp-program-options
Gerd Moellmann's avatar
Gerd Moellmann committed
144
  (list "-a")
145
  "Options for the arp program."
Gerd Moellmann's avatar
Gerd Moellmann committed
146
  :group 'net-utils
147
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
148

149
(defcustom route-program
Gerd Moellmann's avatar
Gerd Moellmann committed
150 151 152 153 154
  (if (eq system-type 'windows-nt)
      "route"
    "netstat")
  "Program to print routing tables."
  :group 'net-utils
155
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
156

157
(defcustom route-program-options
Gerd Moellmann's avatar
Gerd Moellmann committed
158 159 160
  (if (eq system-type 'windows-nt)
      (list "print")
    (list "-r"))
161
  "Options for the route program."
Gerd Moellmann's avatar
Gerd Moellmann committed
162
  :group 'net-utils
163
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
164

165
(defcustom nslookup-program "nslookup"
Gerd Moellmann's avatar
Gerd Moellmann committed
166 167
  "Program to interactively query DNS information."
  :group 'net-utils
168
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
169

170 171
(defcustom nslookup-program-options nil
  "Options for the nslookup program."
Gerd Moellmann's avatar
Gerd Moellmann committed
172
  :group 'net-utils
173
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
174 175

(defcustom nslookup-prompt-regexp "^> "
176 177 178
  "Regexp to match the nslookup prompt.

This variable is only used if the variable
179
`comint-use-prompt-regexp' is non-nil."
Gerd Moellmann's avatar
Gerd Moellmann committed
180
  :group 'net-utils
181
  :type  'regexp)
Gerd Moellmann's avatar
Gerd Moellmann committed
182

183
(defcustom dig-program "dig"
Gerd Moellmann's avatar
Gerd Moellmann committed
184 185
  "Program to query DNS information."
  :group 'net-utils
186
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
187 188

(defcustom ftp-program "ftp"
189
  "Program to run to do FTP transfers."
Gerd Moellmann's avatar
Gerd Moellmann committed
190
  :group 'net-utils
191
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
192 193

(defcustom ftp-program-options nil
194
  "Options for the ftp program."
Gerd Moellmann's avatar
Gerd Moellmann committed
195
  :group 'net-utils
196
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
197 198

(defcustom ftp-prompt-regexp "^ftp>"
199 200 201
  "Regexp which matches the FTP program's prompt.

This variable is only used if the variable
202
`comint-use-prompt-regexp' is non-nil."
Gerd Moellmann's avatar
Gerd Moellmann committed
203
  :group 'net-utils
204
  :type  'regexp)
Gerd Moellmann's avatar
Gerd Moellmann committed
205 206 207 208

(defcustom smbclient-program "smbclient"
  "Smbclient program."
  :group 'net-utils
209
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
210 211

(defcustom smbclient-program-options nil
212
  "Options for the smbclient program."
Gerd Moellmann's avatar
Gerd Moellmann committed
213
  :group 'net-utils
214
  :type  '(repeat string))
Gerd Moellmann's avatar
Gerd Moellmann committed
215 216

(defcustom smbclient-prompt-regexp "^smb: \>"
217 218 219
  "Regexp which matches the smbclient program's prompt.

This variable is only used if the variable
220
`comint-use-prompt-regexp' is non-nil."
Gerd Moellmann's avatar
Gerd Moellmann committed
221
  :group 'net-utils
222
  :type  'regexp)
Gerd Moellmann's avatar
Gerd Moellmann committed
223

224
(defcustom dns-lookup-program "host"
Peter Breton's avatar
Peter Breton committed
225 226
  "Program to interactively query DNS information."
  :group 'net-utils
227
  :type  'string)
Peter Breton's avatar
Peter Breton committed
228

229 230
(defcustom dns-lookup-program-options nil
  "Options for the dns-lookup program."
Peter Breton's avatar
Peter Breton committed
231
  :group 'net-utils
232
  :type  '(repeat string))
Peter Breton's avatar
Peter Breton committed
233

234 235 236 237
;; Internal variables
(defvar network-connection-service nil)
(defvar network-connection-host    nil)

Gerd Moellmann's avatar
Gerd Moellmann committed
238 239 240 241 242
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Nslookup goodies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst nslookup-font-lock-keywords
243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261
  (list
   (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face)
   (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
         1 'font-lock-keyword-face)
   ;; Dotted quads
   (list
    (mapconcat 'identity
               (make-list 4 "[0-9]+")
               "\\.")
    0 'font-lock-variable-name-face)
   ;; Host names
   (list
    (let ((host-expression "[-A-Za-z0-9]+"))
      (concat
       (mapconcat 'identity
                  (make-list 2 host-expression)
                  "\\.")
       "\\(\\." host-expression "\\)*"))
    0 'font-lock-variable-name-face))
262
  "Expressions to font-lock for nslookup.")
Gerd Moellmann's avatar
Gerd Moellmann committed
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Simplified versions of some at-point functions from ffap.el.
;; It's not worth loading all of ffap just for these.
(defun net-utils-machine-at-point ()
  (let ((pt (point)))
    (buffer-substring-no-properties
     (save-excursion
       (skip-chars-backward "-a-zA-Z0-9.")
       (point))
     (save-excursion
       (skip-chars-forward "-a-zA-Z0-9.")
       (skip-chars-backward "." pt)
       (point)))))

(defun net-utils-url-at-point ()
  (let ((pt (point)))
    (buffer-substring-no-properties
     (save-excursion
       (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
       (skip-chars-forward "^A-Za-z0-9" pt)
       (point))
     (save-excursion
       (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
       (skip-chars-backward ":;.,!?" pt)
       (point)))))


(defun net-utils-remove-ctrl-m-filter (process output-string)
  "Remove trailing control Ms."
  (let ((old-buffer (current-buffer))
	(filtered-string output-string))
    (unwind-protect
	(let ((moving))
	  (set-buffer (process-buffer process))
	  (setq moving (= (point) (process-mark process)))
302

Gerd Moellmann's avatar
Gerd Moellmann committed
303 304 305 306 307 308 309 310 311 312 313
	  (while (string-match "\r" filtered-string)
	       (setq filtered-string
		     (replace-match "" nil nil filtered-string)))

	  (save-excursion
	    ;; Insert the text, moving the process-marker.
	    (goto-char (process-mark process))
	    (insert filtered-string)
	    (set-marker (process-mark process) (point)))
	  (if moving (goto-char (process-mark process))))
      (set-buffer old-buffer))))
314

315
(defun net-utils-run-program (name header program args)
Gerd Moellmann's avatar
Gerd Moellmann committed
316
  "Run a network information program."
317 318 319 320 321 322 323 324 325
  (let ((buf (get-buffer-create (concat "*" name "*"))))
    (set-buffer buf)
    (erase-buffer)
    (insert header "\n")
    (set-process-filter
     (apply 'start-process name buf program args)
     'net-utils-remove-ctrl-m-filter)
    (display-buffer buf)
    buf))
Gerd Moellmann's avatar
Gerd Moellmann committed
326 327 328 329 330 331 332 333 334

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Wrappers for external network programs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;###autoload
(defun traceroute (target)
  "Run traceroute program for TARGET."
  (interactive "sTarget: ")
335
  (let ((options
Gerd Moellmann's avatar
Gerd Moellmann committed
336 337 338 339 340 341 342
	 (if traceroute-program-options
	     (append traceroute-program-options (list target))
	   (list target))))
    (net-utils-run-program
     (concat "Traceroute" " " target)
     (concat "** Traceroute ** " traceroute-program " ** " target)
     traceroute-program
343
     options)))
Gerd Moellmann's avatar
Gerd Moellmann committed
344 345 346 347

;;;###autoload
(defun ping (host)
  "Ping HOST.
348
If your system's ping continues until interrupted, you can try setting
Gerd Moellmann's avatar
Gerd Moellmann committed
349
`ping-program-options'."
350
  (interactive
Gerd Moellmann's avatar
Gerd Moellmann committed
351
   (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
352
  (let ((options
Gerd Moellmann's avatar
Gerd Moellmann committed
353 354 355 356 357 358 359
	 (if ping-program-options
	     (append ping-program-options (list host))
	   (list host))))
    (net-utils-run-program
     (concat "Ping" " " host)
     (concat "** Ping ** " ping-program " ** " host)
     ping-program
360
     options)))
Gerd Moellmann's avatar
Gerd Moellmann committed
361 362

;;;###autoload
363 364
(defun ifconfig ()
  "Run ifconfig program."
Gerd Moellmann's avatar
Gerd Moellmann committed
365 366
  (interactive)
  (net-utils-run-program
367 368 369 370
   "Ifconfig"
   (concat "** Ifconfig ** " ifconfig-program " ** ")
   ifconfig-program
   ifconfig-program-options))
Gerd Moellmann's avatar
Gerd Moellmann committed
371

372
;; Windows uses this name.
Gerd Moellmann's avatar
Gerd Moellmann committed
373
;;;###autoload
374
(defalias 'ipconfig 'ifconfig)
Gerd Moellmann's avatar
Gerd Moellmann committed
375

376 377 378 379 380 381 382 383 384 385
;;;###autoload
(defun iwconfig ()
  "Run iwconfig program."
  (interactive)
  (net-utils-run-program
   "Iwconfig"
   (concat "** Iwconfig ** " iwconfig-program " ** ")
   iwconfig-program
   iwconfig-program-options))

Gerd Moellmann's avatar
Gerd Moellmann committed
386 387 388 389 390 391 392 393
;;;###autoload
(defun netstat ()
  "Run netstat program."
  (interactive)
  (net-utils-run-program
   "Netstat"
   (concat "** Netstat ** " netstat-program " ** ")
   netstat-program
394
   netstat-program-options))
Gerd Moellmann's avatar
Gerd Moellmann committed
395 396 397

;;;###autoload
(defun arp ()
398
  "Run arp program."
Gerd Moellmann's avatar
Gerd Moellmann committed
399 400 401 402 403
  (interactive)
  (net-utils-run-program
   "Arp"
   (concat "** Arp ** " arp-program " ** ")
   arp-program
404
   arp-program-options))
Gerd Moellmann's avatar
Gerd Moellmann committed
405 406 407

;;;###autoload
(defun route ()
408
  "Run route program."
Gerd Moellmann's avatar
Gerd Moellmann committed
409 410 411 412 413
  (interactive)
  (net-utils-run-program
   "Route"
   (concat "** Route ** " route-program " ** ")
   route-program
414
   route-program-options))
Gerd Moellmann's avatar
Gerd Moellmann committed
415 416 417 418 419 420 421 422

;; FIXME -- Needs to be a process filter
;; (defun netstat-with-filter (filter)
;;   "Run netstat program."
;;   (interactive "sFilter: ")
;;   (netstat)
;;   (set-buffer (get-buffer "*Netstat*"))
;;   (goto-char (point-min))
423
;;   (delete-matching-lines filter))
Gerd Moellmann's avatar
Gerd Moellmann committed
424 425 426 427 428 429

;;;###autoload
(defun nslookup-host (host)
  "Lookup the DNS information for HOST."
  (interactive
   (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
430
  (let ((options
Gerd Moellmann's avatar
Gerd Moellmann committed
431 432 433 434 435 436 437 438 439 440
	 (if nslookup-program-options
	     (append nslookup-program-options (list host))
	   (list host))))
    (net-utils-run-program
     "Nslookup"
     (concat "** "
      (mapconcat 'identity
		(list "Nslookup" host nslookup-program)
		" ** "))
     nslookup-program
441
     options)))
Gerd Moellmann's avatar
Gerd Moellmann committed
442 443 444 445 446 447

;;;###autoload
(defun nslookup ()
  "Run nslookup program."
  (interactive)
  (comint-run nslookup-program)
448
  (nslookup-mode))
Gerd Moellmann's avatar
Gerd Moellmann committed
449

450 451 452 453 454
(defvar comint-prompt-regexp)
(defvar comint-input-autoexpand)

(autoload 'comint-mode "comint" nil t)

Gerd Moellmann's avatar
Gerd Moellmann committed
455
;; Using a derived mode gives us keymaps, hooks, etc.
456
(define-derived-mode nslookup-mode comint-mode "Nslookup"
Gerd Moellmann's avatar
Gerd Moellmann committed
457
  "Major mode for interacting with the nslookup program."
458
  (set
Gerd Moellmann's avatar
Gerd Moellmann committed
459 460 461
   (make-local-variable 'font-lock-defaults)
   '((nslookup-font-lock-keywords)))
  (setq comint-prompt-regexp nslookup-prompt-regexp)
462
  (setq comint-input-autoexpand t))
Gerd Moellmann's avatar
Gerd Moellmann committed
463 464 465

(define-key nslookup-mode-map "\t" 'comint-dynamic-complete)

Peter Breton's avatar
Peter Breton committed
466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481
;;;###autoload
(defun dns-lookup-host (host)
  "Lookup the DNS information for HOST (name or IP address)."
  (interactive
   (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
  (let ((options
	 (if dns-lookup-program-options
	     (append dns-lookup-program-options (list host))
	   (list host))))
    (net-utils-run-program
     (concat "DNS Lookup [" host "]")
     (concat "** "
      (mapconcat 'identity
		(list "DNS Lookup" host dns-lookup-program)
		" ** "))
     dns-lookup-program
482 483 484
     options)))

(autoload 'ffap-string-at-point "ffap")
Peter Breton's avatar
Peter Breton committed
485

Gerd Moellmann's avatar
Gerd Moellmann committed
486
;;;###autoload
487
(defun run-dig (host)
Gerd Moellmann's avatar
Gerd Moellmann committed
488 489 490
  "Run dig program."
  (interactive
   (list
491 492
    (read-from-minibuffer "Lookup host: "
                          (or (ffap-string-at-point 'machine) ""))))
Gerd Moellmann's avatar
Gerd Moellmann committed
493 494 495 496 497 498 499
  (net-utils-run-program
   "Dig"
   (concat "** "
	   (mapconcat 'identity
		      (list "Dig" host dig-program)
		      " ** "))
   dig-program
500
   (list host)))
Gerd Moellmann's avatar
Gerd Moellmann committed
501

502 503
(autoload 'comint-exec "comint")

Gerd Moellmann's avatar
Gerd Moellmann committed
504 505 506 507
;; This is a lot less than ange-ftp, but much simpler.
;;;###autoload
(defun ftp (host)
  "Run ftp program."
508
  (interactive
Gerd Moellmann's avatar
Gerd Moellmann committed
509
   (list
510
    (read-from-minibuffer
Gerd Moellmann's avatar
Gerd Moellmann committed
511 512 513
     "Ftp to Host: " (net-utils-machine-at-point))))
  (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
    (set-buffer buf)
514
    (ftp-mode)
Gerd Moellmann's avatar
Gerd Moellmann committed
515 516 517 518
    (comint-exec buf (concat "ftp-" host) ftp-program nil
		 (if ftp-program-options
		     (append (list host) ftp-program-options)
		   (list host)))
519
    (pop-to-buffer buf)))
Gerd Moellmann's avatar
Gerd Moellmann committed
520

521
(define-derived-mode ftp-mode comint-mode "FTP"
Gerd Moellmann's avatar
Gerd Moellmann committed
522 523 524
  "Major mode for interacting with the ftp program."
  (setq comint-prompt-regexp ftp-prompt-regexp)
  (setq comint-input-autoexpand t)
525 526 527 528 529 530 531 532 533
  ;; Only add the password-prompting hook if it's not already in the
  ;; global hook list.  This stands a small chance of losing, if it's
  ;; later removed from the global list (very small, since any
  ;; password prompts will probably immediately follow the initial
  ;; connection), but it's better than getting prompted twice for the
  ;; same password.
  (unless (memq 'comint-watch-for-password-prompt
		(default-value 'comint-output-filter-functions))
    (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
534
	      nil t)))
Gerd Moellmann's avatar
Gerd Moellmann committed
535 536 537 538 539 540

;; Occasionally useful
(define-key ftp-mode-map "\t" 'comint-dynamic-complete)

(defun smbclient (host service)
  "Connect to SERVICE on HOST via SMB."
541
  (interactive
Gerd Moellmann's avatar
Gerd Moellmann committed
542
   (list
543
    (read-from-minibuffer
Gerd Moellmann's avatar
Gerd Moellmann committed
544 545 546 547 548 549
     "Connect to Host: " (net-utils-machine-at-point))
    (read-from-minibuffer "SMB Service: ")))
  (let* ((name (format "smbclient [%s\\%s]" host service))
	 (buf (get-buffer-create (concat "*" name "*")))
	 (service-name (concat "\\\\" host "\\" service)))
    (set-buffer buf)
550
    (smbclient-mode)
Gerd Moellmann's avatar
Gerd Moellmann committed
551 552 553 554
    (comint-exec buf name smbclient-program nil
		 (if smbclient-program-options
		     (append (list service-name) smbclient-program-options)
		   (list service-name)))
555
    (pop-to-buffer buf)))
Gerd Moellmann's avatar
Gerd Moellmann committed
556 557 558

(defun smbclient-list-shares (host)
  "List services on HOST."
559
  (interactive
Gerd Moellmann's avatar
Gerd Moellmann committed
560
   (list
561
    (read-from-minibuffer
562
     "Connect to Host: " (net-utils-machine-at-point))))
Gerd Moellmann's avatar
Gerd Moellmann committed
563 564 565
  (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
    (set-buffer buf)
    (smbclient-mode)
566 567 568
    (comint-exec buf "smbclient-list-shares"
		 smbclient-program nil (list "-L" host))
    (pop-to-buffer buf)))
569

570
(define-derived-mode smbclient-mode comint-mode "smbclient"
Gerd Moellmann's avatar
Gerd Moellmann committed
571 572 573
  "Major mode for interacting with the smbclient program."
  (setq comint-prompt-regexp smbclient-prompt-regexp)
  (setq comint-input-autoexpand t)
574 575 576 577 578 579 580 581 582
  ;; Only add the password-prompting hook if it's not already in the
  ;; global hook list.  This stands a small chance of losing, if it's
  ;; later removed from the global list (very small, since any
  ;; password prompts will probably immediately follow the initial
  ;; connection), but it's better than getting prompted twice for the
  ;; same password.
  (unless (memq 'comint-watch-for-password-prompt
		(default-value 'comint-output-filter-functions))
    (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
583
	      nil t)))
Gerd Moellmann's avatar
Gerd Moellmann committed
584 585 586 587 588 589 590


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Network Connections
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Full list is available at:
Richard M. Stallman's avatar
Richard M. Stallman committed
591
;; http://www.iana.org/assignments/port-numbers
592
(defvar network-connection-service-alist
Gerd Moellmann's avatar
Gerd Moellmann committed
593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614
  (list
    (cons 'echo          7)
    (cons 'active-users 11)
    (cons 'daytime      13)
    (cons 'chargen      19)
    (cons 'ftp          21)
    (cons 'telnet	23)
    (cons 'smtp		25)
    (cons 'time		37)
    (cons 'whois        43)
    (cons 'gopher       70)
    (cons 'finger       79)
    (cons 'www		80)
    (cons 'pop2		109)
    (cons 'pop3		110)
    (cons 'sun-rpc	111)
    (cons 'nntp		119)
    (cons 'ntp		123)
    (cons 'netbios-name 137)
    (cons 'netbios-data 139)
    (cons 'irc		194)
    (cons 'https	443)
615
    (cons 'rlogin	513))
Gerd Moellmann's avatar
Gerd Moellmann committed
616
  "Alist of services and associated TCP port numbers.
617 618
This list is not complete.")

619 620 621 622 623
;; Workhorse routine
(defun run-network-program (process-name host port &optional initial-string)
  (let ((tcp-connection)
	(buf))
    (setq buf (get-buffer-create (concat "*" process-name "*")))
Gerd Moellmann's avatar
Gerd Moellmann committed
624
    (set-buffer buf)
625
    (or
Gerd Moellmann's avatar
Gerd Moellmann committed
626
     (setq tcp-connection
627 628
	   (open-network-stream process-name buf host port))
     (error "Could not open connection to %s" host))
Gerd Moellmann's avatar
Gerd Moellmann committed
629 630 631
    (erase-buffer)
    (set-marker (process-mark tcp-connection) (point-min))
    (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
632
    (and initial-string
633
	 (process-send-string tcp-connection
634
			      (concat initial-string "\r\n")))
Gerd Moellmann's avatar
Gerd Moellmann committed
635 636 637 638 639 640
    (display-buffer buf)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simple protocols
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

641 642 643 644 645 646 647 648 649
(defcustom finger-X.500-host-regexps nil
  "A list of regular expressions matching host names.
If a host name passed to `finger' matches one of these regular
expressions, it is assumed to be a host that doesn't accept
queries of the form USER@HOST, and wants a query containing USER only."
  :group 'net-utils
  :type '(repeat regexp)
  :version "21.1")

Gerd Moellmann's avatar
Gerd Moellmann committed
650 651 652 653 654 655 656 657 658 659 660 661 662
;; Finger protocol
;;;###autoload
(defun finger (user host)
  "Finger USER on HOST."
  ;; One of those great interactive statements that's actually
  ;; longer than the function call! The idea is that if the user
  ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
  ;; host name. If we don't see an "@", we'll prompt for the host.
  (interactive
    (let* ((answer (read-from-minibuffer "Finger User: "
					 (net-utils-url-at-point)))
	   (index  (string-match (regexp-quote "@") answer)))
      (if index
663 664 665 666 667 668 669 670 671
	  (list (substring answer 0 index)
		(substring answer (1+ index)))
	(list answer
	      (read-from-minibuffer "At Host: "
				    (net-utils-machine-at-point))))))
  (let* ((user-and-host (concat user "@" host))
	 (process-name (concat "Finger [" user-and-host "]"))
	 (regexps finger-X.500-host-regexps)
	 found)
Peter Breton's avatar
Peter Breton committed
672 673 674 675 676
    (and regexps
	 (while (not (string-match (car regexps) host))
	   (setq regexps (cdr regexps)))
	 (when regexps
	   (setq user-and-host user)))
677 678 679
    (run-network-program
     process-name
     host
Gerd Moellmann's avatar
Gerd Moellmann committed
680
     (cdr (assoc 'finger network-connection-service-alist))
681
     user-and-host)))
Gerd Moellmann's avatar
Gerd Moellmann committed
682 683 684 685

(defcustom whois-server-name "rs.internic.net"
  "Default host name for the whois service."
  :group 'net-utils
686
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
687 688 689 690

(defcustom whois-server-list
  '(("whois.arin.net")     ; Networks, ASN's, and related POC's (numbers)
    ("rs.internic.net")  ; domain related info
691
    ("whois.publicinterestregistry.net")
Gerd Moellmann's avatar
Gerd Moellmann committed
692 693 694 695 696 697 698 699 700 701
    ("whois.abuse.net")
    ("whois.apnic.net")
    ("nic.ddn.mil")
    ("whois.nic.mil")
    ("whois.nic.gov")
    ("whois.ripe.net"))
  "A list of whois servers that can be queried."
  :group 'net-utils
  :type '(repeat (list string)))

702 703 704
;; FIXME: modern whois clients include a much better tld <-> whois server
;; list, Emacs should probably avoid specifying the server as the client
;; will DTRT anyway... -rfr
Gerd Moellmann's avatar
Gerd Moellmann committed
705 706
(defcustom whois-server-tld
  '(("rs.internic.net" . "com")
707
    ("whois.publicinterestregistry.net" . "org")
Gerd Moellmann's avatar
Gerd Moellmann committed
708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727
    ("whois.ripe.net" . "be")
    ("whois.ripe.net" . "de")
    ("whois.ripe.net" . "dk")
    ("whois.ripe.net" . "it")
    ("whois.ripe.net" . "fi")
    ("whois.ripe.net" . "fr")
    ("whois.ripe.net" . "uk")
    ("whois.apnic.net" . "au")
    ("whois.apnic.net" . "ch")
    ("whois.apnic.net" . "hk")
    ("whois.apnic.net" . "jp")
    ("whois.nic.gov" . "gov")
    ("whois.nic.mil" . "mil"))
  "Alist to map top level domains to whois servers."
  :group 'net-utils
  :type '(repeat (cons string string)))

(defcustom whois-guess-server t
  "If non-nil then whois will try to deduce the appropriate whois
server from the query.  If the query doesn't look like a domain or hostname
728
then the server named by `whois-server-name' is used."
Gerd Moellmann's avatar
Gerd Moellmann committed
729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760
  :group 'net-utils
  :type 'boolean)

(defun whois-get-tld (host)
  "Return the top level domain of `host', or nil if it isn't a domain name."
  (let ((i (1- (length host)))
	(max-len (- (length host) 5)))
    (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
      (setq i (1- i)))
    (if (= i max-len)
	nil
      (substring host (1+ i)))))

;; Whois protocol
;;;###autoload
(defun whois (arg search-string)
  "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
If `whois-guess-server' is non-nil, then try to deduce the correct server
from SEARCH-STRING.  With argument, prompt for whois server."
  (interactive "P\nsWhois: ")
  (let* ((whois-apropos-host (if whois-guess-server
				 (rassoc (whois-get-tld search-string)
					 whois-server-tld)
			       nil))
	 (server-name (if whois-apropos-host
			  (car whois-apropos-host)
			whois-server-name))
	 (host
	  (if arg
	      (completing-read "Whois server name: "
			       whois-server-list nil nil "whois.")
	    server-name)))
761
    (run-network-program
Gerd Moellmann's avatar
Gerd Moellmann committed
762 763 764
     "Whois"
     host
     (cdr (assoc 'whois network-connection-service-alist))
765
     search-string)))
Gerd Moellmann's avatar
Gerd Moellmann committed
766 767 768 769

(defcustom whois-reverse-lookup-server "whois.arin.net"
  "Server which provides inverse DNS mapping."
  :group 'net-utils
770
  :type  'string)
Gerd Moellmann's avatar
Gerd Moellmann committed
771 772 773 774 775 776 777 778 779 780 781

;;;###autoload
(defun whois-reverse-lookup ()
  (interactive)
  (let ((whois-server-name whois-reverse-lookup-server))
    (call-interactively 'whois)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; General Network connection
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

782
;; Using a derived mode gives us keymaps, hooks, etc.
783
(define-derived-mode
784
  network-connection-mode comint-mode "Network-Connection"
785
  "Major mode for interacting with the network-connection program.")
786 787

(defun network-connection-mode-setup (host service)
788 789 790
  (make-local-variable 'network-connection-host)
  (setq network-connection-host host)
  (make-local-variable 'network-connection-service)
Pavel Janík's avatar
Pavel Janík committed
791
  (setq network-connection-service service))
792

Gerd Moellmann's avatar
Gerd Moellmann committed
793 794 795
;;;###autoload
(defun network-connection-to-service (host service)
  "Open a network connection to SERVICE on HOST."
796
  (interactive
Gerd Moellmann's avatar
Gerd Moellmann committed
797 798
   (list
    (read-from-minibuffer "Host: " (net-utils-machine-at-point))
799 800 801
    (completing-read "Service: "
		     (mapcar
		      (function
Gerd Moellmann's avatar
Gerd Moellmann committed
802 803 804
		       (lambda (elt)
			 (list (symbol-name (car elt)))))
		      network-connection-service-alist))))
805 806
  (network-connection
   host
807
   (cdr (assoc (intern service) network-connection-service-alist))))
Gerd Moellmann's avatar
Gerd Moellmann committed
808 809 810 811 812 813 814 815 816

;;;###autoload
(defun network-connection (host port)
  "Open a network connection to HOST on PORT."
  (interactive "sHost: \nnPort: ")
  (network-service-connection host (number-to-string port)))

(defun network-service-connection (host service)
  "Open a network connection to SERVICE on HOST."
817 818 819
  (let* ((process-name (concat "Network Connection [" host " " service "]"))
	 (portnum (string-to-number service))
	 (buf (get-buffer-create (concat "*" process-name "*"))))
Gerd Moellmann's avatar
Gerd Moellmann committed
820
    (or (zerop portnum) (setq service portnum))
821
    (make-comint
Gerd Moellmann's avatar
Gerd Moellmann committed
822 823
     process-name
     (cons host service))
824 825 826
    (set-buffer buf)
    (network-connection-mode)
    (network-connection-mode-setup host service)
827
    (pop-to-buffer buf)))
Gerd Moellmann's avatar
Gerd Moellmann committed
828

829 830
(defvar comint-input-ring)

831 832 833 834 835 836
(defun network-connection-reconnect  ()
  "Reconnect a network connection, preserving the old input ring."
  (interactive)
  (let ((proc (get-buffer-process (current-buffer)))
	(old-comint-input-ring comint-input-ring)
	(host network-connection-host)
837
	(service network-connection-service))
838 839 840 841 842 843
    (if (not (or (not proc)
		 (eq (process-status proc) 'closed)))
	(message "Still connected")
      (goto-char (point-max))
      (insert (format "Reopening connection to %s\n" host))
      (network-connection host
844 845 846
			  (if (numberp service)
			      service
			    (cdr (assoc service network-connection-service-alist))))
847
      (and old-comint-input-ring
848
	   (setq comint-input-ring old-comint-input-ring)))))
849

Gerd Moellmann's avatar
Gerd Moellmann committed
850 851
(provide 'net-utils)

852
;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314
Gerd Moellmann's avatar
Gerd Moellmann committed
853
;;; net-utils.el ends here