comparison lisp/net/net-utils.el @ 32123:2e9fda397ea2

* net/net-utils.el (nslookup-font-lock-keywords, ftp-font-lock-keywords, smbclient-font-lock-keywords): Only set if window-system is non-nil (net-utils-run-program): Returns buffer. (network-connection-reconnect): Added this function.

32122:034d1bf7a606

;;; net-utils.el --- Network functions

;; Author:  Peter Breton <[e-mail]>
;; 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

;; 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))

  :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

  :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)

  "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)
  )

  "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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Nslookup goodies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst nslookup-font-lock-keywords
  (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
  (progn
    (require 'font-lock)
    (list
     (list ftp-prompt-regexp 0 font-lock-reference-face))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; smbclient goodies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst smbclient-font-lock-keywords
  (progn
    (require 'font-lock)
    (list
     (list smbclient-prompt-regexp 0 font-lock-reference-face))))

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

	(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

	    (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)

     )))

;;;###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)

   ipconfig-program-options
   ))

;; This is the normal name on most Unixes.
;;;###autoload
(defalias 'ifconfig 'ipconfig) 

;;;###autoload
(defun netstat ()
  "Run netstat program."
  (interactive)

;;;###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"

   '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)

  "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)

		   (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")

;; 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 "*")))

    (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)

    )
  "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

	 found)
    (while (not (string-match (car regexps) host))
      (setq regexps (cdr regexps)))
    (when regexps
      (setq user-and-host user))
    (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."

	 (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
     )))

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

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

(defun network-connection-mode-setup (host service)
  (let ((network-abbrev-table
	 (or 
	  (assoc service network-connection-service-abbrev-alist)
	 (and (rassoc service network-connection-service-alist)
	      (assoc 
	       (elt (rassoc service network-connection-service-alist) 0)
	       network-connection-service-abbrev-alist)))))
    (make-local-variable 'network-connection-host)
    (setq network-connection-host host)
    (make-local-variable 'network-connection-service) 
    (setq network-connection-service service)
    (and network-abbrev-table
	 (setq local-abbrev-table (cdr network-abbrev-table))
	 (abbrev-mode t)
	 )))

;;;###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)

	(process-name (concat "Network Connection [" host " " service "]"))
	(portnum (string-to-number service))
	(buf (get-buffer-create (concat "*" process-name "*")))
	)
    (or (zerop portnum) (setq service portnum))
    (make-comint 
     process-name
     (cons host service))
    (set-buffer buf)
    (network-connection-mode)
    (network-connection-mode-setup host service)
    (pop-to-buffer buf)
    ))

(provide 'net-utils)

;;; net-utils.el ends here

32123:2e9fda397ea2

;;; net-utils.el --- Network functions

;; Author:  Peter Breton <[e-mail]>
;; Created: Sun Mar 16 1997
;; Keywords: network communications
;; Time-stamp: <2000-10-04 01:32:16 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

;; 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))

  :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

  :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)

  "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)
  )

  "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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	(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

	    (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)
      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)

     )))

;;;###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)

   ipconfig-program-options
   ))

;; This is the normal name on most Unixes.
;;;###autoload
(defalias 'ifconfig 'ipconfig)

;;;###autoload
(defun netstat ()
  "Run netstat program."
  (interactive)

;;;###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"

   '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)

  "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)

		   (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")

;; 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 "*")))

    (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)

    )
  "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

	 found)
    (while (not (string-match (car regexps) host))
      (setq regexps (cdr regexps)))
    (when regexps
      (setq user-and-host user))
    (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."

	 (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
     )))

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

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

(defun network-connection-mode-setup (host service)
  (let ((network-abbrev-table
	 (or
	  (assoc service network-connection-service-abbrev-alist)
	 (and (rassoc service network-connection-service-alist)
	      (assoc
	       (elt (rassoc service network-connection-service-alist) 0)
	       network-connection-service-abbrev-alist)))))
    (make-local-variable 'network-connection-host)
    (setq network-connection-host host)
    (make-local-variable 'network-connection-service)
    (setq network-connection-service service)
    (and network-abbrev-table
	 (setq local-abbrev-table (cdr network-abbrev-table))
	 (abbrev-mode t)
	 )))

;;;###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)

	(process-name (concat "Network Connection [" host " " service "]"))
	(portnum (string-to-number service))
	(buf (get-buffer-create (concat "*" process-name "*")))
	)
    (or (zerop portnum) (setq service portnum))
    (make-comint
     process-name
     (cons host service))
    (set-buffer buf)
    (network-connection-mode)
    (network-connection-mode-setup host service)
    (pop-to-buffer buf)
    ))

(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)
	(service network-connection-service)
	)
    (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
       (if (numberp service)
	   service
	 (cdr (assoc service network-connection-service-alist))))
      (and old-comint-input-ring
	   (setq comint-input-ring old-comint-input-ring))
      )))

(provide 'net-utils)

;;; net-utils.el ends here