mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-18 10:16:51 +00:00
33cbd09103
(run-network-program): Changed backquotes to new style Added smbclient functions and variables
859 lines
23 KiB
EmacsLisp
859 lines
23 KiB
EmacsLisp
;;; net-utils.el --- Network functions
|
|
|
|
;; Author: Peter Breton <pbreton@cs.umb.edu>
|
|
;; Created: Sun Mar 16 1997
|
|
;; Keywords: network communications
|
|
;; Time-stamp: <1999-11-13 10:19:01 pbreton>
|
|
|
|
;; 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
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; 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
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; There are three main areas of functionality:
|
|
;;
|
|
;; * Wrap common network utility programs (ping, traceroute, netstat,
|
|
;; nslookup, arp, route). Note that these wrappers are of the diagnostic
|
|
;; functions of these programs only.
|
|
;;
|
|
;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
|
|
;;
|
|
;; * 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,
|
|
;; but rather in /sbin, /usr/sbin, and so on.
|
|
|
|
|
|
;;; Code:
|
|
(eval-when-compile
|
|
(require 'comint))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Customization Variables
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defgroup net-utils nil
|
|
"Network utility functions."
|
|
:prefix "net-utils-"
|
|
:group 'comm
|
|
:version "20.3"
|
|
)
|
|
|
|
(defcustom net-utils-remove-ctl-m
|
|
(member system-type (list 'windows-nt 'msdos))
|
|
"If non-nil, remove control-Ms from output."
|
|
:group 'net-utils
|
|
:type 'boolean
|
|
)
|
|
|
|
(defcustom traceroute-program
|
|
(if (eq system-type 'windows-nt)
|
|
"tracert"
|
|
"traceroute")
|
|
"Program to trace network hops to a destination."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom traceroute-program-options nil
|
|
"Options for the traceroute program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom ping-program "ping"
|
|
"Program to send network test packets to a host."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
;; On Linux and Irix, the system's ping program seems to send packets
|
|
;; indefinitely unless told otherwise
|
|
(defcustom ping-program-options
|
|
(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
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom ipconfig-program
|
|
(if (eq system-type 'windows-nt)
|
|
"ipconfig"
|
|
"ifconfig")
|
|
"Program to print network configuration information."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom ipconfig-program-options
|
|
(list
|
|
(if (eq system-type 'windows-nt)
|
|
"/all" "-a"))
|
|
"Options for ipconfig-program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom netstat-program "netstat"
|
|
"Program to print network statistics."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom netstat-program-options
|
|
(list "-a")
|
|
"Options for netstat-program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom arp-program "arp"
|
|
"Program to print IP to address translation tables."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom arp-program-options
|
|
(list "-a")
|
|
"Options for arp-program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom route-program
|
|
(if (eq system-type 'windows-nt)
|
|
"route"
|
|
"netstat")
|
|
"Program to print routing tables."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom route-program-options
|
|
(if (eq system-type 'windows-nt)
|
|
(list "print")
|
|
(list "-r"))
|
|
"Options for route-program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom nslookup-program "nslookup"
|
|
"Program to interactively query DNS information."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom nslookup-program-options nil
|
|
"List of options to pass to the nslookup program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom nslookup-prompt-regexp "^> "
|
|
"Regexp to match the nslookup prompt."
|
|
:group 'net-utils
|
|
:type 'regexp
|
|
)
|
|
|
|
(defcustom dig-program "dig"
|
|
"Program to query DNS information."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom ftp-program "ftp"
|
|
"Progam to run to do FTP transfers."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom ftp-program-options nil
|
|
"List of options to pass to the FTP program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom ftp-prompt-regexp "^ftp>"
|
|
"Regexp which matches the FTP program's prompt."
|
|
:group 'net-utils
|
|
:type 'regexp
|
|
)
|
|
|
|
(defcustom smbclient-program "smbclient"
|
|
"Smbclient program."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom smbclient-program-options nil
|
|
"List of options to pass to the smbclient program."
|
|
:group 'net-utils
|
|
:type '(repeat string)
|
|
)
|
|
|
|
(defcustom smbclient-prompt-regexp "^smb: \>"
|
|
"Regexp which matches the smbclient program's prompt."
|
|
:group 'net-utils
|
|
:type 'regexp
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Nslookup goodies
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defconst nslookup-font-lock-keywords
|
|
(and window-system
|
|
(progn
|
|
(require 'font-lock)
|
|
(list
|
|
(list nslookup-prompt-regexp 0 font-lock-reference-face)
|
|
(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)
|
|
)))
|
|
"Expressions to font-lock for nslookup.")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FTP goodies
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defconst ftp-font-lock-keywords
|
|
(and window-system
|
|
(progn
|
|
(require 'font-lock)
|
|
(list
|
|
(list ftp-prompt-regexp 0 font-lock-reference-face)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; smbclient goodies
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defconst smbclient-font-lock-keywords
|
|
(and window-system
|
|
(progn
|
|
(require 'font-lock)
|
|
(list
|
|
(list smbclient-prompt-regexp 0 font-lock-reference-face)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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)))
|
|
|
|
(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))))
|
|
|
|
(defmacro net-utils-run-program (name header program &rest args)
|
|
"Run a network information program."
|
|
` (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)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Wrappers for external network programs
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;###autoload
|
|
(defun traceroute (target)
|
|
"Run traceroute program for TARGET."
|
|
(interactive "sTarget: ")
|
|
(let ((options
|
|
(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
|
|
options
|
|
)))
|
|
|
|
;;;###autoload
|
|
(defun ping (host)
|
|
"Ping HOST.
|
|
If your system's ping continues until interrupted, you can try setting
|
|
`ping-program-options'."
|
|
(interactive
|
|
(list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
|
|
(let ((options
|
|
(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
|
|
options
|
|
)))
|
|
|
|
;;;###autoload
|
|
(defun ipconfig ()
|
|
"Run ipconfig program."
|
|
(interactive)
|
|
(net-utils-run-program
|
|
"Ipconfig"
|
|
(concat "** Ipconfig ** " ipconfig-program " ** ")
|
|
ipconfig-program
|
|
ipconfig-program-options
|
|
))
|
|
|
|
;; This is the normal name on most Unixes.
|
|
;;;###autoload
|
|
(defalias 'ifconfig 'ipconfig)
|
|
|
|
;;;###autoload
|
|
(defun netstat ()
|
|
"Run netstat program."
|
|
(interactive)
|
|
(net-utils-run-program
|
|
"Netstat"
|
|
(concat "** Netstat ** " netstat-program " ** ")
|
|
netstat-program
|
|
netstat-program-options
|
|
))
|
|
|
|
;;;###autoload
|
|
(defun arp ()
|
|
"Run the arp program."
|
|
(interactive)
|
|
(net-utils-run-program
|
|
"Arp"
|
|
(concat "** Arp ** " arp-program " ** ")
|
|
arp-program
|
|
arp-program-options
|
|
))
|
|
|
|
;;;###autoload
|
|
(defun route ()
|
|
"Run the route program."
|
|
(interactive)
|
|
(net-utils-run-program
|
|
"Route"
|
|
(concat "** Route ** " route-program " ** ")
|
|
route-program
|
|
route-program-options
|
|
))
|
|
|
|
;; 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))
|
|
;; (delete-matching-lines filter)
|
|
;; )
|
|
|
|
;;;###autoload
|
|
(defun nslookup-host (host)
|
|
"Lookup the DNS information for HOST."
|
|
(interactive
|
|
(list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
|
|
(let ((options
|
|
(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
|
|
options
|
|
)))
|
|
|
|
|
|
;;;###autoload
|
|
(defun nslookup ()
|
|
"Run nslookup program."
|
|
(interactive)
|
|
(require 'comint)
|
|
(comint-run nslookup-program)
|
|
(set-process-filter (get-buffer-process "*nslookup*")
|
|
'net-utils-remove-ctrl-m-filter)
|
|
(nslookup-mode)
|
|
)
|
|
|
|
;; Using a derived mode gives us keymaps, hooks, etc.
|
|
(define-derived-mode
|
|
nslookup-mode comint-mode "Nslookup"
|
|
"Major mode for interacting with the nslookup program."
|
|
(set
|
|
(make-local-variable 'font-lock-defaults)
|
|
'((nslookup-font-lock-keywords)))
|
|
(setq local-abbrev-table nslookup-mode-abbrev-table)
|
|
(abbrev-mode t)
|
|
(make-local-variable 'comint-prompt-regexp)
|
|
(setq comint-prompt-regexp nslookup-prompt-regexp)
|
|
(make-local-variable 'comint-input-autoexpand)
|
|
(setq comint-input-autoexpand t)
|
|
)
|
|
|
|
(define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
|
|
|
|
(define-abbrev nslookup-mode-abbrev-table "e" "exit")
|
|
(define-abbrev nslookup-mode-abbrev-table "f" "finger")
|
|
(define-abbrev nslookup-mode-abbrev-table "h" "help")
|
|
(define-abbrev nslookup-mode-abbrev-table "lse" "lserver")
|
|
(define-abbrev nslookup-mode-abbrev-table "q" "exit")
|
|
(define-abbrev nslookup-mode-abbrev-table "r" "root")
|
|
(define-abbrev nslookup-mode-abbrev-table "s" "set")
|
|
(define-abbrev nslookup-mode-abbrev-table "se" "server")
|
|
(define-abbrev nslookup-mode-abbrev-table "v" "viewer")
|
|
|
|
;;;###autoload
|
|
(defun dig (host)
|
|
"Run dig program."
|
|
(interactive
|
|
(list
|
|
(progn
|
|
(require 'ffap)
|
|
(read-from-minibuffer
|
|
"Lookup host: "
|
|
(or (ffap-string-at-point 'machine) "")))))
|
|
(net-utils-run-program
|
|
"Dig"
|
|
(concat "** "
|
|
(mapconcat 'identity
|
|
(list "Dig" host dig-program)
|
|
" ** "))
|
|
dig-program
|
|
(list host)
|
|
))
|
|
|
|
;; This is a lot less than ange-ftp, but much simpler.
|
|
;;;###autoload
|
|
(defun ftp (host)
|
|
"Run ftp program."
|
|
(interactive
|
|
(list
|
|
(read-from-minibuffer
|
|
"Ftp to Host: " (net-utils-machine-at-point))))
|
|
(require 'comint)
|
|
(let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
|
|
(set-buffer buf)
|
|
(comint-mode)
|
|
(comint-exec buf (concat "ftp-" host) ftp-program nil
|
|
(if ftp-program-options
|
|
(append (list host) ftp-program-options)
|
|
(list host)))
|
|
(ftp-mode)
|
|
(switch-to-buffer-other-window buf)
|
|
))
|
|
|
|
(define-derived-mode
|
|
ftp-mode comint-mode "FTP"
|
|
"Major mode for interacting with the ftp program."
|
|
|
|
(set
|
|
(make-local-variable 'font-lock-defaults)
|
|
'((ftp-font-lock-keywords)))
|
|
|
|
(make-local-variable 'comint-prompt-regexp)
|
|
(setq comint-prompt-regexp ftp-prompt-regexp)
|
|
|
|
(make-local-variable 'comint-input-autoexpand)
|
|
(setq comint-input-autoexpand t)
|
|
|
|
;; Already buffer local!
|
|
(setq comint-output-filter-functions
|
|
(list 'comint-watch-for-password-prompt))
|
|
|
|
(setq local-abbrev-table ftp-mode-abbrev-table)
|
|
(abbrev-mode t)
|
|
)
|
|
|
|
(define-abbrev ftp-mode-abbrev-table "q" "quit")
|
|
(define-abbrev ftp-mode-abbrev-table "g" "get")
|
|
(define-abbrev ftp-mode-abbrev-table "p" "prompt")
|
|
(define-abbrev ftp-mode-abbrev-table "anon" "anonymous")
|
|
|
|
;; Occasionally useful
|
|
(define-key ftp-mode-map "\t" 'comint-dynamic-complete)
|
|
|
|
(defun smbclient (host service)
|
|
"Connect to SERVICE on HOST via SMB."
|
|
(interactive
|
|
(list
|
|
(read-from-minibuffer
|
|
"Connect to Host: " (net-utils-machine-at-point))
|
|
(read-from-minibuffer "SMB Service: ")))
|
|
(require 'comint)
|
|
(let* ((name (format "smbclient [%s\\%s]" host service))
|
|
(buf (get-buffer-create (concat "*" name "*")))
|
|
(service-name (concat "\\\\" host "\\" service)))
|
|
(set-buffer buf)
|
|
(comint-mode)
|
|
(comint-exec buf name smbclient-program nil
|
|
(if smbclient-program-options
|
|
(append (list service-name) smbclient-program-options)
|
|
(list service-name)))
|
|
(smbclient-mode)
|
|
(switch-to-buffer-other-window buf)
|
|
))
|
|
|
|
(defun smbclient-list-shares (host)
|
|
"List services on HOST."
|
|
(interactive
|
|
(list
|
|
(read-from-minibuffer
|
|
"Connect to Host: " (net-utils-machine-at-point))
|
|
))
|
|
(let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
|
|
(set-buffer buf)
|
|
(comint-mode)
|
|
(comint-exec
|
|
buf
|
|
"smbclient-list-shares"
|
|
smbclient-program
|
|
nil
|
|
(list "-L" host)
|
|
)
|
|
(smbclient-mode)
|
|
(switch-to-buffer-other-window buf)))
|
|
|
|
(define-derived-mode
|
|
smbclient-mode comint-mode "smbclient"
|
|
"Major mode for interacting with the smbclient program."
|
|
|
|
(set
|
|
(make-local-variable 'font-lock-defaults)
|
|
'((smbclient-font-lock-keywords)))
|
|
|
|
(make-local-variable 'comint-prompt-regexp)
|
|
(setq comint-prompt-regexp smbclient-prompt-regexp)
|
|
|
|
(make-local-variable 'comint-input-autoexpand)
|
|
(setq comint-input-autoexpand t)
|
|
|
|
;; Already buffer local!
|
|
(setq comint-output-filter-functions
|
|
(list 'comint-watch-for-password-prompt))
|
|
|
|
(setq local-abbrev-table smbclient-mode-abbrev-table)
|
|
(abbrev-mode t)
|
|
)
|
|
|
|
(define-abbrev smbclient-mode-abbrev-table "q" "quit")
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Network Connections
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Full list is available at:
|
|
;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
|
|
(defvar network-connection-service-alist
|
|
(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)
|
|
(cons 'rlogin 513)
|
|
)
|
|
"Alist of services and associated TCP port numbers.
|
|
This list in not complete.")
|
|
|
|
;; Workhorse macro
|
|
(defmacro run-network-program (process-name host port
|
|
&optional initial-string)
|
|
`
|
|
(let ((tcp-connection)
|
|
(buf)
|
|
)
|
|
(setq buf (get-buffer-create (concat "*" ,process-name "*")))
|
|
(set-buffer buf)
|
|
(or
|
|
(setq tcp-connection
|
|
(open-network-stream
|
|
,process-name
|
|
buf
|
|
,host
|
|
,port
|
|
))
|
|
(error "Could not open connection to %s" ,host))
|
|
(erase-buffer)
|
|
(set-marker (process-mark tcp-connection) (point-min))
|
|
(set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
|
|
(and ,initial-string
|
|
(process-send-string tcp-connection
|
|
(concat ,initial-string "\r\n")))
|
|
(display-buffer buf)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Simple protocols
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; 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
|
|
(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 "]"))
|
|
)
|
|
(run-network-program
|
|
process-name
|
|
host
|
|
(cdr (assoc 'finger network-connection-service-alist))
|
|
user-and-host
|
|
)))
|
|
|
|
(defcustom whois-server-name "rs.internic.net"
|
|
"Default host name for the whois service."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
(defcustom whois-server-list
|
|
'(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers)
|
|
("rs.internic.net") ; domain related info
|
|
("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)))
|
|
|
|
(defcustom whois-server-tld
|
|
'(("rs.internic.net" . "com")
|
|
("rs.internic.net" . "org")
|
|
("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
|
|
then the server named by whois-server-name is used."
|
|
: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)))
|
|
(run-network-program
|
|
"Whois"
|
|
host
|
|
(cdr (assoc 'whois network-connection-service-alist))
|
|
search-string
|
|
)))
|
|
|
|
(defcustom whois-reverse-lookup-server "whois.arin.net"
|
|
"Server which provides inverse DNS mapping."
|
|
:group 'net-utils
|
|
:type 'string
|
|
)
|
|
|
|
;;;###autoload
|
|
(defun whois-reverse-lookup ()
|
|
(interactive)
|
|
(let ((whois-server-name whois-reverse-lookup-server))
|
|
(call-interactively 'whois)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; General Network connection
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;###autoload
|
|
(defun network-connection-to-service (host service)
|
|
"Open a network connection to SERVICE on HOST."
|
|
(interactive
|
|
(list
|
|
(read-from-minibuffer "Host: " (net-utils-machine-at-point))
|
|
(completing-read "Service: "
|
|
(mapcar
|
|
(function
|
|
(lambda (elt)
|
|
(list (symbol-name (car elt)))))
|
|
network-connection-service-alist))))
|
|
(network-connection
|
|
host
|
|
(cdr (assoc (intern service) network-connection-service-alist)))
|
|
)
|
|
|
|
;;;###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."
|
|
(require 'comint)
|
|
(let (
|
|
(process-name (concat "Network Connection [" host " " service "]"))
|
|
(portnum (string-to-number service))
|
|
)
|
|
(or (zerop portnum) (setq service portnum))
|
|
(make-comint
|
|
process-name
|
|
(cons host service))
|
|
(pop-to-buffer (get-buffer (concat "*" process-name "*")))
|
|
))
|
|
|
|
(provide 'net-utils)
|
|
|
|
;;; net-utils.el ends here
|