[buug] dig-browser.el -- browse DNS zones in Emacs (alpha)
Ian Zimmerman
itz at speakeasy.org
Tue Dec 17 00:58:50 PST 2002
The following message is a courtesy copy of an article
that has been posted to gnu.emacs.sources as well.
;;; dig-browser.el --- a dired-style DNS zone browser
;; Copyright (C) 2002 Ian Zimmerman
;; Author: Ian Zimmerman <itz at speakeasy.org>
;; Created: Sat Dec 14 2002
;; Keywords: network communication domain zone
;; This file is NOT part of GNU Emacs. It is nevertheless distributed
;; under the same conditions:
;; 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:
;;
;; Originally I had the idea of wrapping dig (actually a clone whose output
;; is easier to parse) in a simple Gtk GUI program with just a clickable
;; tree control to represent the DNS info. But, it seemed a waste, because
;; there's really nothing graphical to this. And dired provided an excellent
;; example to follow.
;; still missing: sorting by various fields in resource records. The problem
;; is that Info document about sort-subr says:
;; Markers pointing into any sort records are left with no useful
;; position after `sort-subr' returns.
;; which of course ruins my whole parade with inserted subdomains. I will
;; ask around how this might be solved.
;;; Code:
(require 'thingatpt)
(require 'message)
(require 'net-utils)
;; customizations
(defgroup dig-browser nil
"DNS browsing through dig."
:prefix "dig-browser-"
:group 'net-utils
:version "21.2")
(defcustom dig-browser-local-server "localhost"
"DNS server to submit NS queries to."
:group 'dig-browser
:type 'string)
(defcustom dig-browser-port 53
"IP Port to connect to for DNS queries."
:group 'dig-browser
:type 'integer)
(defcustom dig-browser-srcaddr "0.0.0.0"
"IP source address to use for DNS queries."
:group 'dig-browser
:type 'string)
(defcustom dig-browser-retry 3
"Number of retries to use for DNS queries."
:group 'dig-browser
:type 'string)
(defcustom dig-browser-timeout 5
"Timeout in seconds to use for DNS queries."
:group 'dig-browser
:type 'string)
(defcustom dig-browser-extra-switches '("+tcp")
"Extra switches to pass to the dig program."
:group 'dig-browser
:type '(repeat string))
(defcustom dig-browser-subdomain-indent 2
"Number of spaces by which to indent expanded subdomains."
:group 'dig-browser
:type 'integer)
;; programmer variables
(defvar dig-browser-mode-hook nil
"Hook for functions to run in newly created Dig Browser mode buffers.")
(defvar dig-browser-before-fetch-hook nil
"Hook for functions to run in Dig Browser mode buffers before dig program runs.")
(defvar dig-browser-after-fetch-hook nil
"Hook for functions to run in Dig Browser mode buffers after dig program runs.")
(defvar dig-browser-before-insert-hook nil
"Hook for functions to run in Dig Browser mode buffers before RRs are inserted.")
(defvar dig-browser-after-insert-hook nil
"Hook for functions to run in Dig Browser mode buffers after RRs are inserted.")
(defconst dig-browser-font-lock-keywords
(list
(list "[ \t]NS[ \t]+\\([^ \t\n]+\\)$" 1 font-lock-function-name-face)
(list "[ \t]CNAME[ \t]+\\([^ \t\n]+\\)$" 1 font-lock-keyword-face)
(list "[ \t]IN[ \t]+MX[ \t]+\\(.*\\)$" 1 font-lock-string-face)
(list "[ \t]IN[ \t]+SOA[ \t]+\\(.*\\)$" 1 font-lock-type-face))
"Highlighting data for Dig Browser major mode.")
(defconst dig-browser-syntax-table
(let ((tbl (copy-syntax-table)))
(modify-syntax-entry ?- "_" tbl)
(modify-syntax-entry ?. "_" tbl)
tbl)
"Character syntax table to use in Dig Browser major mode.")
(defconst dig-browser-mode-map
(let ((kmap (make-sparse-keymap)))
(suppress-keymap kmap)
(define-key kmap "b" 'describe-bindings)
(define-key kmap "g" 'revert-buffer)
(define-key kmap "h" 'describe-mode)
(define-key kmap "i" 'dig-browser-expand)
(define-key kmap "j" 'dig-browser-goto-domain-at-point)
(define-key kmap "m" 'dig-browser-mail-hostmaster)
(define-key kmap "n" 'dig-browser-next-subdomain)
(define-key kmap "o" 'dig-browser-browse-other-window)
(define-key kmap "p" 'dig-browser-prev-subdomain)
(define-key kmap "q" 'quit-window)
(define-key kmap "u" 'dig-browser-up-tree)
(define-key kmap "^" 'dig-browser-browse-parent)
(define-key kmap "$" 'dig-browser-collapse)
(define-key kmap "\C-m" 'dig-browser-toggle-state)
kmap)
"Keymap to use in Dig Browser major mode.")
(defconst dig-browser-column-alist
(list '(domain . 0) '(ttl . 1) '(class . 2) '(type . 3) '(data . 4))
"Dictionary of column names for Dig Browser major mode.")
(defvar dig-browser-history nil
"History of user input for Dig Browser mode.")
;; internals
(defun dig-browser-make-rr (line)
"Create a resource record (a list with 5 members) from a line of dig(1) output."
(remove-text-properties 0 (length line) '(face nil fontified nil) line)
(let ((fields (split-string line)))
(list (nth 0 fields) (nth 1 fields) (nth 2 fields) (nth 3 fields)
(mapconcat 'identity (nthcdr 4 fields) " "))))
(defun dig-browser-query (domain &optional server type)
"Ask the DNS a question.
This is implemented by executing dig(1) as a synchronous subprocess,
and parsing its answer. If SERVER is nil, it defaults to the value
of `dig-browser-local-server' ; if TYPE is nil, it defaults to \"any\"."
(setq server (or server dig-browser-local-server))
(setq type (or type "any"))
(let ((b (get-buffer-create (concat " *dig @" server " " domain " " type "*")))
(records nil))
(with-current-buffer b
(erase-buffer)
(apply 'call-process dig-program nil t nil
(append
(list
(format "@%s" server)
"-p" (int-to-string dig-browser-port)
"-b" dig-browser-srcaddr
(concat "+tries=" (int-to-string dig-browser-retry))
(concat "+time=" (int-to-string dig-browser-timeout)))
dig-browser-extra-switches
(list domain type)))
(goto-char (point-min))
(cond
((re-search-forward "^;;[ \t]*->>HEADER<<-.* status: \\([A-Z]+\\)" nil t)
(let ((res (match-string 1)))
(if (not (string-equal res "NOERROR"))
(error "Dig error: %s" res))))
((re-search-forward "^;[ \t]*Transfer[ \t]+failed" nil t)
(error "Dig error: Transfer failed")))
(goto-char (point-max))
(while (re-search-backward "^[^; \t\n]" nil t)
(let ((line (thing-at-point 'line)))
(setq records (cons (dig-browser-make-rr line) records))))
records)))
(defun dig-browser-maybe-map (l p f)
"Apply F to each element of L that satisfies P, return the list of them."
(if (null l) nil
(let ((hd (car l)) (rest (dig-browser-maybe-map (cdr l) p f)))
(if (funcall p hd)
(cons (funcall f hd) rest)
rest))))
(defun dig-browser-fetch-servers (domain)
"Get the list of name servers authoritative for DOMAIN."
(dig-browser-maybe-map
(dig-browser-query domain nil "ns")
(lambda (rr)
(and
(string-equal (downcase domain) (downcase (nth 0 rr)))
(string-equal "ns" (downcase (nth 3 rr)))))
(lambda (rr) (list (nth 4 rr)))))
(defsubst dig-browser-fetch-zone (domain server)
"Get a list of resource records for the zone at DOMAIN.
This is implemented by a zone transfer (AXFR)."
(butlast (dig-browser-query domain server "axfr")))
(defun dig-browser-compute-widths (rrs)
"Compute the maximum widths of the various fields of resource records RRS."
(let ((widths (vector 0 0 0 0)))
(while rrs
(let* ((rr (car rrs))
(l0 (length (nth 0 rr)))
(l1 (length (nth 1 rr)))
(l2 (length (nth 2 rr)))
(l3 (length (nth 3 rr))))
(if (> l0 (aref widths 0)) (aset widths 0 l0))
(if (> l1 (aref widths 1)) (aset widths 1 l1))
(if (> l2 (aref widths 2)) (aset widths 2 l2))
(if (> l3 (aref widths 3)) (aset widths 3 l3)))
(setq rrs (cdr rrs)))
widths))
(defun dig-browser-insert-rrs (rrs server &optional level)
"Insert a textual representation of RRS at point in the current buffer.
If LEVEL is a positive number, indent all the records LEVEL times
`dig-browser-subdomain-indent' spaces, starting from column 0.
Also prepend a record to local variable `domain-intervals' remembering
the domain, level, buffer position, and server."
(setq level (or level 0))
(beginning-of-line)
(let ((indent (* level dig-browser-subdomain-indent))
(widths (dig-browser-compute-widths rrs))
(p (point))
(domain (caar rrs)))
(run-hooks 'dig-browser-before-insert-hook)
(while rrs
;; this is too slow for huge domains for some reason, even though I clear the markers
;; (let* ((rr (car rrs)) (r0 (nth 0 rr)) (r1 (nth 1 rr))
;; (r2 (nth 2 rr)) (r3 (nth 3 rr)) (r4 (nth 4 rr)))
;; (insert (make-string indent ?\ ))
;; (insert r0)
;; (insert (make-string (- (aref widths 0) (length r0)) ?\ ))
;; (insert (make-string (+ 2 (- (aref widths 1) (length r1))) ?\ ))
;; (insert r1)
;; (insert " ")
;; (insert r2)
;; (insert (make-string (+ 2 (- (aref widths 2) (length r2))) ?\ ))
;; (insert r3)
;; (insert (make-string (+ 2 (- (aref widths 3) (length r3))) ?\ ))
;; (insert r4))
;; (insert "\n")
(let* ((rr (car rrs)) (r0 (nth 0 rr)) (r1 (nth 1 rr))
(r2 (nth 2 rr)) (r3 (nth 3 rr)) (r4 (nth 4 rr))
(l1 (length r1))
(l4 (length r4))
(total-length
(+ indent
(aref widths 0) 2
(aref widths 1) 2
(aref widths 2) 2
(aref widths 3) 2
l4 1))
(line (make-string total-length ?\ ))
(offset indent))
(store-substring line offset r0)
(setq offset (+ offset (aref widths 0) 2 (- (aref widths 1) l1)))
(store-substring line offset r1)
(setq offset (+ offset l1 2))
(store-substring line offset r2)
(setq offset (+ offset (aref widths 2) 2))
(store-substring line offset r3)
(setq offset (+ offset (aref widths 3) 2))
(store-substring line offset r4)
(setq offset (+ offset l4))
(store-substring line offset "\n")
(insert line))
(setq rrs (cdr rrs)))
(save-restriction
(narrow-to-region p (point))
(run-hooks 'dig-browser-after-insert-hook))
(let ((mbeg (set-marker (make-marker) p)) (mend (set-marker (make-marker) (point))))
(set-marker-insertion-type mend t)
(setq domain-intervals (cons (list domain level (cons mbeg mend) server 'visible) domain-intervals)))
(goto-char p)
(back-to-indentation)))
;; return the top level domain for the buffer
(defsubst dig-browser-domain ()
(caar (last domain-intervals)))
;; return the server from which listing was obtained
(defsubst dig-browser-server ()
(nth 3 (car (last domain-intervals))))
;; return interval list entry whose zone point is on
(defun dig-browser-interval ()
(or
(let ((p (point)) (intervals domain-intervals))
(catch 'out
(while intervals
(let ((interval (car intervals)))
(if (and (<= (car (nth 2 interval)) p)
(> (cdr (nth 2 interval)) p))
(throw 'out interval)))
(setq intervals (cdr intervals)))))
(car (last domain-intervals))))
(defsubst dig-browser-interval-domain ()
(nth 0 (dig-browser-interval)))
(defsubst dig-browser-interval-level ()
(nth 1 (dig-browser-interval)))
(defsubst dig-browser-interval-indent ()
(* (dig-browser-interval-level) dig-browser-subdomain-indent))
(defsubst dig-browser-interval-bounds ()
(nth 2 (dig-browser-interval)))
(defsubst dig-browser-interval-start ()
(car (dig-browser-interval-bounds)))
(defsubst dig-browser-interval-end ()
(cdr (dig-browser-interval-bounds)))
(defsubst dig-browser-interval-server ()
(nth 3 (dig-browser-interval)))
(defun dig-browser-revert (ignore-auto noconfirm)
"Refresh a buffer browsing DNS information."
(let ((server (dig-browser-server)))
(run-hooks 'dig-browser-before-fetch-hook)
(let* ((d (dig-browser-domain))
(rrs (dig-browser-fetch-zone d server)))
(if (null rrs) (error "Unable to fetch information for %s from %s" d server)
(run-hooks 'dig-browser-after-fetch-hook)
(let ((intervals domain-intervals))
(while intervals
(let ((m1 (car (nth 2 (car intervals)))) (m2 (cdr (nth 2 (car intervals)))))
(set-marker m1 nil) (set-marker m2 nil))
(setq intervals (cdr intervals))))
(setq domain-intervals nil)
(let ((inhibit-read-only t))
(erase-buffer)
(redraw-frame (window-frame (selected-window)))
(dig-browser-insert-rrs rrs server 0)))))
(set-buffer-modified-p nil))
;; Dig Browser mode is suitable only for specially formatted data.
(put 'dig-browser-mode 'mode-class 'special)
(defun dig-browser-mode ()
"Special major mode for browsing DNS zone information.
\\<dig-browser-mode-map> Commands:
\\[dig-browser-expand] - Expand the subdomain of an expandable NS RR.
\\[dig-browser-goto-domain-at-point] - Jump to a following resource record keyed by the domain at point.
\\[dig-browser-mail-hostmaster] - Start an email message to the address from the SOA record.
\\[dig-browser-next-subdomain] - Jump to a following NS resource record for a subdomain.
\\[dig-browser-browse-other-window] - Open a new window to browse the domain at point.
\\[dig-browser-prev-subdomain] - Jump to a preceding NS resource record for a subdomain.
\\[dig-browser-up-tree] - Go to the NS RR in the parent domain of the subdomain point is on.
\\[dig-browser-browse-parent] - Open a new window to browse the parent of the current domain.
\\[dig-browser-collapse] - Collapse the subdomain point is on.
\\[dig-browser-toggle-state] - Assuming the point is on an expandable NS RR, expand the subdomain."
(kill-all-local-variables)
(setq major-mode 'dig-browser-mode
mode-name "Dig Browser"
buffer-read-only t)
(buffer-disable-undo)
(use-local-map dig-browser-mode-map)
(set-syntax-table dig-browser-syntax-table)
(set (make-local-variable 'font-lock-defaults)
'(dig-browser-font-lock-keywords t nil nil))
(set (make-local-variable 'revert-buffer-function)
(function dig-browser-revert))
(set (make-local-variable 'selective-display) t)
(set (make-local-variable 'selective-display-ellipses) t)
(set (make-local-variable 'domain-intervals) nil)
(run-hooks 'dig-browser-mode-hook))
(defun dig-browser-domain-at-point ()
"Return the domain name point is on. Signal error if point is not on a domain."
(let* ((bs (bounds-of-thing-at-point 'sexp))
(s (buffer-substring-no-properties (car bs) (cdr bs))))
(if (string-match "\\`\\(\\.\\|\\([A-Za-z0-9]\\([-A-Za-z0-9]*[A-Za-z0-9]\\)?\\.\\)+\\)\\'" s)
s
(error "No domain at point"))))
(defun dig-browser-goto-column (c)
"Go to the specified column of the current RR."
(back-to-indentation)
(re-search-forward "[^ \t\n]+[ \t]+" nil nil (cdr (assq c dig-browser-column-alist))))
(defun dig-browser-next-rr-satisfying (restrict n p)
"Go to the next Nth RR satisyfing P.
P should expect its argument to be a list created by `dig-browser-make-rr'.
RESTRICT tells if matches in subdomains and superdomains count."
(let ((pt (point)) (limit nil) (i 0))
(if restrict
(let ((l (dig-browser-interval-level)))
(save-restriction
(narrow-to-region (dig-browser-interval-start) (dig-browser-interval-end))
(while (< i n)
(if (> i 0) (forward-line 1))
(let ((rr (dig-browser-make-rr (thing-at-point 'line))))
(while (or (not (funcall p rr))
(> (dig-browser-interval-level) l))
(forward-line 1)
(if (and limit (>= (point) limit))
(progn
(goto-char pt)
(error "No matching records")))
(if (eobp) (progn (goto-char (point-min)) (setq limit pt)))
(setq rr (dig-browser-make-rr (thing-at-point 'line)))))
(setq i (1+ i)))))
(while (< i n)
(if (> i 0) (forward-line 1))
(let ((rr (dig-browser-make-rr (thing-at-point 'line))))
(while (not (funcall p rr))
(forward-line 1)
(if (and limit (>= (point) limit))
(progn
(goto-char pt)
(error "No matching records")))
(if (eobp) (progn (goto-char (point-min)) (setq limit pt)))
(setq rr (dig-browser-make-rr (thing-at-point 'line)))))
(setq i (1+ i))))))
(defun dig-browser-prev-rr-satisfying (restrict n p)
"Go to the previous Nth RR satisyfing P.
P should expect its argument to be a list created by `dig-browser-make-rr'.
RESTRICT tells if matches in subdomains and superdomains count."
(let ((pt (point)) (limit nil) (i 0))
(if restrict
(let ((l (dig-browser-interval-level)))
(save-restriction
(narrow-to-region (dig-browser-interval-start) (dig-browser-interval-end))
(while (< i n)
(if (> i 0) (progn (if (bobp) (goto-char (point-max))) (forward-line -1)))
(let ((rr (dig-browser-make-rr (thing-at-point 'line))))
(while (or (not (funcall p rr))
(> (dig-browser-interval-level) l))
(if (and limit (< (point) limit))
(progn
(goto-char pt)
(error "No matching records")))
(if (bobp) (progn (setq limit pt) (goto-char (point-max))))
(forward-line -1)
(setq rr (dig-browser-make-rr (thing-at-point 'line)))))
(setq i (1+ i)))))
(while (< i n)
(if (> i 0) (progn (if (bobp) (goto-char (point-max))) (forward-line -1)))
(let ((rr (dig-browser-make-rr (thing-at-point 'line))))
(while (not (funcall p rr))
(if (bobp) (goto-char (point-max)))
(if (and limit (< (point) limit))
(progn
(goto-char pt)
(error "No matching records")))
(if (bobp) (progn (setq limit pt) (goto-char (point-max))))
(forward-line -1)
(setq rr (dig-browser-make-rr (thing-at-point 'line)))))
(setq i (1+ i))))))
(defun dig-browser-hostmaster ()
"Return the email address from the SOA record, as a string."
(save-restriction
(narrow-to-region (dig-browser-interval-start) (dig-browser-interval-end))
(save-excursion
(goto-char (point-min))
(dig-browser-next-rr-satisfying t 1 (lambda (rr) (string-equal "SOA" (nth 3 rr))))
(dig-browser-goto-column 'data)
(skip-chars-forward "-a-zA-Z0-9.")
(skip-chars-forward " \t")
(let* ((bs (bounds-of-thing-at-point 'sexp))
(s (buffer-substring-no-properties (car bs) (cdr bs))))
(string-match "\\`\\([^.]+\\)\\.\\(.*[^.]\\)\\.?\\'" s)
(replace-match "\\1@\\2" nil nil s)))))
(defun dig-browser-parent-domain (domain)
"Return the domain name one level up from the argument in the DNS hierarchy."
(if (string-equal domain ".") (error "The root domain has no parent")
(string-match "\\`[^.]+\\.\\(.*\\)\\'" domain)
(replace-match "\\1" nil nil domain)))
(defun dig-browser-descendant-p (subdom dom)
"Tests if SUBDOM is a proper subdomain of DOM."
(let ((lsub (length subdom)) (l (length dom)))
(and (> lsub (1+ l))
(char-equal ?. (aref subdom (- lsub l 1)))
(string-equal (downcase dom) (downcase (substring subdom (- lsub l)))))))
(defun dig-browser-get-args (&optional domain)
(setq domain (or domain (read-string "Domain: " nil 'dig-browser-history)))
(let* ((servers (dig-browser-fetch-servers domain))
(default (caar servers))
(server (completing-read (format "Server [%s]: " default)
servers nil t nil 'dig-browser-history default)))
(list domain server)))
(defun dig-browser-rr-state ()
"Test if the point is placed on an expandable NS record.
Return nil if not an expandable NS record, t if expandable but not yet expanded,
one of the symbols visible or invisible if expanded and in that state."
(save-excursion
(dig-browser-goto-column 'type)
(if (not (looking-at "NS[ \t]")) nil
(dig-browser-goto-column 'data)
(if (not (dig-browser-descendant-p
(dig-browser-domain-at-point)
(dig-browser-interval-domain))) nil
(skip-chars-forward "^\r\n")
(if (looking-at "\r") 'invisible
(let ((l (dig-browser-interval-level)))
(forward-char 1)
(if (> (dig-browser-interval-level) l) 'visible t)))))))
;; commands
;;;###autoload
(defun dig-browser (domain server)
"Enter a buffer browsing the DNS information for DOMAIN."
(interactive (dig-browser-get-args))
(let ((b (get-buffer-create (format "*Dig @%s %s*" server domain))))
(pop-to-buffer b)
(if (= (buffer-size) 0)
(progn
(run-hooks 'dig-browser-before-fetch-hook)
(let ((rrs (dig-browser-fetch-zone domain server)))
(if (null rrs) (error "Unable to fetch information for %s from %s" domain server))
(progn
(run-hooks 'dig-browser-after-fetch-hook)
(dig-browser-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(dig-browser-insert-rrs rrs server 0))
(set-buffer-modified-p nil)))))))
(defun dig-browser-goto-domain-at-point (&optional n)
"Jump to a following resource record keyed by the domain at point.
There can be many such records; if the optional number N is present,
this command jumps to the Nth one; if N is negative, to the Nth preceding one.
Wrap around at the end of the buffer."
(interactive "p")
(let ((d (dig-browser-domain-at-point)))
(cond
((> n 0)
(if (eq last-command 'dig-browser-goto-domain-at-point) (forward-line 1))
(dig-browser-next-rr-satisfying nil n (lambda (rr) (string-equal d (nth 0 rr))))
(back-to-indentation))
((< n 0)
(if (eq last-command 'dig-browser-goto-domain-at-point)
(progn (if (bobp) (goto-char (point-max))) (forward-line -1)))
(dig-browser-prev-rr-satisfying nil (- n) (lambda (rr) (string-equal d (nth 0 rr))))
(back-to-indentation))
(t nil))))
(defun dig-browser-next-subdomain (&optional n)
"Jump to a following NS resource record for a subdomain.
There can be many such records; if the optional number N is present,
this command jumps to the Nth one; if N is negative, to the Nth preceding one.
Wrap around at the end of the buffer."
(interactive "p")
(save-restriction
(narrow-to-region (dig-browser-interval-start) (dig-browser-interval-end))
(let* ((d (dig-browser-interval-domain)) (l (dig-browser-interval-level))
(selective-display (* l dig-browser-subdomain-indent)))
(cond
((> n 0)
(if (eq last-command 'dig-browser-next-subdomain)
(progn
(forward-line 1)
(if (eobp) (goto-char (point-min)))))
(dig-browser-next-rr-satisfying
t n (lambda (rr) (and (string-equal "NS" (nth 3 rr))
(dig-browser-descendant-p (nth 0 rr) d))))
(back-to-indentation))
((< n 0)
(if (eq last-command 'dig-browser-next-subdomain)
(progn
(if (bobp) (goto-char (point-max)))
(forward-line -1)))
(dig-browser-prev-rr-satisfying
t n (lambda (rr) (and (string-equal "NS" (nth 3 rr))
(dig-browser-descendant-p (nth 0 rr) d))))
(back-to-indentation))
(t nil)))))
(defun dig-browser-prev-subdomain (&optional n)
"Jump to a preceding NS resource record for a subdomain.
There can be many such records; if the optional number N is present,
this command jumps to the Nth one; if N is negative, to the Nth following one.
Wrap around at the beginning of the buffer."
(interactive "p")
(save-restriction
(narrow-to-region (dig-browser-interval-start) (dig-browser-interval-end))
(let* ((d (dig-browser-interval-domain)) (l (dig-browser-interval-level))
(selective-display (* l dig-browser-subdomain-indent)))
(cond
((< n 0)
(if (eq last-command 'dig-browser-prev-subdomain)
(progn
(forward-line 1)
(if (eobp) (goto-char (point-min)))))
(dig-browser-next-rr-satisfying
t n (lambda (rr) (and (string-equal "NS" (nth 3 rr))
(dig-browser-descendant-p (nth 0 rr) d))))
(back-to-indentation))
((> n 0)
(if (eq last-command 'dig-browser-prev-subdomain)
(progn
(if (bobp) (goto-char (point-max)))
(forward-line -1)))
(dig-browser-prev-rr-satisfying
t n (lambda (rr) (and (string-equal "NS" (nth 3 rr))
(dig-browser-descendant-p (nth 0 rr) d))))
(back-to-indentation))
(t nil)))))
(defun dig-browser-mail-hostmaster ()
"Start an email message to the address from the SOA record."
(interactive)
(message-mail (dig-browser-hostmaster) (dig-browser-interval-domain)))
(defun dig-browser-browse-parent (domain server)
"Open a new window to browse the parent of the current domain."
(interactive (dig-browser-get-args (dig-browser-parent-domain (dig-browser-domain))))
(dig-browser domain server))
(defun dig-browser-browse-other-window (domain server)
"Open a new window to browse the domain at point."
(interactive (dig-browser-get-args (dig-browser-domain-at-point)))
(dig-browser domain server))
(defun dig-browser-collapse ()
"Collapse the subdomain point is on."
(interactive)
(let ((flag (nthcdr 4 (dig-browser-interval))))
(setcar flag 'invisible))
(save-restriction
(narrow-to-region (1- (dig-browser-interval-start)) (1- (dig-browser-interval-end)))
(goto-char (1- (point-min)))
(save-excursion
(let ((inhibit-read-only t))
(while (search-forward "\n" nil t)
(replace-match "\r"))))))
(defun dig-browser-expand ()
"Expand the subdomain of an expandable NS RR."
(interactive)
(if (not (eq (dig-browser-rr-state) 'invisible))
(error "No collapsed subdomain here"))
(save-excursion
(search-forward "\r")
(let ((flag (nthcdr 4 (dig-browser-interval)))
(l (dig-browser-interval-level))
(inhibit-read-only t))
(replace-match "\n")
(setcar flag 'visible)
(save-restriction
(narrow-to-region (point) (1- (dig-browser-interval-end)))
(while (search-forward "\r" nil t)
(if (<= (dig-browser-interval-level) l) (replace-match "\n")))))))
(defun dig-browser-up-tree ()
"Go to the NS RR in the parent domain of the subdomain point is on."
(interactive)
(goto-char (dig-browser-interval-start))
(forward-line -1)
(back-to-indentation))
(defun dig-browser-toggle-state ()
"Assuming the point is on an expandable NS RR, expand the subdomain.
If already expanded, toggle its visible state."
(interactive)
(let ((state (dig-browser-rr-state)))
(cond
((null state)
(error "Not on an expandable subdomain NS record"))
((eq state 'visible)
(save-excursion
(forward-line 1)
(dig-browser-collapse)))
((eq state 'invisible)
(dig-browser-expand))
(t
(dig-browser-goto-column 'domain)
(let ((domain (dig-browser-domain-at-point))
(server
(progn
(dig-browser-goto-column 'data)
(dig-browser-domain-at-point))))
(run-hooks 'dig-browser-before-fetch-hook)
(let ((l (dig-browser-interval-level))
(rrs (dig-browser-fetch-zone domain server)))
(if (null rrs) (error "Unable to fetch information for %s from %s" domain server))
(progn
(run-hooks 'dig-browser-after-fetch-hook)
(forward-line 1)
(let ((inhibit-read-only t))
(dig-browser-insert-rrs rrs server (1+ l)))
(set-buffer-modified-p nil))))))))
(provide 'dig-browser)
;;; dig-browser.el ends here
--
Ian Zimmerman, Oakland, California, U.S.A.
if (sizeof(signed) > sizeof(unsigned) + 4) { delete this; }
GPG: 433BA087 9C0F 194F 203A 63F7 B1B8 6E5A 8CA3 27DB 433B A087
More information about the buug
mailing list