zone.lisp: Sort records for presentation.

Currently order by domain components, right to left, and then by RRTYPE
name.

diff --git a/zone.lisp b/zone.lisp
index 2228c07..ec081ef 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -286,6 +286,37 @@
            (join-strings #\. (list prefix zone-name))
            prefix))))
 
+(export 'zone-records-sorted)
+(defun zone-records-sorted (zone)
+  "Return the ZONE's records, in a pleasant sorted order."
+  (sort (copy-seq (zone-records zone))
+       (lambda (zr-a zr-b)
+         (let* ((name-a (zr-name zr-a)) (pos-a (length name-a))
+                (name-b (zr-name zr-b)) (pos-b (length name-b)))
+           (loop (let ((dot-a (or (position #\. name-a
+                                            :from-end t :end pos-a)
+                                  -1))
+                       (dot-b (or (position #\. name-b
+                                            :from-end t :end pos-b)
+                                  -1)))
+                   (cond ((string< name-a name-b
+                                   :start1 (1+ dot-a) :end1 pos-a
+                                   :start2 (1+ dot-b) :end2 pos-b)
+                          (return t))
+                         ((string> name-a name-b
+                                   :start1 (1+ dot-a) :end1 pos-a
+                                   :start2 (1+ dot-b) :end2 pos-b)
+                          (return nil))
+                         ((= dot-a dot-b -1)
+                          (return (string< (zr-type zr-a) (zr-type zr-b))))
+                         ((= dot-a -1)
+                          (return t))
+                         ((= dot-b -1)
+                          (return nil))
+                         (t
+                          (setf pos-a dot-a)
+                          (setf pos-b dot-b)))))))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Serial numbering.
 
@@ -1037,7 +1068,7 @@ $TTL ~2@*~D~2%"
              (soa-retry soa)
              (soa-expire soa)
              (soa-min-ttl soa)))
-  (dolist (zr (zone-records zone))
+  (dolist (zr (zone-records-sorted zone))
     (bind-record (zr-type zr) zr)))
 
 (export 'bind-format-record)
@@ -1163,7 +1194,7 @@ $TTL ~2@*~D~2%"
                    (soa-expire soa)
                    (soa-min-ttl soa)
                    (zone-default-ttl zone)))
-  (dolist (zr (zone-records zone))
+  (dolist (zr (zone-records-sorted zone))
     (tinydns-record (zr-type zr) zr)))
 
 ;;;----- That's all, folks --------------------------------------------------