~mdw
/
zone
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
zone.lisp: Add support for TXT records.
[zone]
/
zone.lisp
diff --git
a/zone.lisp
b/zone.lisp
index
2e108ba
..
0e0ed47
100644
(file)
--- a/
zone.lisp
+++ b/
zone.lisp
@@
-1,7
+1,5
@@
;;; -*-lisp-*-
;;;
;;; -*-lisp-*-
;;;
-;;; $Id$
-;;;
;;; DNS zone generation
;;;
;;; (c) 2005 Straylight/Edgeware
;;; DNS zone generation
;;;
;;; (c) 2005 Straylight/Edgeware
@@
-29,7
+27,7
@@
(defpackage #:zone
(:use #:common-lisp
#:mdw.base #:mdw.str #:collect #:safely
(defpackage #:zone
(:use #:common-lisp
#:mdw.base #:mdw.str #:collect #:safely
- #:net #:services)
+ #:net #:
net-sys #:
services)
(:export #:soa #:mx #:zone #:zone-record #:zone-subdomain
#:*default-zone-source* #:*default-zone-refresh*
#:*default-zone-retry* #:*default-zone-expire*
(:export #:soa #:mx #:zone #:zone-record #:zone-subdomain
#:*default-zone-source* #:*default-zone-refresh*
#:*default-zone-retry* #:*default-zone-expire*
@@
-151,18
+149,8
@@
;;;--------------------------------------------------------------------------
;;; Zone defaults. It is intended that scripts override these.
;;;--------------------------------------------------------------------------
;;; Zone defaults. It is intended that scripts override these.
-#+ecl
-(cffi:defcfun gethostname :int
- (name :pointer)
- (len :uint))
-
(defvar *default-zone-source*
(defvar *default-zone-source*
- (let ((hn #+cmu (unix:unix-gethostname)
- #+clisp (unix:get-host-name)
- #+ecl (cffi:with-foreign-pointer-as-string (buffer 256 len)
- (let ((rc (gethostname buffer len)))
- (unless (zerop rc)
- (error "gethostname(2) failed (rc = ~A)." rc))))))
+ (let ((hn (gethostname)))
(and hn (concatenate 'string (canonify-hostname hn) ".")))
"The default zone source: the current host's name.")
(and hn (concatenate 'string (canonify-hostname hn) ".")))
"The default zone source: the current host's name.")
@@
-587,6
+575,10
@@
":cname HOST"
(rec :data (zone-parse-host data zname)))
":cname HOST"
(rec :data (zone-parse-host data zname)))
+(defzoneparse :txt (name data rec)
+ ":txt TEXT"
+ (rec :data data))
+
(defzoneparse :mx (name data rec :zname zname)
":mx ((HOST :prio INT :ip IPADDR)*)"
(dolist (mx (listify data))
(defzoneparse :mx (name data rec :zname zname)
":mx ((HOST :prio INT :ip IPADDR)*)"
(dolist (mx (listify data))
@@
-656,9
+648,7
@@
(defzoneparse (:rev :reverse) (name data rec)
":reverse ((NET :bytes BYTES) ZONE*)"
(setf data (listify data))
(defzoneparse (:rev :reverse) (name data rec)
":reverse ((NET :bytes BYTES) ZONE*)"
(setf data (listify data))
- (destructuring-bind
- (net &key bytes)
- (listify (car data))
+ (destructuring-bind (net &key bytes) (listify (car data))
(setf net (zone-parse-net net name))
(unless bytes
(setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
(setf net (zone-parse-net net name))
(unless bytes
(setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
@@
-682,18
+672,15
@@
:ttl (zr-ttl zr) :data (zr-name zr))
(setf (gethash name seen) t)))))))))
:ttl (zr-ttl zr) :data (zr-name zr))
(setf (gethash name seen) t)))))))))
-(defzoneparse (:cidr-delegation :cidr) (name data rec)
+(defzoneparse (:cidr-delegation :cidr) (name data rec
:zname zname
)
":cidr-delegation ((NET :bytes BYTES) (TARGET-NET [TARGET-ZONE])*)"
":cidr-delegation ((NET :bytes BYTES) (TARGET-NET [TARGET-ZONE])*)"
- (destructuring-bind
- (net &key bytes)
- (listify (car data))
+ (setf data (listify data))
+ (destructuring-bind (net &key bytes) (listify (car data))
(setf net (zone-parse-net net name))
(unless bytes
(setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
(setf net (zone-parse-net net name))
(unless bytes
(setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
- (dolist (map (cdr data))
- (destructuring-bind
- (tnet &optional tdom)
- (listify map)
+ (dolist (map (or (cdr data) (list (list net))))
+ (destructuring-bind (tnet &optional tdom) (listify map)
(setf tnet (zone-parse-net tnet name))
(unless (ipnet-subnetp net tnet)
(error "~A is not a subnet of ~A."
(setf tnet (zone-parse-net tnet name))
(unless (ipnet-subnetp net tnet)
(error "~A is not a subnet of ~A."
@@
-705,25
+692,25
@@
(join-strings
#\.
(append (reverse (loop
(join-strings
#\.
(append (reverse (loop
- for i from (1- bytes) downto 0
- until (zerop (logand mask
- (ash #xff
- (* 8 i))))
- collect (logand #xff
- (ash net (* -8 i)))))
+ for i from (1- bytes) downto 0
+ until (zerop (logand mask
+ (ash #xff
+ (* 8 i))))
+ collect (ldb (byte 8 (* i 8)) net)))
(list name))))))
(list name))))))
- (setf tdom (string-downcase
tdom
))
+ (setf tdom (string-downcase
(stringify tdom)
))
(dotimes (i (ipnet-hosts tnet))
(dotimes (i (ipnet-hosts tnet))
- (let* ((addr (ipnet-host tnet i))
- (tail (join-strings #\.
- (loop
+ (unless (zerop i)
+ (let* ((addr (ipnet-host tnet i))
+ (tail (join-strings #\.
+ (loop
for i from 0 below bytes
collect
for i from 0 below bytes
collect
-
(logand #xff
-
(ash addr (* 8 i)))))))
- (rec :name (format nil "~A.~A" tail name)
- :type :cname
-
:data (format nil "~A.~A" tail tdom
))))))))
+ (logand #xff
+ (ash addr (* 8 i)))))))
+
(rec :name (format nil "~A.~A" tail name)
+
:type :cname
+
:data (format nil "~A.~A" tail tdom)
))))))))
;;;--------------------------------------------------------------------------
;;; Zone file output.
;;;--------------------------------------------------------------------------
;;; Zone file output.