X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/8e7c1366598806dff2b2e4fb2016efb5a78f42ec..098b57a28b428a9f21b44098da374c79d866ed80:/zone.lisp diff --git a/zone.lisp b/zone.lisp index 8dc3df0..751baff 100644 --- a/zone.lisp +++ b/zone.lisp @@ -27,21 +27,7 @@ (defpackage #:zone (:use #:common-lisp #:mdw.base #:mdw.str #:collect #:safely - #:net #:net-sys #:services) - (:export #:soa #:mx #:zone #:zone-record #:zone-subdomain - #:*default-zone-source* #:*default-zone-refresh* - #:*default-zone-retry* #:*default-zone-expire* - #:*default-zone-min-ttl* #:*default-zone-ttl* - #:*default-mx-priority* #:*default-zone-admin* - #:*zone-output-path* - #:*preferred-subnets* #:zone-preferred-subnet-p - #:preferred-subnet-case - #:zone-find #:zone-parse #:zone-write #:zone-create #:defzone - #:defrevzone #:zone-save #:zone-make-name - #:defzoneparse #:zone-parse-host - #:bind-hostname #:bind-record #:bind-format-record - #:bind-record-type #:bind-record-format-args - #:timespec-seconds #:make-zone-serial)) + #:net #:services)) (in-package #:zone) @@ -73,6 +59,7 @@ (defun to-mixed-base (base val) (push r a) (setf val q))))) +(export 'timespec-seconds) (defun timespec-seconds (ts) "Convert a timespec TS to seconds. A timespec may be a real count of seconds, or a list (COUNT UNIT): UNIT may be any of a number of obvious @@ -124,6 +111,7 @@ (defun iso-date (&optional time &key datep timep (sep #\ )) ;;;-------------------------------------------------------------------------- ;;; Zone types. +(export 'soa) (defstruct (soa (:predicate soap)) "Start-of-authority record information." source @@ -134,11 +122,13 @@ (defstruct (soa (:predicate soap)) min-ttl serial) +(export 'mx) (defstruct (mx (:predicate mxp)) "Mail-exchange record information." priority domain) +(export 'zone) (defstruct (zone (:predicate zonep)) "Zone information." soa @@ -149,29 +139,37 @@ (defstruct (zone (:predicate zonep)) ;;;-------------------------------------------------------------------------- ;;; Zone defaults. It is intended that scripts override these. +(export '*default-zone-source*) (defvar *default-zone-source* (let ((hn (gethostname))) (and hn (concatenate 'string (canonify-hostname hn) "."))) "The default zone source: the current host's name.") +(export '*default-zone-refresh*) (defvar *default-zone-refresh* (* 24 60 60) "Default zone refresh interval: one day.") +(export '*default-zone-admin*) (defvar *default-zone-admin* nil "Default zone administrator's email address.") +(export '*default-zone-retry*) (defvar *default-zone-retry* (* 60 60) "Default znoe retry interval: one hour.") +(export '*default-zone-expire*) (defvar *default-zone-expire* (* 14 24 60 60) "Default zone expiry time: two weeks.") +(export '*default-zone-min-ttl*) (defvar *default-zone-min-ttl* (* 4 60 60) "Default zone minimum TTL/negative TTL: four hours.") +(export '*default-zone-ttl*) (defvar *default-zone-ttl* (* 8 60 60) "Default zone TTL (for records without explicit TTLs): 8 hours.") +(export '*default-mx-priority*) (defvar *default-mx-priority* 50 "Default MX priority.") @@ -181,14 +179,15 @@ (defvar *default-mx-priority* 50 (defvar *zones* (make-hash-table :test #'equal) "Map of known zones.") +(export 'zone-find) (defun zone-find (name) "Find a zone given its NAME." (gethash (string-downcase (stringify name)) *zones*)) - (defun (setf zone-find) (zone name) "Make the zone NAME map to ZONE." (setf (gethash (string-downcase (stringify name)) *zones*) zone)) +(export 'zone-record) (defstruct (zone-record (:conc-name zr-)) "A zone record." (name ') @@ -197,6 +196,7 @@ (defstruct (zone-record (:conc-name zr-)) (make-ptr-p nil) data) +(export 'zone-subdomain) (defstruct (zone-subdomain (:conc-name zs-)) "A subdomain. Slightly weird. Used internally by zone-process-records below, and shouldn't escape." @@ -204,9 +204,11 @@ (defstruct (zone-subdomain (:conc-name zs-)) ttl records) +(export '*zone-output-path*) (defvar *zone-output-path* *default-pathname-defaults* "Pathname defaults to merge into output files.") +(export '*preferred-subnets*) (defvar *preferred-subnets* nil "Subnets to prefer when selecting defaults.") @@ -219,10 +221,12 @@ (defun zone-file-name (zone type) :type (string-downcase type)) *zone-output-path*)) +(export 'zone-preferred-subnet-p) (defun zone-preferred-subnet-p (name) "Answer whether NAME (a string or symbol) names a preferred subnet." (member name *preferred-subnets* :test #'string-equal)) +(export 'preferred-subnet-case) (defmacro preferred-subnet-case (&body clauses) "CLAUSES have the form (SUBNETS . FORMS) -- evaluate the first FORMS whose SUBNETS (a list or single symbol, not evaluated) are considered preferred @@ -293,6 +297,7 @@ (defun zone-process-records (rec ttl func) (zs-ttl s)))))) (process rec nil ttl))) +(export 'zone-parse-host) (defun zone-parse-host (f zname) "Parse a host name F: if F ends in a dot then it's considered absolute; otherwise it's relative to ZNAME." @@ -372,6 +377,7 @@ (defun zone-cidr-delg-default-name (ipn bytes) ;;;-------------------------------------------------------------------------- ;;; Serial numbering. +(export 'make-zone-serial) (defun make-zone-serial (name) "Given a zone NAME, come up with a new serial number. This will (very carefully) update a file ZONE.serial in the current directory." @@ -432,6 +438,7 @@ (defun zone-parse-head (head) :min-ttl (timespec-seconds min-ttl) :serial serial)))) +(export 'zone-make-name) (defun zone-make-name (prefix zone-name) (if (or (not prefix) (string= prefix "@")) zone-name @@ -440,6 +447,7 @@ (defun zone-make-name (prefix zone-name) (join-strings #\. (list prefix zone-name)) prefix)))) +(export 'defzoneparse) (defmacro defzoneparse (types (name data list &key (prefix (gensym "PREFIX")) (zname (gensym "ZNAME")) @@ -517,6 +525,7 @@ (defun zone-parse-records (zone records) #'parse-record)) (setf (zone-records zone) (nconc (zone-records zone) rec))))) +(export 'zone-parse) (defun zone-parse (zf) "Parse a ZONE form. The syntax of a zone form is as follows: @@ -534,6 +543,7 @@ (defun zone-parse (zf) (zone-parse-records zone (cdr zf)) zone))) +(export 'zone-create) (defun zone-create (zf) "Zone construction function. Given a zone form ZF, construct the zone and add it to the table." @@ -542,10 +552,12 @@ (defun zone-create (zf) (setf (zone-find name) zone) name)) +(export 'defzone) (defmacro defzone (soa &rest zf) "Zone definition macro." `(zone-create '(,soa ,@zf))) +(export 'defrevzone) (defmacro defrevzone (head &rest zf) "Define a reverse zone, with the correct name." (destructuring-bind @@ -575,6 +587,10 @@ (defzoneparse :cname (name data rec :zname 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)) @@ -637,12 +653,16 @@ (defzoneparse :net (name data rec) (rec :name (zone-parse-host "mask" name) :type :a :data (ipnet-mask n)) - (rec :name (zone-parse-host "broadcast" name) + (rec :name (zone-parse-host "bcast" name) :type :a :data (ipnet-broadcast n))))) (defzoneparse (:rev :reverse) (name data rec) - ":reverse ((NET :bytes BYTES) ZONE*)" + ":reverse ((NET :bytes BYTES) ZONE*) + + Add a reverse record each host in the ZONEs (or all zones) that lies + within NET. The BYTES give the number of prefix labels generated; this + defaults to the smallest number of bytes needed to enumerate the net." (setf data (listify data)) (destructuring-bind (net &key bytes) (listify (car data)) (setf net (zone-parse-net net name)) @@ -669,48 +689,62 @@ (defzoneparse (:rev :reverse) (name data rec) (setf (gethash name seen) t))))))))) (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])*) + + Insert CNAME records for delegating a portion of the reverse-lookup + namespace which doesn't align with an octet boundary. + + The NET specifies the origin network, in which the reverse records + naturally lie. The BYTES are the number of labels to supply for each + address; the default is the smallest number which suffices to enumerate + the entire NET. The TARGET-NETs are subnets of NET which are to be + delegated. The TARGET-ZONEs are the zones to which we are delegating + authority for the reverse records: the default is to append labels for those + octets of the subnet base address which are not the same in all address in + the subnet." (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)))) (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." - (ipnet-pretty tnet) - (ipnet-pretty net))) - (unless tdom - (with-ipnet (net mask) tnet - (setf tdom - (join-strings - #\. - (append (reverse (loop - for i from (1- bytes) downto 0 - until (zerop (logand mask - (ash #xff - (* 8 i)))) - collect (ldb (byte 8 (* i 8)) net))) - (list name)))))) - (setf tdom (string-downcase (stringify tdom))) - (dotimes (i (ipnet-hosts tnet)) - (unless (zerop i) - (let* ((addr (ipnet-host tnet i)) - (tail (join-strings #\. - (loop - 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))))))))) + (destructuring-bind (tnets &optional tdom) (listify map) + (dolist (tnet (listify tnets)) + (setf tnet (zone-parse-net tnet name)) + (unless (ipnet-subnetp net tnet) + (error "~A is not a subnet of ~A." + (ipnet-pretty tnet) + (ipnet-pretty net))) + (unless tdom + (with-ipnet (net mask) tnet + (setf tdom + (join-strings + #\. + (append (reverse (loop + for i from (1- bytes) downto 0 + until (zerop (logand mask + (ash #xff + (* 8 i)))) + collect (ldb (byte 8 (* i 8)) net))) + (list name)))))) + (setf tdom (string-downcase (stringify tdom))) + (dotimes (i (ipnet-hosts tnet)) + (unless (zerop i) + (let* ((addr (ipnet-host tnet i)) + (tail (join-strings #\. + (loop + 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)))))))))) ;;;-------------------------------------------------------------------------- ;;; Zone file output. +(export 'zone-write) (defgeneric zone-write (format zone stream) (:documentation "Write ZONE's records to STREAM in the specified FORMAT.")) @@ -725,6 +759,7 @@ (defmethod zone-write :around (format zone stream) (*zone-output-stream* stream)) (call-next-method))) +(export 'zone-save) (defun zone-save (zones &key (format :bind)) "Write the named ZONES to files. If no zones are given, write all the zones." @@ -742,6 +777,7 @@ (defun zone-save (zones &key (format :bind)) ;;;-------------------------------------------------------------------------- ;;; Bind format output. +(export 'bind-hostname) (defun bind-hostname (hostname) (if (not hostname) "@" @@ -791,8 +827,10 @@ (defmethod zone-write ((format (eql :bind)) zone stream) (dolist (zr (zone-records zone)) (bind-record (zr-type zr) zr))) +(export 'bind-record) (defgeneric bind-record (type zr)) +(export 'bind-format-record) (defun bind-format-record (name ttl type format args) (format *zone-output-stream* "~A~20T~@[~8D~]~30TIN ~A~40T~?~%" @@ -810,9 +848,11 @@ (defmethod bind-record (type zr) (bind-record-type type) format args))) +(export 'bind-record-type) (defgeneric bind-record-type (type) (:method (type) type)) +(export 'bind-record-format-args) (defgeneric bind-record-format-args (type data) (:method ((type (eql :a)) data) (list "~A" (ipaddr-string data))) (:method ((type (eql :ptr)) data) (list "~A" (bind-hostname data)))