net.lisp, zone.lisp: Improve commentary and docstrings.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 15 Apr 2014 10:57:24 +0000 (11:57 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 15 Apr 2014 15:47:05 +0000 (16:47 +0100)
Also one or two minor whitespace fixes.

net.lisp
zone.lisp

index e764581..d5f4d76 100644 (file)
--- a/net.lisp
+++ b/net.lisp
 
 (export 'string-ipaddr)
 (defun string-ipaddr (str &key (start 0) (end nil))
 
 (export 'string-ipaddr)
 (defun string-ipaddr (str &key (start 0) (end nil))
-  "Parse STR as an IP address in dotted-quad form and return the integer
-   equivalent.  STR may be anything at all: it's converted as if by
-   `stringify'.  The START and END arguments may be used to parse out a
-   substring."
+  "Parse STR into an address.
+
+   STR may be anything at all: it's converted as if by `stringify'.
+   The START and END arguments may be used to parse out a substring."
   (setf str (stringify str))
   (setf-default end (length str))
   (let ((addr 0) (noct 0))
   (setf str (stringify str))
   (setf-default end (length str))
   (let ((addr 0) (noct 0))
   (typep ip 'ipaddr))
 
 (defun ipaddr (ip)
   (typep ip 'ipaddr))
 
 (defun ipaddr (ip)
-  "Convert IP to an IP address.  If it's an integer, return it unchanged;
-   otherwise convert by `string-ipaddr'."
+  "Convert IP to an IP address.
+
+   If it's an integer, return it unchanged; otherwise convert by
+   `string-ipaddr'."
   (typecase ip
     (ipaddr ip)
     (t (string-ipaddr ip))))
   (typecase ip
     (ipaddr ip)
     (t (string-ipaddr ip))))
 
 (export 'ipmask-cidl-slash)
 (defun ipmask-cidl-slash (mask)
 
 (export 'ipmask-cidl-slash)
 (defun ipmask-cidl-slash (mask)
-  "Given a netmask MASK, return an integer N such that (integer-netmask N) =
-   MASK, or nil if this is impossible."
+  "Given a netmask MASK, try to compute a prefix length.
+
+   Return an integer N such that (integer-netmask N) = MASK, or nil if this
+   is impossible."
   (dotimes (i 33)
     (when (= mask (integer-netmask i))
       (return i))))
   (dotimes (i 33)
     (when (= mask (integer-netmask i))
       (return i))))
 
 (export 'with-ipnet)
 (defmacro with-ipnet ((net mask) ipn &body body)
 
 (export 'with-ipnet)
 (defmacro with-ipnet ((net mask) ipn &body body)
-  "Evaluate BODY with NET and MASK bound to the base address and netmask of
-   IPN.  Either NET or MASK (or, less usefully, both) may be nil if not
-   wanted."
+  "Evaluate the BODY with components of IPN in scope.
+
+   The NET is bound to the underlying network base address and MASK is bound
+   to the netmask, again as an integer.  Either (or both) of these may be nil
+   if not wanted."
   (with-gensyms tmp
     `(let ((,tmp ,ipn))
        (let (,@(and net `((,net (ipnet-net ,tmp))))
   (with-gensyms tmp
     `(let ((,tmp ,ipn))
        (let (,@(and net `((,net (ipnet-net ,tmp))))
 
 (export 'ipnet-host)
 (defun ipnet-host (ipn host)
 
 (export 'ipnet-host)
 (defun ipnet-host (ipn host)
-  "Return the address of the given HOST in network IPN.  This works even with
-   a non-contiguous netmask."
+  "Return the address of the given HOST in network IPN.
+
+   This works even with a non-contiguous netmask."
   (check-type host u32)
   (with-ipnet (net mask) ipn
     (let ((i 0) (m 1) (a net) (h host))
   (check-type host u32)
   (with-ipnet (net mask) ipn
     (let ((i 0) (m 1) (a net) (h host))
 
 (export 'parse-ipaddr)
 (defun parse-ipaddr (addr)
 
 (export 'parse-ipaddr)
 (defun parse-ipaddr (addr)
-  "Convert the string ADDR into an IP address: tries all sorts of things:
+  "Convert the string ADDR into an IP address.
+
+   Tries all sorts of things:
 
    (NET [INDEX])       index a network: NET is a network name defined by
                        defnet; INDEX is an index or one of the special
 
    (NET [INDEX])       index a network: NET is a network name defined by
                        defnet; INDEX is an index or one of the special
 
 (export 'net-get-as-ipnet)
 (defun net-get-as-ipnet (form)
 
 (export 'net-get-as-ipnet)
 (defun net-get-as-ipnet (form)
-  "Transform FORM into an ipnet.  FORM may be a network name, or something
-acceptable to the ipnet function."
+  "Transform FORM into an ipnet.
+
+   FORM may be a network name, or something acceptable to the ipnet
+   function."
   (let ((net (net-find form)))
     (if net (net-ipnet net)
        (ipnet form))))
 
 (defun process-net-form (root addr subnets)
   (let ((net (net-find form)))
     (if net (net-ipnet net)
        (ipnet form))))
 
 (defun process-net-form (root addr subnets)
-  "Unpack a net-form.  The return value is a list of entries, each of which
-   is a list of the form (NAME ADDR MASK).  The first entry is merely repeats
-   the given ROOT and ADDR arguments (unpacking ADDR into separate network
-   address and mask).  The SUBNETS are then processed: they are a list of
-   items of the form (NAME NUM-HOSTS . SUBNETS), where NAME names the subnet,
-   NUM-HOSTS is the number of hosts in it, and SUBNETS are its sub-subnets in
-   the same form.  An error is signalled if a net's subnets use up more hosts
-   than the net has to start with."
+  "Unpack a net-form.
+
+   The return value is a list of entries, each of which is a list of the form
+   (NAME ADDR MASK).  The first entry is merely repeats the given ROOT and
+   ADDR arguments (unpacking ADDR into separate network address and mask).
+   The SUBNETS are then processed: they are a list of items of the form (NAME
+   NUM-HOSTS . SUBNETS), where NAME names the subnet, NUM-HOSTS is the number
+   of hosts in it, and SUBNETS are its sub-subnets in the same form.  An
+   error is signalled if a net's subnets use up more hosts than the net has
+   to start with."
+
   (labels ((frob (subnets limit finger)
             (when subnets
               (destructuring-bind (name size &rest subs) (car subnets)
   (labels ((frob (subnets limit finger)
             (when subnets
               (destructuring-bind (name size &rest subs) (car subnets)
@@ -379,8 +393,10 @@ acceptable to the ipnet function."
 
 (export 'net-create)
 (defun net-create (name net)
 
 (export 'net-create)
 (defun net-create (name net)
-  "Construct a new network called NAME and add it to the map.  The ARGS
-   describe the new network, in a form acceptable to the ipnet function."
+  "Construct a new network called NAME and add it to the map.
+
+   The ARGS describe the new network, in a form acceptable to the `ipnet'
+   function."
   (let ((ipn (ipnet net)))
     (setf (net-find name)
          (make-net :name (string-downcase (stringify name))
   (let ((ipn (ipnet net)))
     (setf (net-find name)
          (make-net :name (string-downcase (stringify name))
@@ -390,7 +406,9 @@ acceptable to the ipnet function."
 
 (export 'defnet)
 (defmacro defnet (name net &rest subnets)
 
 (export 'defnet)
 (defmacro defnet (name net &rest subnets)
-  "Main network definition macro.  None of the arguments is evaluated."
+  "Main network definition macro.
+
+   None of the arguments is evaluated."
   `(progn
     ,@(loop for (name addr mask) in (process-net-form name net subnets)
            collect `(net-create ',name '(,addr . ,mask)))
   `(progn
     ,@(loop for (name addr mask) in (process-net-form name net subnets)
            collect `(net-create ',name '(,addr . ,mask)))
@@ -408,8 +426,9 @@ acceptable to the ipnet function."
 
 (export 'net-host)
 (defun net-host (net host)
 
 (export 'net-host)
 (defun net-host (net host)
-  "Return the given HOST on the NEXT.  HOST may be an index (in range, of
-   course), or one of the keywords:
+  "Return the given HOST on the NEXT.
+
+   HOST may be an index (in range, of course), or one of the keywords:
 
    :NEXT       next host, as by net-next-host
    :NET        network base address
 
    :NEXT       next host, as by net-next-host
    :NET        network base address
index 73f3f0f..9e5795d 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -63,7 +63,7 @@
 (defun timespec-seconds (ts)
   "Convert a timespec TS to 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
+   A timespec may be a real count of seconds, or a list (COUNT UNIT) UNIT
    may be any of a number of obvious time units."
   (cond ((null ts) 0)
        ((realp ts) (floor ts))
    may be any of a number of obvious time units."
   (cond ((null ts) 0)
        ((realp ts) (floor ts))
 
 (export 'zone-subdomain)
 (defstruct (zone-subdomain (:conc-name zs-))
 
 (export 'zone-subdomain)
 (defstruct (zone-subdomain (:conc-name zs-))
-  "A subdomain.  Slightly weird.  Used internally by zone-process-records
-   below, and shouldn't escape."
+  "A subdomain.
+
+   Slightly weird.  Used internally by `zone-process-records', and shouldn't
+   escape."
   name
   ttl
   records)
   name
   ttl
   records)
 
 (export 'preferred-subnet-case)
 (defmacro preferred-subnet-case (&body clauses)
 
 (export 'preferred-subnet-case)
 (defmacro preferred-subnet-case (&body clauses)
-  "CLAUSES have the form (SUBNETS . FORMS).
+  "Execute a form based on which networks are considered preferred.
 
 
-   Evaluate the first FORMS whose SUBNETS (a list or single symbol, not
-   evaluated) are considered preferred by zone-preferred-subnet-p.  If
-   SUBNETS is the symbol t then the clause always matches."
+   The CLAUSES have the form (SUBNETS . FORMS) -- evaluate the first FORMS
+   whose SUBNETS (a list or single symbol, not evaluated) are listed in
+   `*preferred-subnets*'.  If SUBNETS is the symbol `t' then the clause
+   always matches."
   `(cond
     ,@(mapcar (lambda (clause)
                (let ((subnets (car clause)))
   `(cond
     ,@(mapcar (lambda (clause)
                (let ((subnets (car clause)))
 
    TTL is the default time-to-live for records which don't specify one.
 
 
    TTL is the default time-to-live for records which don't specify one.
 
-   The syntax is a little fiddly to describe.  It operates relative to a
-   subzone name NAME.
+   REC is a list of records of the form
+
+       ({ :ttl TTL | TYPE DATA | (LABEL . REC) }*)
+
+   The various kinds of entries have the following meanings.
+
+   :ttl TTL            Set the TTL for subsequent records (at this level of
+                         nesting only).
+
+   TYPE DATA           Define a record with a particular TYPE and DATA.
+                         Record types are defined using `defzoneparse' and
+                         the syntax of the data is idiosyncratic.
+
+   ((LABEL ...) . REC) Define records for labels within the zone.  Any
+                         records defined within REC will have their domains
+                         prefixed by each of the LABELs.  A singleton list
+                         of labels may instead be written as a single
+                         label.  Note, therefore, that
+
+                               (host (sub :a \"169.254.1.1\"))
 
 
-   ZONE-RECORD: RR | TTL | SUBZONE
-       The body of a zone form is a sequence of these.
+                         defines a record for `host.sub' -- not `sub.host'.
 
 
-   TTL: :ttl INTEGER
-       Sets the TTL for subsequent RRs in this zone or subzone.
+   If REC contains no top-level records, but it does define records for a
+   label listed in `*preferred-subnets*', then the records for the first such
+   label are also promoted to top-level.
 
 
-   RR: SYMBOL DATA
-       Adds a record for the current NAME; the SYMBOL denotes the record
-       type, and the DATA depends on the type.
+   The FUNC is called for each record encountered, represented as a
+   `zone-record' object.  Zone parsers are not called: you get the record
+   types and data from the input form; see `zone-parse-records' if you want
+   the raw output."
 
 
-   SUBZONE: (LABELS ZONE-RECORD*)
-       Defines a subzone.  The LABELS is either a list of labels, or a
-       singleton label.  For each LABEL, evaluate the ZONE-RECORDs relative
-       to LABEL.NAME.  The special LABEL `@' is a no-op."
   (labels ((sift (rec ttl)
   (labels ((sift (rec ttl)
+            ;; Parse the record list REC into lists of `zone-record' and
+            ;; `zone-subdomain' objects, sorting out TTLs and so on.
+            ;; Returns them as two values.
+
             (collecting (top sub)
               (loop
                 (unless rec
             (collecting (top sub)
               (loop
                 (unless rec
                                     sub)))
                         (t
                          (error "Unexpected record form ~A" (car r))))))))
                                     sub)))
                         (t
                          (error "Unexpected record form ~A" (car r))))))))
+
           (process (rec dom ttl)
           (process (rec dom ttl)
+            ;; Recursirvely process the record list REC, with a list DOM of
+            ;; prefix labels, and a default TTL.  Promote records for a
+            ;; preferred subnet to toplevel if there are no toplevel records
+            ;; already.
+
             (multiple-value-bind (top sub) (sift rec ttl)
               (if (and dom (null top) sub)
                   (let ((preferred
             (multiple-value-bind (top sub) (sift rec ttl)
               (if (and dom (null top) sub)
                   (let ((preferred
                 (process (zs-records s)
                          (cons (zs-name s) dom)
                          (zs-ttl s))))))
                 (process (zs-records s)
                          (cons (zs-name s) dom)
                          (zs-ttl s))))))
+
+    ;; Process the records we're given with no prefix.
     (process rec nil ttl)))
 
 (export 'zone-parse-host)
 (defun zone-parse-host (f zname)
     (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."
+  "Parse a host name F.
+
+   If F ends in a dot then it's considered absolute; otherwise it's relative
+   to ZNAME."
   (setf f (stringify f))
   (cond ((string= f "@") (stringify zname))
        ((and (plusp (length f))
   (setf f (stringify f))
   (cond ((string= f "@") (stringify zname))
        ((and (plusp (length f))
 
 (export 'zone-make-name)
 (defun zone-make-name (prefix zone-name)
 
 (export 'zone-make-name)
 (defun zone-make-name (prefix zone-name)
+  "Compute a full domain name from a PREFIX and a ZONE-NAME.
+
+   If the PREFIX ends with `.' then it's absolute already; otherwise, append
+   the ZONE-NAME, separated with a `.'.  If PREFIX is nil, or `@', then
+   return the ZONE-NAME only."
   (if (or (not prefix) (string= prefix "@"))
       zone-name
       (let ((len (length prefix)))
   (if (or (not prefix) (string= prefix "@"))
       zone-name
       (let ((len (length prefix)))
                        &body body)
   "Define a new zone record type.
 
                        &body body)
   "Define a new zone record type.
 
-   The TYPES may be a list of synonyms.  The other arguments are as follows:
+   The arguments are as follows:
+
+   TYPES       A singleton type symbol, or a list of aliases.
 
    NAME                The name of the record to be added.
 
 
    NAME                The name of the record to be added.
 
                                                   :make-ptr-p ,tmakeptrp)
                                 ,col)))
                 ,@body)))
                                                   :make-ptr-p ,tmakeptrp)
                                 ,col)))
                 ,@body)))
-         ',type)))))
+          ',type)))))
 
 (export 'zone-parse-records)
 (defun zone-parse-records (zname ttl records)
 
 (export 'zone-parse-records)
 (defun zone-parse-records (zname ttl records)
 (defun zone-parse (zf)
   "Parse a ZONE form.
 
 (defun zone-parse (zf)
   "Parse a ZONE form.
 
-  The syntax of a zone form is as follows:
+   The syntax of a zone form is as follows:
 
    ZONE-FORM:
      ZONE-HEAD ZONE-RECORD*
 
    ZONE-FORM:
      ZONE-HEAD ZONE-RECORD*