;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
-;;;
+;;;
;;; This program 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 this program; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#:*default-zone-retry* #:*default-zone-expire*
#:*default-zone-min-ttl* #:*default-zone-ttl*
#:*default-mx-priority* #:*default-zone-admin*
- #:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
- #:defrevzone #:zone-save
+ #:*zone-output-path*
+ #:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
+ #:defrevzone #:zone-save
#:defzoneparse #:zone-parse-host
#:timespec-seconds #:make-zone-serial))
"Default MX priority.")
;;;--------------------------------------------------------------------------
-;;; Serial numbering.
-
-(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."
- (let* ((file (format nil "~(~A~).serial" name))
- (last (with-open-file (in file
- :direction :input
- :if-does-not-exist nil)
- (if in (read in)
- (list 0 0 0 0))))
- (now (multiple-value-bind
- (sec min hr dy mon yr dow dstp tz)
- (get-decoded-time)
- (declare (ignore sec min hr dow dstp tz))
- (list dy mon yr)))
- (seq (cond ((not (equal now (cdr last))) 0)
- ((< (car last) 99) (1+ (car last)))
- (t (error "Run out of sequence numbers for ~A" name)))))
- (safely-writing (out file)
- (format out
- ";; Serial number file for zone ~A~%~
- ;; (LAST-SEQ DAY MONTH YEAR)~%~
- ~S~%"
- name
- (cons seq now)))
- (from-mixed-base '(100 100 100) (reverse (cons seq now)))))
-
-;;;--------------------------------------------------------------------------
;;; Zone variables and structures.
(defvar *zones* (make-hash-table :test #'equal)
ttl
records)
+(defvar *zone-output-path* *default-pathname-defaults*
+ "Pathname defaults to merge into output files.")
+
;;;--------------------------------------------------------------------------
;;; Zone infrastructure.
+(defun zone-file-name (zone type)
+ "Choose a file name for a given ZONE and TYPE."
+ (merge-pathnames (make-pathname :name (string-downcase zone)
+ :type (string-downcase type))
+ *zone-output-path*))
+
(defun zone-process-records (rec ttl func)
"Sort out the list of records in REC, calling FUNC for each one. TTL is
the default time-to-live for records which don't specify one."
(setf addr (ash addr (* 8 (- 4 n))))
(make-ipnet addr (* 8 n))))
-(defun zone-reverse-records (records net list bytes dom)
- "Construct a reverse zone given a forward zone's RECORDS list, the NET that
- the reverse zone is to serve, a LIST to collect the records into, how many
- BYTES of data need to end up in the zone, and the DOM-ain suffix."
- (dolist (zr records)
- (when (and (eq (zr-type zr) :a)
- (not (zr-defsubp zr))
- (ipaddr-networkp (zr-data zr) net))
- (collect (make-zone-record
- :name (string-downcase
- (join-strings
- #\.
- (collecting ()
- (dotimes (i bytes)
- (collect (logand #xff (ash (zr-data zr)
- (* -8 i)))))
- (collect dom))))
- :type :ptr
- :ttl (zr-ttl zr)
- :data (zr-name zr))
- list))))
-
-(defun zone-reverse (data name list)
- "Process a :reverse record's DATA, for a domain called NAME, and add the
- records to the LIST."
- (destructuring-bind
- (net &key bytes zones)
- (listify data)
- (setf net (zone-parse-net net name))
- (dolist (z (or (listify zones)
- (hash-table-keys *zones*)))
- (zone-reverse-records (zone-records (zone-find z))
- net
- list
- (or bytes
- (ipnet-changeable-bytes (ipnet-mask net)))
- name))))
-
(defun zone-parse-net (net name)
"Given a NET, and the NAME of a domain to guess from if NET is null, return
the ipnet for the network."
(unless (ipnet-subnetp net tnet)
(error "~A is not a subnet of ~A."
(ipnet-pretty tnet)
- (ipnet-pretty net)))
+ (ipnet-pretty net)))
(unless tdom
(setf tdom
(join-strings #\.
:ttl ttl
:data (join-strings #\. (list tail tdom)))
list)))))))
-
+
+;;;--------------------------------------------------------------------------
+;;; Serial numbering.
+
+(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."
+ (let* ((file (zone-file-name name :serial))
+ (last (with-open-file (in file
+ :direction :input
+ :if-does-not-exist nil)
+ (if in (read in)
+ (list 0 0 0 0))))
+ (now (multiple-value-bind
+ (sec min hr dy mon yr dow dstp tz)
+ (get-decoded-time)
+ (declare (ignore sec min hr dow dstp tz))
+ (list dy mon yr)))
+ (seq (cond ((not (equal now (cdr last))) 0)
+ ((< (car last) 99) (1+ (car last)))
+ (t (error "Run out of sequence numbers for ~A" name)))))
+ (safely-writing (out file)
+ (format out
+ ";; Serial number file for zone ~A~%~
+ ;; (LAST-SEQ DAY MONTH YEAR)~%~
+ ~S~%"
+ name
+ (cons seq now)))
+ (from-mixed-base '(100 100 100) (reverse (cons seq now)))))
+
;;;--------------------------------------------------------------------------
;;; Zone form parsing.
NAME The name of the record to be added.
DATA The content of the record to be added (a single object,
- unevaluated).
+ unevaluated).
LIST A function to add a record to the zone. See below.
(setf types (listify types))
(let* ((type (car types))
(func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
- (with-parsed-body (doc decls body body)
+ (with-parsed-body (body decls doc) body
(with-gensyms (col tname ttype tttl tdata tdefsubp i)
`(progn
(dolist (,i ',types)
(zr-defsubp zr)))))
(zone-process-records records
(zone-default-ttl zone)
- #'parse-record ))
+ #'parse-record))
(setf (zone-records zone) (nconc (zone-records zone) rec)))))
(defun zone-parse (zf)
(rec :name (zone-parse-host "broadcast" name)
:type :a
:data (ipnet-broadcast n)))))
-
+
(defzoneparse (:rev :reverse) (name data rec)
":reverse ((NET :bytes BYTES) ZONE*)"
(setf data (listify data))
(unless (ipnet-subnetp net tnet)
(error "~A is not a subnet of ~A."
(ipnet-pretty tnet)
- (ipnet-pretty net)))
+ (ipnet-pretty net)))
(unless tdom
(with-ipnet (net mask) tnet
(setf tdom
(soa-expire soa)
(soa-min-ttl soa)))
(dolist (zr (zone-records zone))
- (case (zr-type zr)
+ (ecase (zr-type zr)
(:a
(printrec zr)
(format stream "~A~%" (ipaddr-string (zr-data zr))))
- ((:ptr :cname)
- (printrec zr)
- (format stream "~A~%" (fix-host (zr-data zr))))
- (:ns
+ ((:ptr :cname :ns)
(printrec zr)
(format stream "~A~%" (fix-host (zr-data zr))))
(:mx
(unless zz
(error "Unknown zone `~A'." z))
(let ((stream (safely-open-output-stream safe
- (format nil
- "~(~A~).zone"
- z))))
+ (zone-file-name z :zone))))
(zone-write zz stream))))))
;;;----- That's all, folks --------------------------------------------------
~mdw / zone / blobdiff