comparison lisp/net/net-utils.el @ 32197:b949d342e936

(nslookup-prompt-regexp, ftp-prompt-regexp) (smbclient-prompt-regexp): Add usage note to doc string. (ftp-font-lock-keywords, smbclient-font-lock-keywords): Removed. (ftp-mode, smbclient-mode): Don't set `font-lock-defaults'. Use add-hook for adding the comint filter function, and only do so if it's not already in the global hook list. (ftp-mode, smbclient-mode, nslookup-mode): Remove redundant calls to `make-local-variable'. (nslookup-font-lock-keywords): Remove prompt entry. (nslookup): Don't set the process-filter. (finger): Exit the loop correctly when the regexps list runs out. (ftp, smbclient, smbclient-list-shares): Set the real major mode immediately, not after execing. Use `pop-to-buffer' instead of `switch-to-buffer-other-window'.

32196:219a95f2ef05

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

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

  :group 'net-utils
  :type  '(repeat string)
  )

(defcustom smbclient-prompt-regexp "^smb: \>"
  "Regexp which matches the smbclient program's prompt."
  :group 'net-utils
  :type  'regexp
  )

;; Internal variables

(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

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

;; Simplified versions of some at-point functions from ffap.el.
;; It's not worth loading all of ffap just for these.

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

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

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

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

				    (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)
    (while (not (string-match (car regexps) host))
      (setq regexps (cdr regexps)))
    (when regexps
      (setq user-and-host user))
    (run-network-program
     process-name

32197:b949d342e936

  :group 'net-utils
  :type  '(repeat string)
  )

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

This variable is only used if the variable
`comint-use-prompt-regexp-instead-of-fields' is non-nil."
  :group 'net-utils
  :type  'regexp
  )

(defcustom dig-program  "dig"

  :group 'net-utils
  :type  '(repeat string)
  )

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

This variable is only used if the variable
`comint-use-prompt-regexp-instead-of-fields' is non-nil."
  :group 'net-utils
  :type  'regexp
  )

(defcustom smbclient-program "smbclient"

  :group 'net-utils
  :type  '(repeat string)
  )

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

This variable is only used if the variable
`comint-use-prompt-regexp-instead-of-fields' is non-nil."
  :group 'net-utils
  :type  'regexp
  )

;; Internal variables

(defconst nslookup-font-lock-keywords
  (progn
    (require 'font-lock)
    (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

      0 font-lock-variable-name-face)
     ))
  "Expressions to font-lock for nslookup.")

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

;; Simplified versions of some at-point functions from ffap.el.
;; It's not worth loading all of ffap just for these.

(defun nslookup ()
  "Run nslookup program."
  (interactive)
  (require 'comint)
  (comint-run nslookup-program)
  (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)
  (setq comint-prompt-regexp nslookup-prompt-regexp)
  (setq comint-input-autoexpand t)
  )

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

    (read-from-minibuffer
     "Ftp to Host: " (net-utils-machine-at-point))))
  (require 'comint)
  (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
    (set-buffer buf)
    (ftp-mode)
    (comint-exec buf (concat "ftp-" host) ftp-program nil
		 (if ftp-program-options
		     (append (list host) ftp-program-options)
		   (list host)))
    (pop-to-buffer buf)))

(define-derived-mode ftp-mode comint-mode "FTP"
  "Major mode for interacting with the ftp program."
  (setq comint-prompt-regexp ftp-prompt-regexp)
  (setq comint-input-autoexpand t)
  ;; 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
	      nil t))
  (setq local-abbrev-table ftp-mode-abbrev-table)
  (abbrev-mode t)
  )

(define-abbrev ftp-mode-abbrev-table "q"    "quit")

  (require 'comint)
  (let* ((name (format "smbclient [%s\\%s]" host service))
	 (buf (get-buffer-create (concat "*" name "*")))
	 (service-name (concat "\\\\" host "\\" service)))
    (set-buffer buf)
    (smbclient-mode)
    (comint-exec buf name smbclient-program nil
		 (if smbclient-program-options
		     (append (list service-name) smbclient-program-options)
		   (list service-name)))
    (pop-to-buffer 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)
    (smbclient-mode)
    (comint-exec buf "smbclient-list-shares"
		 smbclient-program nil (list "-L" host))
    (pop-to-buffer buf)))

(define-derived-mode smbclient-mode comint-mode "smbclient"
  "Major mode for interacting with the smbclient program."
  (setq comint-prompt-regexp smbclient-prompt-regexp)
  (setq comint-input-autoexpand t)
  ;; 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
	      nil t))
  (setq local-abbrev-table smbclient-mode-abbrev-table)
  (abbrev-mode t)
  )

(define-abbrev smbclient-mode-abbrev-table "q"    "quit")

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

				    (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)
    (while (and regexps (not (string-match (car regexps) host)))
      (setq regexps (cdr regexps)))
    (when regexps
      (setq user-and-host user))
    (run-network-program
     process-name