zone: Allow control over output file names.
[zone] / zone.lisp
index 7e6da2b..6b11880 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -33,8 +33,9 @@
             #:*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."
                     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.
 
 (defun zone-parse-head (head)
@@ -786,14 +758,11 @@ $TTL ~2@*~D~2%"
              (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
@@ -815,9 +784,7 @@ $TTL ~2@*~D~2%"
        (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 --------------------------------------------------