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/>.
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.
41 ;; On some systems, some of these programs are not in normal user path,
42 ;; but rather in /sbin, /usr/sbin, and so on.
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; Customization Variables
49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 (defgroup net-utils nil
52 "Network utility functions."
57 (defcustom traceroute-program
58 (if (eq system-type
'windows-nt
)
61 "Program to trace network hops to a destination."
65 (defcustom traceroute-program-options nil
66 "Options for the traceroute program."
68 :type
'(repeat string
))
70 (defcustom ping-program
"ping"
71 "Program to send network test packets to a host."
75 ;; On GNU/Linux and Irix, the system's ping program seems to send packets
76 ;; indefinitely unless told otherwise
77 (defcustom ping-program-options
78 (and (memq system-type
'(gnu/linux irix
))
80 "Options for the ping program.
81 These options can be used to limit how many ICMP packets are emitted."
83 :type
'(repeat string
))
85 (define-obsolete-variable-alias 'ipconfig-program
'ifconfig-program
"22.2")
87 (defcustom ifconfig-program
88 (if (eq system-type
'windows-nt
)
91 "Program to print network configuration information."
95 (define-obsolete-variable-alias 'ipconfig-program-options
96 'ifconfig-program-options
"22.2")
98 (defcustom ifconfig-program-options
100 (if (eq system-type
'windows-nt
)
102 "Options for the ifconfig program."
104 :type
'(repeat string
))
106 (defcustom iwconfig-program
"iwconfig"
107 "Program to print wireless network configuration information."
112 (defcustom iwconfig-program-options nil
113 "Options for the iwconfig program."
115 :type
'(repeat string
)
118 (defcustom netstat-program
"netstat"
119 "Program to print network statistics."
123 (defcustom netstat-program-options
125 "Options for the netstat program."
127 :type
'(repeat string
))
129 (defcustom arp-program
"arp"
130 "Program to print IP to address translation tables."
134 (defcustom arp-program-options
136 "Options for the arp program."
138 :type
'(repeat string
))
140 (defcustom route-program
141 (if (eq system-type
'windows-nt
)
144 "Program to print routing tables."
148 (defcustom route-program-options
149 (if (eq system-type
'windows-nt
)
152 "Options for the route program."
154 :type
'(repeat string
))
156 (defcustom nslookup-program
"nslookup"
157 "Program to interactively query DNS information."
161 (defcustom nslookup-program-options nil
162 "Options for the nslookup program."
164 :type
'(repeat string
))
166 (defcustom nslookup-prompt-regexp
"^> "
167 "Regexp to match the nslookup prompt.
169 This variable is only used if the variable
170 `comint-use-prompt-regexp' is non-nil."
174 (defcustom dig-program
"dig"
175 "Program to query DNS information."
179 (defcustom ftp-program
"ftp"
180 "Program to run to do FTP transfers."
184 (defcustom ftp-program-options nil
185 "Options for the ftp program."
187 :type
'(repeat string
))
189 (defcustom ftp-prompt-regexp
"^ftp>"
190 "Regexp which matches the FTP program's prompt.
192 This variable is only used if the variable
193 `comint-use-prompt-regexp' is non-nil."
197 (defcustom smbclient-program
"smbclient"
202 (defcustom smbclient-program-options nil
203 "Options for the smbclient program."
205 :type
'(repeat string
))
207 (defcustom smbclient-prompt-regexp
"^smb: \>"
208 "Regexp which matches the smbclient program's prompt.
210 This variable is only used if the variable
211 `comint-use-prompt-regexp' is non-nil."
215 (defcustom dns-lookup-program
"host"
216 "Program to interactively query DNS information."
220 (defcustom dns-lookup-program-options nil
221 "Options for the dns-lookup program."
223 :type
'(repeat string
))
225 ;; Internal variables
226 (defvar network-connection-service nil
)
227 (defvar network-connection-host nil
)
229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
231 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233 (defvar nslookup-font-lock-keywords
235 (list "^[A-Za-z0-9 _]+:" 0 'font-lock-type-face
)
236 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>"
237 1 'font-lock-keyword-face
)
241 (make-list 4 "[0-9]+")
243 0 'font-lock-variable-name-face
)
246 (let ((host-expression "[-A-Za-z0-9]+"))
249 (make-list 2 host-expression
)
251 "\\(\\." host-expression
"\\)*"))
252 0 'font-lock-variable-name-face
))
253 "Expressions to font-lock for nslookup.")
255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
256 ;; General network utilities mode
257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259 (defvar net-utils-font-lock-keywords
263 (mapconcat 'identity
(make-list 4 "[0-9]+") "\\.")
264 0 'font-lock-variable-name-face
)
265 ;; Simple rfc4291 addresses
267 "\\( \\([[:xdigit:]]+\\(:\\|::\\)\\)+[[:xdigit:]]+\\)"
269 "\\(::[[:xdigit:]]+\\)")
270 0 'font-lock-variable-name-face
)
273 (let ((host-expression "[-A-Za-z0-9]+"))
275 (mapconcat 'identity
(make-list 2 host-expression
) "\\.")
276 "\\(\\." host-expression
"\\)*"))
277 0 'font-lock-variable-name-face
))
278 "Expressions to font-lock for general network utilities.")
280 (define-derived-mode net-utils-mode special-mode
"NetworkUtil"
281 "Major mode for interacting with an external network utility."
282 (set (make-local-variable 'font-lock-defaults
)
283 '((net-utils-font-lock-keywords)))
284 (setq-local revert-buffer-function
#'net-utils--revert-function
))
286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
290 ;; Simplified versions of some at-point functions from ffap.el.
291 ;; It's not worth loading all of ffap just for these.
292 (defun net-utils-machine-at-point ()
294 (buffer-substring-no-properties
296 (skip-chars-backward "-a-zA-Z0-9.")
299 (skip-chars-forward "-a-zA-Z0-9.")
300 (skip-chars-backward "." pt
)
303 (defun net-utils-url-at-point ()
305 (buffer-substring-no-properties
307 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
308 (skip-chars-forward "^A-Za-z0-9" pt
)
311 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
312 (skip-chars-backward ":;.,!?" pt
)
315 (defun net-utils-remove-ctrl-m-filter (process output-string
)
316 "Remove trailing control Ms."
317 (with-current-buffer (process-buffer process
)
319 (let ((inhibit-read-only t
)
320 (filtered-string output-string
))
321 (while (string-match "\r" filtered-string
)
322 (setq filtered-string
323 (replace-match "" nil nil filtered-string
)))
324 ;; Insert the text, moving the process-marker.
325 (goto-char (process-mark process
))
326 (insert filtered-string
)
327 (set-marker (process-mark process
) (point))))))
329 (declare-function w32-get-console-output-codepage
"w32proc.c" ())
331 (defun net-utils-run-program (name header program args
)
332 "Run a network information program."
333 (let ((buf (get-buffer-create (concat "*" name
"*")))
334 (coding-system-for-read
335 ;; MS-Windows versions of network utilities output text
336 ;; encoded in the console (a.k.a. "OEM") codepage, which is
337 ;; different from the default system (a.k.a. "ANSI")
339 (if (eq system-type
'windows-nt
)
340 (intern (format "cp%d" (w32-get-console-output-codepage)))
341 coding-system-for-read
)))
346 (apply 'start-process name buf program args
)
347 'net-utils-remove-ctrl-m-filter
)
351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
352 ;; General network utilities (diagnostic)
353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
355 ;; Todo: This data could be saved in a bookmark.
356 (defvar net-utils--revert-cmd nil
)
358 (defun net-utils-run-simple (buffer program-name args
&optional nodisplay
)
359 "Run a network utility for diagnostic output only."
360 (with-current-buffer (if (stringp buffer
) (get-buffer-create buffer
) buffer
)
361 (let ((proc (get-buffer-process (current-buffer))))
363 (set-process-filter proc nil
)
364 (delete-process proc
)))
365 (let ((inhibit-read-only t
)
366 (coding-system-for-read
367 ;; MS-Windows versions of network utilities output text
368 ;; encoded in the console (a.k.a. "OEM") codepage, which is
369 ;; different from the default system (a.k.a. "ANSI")
371 (if (eq system-type
'windows-nt
)
372 (intern (format "cp%d" (w32-get-console-output-codepage)))
373 coding-system-for-read
)))
376 (setq-local net-utils--revert-cmd
377 `(net-utils-run-simple ,(current-buffer)
378 ,program-name
,args nodisplay
))
380 (apply 'start-process program-name
381 (current-buffer) program-name args
)
382 'net-utils-remove-ctrl-m-filter
)
383 (unless nodisplay
(display-buffer (current-buffer)))))
385 (defun net-utils--revert-function (&optional ignore-auto noconfirm
)
386 (message "Reverting `%s'..." (buffer-name))
387 (apply (car net-utils--revert-cmd
) (cdr net-utils--revert-cmd
))
388 (let ((proc (get-buffer-process (current-buffer))))
390 (set-process-sentinel
392 (lambda (process event
)
393 (when (string= event
"finished\n")
394 (message "Reverting `%s' done" (process-buffer process
))))))))
398 "Run ifconfig and display diagnostic output."
400 (net-utils-run-simple
401 (format "*%s*" ifconfig-program
)
403 ifconfig-program-options
))
405 (defalias 'ipconfig
'ifconfig
)
409 "Run iwconfig and display diagnostic output."
411 (net-utils-run-simple
412 (format "*%s*" iwconfig-program
)
414 iwconfig-program-options
))
418 "Run netstat and display diagnostic output."
420 (net-utils-run-simple
421 (format "*%s*" netstat-program
)
423 netstat-program-options
))
427 "Run arp and display diagnostic output."
429 (net-utils-run-simple
430 (format "*%s*" arp-program
)
432 arp-program-options
))
436 "Run route and display diagnostic output."
438 (net-utils-run-simple
439 (format "*%s*" route-program
)
441 route-program-options
))
443 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
444 ;; Wrappers for external network programs
445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
448 (defun traceroute (target)
449 "Run traceroute program for TARGET."
450 (interactive "sTarget: ")
452 (if traceroute-program-options
453 (append traceroute-program-options
(list target
))
455 (net-utils-run-simple
456 (concat "Traceroute" " " target
)
463 If your system's ping continues until interrupted, you can try setting
464 `ping-program-options'."
466 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
468 (if ping-program-options
469 (append ping-program-options
(list host
))
471 (net-utils-run-program
472 (concat "Ping" " " host
)
473 (concat "** Ping ** " ping-program
" ** " host
)
477 ;; FIXME -- Needs to be a process filter
478 ;; (defun netstat-with-filter (filter)
479 ;; "Run netstat program."
480 ;; (interactive "sFilter: ")
482 ;; (set-buffer (get-buffer "*Netstat*"))
483 ;; (goto-char (point-min))
484 ;; (delete-matching-lines filter))
487 (defun nslookup-host (host)
488 "Lookup the DNS information for HOST."
490 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
492 (if nslookup-program-options
493 (append nslookup-program-options
(list host
))
495 (net-utils-run-program
499 (list "Nslookup" host nslookup-program
)
506 "Run nslookup program."
508 (switch-to-buffer (make-comint "nslookup" nslookup-program
))
511 (defvar comint-prompt-regexp
)
512 (defvar comint-input-autoexpand
)
514 (autoload 'comint-mode
"comint" nil t
)
516 (defvar nslookup-mode-map
517 (let ((map (make-sparse-keymap)))
518 (define-key map
"\t" 'completion-at-point
)
521 ;; Using a derived mode gives us keymaps, hooks, etc.
522 (define-derived-mode nslookup-mode comint-mode
"Nslookup"
523 "Major mode for interacting with the nslookup program."
525 (make-local-variable 'font-lock-defaults
)
526 '((nslookup-font-lock-keywords)))
527 (setq comint-prompt-regexp nslookup-prompt-regexp
)
528 (setq comint-input-autoexpand t
))
531 (defun dns-lookup-host (host)
532 "Lookup the DNS information for HOST (name or IP address)."
534 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
536 (if dns-lookup-program-options
537 (append dns-lookup-program-options
(list host
))
539 (net-utils-run-program
540 (concat "DNS Lookup [" host
"]")
543 (list "DNS Lookup" host dns-lookup-program
)
548 (autoload 'ffap-string-at-point
"ffap")
551 (defun run-dig (host)
555 (read-from-minibuffer "Lookup host: "
556 (or (ffap-string-at-point 'machine
) ""))))
557 (net-utils-run-program
561 (list "Dig" host dig-program
)
566 (autoload 'comint-exec
"comint")
568 ;; This is a lot less than ange-ftp, but much simpler.
574 (read-from-minibuffer
575 "Ftp to Host: " (net-utils-machine-at-point))))
576 (let ((buf (get-buffer-create (concat "*ftp [" host
"]*"))))
579 (comint-exec buf
(concat "ftp-" host
) ftp-program nil
580 (if ftp-program-options
581 (append (list host
) ftp-program-options
)
583 (pop-to-buffer buf
)))
586 (let ((map (make-sparse-keymap)))
587 ;; Occasionally useful
588 (define-key map
"\t" 'completion-at-point
)
591 (define-derived-mode ftp-mode comint-mode
"FTP"
592 "Major mode for interacting with the ftp program."
593 (setq comint-prompt-regexp ftp-prompt-regexp
)
594 (setq comint-input-autoexpand t
)
595 ;; Only add the password-prompting hook if it's not already in the
596 ;; global hook list. This stands a small chance of losing, if it's
597 ;; later removed from the global list (very small, since any
598 ;; password prompts will probably immediately follow the initial
599 ;; connection), but it's better than getting prompted twice for the
601 (unless (memq 'comint-watch-for-password-prompt
602 (default-value 'comint-output-filter-functions
))
603 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
606 (defun smbclient (host service
)
607 "Connect to SERVICE on HOST via SMB."
610 (read-from-minibuffer
611 "Connect to Host: " (net-utils-machine-at-point))
612 (read-from-minibuffer "SMB Service: ")))
613 (let* ((name (format "smbclient [%s\\%s]" host service
))
614 (buf (get-buffer-create (concat "*" name
"*")))
615 (service-name (concat "\\\\" host
"\\" service
)))
618 (comint-exec buf name smbclient-program nil
619 (if smbclient-program-options
620 (append (list service-name
) smbclient-program-options
)
621 (list service-name
)))
622 (pop-to-buffer buf
)))
624 (defun smbclient-list-shares (host)
625 "List services on HOST."
628 (read-from-minibuffer
629 "Connect to Host: " (net-utils-machine-at-point))))
630 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host
))))
633 (comint-exec buf
"smbclient-list-shares"
634 smbclient-program nil
(list "-L" host
))
635 (pop-to-buffer buf
)))
637 (define-derived-mode smbclient-mode comint-mode
"smbclient"
638 "Major mode for interacting with the smbclient program."
639 (setq comint-prompt-regexp smbclient-prompt-regexp
)
640 (setq comint-input-autoexpand t
)
641 ;; Only add the password-prompting hook if it's not already in the
642 ;; global hook list. This stands a small chance of losing, if it's
643 ;; later removed from the global list (very small, since any
644 ;; password prompts will probably immediately follow the initial
645 ;; connection), but it's better than getting prompted twice for the
647 (unless (memq 'comint-watch-for-password-prompt
648 (default-value 'comint-output-filter-functions
))
649 (add-hook 'comint-output-filter-functions
'comint-watch-for-password-prompt
653 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
654 ;; Network Connections
655 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
657 ;; Full list is available at:
658 ;; http://www.iana.org/assignments/port-numbers
659 (defvar network-connection-service-alist
662 (cons 'active-users
11)
678 (cons 'netbios-name
137)
679 (cons 'netbios-data
139)
683 "Alist of services and associated TCP port numbers.
684 This list is not complete.")
687 (defun run-network-program (process-name host port
&optional initial-string
)
688 (let ((tcp-connection)
690 (setq buf
(get-buffer-create (concat "*" process-name
"*")))
694 (open-network-stream process-name buf host port
))
695 (error "Could not open connection to %s" host
))
697 (set-marker (process-mark tcp-connection
) (point-min))
698 (set-process-filter tcp-connection
'net-utils-remove-ctrl-m-filter
)
700 (process-send-string tcp-connection
701 (concat initial-string
"\r\n")))
702 (display-buffer buf
)))
704 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
706 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
708 (defcustom finger-X
.500-host-regexps nil
709 "A list of regular expressions matching host names.
710 If a host name passed to `finger' matches one of these regular
711 expressions, it is assumed to be a host that doesn't accept
712 queries of the form USER@HOST, and wants a query containing USER only."
714 :type
'(repeat regexp
)
719 (defun finger (user host
)
720 "Finger USER on HOST."
721 ;; One of those great interactive statements that's actually
722 ;; longer than the function call! The idea is that if the user
723 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
724 ;; host name. If we don't see an "@", we'll prompt for the host.
726 (let* ((answer (read-from-minibuffer "Finger User: "
727 (net-utils-url-at-point)))
728 (index (string-match (regexp-quote "@") answer
)))
730 (list (substring answer
0 index
)
731 (substring answer
(1+ index
)))
733 (read-from-minibuffer "At Host: "
734 (net-utils-machine-at-point))))))
735 (let* ((user-and-host (concat user
"@" host
))
736 (process-name (concat "Finger [" user-and-host
"]"))
737 (regexps finger-X
.500-host-regexps
)
740 (while (not (string-match (car regexps
) host
))
741 (setq regexps
(cdr regexps
)))
743 (setq user-and-host user
)))
747 (cdr (assoc 'finger network-connection-service-alist
))
750 (defcustom whois-server-name
"rs.internic.net"
751 "Default host name for the whois service."
755 (defcustom whois-server-list
756 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
757 ("rs.internic.net") ; domain related info
758 ("whois.publicinterestregistry.net")
765 "A list of whois servers that can be queried."
767 :type
'(repeat (list string
)))
769 ;; FIXME: modern whois clients include a much better tld <-> whois server
770 ;; list, Emacs should probably avoid specifying the server as the client
771 ;; will DTRT anyway... -rfr
772 (defcustom whois-server-tld
773 '(("rs.internic.net" .
"com")
774 ("whois.publicinterestregistry.net" .
"org")
775 ("whois.ripe.net" .
"be")
776 ("whois.ripe.net" .
"de")
777 ("whois.ripe.net" .
"dk")
778 ("whois.ripe.net" .
"it")
779 ("whois.ripe.net" .
"fi")
780 ("whois.ripe.net" .
"fr")
781 ("whois.ripe.net" .
"uk")
782 ("whois.apnic.net" .
"au")
783 ("whois.apnic.net" .
"ch")
784 ("whois.apnic.net" .
"hk")
785 ("whois.apnic.net" .
"jp")
786 ("whois.nic.gov" .
"gov")
787 ("whois.nic.mil" .
"mil"))
788 "Alist to map top level domains to whois servers."
790 :type
'(repeat (cons string string
)))
792 (defcustom whois-guess-server t
793 "If non-nil then whois will try to deduce the appropriate whois
794 server from the query. If the query doesn't look like a domain or hostname
795 then the server named by `whois-server-name' is used."
799 (defun whois-get-tld (host)
800 "Return the top level domain of `host', or nil if it isn't a domain name."
801 (let ((i (1- (length host
)))
802 (max-len (- (length host
) 5)))
803 (while (not (or (= i max-len
) (char-equal (aref host i
) ?.
)))
807 (substring host
(1+ i
)))))
811 (defun whois (arg search-string
)
812 "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
813 If `whois-guess-server' is non-nil, then try to deduce the correct server
814 from SEARCH-STRING. With argument, prompt for whois server."
815 (interactive "P\nsWhois: ")
816 (let* ((whois-apropos-host (if whois-guess-server
817 (rassoc (whois-get-tld search-string
)
820 (server-name (if whois-apropos-host
821 (car whois-apropos-host
)
825 (completing-read "Whois server name: "
826 whois-server-list nil nil
"whois.")
831 (cdr (assoc 'whois network-connection-service-alist
))
834 (defcustom whois-reverse-lookup-server
"whois.arin.net"
835 "Server which provides inverse DNS mapping."
840 (defun whois-reverse-lookup ()
842 (let ((whois-server-name whois-reverse-lookup-server
))
843 (call-interactively 'whois
)))
845 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
846 ;;; General Network connection
847 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
849 ;; Using a derived mode gives us keymaps, hooks, etc.
851 network-connection-mode comint-mode
"Network-Connection"
852 "Major mode for interacting with the network-connection program.")
854 (defun network-connection-mode-setup (host service
)
855 (make-local-variable 'network-connection-host
)
856 (setq network-connection-host host
)
857 (make-local-variable 'network-connection-service
)
858 (setq network-connection-service service
))
861 (defun network-connection-to-service (host service
)
862 "Open a network connection to SERVICE on HOST."
865 (read-from-minibuffer "Host: " (net-utils-machine-at-point))
866 (completing-read "Service: "
870 (list (symbol-name (car elt
)))))
871 network-connection-service-alist
))))
874 (cdr (assoc (intern service
) network-connection-service-alist
))))
877 (defun network-connection (host port
)
878 "Open a network connection to HOST on PORT."
879 (interactive "sHost: \nnPort: ")
880 (network-service-connection host
(number-to-string port
)))
882 (defun network-service-connection (host service
)
883 "Open a network connection to SERVICE on HOST."
884 (let* ((process-name (concat "Network Connection [" host
" " service
"]"))
885 (portnum (string-to-number service
))
886 (buf (get-buffer-create (concat "*" process-name
"*"))))
887 (or (zerop portnum
) (setq service portnum
))
892 (network-connection-mode)
893 (network-connection-mode-setup host service
)
894 (pop-to-buffer buf
)))
896 (defvar comint-input-ring
)
898 (defun network-connection-reconnect ()
899 "Reconnect a network connection, preserving the old input ring."
901 (let ((proc (get-buffer-process (current-buffer)))
902 (old-comint-input-ring comint-input-ring
)
903 (host network-connection-host
)
904 (service network-connection-service
))
905 (if (not (or (not proc
)
906 (eq (process-status proc
) 'closed
)))
907 (message "Still connected")
908 (goto-char (point-max))
909 (insert (format "Reopening connection to %s\n" host
))
910 (network-connection host
911 (if (numberp service
)
913 (cdr (assoc service network-connection-service-alist
))))
914 (and old-comint-input-ring
915 (setq comint-input-ring old-comint-input-ring
)))))
919 ;;; net-utils.el ends here