Commit | Line | Data |
---|---|---|
7e282fb5 | 1 | ;;; -*-lisp-*- |
2 | ;;; | |
7e282fb5 | 3 | ;;; DNS zone generation |
4 | ;;; | |
5 | ;;; (c) 2005 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This program is free software; you can redistribute it and/or modify | |
11 | ;;; it under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 2 of the License, or | |
13 | ;;; (at your option) any later version. | |
7fff3797 | 14 | ;;; |
7e282fb5 | 15 | ;;; This program is distributed in the hope that it will be useful, |
16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
7fff3797 | 19 | ;;; |
7e282fb5 | 20 | ;;; You should have received a copy of the GNU General Public License |
21 | ;;; along with this program; if not, write to the Free Software Foundation, | |
22 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
23 | ||
fe5fb85a MW |
24 | ;;;-------------------------------------------------------------------------- |
25 | ;;; Packaging. | |
26 | ||
7e282fb5 | 27 | (defpackage #:zone |
716105aa MW |
28 | (:use #:common-lisp |
29 | #:mdw.base #:mdw.str #:collect #:safely | |
32ebbe9b MW |
30 | #:net #:services) |
31 | (:import-from #:net #:round-down #:round-up)) | |
fe5fb85a | 32 | |
7e282fb5 | 33 | (in-package #:zone) |
34 | ||
fe5fb85a MW |
35 | ;;;-------------------------------------------------------------------------- |
36 | ;;; Various random utilities. | |
37 | ||
38 | (defun to-integer (x) | |
39 | "Convert X to an integer in the most straightforward way." | |
40 | (floor (rational x))) | |
41 | ||
42 | (defun from-mixed-base (base val) | |
43 | "BASE is a list of the ranges for the `digits' of a mixed-base | |
2f1d381d | 44 | representation. Convert VAL, a list of digits, into an integer." |
fe5fb85a MW |
45 | (do ((base base (cdr base)) |
46 | (val (cdr val) (cdr val)) | |
47 | (a (car val) (+ (* a (car base)) (car val)))) | |
48 | ((or (null base) (null val)) a))) | |
49 | ||
50 | (defun to-mixed-base (base val) | |
51 | "BASE is a list of the ranges for the `digits' of a mixed-base | |
2f1d381d | 52 | representation. Convert VAL, an integer, into a list of digits." |
fe5fb85a MW |
53 | (let ((base (reverse base)) |
54 | (a nil)) | |
55 | (loop | |
56 | (unless base | |
57 | (push val a) | |
58 | (return a)) | |
59 | (multiple-value-bind (q r) (floor val (pop base)) | |
60 | (push r a) | |
61 | (setf val q))))) | |
62 | ||
afa2e2f1 | 63 | (export 'timespec-seconds) |
fe5fb85a | 64 | (defun timespec-seconds (ts) |
f38bc59e MW |
65 | "Convert a timespec TS to seconds. |
66 | ||
f4e0c48f | 67 | A timespec may be a real count of seconds, or a list (COUNT UNIT). UNIT |
f38bc59e | 68 | may be any of a number of obvious time units." |
fe5fb85a MW |
69 | (cond ((null ts) 0) |
70 | ((realp ts) (floor ts)) | |
71 | ((atom ts) | |
72 | (error "Unknown timespec format ~A" ts)) | |
73 | ((null (cdr ts)) | |
74 | (timespec-seconds (car ts))) | |
75 | (t (+ (to-integer (* (car ts) | |
76 | (case (intern (string-upcase | |
77 | (stringify (cadr ts))) | |
78 | '#:zone) | |
79 | ((s sec secs second seconds) 1) | |
80 | ((m min mins minute minutes) 60) | |
81 | ((h hr hrs hour hours) #.(* 60 60)) | |
82 | ((d dy dys day days) #.(* 24 60 60)) | |
83 | ((w wk wks week weeks) #.(* 7 24 60 60)) | |
84 | ((y yr yrs year years) #.(* 365 24 60 60)) | |
85 | (t (error "Unknown time unit ~A" | |
86 | (cadr ts)))))) | |
87 | (timespec-seconds (cddr ts)))))) | |
88 | ||
89 | (defun hash-table-keys (ht) | |
90 | "Return a list of the keys in hashtable HT." | |
91 | (collecting () | |
92 | (maphash (lambda (key val) (declare (ignore val)) (collect key)) ht))) | |
93 | ||
94 | (defun iso-date (&optional time &key datep timep (sep #\ )) | |
f38bc59e MW |
95 | "Construct a textual date or time in ISO format. |
96 | ||
97 | The TIME is the universal time to convert, which defaults to now; DATEP is | |
98 | whether to emit the date; TIMEP is whether to emit the time, and | |
99 | SEP (default is space) is how to separate the two." | |
fe5fb85a MW |
100 | (multiple-value-bind |
101 | (sec min hr day mon yr dow dstp tz) | |
102 | (decode-universal-time (if (or (null time) (eq time :now)) | |
103 | (get-universal-time) | |
104 | time)) | |
105 | (declare (ignore dow dstp tz)) | |
106 | (with-output-to-string (s) | |
107 | (when datep | |
108 | (format s "~4,'0D-~2,'0D-~2,'0D" yr mon day) | |
109 | (when timep | |
110 | (write-char sep s))) | |
111 | (when timep | |
112 | (format s "~2,'0D:~2,'0D:~2,'0D" hr min sec))))) | |
113 | ||
fe5fb85a MW |
114 | ;;;-------------------------------------------------------------------------- |
115 | ;;; Zone types. | |
7e282fb5 | 116 | |
afa2e2f1 | 117 | (export 'soa) |
7e282fb5 | 118 | (defstruct (soa (:predicate soap)) |
119 | "Start-of-authority record information." | |
120 | source | |
121 | admin | |
122 | refresh | |
123 | retry | |
124 | expire | |
125 | min-ttl | |
126 | serial) | |
fe5fb85a | 127 | |
afa2e2f1 | 128 | (export 'mx) |
7e282fb5 | 129 | (defstruct (mx (:predicate mxp)) |
130 | "Mail-exchange record information." | |
131 | priority | |
132 | domain) | |
fe5fb85a | 133 | |
afa2e2f1 | 134 | (export 'zone) |
7e282fb5 | 135 | (defstruct (zone (:predicate zonep)) |
136 | "Zone information." | |
137 | soa | |
138 | default-ttl | |
139 | name | |
140 | records) | |
141 | ||
fe5fb85a MW |
142 | ;;;-------------------------------------------------------------------------- |
143 | ;;; Zone defaults. It is intended that scripts override these. | |
144 | ||
afa2e2f1 | 145 | (export '*default-zone-source*) |
7e282fb5 | 146 | (defvar *default-zone-source* |
8e7c1366 | 147 | (let ((hn (gethostname))) |
8a4f9a18 | 148 | (and hn (concatenate 'string (canonify-hostname hn) "."))) |
7e282fb5 | 149 | "The default zone source: the current host's name.") |
fe5fb85a | 150 | |
afa2e2f1 | 151 | (export '*default-zone-refresh*) |
7e282fb5 | 152 | (defvar *default-zone-refresh* (* 24 60 60) |
153 | "Default zone refresh interval: one day.") | |
fe5fb85a | 154 | |
afa2e2f1 | 155 | (export '*default-zone-admin*) |
7e282fb5 | 156 | (defvar *default-zone-admin* nil |
157 | "Default zone administrator's email address.") | |
fe5fb85a | 158 | |
afa2e2f1 | 159 | (export '*default-zone-retry*) |
7e282fb5 | 160 | (defvar *default-zone-retry* (* 60 60) |
161 | "Default znoe retry interval: one hour.") | |
fe5fb85a | 162 | |
afa2e2f1 | 163 | (export '*default-zone-expire*) |
7e282fb5 | 164 | (defvar *default-zone-expire* (* 14 24 60 60) |
165 | "Default zone expiry time: two weeks.") | |
fe5fb85a | 166 | |
afa2e2f1 | 167 | (export '*default-zone-min-ttl*) |
7e282fb5 | 168 | (defvar *default-zone-min-ttl* (* 4 60 60) |
169 | "Default zone minimum TTL/negative TTL: four hours.") | |
fe5fb85a | 170 | |
afa2e2f1 | 171 | (export '*default-zone-ttl*) |
7e282fb5 | 172 | (defvar *default-zone-ttl* (* 8 60 60) |
173 | "Default zone TTL (for records without explicit TTLs): 8 hours.") | |
fe5fb85a | 174 | |
afa2e2f1 | 175 | (export '*default-mx-priority*) |
7e282fb5 | 176 | (defvar *default-mx-priority* 50 |
177 | "Default MX priority.") | |
178 | ||
fe5fb85a MW |
179 | ;;;-------------------------------------------------------------------------- |
180 | ;;; Zone variables and structures. | |
181 | ||
7e282fb5 | 182 | (defvar *zones* (make-hash-table :test #'equal) |
183 | "Map of known zones.") | |
fe5fb85a | 184 | |
afa2e2f1 | 185 | (export 'zone-find) |
7e282fb5 | 186 | (defun zone-find (name) |
187 | "Find a zone given its NAME." | |
188 | (gethash (string-downcase (stringify name)) *zones*)) | |
189 | (defun (setf zone-find) (zone name) | |
190 | "Make the zone NAME map to ZONE." | |
191 | (setf (gethash (string-downcase (stringify name)) *zones*) zone)) | |
192 | ||
afa2e2f1 | 193 | (export 'zone-record) |
7e282fb5 | 194 | (defstruct (zone-record (:conc-name zr-)) |
195 | "A zone record." | |
196 | (name '<unnamed>) | |
197 | ttl | |
198 | type | |
590ad961 | 199 | (make-ptr-p nil) |
7e282fb5 | 200 | data) |
201 | ||
afa2e2f1 | 202 | (export 'zone-subdomain) |
7e282fb5 | 203 | (defstruct (zone-subdomain (:conc-name zs-)) |
f4e0c48f MW |
204 | "A subdomain. |
205 | ||
206 | Slightly weird. Used internally by `zone-process-records', and shouldn't | |
207 | escape." | |
7e282fb5 | 208 | name |
209 | ttl | |
210 | records) | |
211 | ||
afa2e2f1 | 212 | (export '*zone-output-path*) |
3d7852d9 MW |
213 | (defvar *zone-output-path* nil |
214 | "Pathname defaults to merge into output files. | |
215 | ||
216 | If this is nil then use the prevailing `*default-pathname-defaults*'. | |
217 | This is not the same as capturing the `*default-pathname-defaults*' from | |
218 | load time.") | |
ab87c7bf | 219 | |
afa2e2f1 | 220 | (export '*preferred-subnets*) |
8ce7eb9b MW |
221 | (defvar *preferred-subnets* nil |
222 | "Subnets to prefer when selecting defaults.") | |
223 | ||
fe5fb85a MW |
224 | ;;;-------------------------------------------------------------------------- |
225 | ;;; Zone infrastructure. | |
226 | ||
ab87c7bf MW |
227 | (defun zone-file-name (zone type) |
228 | "Choose a file name for a given ZONE and TYPE." | |
229 | (merge-pathnames (make-pathname :name (string-downcase zone) | |
230 | :type (string-downcase type)) | |
3d7852d9 | 231 | (or *zone-output-path* *default-pathname-defaults*))) |
ab87c7bf | 232 | |
afa2e2f1 | 233 | (export 'zone-preferred-subnet-p) |
8ce7eb9b MW |
234 | (defun zone-preferred-subnet-p (name) |
235 | "Answer whether NAME (a string or symbol) names a preferred subnet." | |
236 | (member name *preferred-subnets* :test #'string-equal)) | |
237 | ||
afa2e2f1 | 238 | (export 'preferred-subnet-case) |
8bd2576e | 239 | (defmacro preferred-subnet-case (&body clauses) |
f4e0c48f | 240 | "Execute a form based on which networks are considered preferred. |
f38bc59e | 241 | |
f4e0c48f MW |
242 | The CLAUSES have the form (SUBNETS . FORMS) -- evaluate the first FORMS |
243 | whose SUBNETS (a list or single symbol, not evaluated) are listed in | |
244 | `*preferred-subnets*'. If SUBNETS is the symbol `t' then the clause | |
245 | always matches." | |
8bd2576e MW |
246 | `(cond |
247 | ,@(mapcar (lambda (clause) | |
248 | (let ((subnets (car clause))) | |
249 | (cons (cond ((eq subnets t) | |
250 | t) | |
251 | ((listp subnets) | |
252 | `(or ,@(mapcar (lambda (subnet) | |
253 | `(zone-preferred-subnet-p | |
254 | ',subnet)) | |
255 | subnets))) | |
256 | (t | |
257 | `(zone-preferred-subnet-p ',subnets))) | |
258 | (cdr clause)))) | |
259 | clauses))) | |
260 | ||
32ebbe9b MW |
261 | (export 'zone-parse-host) |
262 | (defun zone-parse-host (f zname) | |
263 | "Parse a host name F. | |
264 | ||
265 | If F ends in a dot then it's considered absolute; otherwise it's relative | |
266 | to ZNAME." | |
267 | (setf f (stringify f)) | |
268 | (cond ((string= f "@") (stringify zname)) | |
269 | ((and (plusp (length f)) | |
270 | (char= (char f (1- (length f))) #\.)) | |
271 | (string-downcase (subseq f 0 (1- (length f))))) | |
272 | (t (string-downcase (concatenate 'string f "." | |
273 | (stringify zname)))))) | |
274 | ||
275 | (export 'zone-make-name) | |
276 | (defun zone-make-name (prefix zone-name) | |
277 | "Compute a full domain name from a PREFIX and a ZONE-NAME. | |
278 | ||
279 | If the PREFIX ends with `.' then it's absolute already; otherwise, append | |
280 | the ZONE-NAME, separated with a `.'. If PREFIX is nil, or `@', then | |
281 | return the ZONE-NAME only." | |
282 | (if (or (not prefix) (string= prefix "@")) | |
283 | zone-name | |
284 | (let ((len (length prefix))) | |
285 | (if (or (zerop len) (char/= (char prefix (1- len)) #\.)) | |
286 | (join-strings #\. (list prefix zone-name)) | |
287 | prefix)))) | |
288 | ||
289 | ;;;-------------------------------------------------------------------------- | |
290 | ;;; Serial numbering. | |
291 | ||
292 | (export 'make-zone-serial) | |
293 | (defun make-zone-serial (name) | |
294 | "Given a zone NAME, come up with a new serial number. | |
295 | ||
296 | This will (very carefully) update a file ZONE.serial in the current | |
297 | directory." | |
298 | (let* ((file (zone-file-name name :serial)) | |
299 | (last (with-open-file (in file | |
300 | :direction :input | |
301 | :if-does-not-exist nil) | |
302 | (if in (read in) | |
303 | (list 0 0 0 0)))) | |
304 | (now (multiple-value-bind | |
305 | (sec min hr dy mon yr dow dstp tz) | |
306 | (get-decoded-time) | |
307 | (declare (ignore sec min hr dow dstp tz)) | |
308 | (list dy mon yr))) | |
309 | (seq (cond ((not (equal now (cdr last))) 0) | |
310 | ((< (car last) 99) (1+ (car last))) | |
311 | (t (error "Run out of sequence numbers for ~A" name))))) | |
312 | (safely-writing (out file) | |
313 | (format out | |
314 | ";; Serial number file for zone ~A~%~ | |
315 | ;; (LAST-SEQ DAY MONTH YEAR)~%~ | |
316 | ~S~%" | |
317 | name | |
318 | (cons seq now))) | |
319 | (from-mixed-base '(100 100 100) (reverse (cons seq now))))) | |
320 | ||
321 | ;;;-------------------------------------------------------------------------- | |
322 | ;;; Zone form parsing. | |
323 | ||
7e282fb5 | 324 | (defun zone-process-records (rec ttl func) |
f38bc59e MW |
325 | "Sort out the list of records in REC, calling FUNC for each one. |
326 | ||
baad8564 MW |
327 | TTL is the default time-to-live for records which don't specify one. |
328 | ||
f4e0c48f MW |
329 | REC is a list of records of the form |
330 | ||
331 | ({ :ttl TTL | TYPE DATA | (LABEL . REC) }*) | |
332 | ||
333 | The various kinds of entries have the following meanings. | |
334 | ||
335 | :ttl TTL Set the TTL for subsequent records (at this level of | |
336 | nesting only). | |
337 | ||
338 | TYPE DATA Define a record with a particular TYPE and DATA. | |
339 | Record types are defined using `defzoneparse' and | |
340 | the syntax of the data is idiosyncratic. | |
341 | ||
342 | ((LABEL ...) . REC) Define records for labels within the zone. Any | |
343 | records defined within REC will have their domains | |
344 | prefixed by each of the LABELs. A singleton list | |
345 | of labels may instead be written as a single | |
346 | label. Note, therefore, that | |
347 | ||
348 | (host (sub :a \"169.254.1.1\")) | |
baad8564 | 349 | |
f4e0c48f | 350 | defines a record for `host.sub' -- not `sub.host'. |
baad8564 | 351 | |
f4e0c48f MW |
352 | If REC contains no top-level records, but it does define records for a |
353 | label listed in `*preferred-subnets*', then the records for the first such | |
354 | label are also promoted to top-level. | |
baad8564 | 355 | |
f4e0c48f MW |
356 | The FUNC is called for each record encountered, represented as a |
357 | `zone-record' object. Zone parsers are not called: you get the record | |
358 | types and data from the input form; see `zone-parse-records' if you want | |
359 | the raw output." | |
baad8564 | 360 | |
7e282fb5 | 361 | (labels ((sift (rec ttl) |
f4e0c48f MW |
362 | ;; Parse the record list REC into lists of `zone-record' and |
363 | ;; `zone-subdomain' objects, sorting out TTLs and so on. | |
364 | ;; Returns them as two values. | |
365 | ||
7e282fb5 | 366 | (collecting (top sub) |
367 | (loop | |
368 | (unless rec | |
369 | (return)) | |
370 | (let ((r (pop rec))) | |
371 | (cond ((eq r :ttl) | |
372 | (setf ttl (pop rec))) | |
373 | ((symbolp r) | |
374 | (collect (make-zone-record :type r | |
375 | :ttl ttl | |
376 | :data (pop rec)) | |
377 | top)) | |
378 | ((listp r) | |
379 | (dolist (name (listify (car r))) | |
380 | (collect (make-zone-subdomain :name name | |
381 | :ttl ttl | |
382 | :records (cdr r)) | |
383 | sub))) | |
384 | (t | |
385 | (error "Unexpected record form ~A" (car r)))))))) | |
f4e0c48f | 386 | |
4e7e3780 | 387 | (process (rec dom ttl) |
f4e0c48f MW |
388 | ;; Recursirvely process the record list REC, with a list DOM of |
389 | ;; prefix labels, and a default TTL. Promote records for a | |
390 | ;; preferred subnet to toplevel if there are no toplevel records | |
391 | ;; already. | |
392 | ||
7e282fb5 | 393 | (multiple-value-bind (top sub) (sift rec ttl) |
394 | (if (and dom (null top) sub) | |
64e34a97 MW |
395 | (let ((preferred |
396 | (or (find-if (lambda (s) | |
397 | (some #'zone-preferred-subnet-p | |
398 | (listify (zs-name s)))) | |
399 | sub) | |
400 | (car sub)))) | |
8ce7eb9b MW |
401 | (when preferred |
402 | (process (zs-records preferred) | |
403 | dom | |
404 | (zs-ttl preferred)))) | |
405 | (let ((name (and dom | |
406 | (string-downcase | |
407 | (join-strings #\. (reverse dom)))))) | |
408 | (dolist (zr top) | |
409 | (setf (zr-name zr) name) | |
410 | (funcall func zr)))) | |
7e282fb5 | 411 | (dolist (s sub) |
412 | (process (zs-records s) | |
413 | (cons (zs-name s) dom) | |
4e7e3780 | 414 | (zs-ttl s)))))) |
f4e0c48f MW |
415 | |
416 | ;; Process the records we're given with no prefix. | |
4e7e3780 | 417 | (process rec nil ttl))) |
7e282fb5 | 418 | |
7e282fb5 | 419 | (defun zone-parse-head (head) |
f38bc59e MW |
420 | "Parse the HEAD of a zone form. |
421 | ||
422 | This has the form | |
7e282fb5 | 423 | |
424 | (NAME &key :source :admin :refresh :retry | |
b23c65ee | 425 | :expire :min-ttl :ttl :serial) |
7e282fb5 | 426 | |
2f1d381d MW |
427 | though a singleton NAME needn't be a list. Returns the default TTL and an |
428 | soa structure representing the zone head." | |
7e282fb5 | 429 | (destructuring-bind |
430 | (zname | |
431 | &key | |
8a4f9a18 | 432 | (source *default-zone-source*) |
7e282fb5 | 433 | (admin (or *default-zone-admin* |
434 | (format nil "hostmaster@~A" zname))) | |
435 | (refresh *default-zone-refresh*) | |
436 | (retry *default-zone-retry*) | |
437 | (expire *default-zone-expire*) | |
438 | (min-ttl *default-zone-min-ttl*) | |
439 | (ttl min-ttl) | |
440 | (serial (make-zone-serial zname))) | |
441 | (listify head) | |
442 | (values zname | |
443 | (timespec-seconds ttl) | |
444 | (make-soa :admin admin | |
445 | :source (zone-parse-host source zname) | |
446 | :refresh (timespec-seconds refresh) | |
447 | :retry (timespec-seconds retry) | |
448 | :expire (timespec-seconds expire) | |
449 | :min-ttl (timespec-seconds min-ttl) | |
450 | :serial serial)))) | |
451 | ||
afa2e2f1 | 452 | (export 'defzoneparse) |
7e282fb5 | 453 | (defmacro defzoneparse (types (name data list |
5bf80328 | 454 | &key (prefix (gensym "PREFIX")) |
b23c65ee MW |
455 | (zname (gensym "ZNAME")) |
456 | (ttl (gensym "TTL"))) | |
7e282fb5 | 457 | &body body) |
f38bc59e MW |
458 | "Define a new zone record type. |
459 | ||
f4e0c48f MW |
460 | The arguments are as follows: |
461 | ||
462 | TYPES A singleton type symbol, or a list of aliases. | |
fe5fb85a | 463 | |
2f1d381d | 464 | NAME The name of the record to be added. |
fe5fb85a | 465 | |
2f1d381d | 466 | DATA The content of the record to be added (a single object, |
7fff3797 | 467 | unevaluated). |
fe5fb85a | 468 | |
2f1d381d | 469 | LIST A function to add a record to the zone. See below. |
fe5fb85a | 470 | |
5bf80328 MW |
471 | PREFIX The prefix tag used in the original form. |
472 | ||
2f1d381d | 473 | ZNAME The name of the zone being constructed. |
fe5fb85a | 474 | |
2f1d381d | 475 | TTL The TTL for this record. |
fe5fb85a | 476 | |
5bf80328 MW |
477 | You get to choose your own names for these. ZNAME, PREFIX and TTL are |
478 | optional: you don't have to accept them if you're not interested. | |
fe5fb85a | 479 | |
2f1d381d MW |
480 | The LIST argument names a function to be bound in the body to add a new |
481 | low-level record to the zone. It has the prototype | |
fe5fb85a | 482 | |
590ad961 | 483 | (LIST &key :name :type :data :ttl :make-ptr-p) |
fe5fb85a | 484 | |
590ad961 MW |
485 | These (except MAKE-PTR-P, which defaults to nil) default to the above |
486 | arguments (even if you didn't accept the arguments)." | |
7e282fb5 | 487 | (setf types (listify types)) |
488 | (let* ((type (car types)) | |
489 | (func (intern (format nil "ZONE-PARSE/~:@(~A~)" type)))) | |
2ec279f5 | 490 | (with-parsed-body (body decls doc) body |
590ad961 | 491 | (with-gensyms (col tname ttype tttl tdata tmakeptrp i) |
40ded1b8 MW |
492 | `(progn |
493 | (dolist (,i ',types) | |
494 | (setf (get ,i 'zone-parse) ',func)) | |
5bf80328 | 495 | (defun ,func (,prefix ,zname ,data ,ttl ,col) |
40ded1b8 MW |
496 | ,@doc |
497 | ,@decls | |
5bf80328 MW |
498 | (let ((,name (zone-make-name ,prefix ,zname))) |
499 | (flet ((,list (&key ((:name ,tname) ,name) | |
500 | ((:type ,ttype) ,type) | |
501 | ((:data ,tdata) ,data) | |
590ad961 MW |
502 | ((:ttl ,tttl) ,ttl) |
503 | ((:make-ptr-p ,tmakeptrp) nil)) | |
f4decf40 | 504 | #+cmu (declare (optimize ext:inhibit-warnings)) |
5bf80328 MW |
505 | (collect (make-zone-record :name ,tname |
506 | :type ,ttype | |
507 | :data ,tdata | |
590ad961 MW |
508 | :ttl ,tttl |
509 | :make-ptr-p ,tmakeptrp) | |
5bf80328 MW |
510 | ,col))) |
511 | ,@body))) | |
f4e0c48f | 512 | ',type))))) |
7e282fb5 | 513 | |
8fcf1ae3 MW |
514 | (export 'zone-parse-records) |
515 | (defun zone-parse-records (zname ttl records) | |
516 | "Parse a sequence of RECORDS and return a list of raw records. | |
517 | ||
518 | The records are parsed relative to the zone name ZNAME, and using the | |
519 | given default TTL." | |
520 | (collecting (rec) | |
521 | (flet ((parse-record (zr) | |
522 | (let ((func (or (get (zr-type zr) 'zone-parse) | |
523 | (error "No parser for record ~A." | |
524 | (zr-type zr)))) | |
525 | (name (and (zr-name zr) (stringify (zr-name zr))))) | |
526 | (funcall func name zname (zr-data zr) (zr-ttl zr) rec)))) | |
527 | (zone-process-records records ttl #'parse-record)))) | |
7e282fb5 | 528 | |
afa2e2f1 | 529 | (export 'zone-parse) |
7e282fb5 | 530 | (defun zone-parse (zf) |
f38bc59e MW |
531 | "Parse a ZONE form. |
532 | ||
f4e0c48f | 533 | The syntax of a zone form is as follows: |
7e282fb5 | 534 | |
2f1d381d MW |
535 | ZONE-FORM: |
536 | ZONE-HEAD ZONE-RECORD* | |
7e282fb5 | 537 | |
2f1d381d MW |
538 | ZONE-RECORD: |
539 | ((NAME*) ZONE-RECORD*) | |
540 | | SYM ARGS" | |
7e282fb5 | 541 | (multiple-value-bind (zname ttl soa) (zone-parse-head (car zf)) |
8fcf1ae3 MW |
542 | (make-zone :name zname |
543 | :default-ttl ttl | |
544 | :soa soa | |
545 | :records (zone-parse-records zname ttl (cdr zf))))) | |
7e282fb5 | 546 | |
afa2e2f1 | 547 | (export 'zone-create) |
fe5fb85a MW |
548 | (defun zone-create (zf) |
549 | "Zone construction function. Given a zone form ZF, construct the zone and | |
2f1d381d | 550 | add it to the table." |
fe5fb85a MW |
551 | (let* ((zone (zone-parse zf)) |
552 | (name (zone-name zone))) | |
553 | (setf (zone-find name) zone) | |
554 | name)) | |
555 | ||
afa2e2f1 | 556 | (export 'defzone) |
32ebbe9b | 557 | (defmacro defzone (soa &body zf) |
fe5fb85a MW |
558 | "Zone definition macro." |
559 | `(zone-create '(,soa ,@zf))) | |
560 | ||
32ebbe9b MW |
561 | (export '*address-family*) |
562 | (defvar *address-family* t | |
563 | "The default address family. This is bound by `defrevzone'.") | |
564 | ||
afa2e2f1 | 565 | (export 'defrevzone) |
32ebbe9b | 566 | (defmacro defrevzone (head &body zf) |
fe5fb85a | 567 | "Define a reverse zone, with the correct name." |
32ebbe9b MW |
568 | (destructuring-bind (nets &rest args |
569 | &key &allow-other-keys | |
570 | (family '*address-family*) | |
571 | prefix-bits) | |
fe5fb85a | 572 | (listify head) |
32ebbe9b MW |
573 | (with-gensyms (ipn) |
574 | `(dolist (,ipn (net-parse-to-ipnets ',nets ,family)) | |
575 | (let ((*address-family* (ipnet-family ,ipn))) | |
576 | (zone-create `((,(reverse-domain ,ipn ,prefix-bits) | |
577 | ,@',(loop for (k v) on args by #'cddr | |
578 | unless (member k | |
579 | '(:family :prefix-bits)) | |
580 | nconc (list k v))) | |
581 | ,@',zf))))))) | |
582 | ||
583 | (defun map-host-addresses (func addr &key (family *address-family*)) | |
584 | "Call FUNC for each address denoted by ADDR (a `host-parse' address)." | |
585 | ||
586 | (dolist (a (host-addrs (host-parse addr family))) | |
587 | (funcall func a))) | |
588 | ||
589 | (defmacro do-host ((addr spec &key (family *address-family*)) &body body) | |
590 | "Evaluate BODY, binding ADDR to each address denoted by SPEC." | |
591 | `(dolist (,addr (host-addrs (host-parse ,spec ,family))) | |
592 | ,@body)) | |
593 | ||
594 | (export 'zone-set-address) | |
595 | (defun zone-set-address (rec addrspec &rest args | |
596 | &key (family *address-family*) name ttl make-ptr-p) | |
597 | "Write records (using REC) defining addresses for ADDRSPEC." | |
598 | (declare (ignore name ttl make-ptr-p)) | |
599 | (let ((key-args (loop for (k v) on args by #'cddr | |
600 | unless (eq k :family) | |
601 | nconc (list k v)))) | |
602 | (do-host (addr addrspec :family family) | |
603 | (apply rec :type (ipaddr-rrtype addr) :data addr key-args)))) | |
fe5fb85a MW |
604 | |
605 | ;;;-------------------------------------------------------------------------- | |
606 | ;;; Zone record parsers. | |
607 | ||
4e7e3780 | 608 | (defzoneparse :a (name data rec) |
7e282fb5 | 609 | ":a IPADDR" |
32ebbe9b MW |
610 | (zone-set-address #'rec data :make-ptr-p t :family :ipv4)) |
611 | ||
612 | (defzoneparse :addr (name data rec) | |
613 | ":addr IPADDR" | |
614 | (zone-set-address #'rec data :make-ptr-p t)) | |
590ad961 MW |
615 | |
616 | (defzoneparse :svc (name data rec) | |
617 | ":svc IPADDR" | |
32ebbe9b | 618 | (zone-set-address #'rec data)) |
fe5fb85a | 619 | |
7e282fb5 | 620 | (defzoneparse :ptr (name data rec :zname zname) |
621 | ":ptr HOST" | |
622 | (rec :data (zone-parse-host data zname))) | |
fe5fb85a | 623 | |
7e282fb5 | 624 | (defzoneparse :cname (name data rec :zname zname) |
625 | ":cname HOST" | |
626 | (rec :data (zone-parse-host data zname))) | |
fe5fb85a | 627 | |
90022a23 MW |
628 | (defzoneparse :txt (name data rec) |
629 | ":txt TEXT" | |
630 | (rec :data data)) | |
631 | ||
f760c73a MW |
632 | (export '*dkim-pathname-defaults*) |
633 | (defvar *dkim-pathname-defaults* | |
634 | (make-pathname :directory '(:relative "keys") | |
635 | :type "dkim")) | |
636 | ||
75f39e1a MW |
637 | (defzoneparse :dkim (name data rec) |
638 | ":dkim (KEYFILE {:TAG VALUE}*)" | |
639 | (destructuring-bind (file &rest plist) (listify data) | |
640 | (let ((things nil) (out nil)) | |
641 | (labels ((flush () | |
642 | (when out | |
643 | (push (get-output-stream-string out) things) | |
644 | (setf out nil))) | |
645 | (emit (text) | |
646 | (let ((len (length text))) | |
647 | (when (and out (> (+ (file-position out) | |
648 | (length text)) | |
649 | 64)) | |
650 | (flush)) | |
651 | (when (plusp len) | |
652 | (cond ((< len 64) | |
653 | (unless out (setf out (make-string-output-stream))) | |
654 | (write-string text out)) | |
655 | (t | |
656 | (do ((i 0 j) | |
657 | (j 64 (+ j 64))) | |
658 | ((>= i len)) | |
659 | (push (subseq text i (min j len)) things)))))))) | |
660 | (do ((p plist (cddr p))) | |
661 | ((endp p)) | |
662 | (emit (format nil "~(~A~)=~A;" (car p) (cadr p)))) | |
663 | (emit (with-output-to-string (out) | |
664 | (write-string "p=" out) | |
665 | (when file | |
f760c73a MW |
666 | (with-open-file |
667 | (in (merge-pathnames file *dkim-pathname-defaults*)) | |
75f39e1a MW |
668 | (loop |
669 | (when (string= (read-line in) | |
670 | "-----BEGIN PUBLIC KEY-----") | |
671 | (return))) | |
672 | (loop | |
673 | (let ((line (read-line in))) | |
674 | (if (string= line "-----END PUBLIC KEY-----") | |
675 | (return) | |
676 | (write-string line out))))))))) | |
677 | (rec :type :txt | |
678 | :data (nreverse things))))) | |
679 | ||
f1d7d492 MW |
680 | (eval-when (:load-toplevel :execute) |
681 | (dolist (item '((sshfp-algorithm rsa 1) | |
682 | (sshfp-algorithm dsa 2) | |
683 | (sshfp-algorithm ecdsa 3) | |
684 | (sshfp-type sha-1 1) | |
685 | (sshfp-type sha-256 2))) | |
686 | (destructuring-bind (prop sym val) item | |
687 | (setf (get sym prop) val) | |
688 | (export sym)))) | |
689 | ||
f760c73a MW |
690 | (export '*sshfp-pathname-defaults*) |
691 | (defvar *sshfp-pathname-defaults* | |
692 | (make-pathname :directory '(:relative "keys") | |
693 | :type "sshfp")) | |
694 | ||
f1d7d492 MW |
695 | (defzoneparse :sshfp (name data rec) |
696 | ":sshfp { FILENAME | ((FPR :alg ALG :type HASH)*) }" | |
697 | (if (stringp data) | |
f760c73a | 698 | (with-open-file (in (merge-pathnames data *sshfp-pathname-defaults*)) |
f1d7d492 MW |
699 | (loop (let ((line (read-line in nil))) |
700 | (unless line (return)) | |
701 | (let ((words (str-split-words line))) | |
702 | (pop words) | |
703 | (when (string= (car words) "IN") (pop words)) | |
704 | (unless (and (string= (car words) "SSHFP") | |
705 | (= (length words) 4)) | |
706 | (error "Invalid SSHFP record.")) | |
707 | (pop words) | |
708 | (destructuring-bind (alg type fpr) words | |
709 | (rec :data (list (parse-integer alg) | |
710 | (parse-integer type) | |
711 | fpr))))))) | |
712 | (flet ((lookup (what prop) | |
713 | (etypecase what | |
714 | (fixnum what) | |
715 | (symbol (or (get what prop) | |
716 | (error "~S is not a known ~A" what prop)))))) | |
48608192 MW |
717 | (dolist (item (listify data)) |
718 | (destructuring-bind (fpr &key (alg 'rsa) (type 'sha-1)) | |
719 | (listify item) | |
720 | (rec :data (list (lookup alg 'sshfp-algorithm) | |
721 | (lookup type 'sshfp-type) | |
722 | fpr))))))) | |
f1d7d492 | 723 | |
7e282fb5 | 724 | (defzoneparse :mx (name data rec :zname zname) |
725 | ":mx ((HOST :prio INT :ip IPADDR)*)" | |
726 | (dolist (mx (listify data)) | |
727 | (destructuring-bind | |
728 | (mxname &key (prio *default-mx-priority*) ip) | |
729 | (listify mx) | |
730 | (let ((host (zone-parse-host mxname zname))) | |
32ebbe9b | 731 | (when ip (zone-set-address #'rec ip :name host)) |
7e282fb5 | 732 | (rec :data (cons host prio)))))) |
fe5fb85a | 733 | |
7e282fb5 | 734 | (defzoneparse :ns (name data rec :zname zname) |
735 | ":ns ((HOST :ip IPADDR)*)" | |
736 | (dolist (ns (listify data)) | |
737 | (destructuring-bind | |
738 | (nsname &key ip) | |
739 | (listify ns) | |
740 | (let ((host (zone-parse-host nsname zname))) | |
32ebbe9b | 741 | (when ip (zone-set-address #'rec ip :name host)) |
7e282fb5 | 742 | (rec :data host))))) |
fe5fb85a | 743 | |
7e282fb5 | 744 | (defzoneparse :alias (name data rec :zname zname) |
745 | ":alias (LABEL*)" | |
746 | (dolist (a (listify data)) | |
747 | (rec :name (zone-parse-host a zname) | |
748 | :type :cname | |
749 | :data name))) | |
fe5fb85a | 750 | |
716105aa MW |
751 | (defzoneparse :srv (name data rec :zname zname) |
752 | ":srv (((SERVICE &key :port) (PROVIDER &key :port :prio :weight :ip)*)*)" | |
753 | (dolist (srv data) | |
754 | (destructuring-bind (servopts &rest providers) srv | |
755 | (destructuring-bind | |
756 | (service &key ((:port default-port)) (protocol :tcp)) | |
757 | (listify servopts) | |
758 | (unless default-port | |
759 | (let ((serv (serv-by-name service protocol))) | |
760 | (setf default-port (and serv (serv-port serv))))) | |
761 | (let ((rname (format nil "~(_~A._~A~).~A" service protocol name))) | |
762 | (dolist (prov providers) | |
763 | (destructuring-bind | |
764 | (srvname | |
765 | &key | |
766 | (port default-port) | |
767 | (prio *default-mx-priority*) | |
768 | (weight 0) | |
769 | ip) | |
770 | (listify prov) | |
771 | (let ((host (zone-parse-host srvname zname))) | |
32ebbe9b | 772 | (when ip (zone-set-address #'rec ip :name host)) |
716105aa MW |
773 | (rec :name rname |
774 | :data (list prio weight port host)))))))))) | |
775 | ||
a15288b4 | 776 | (defzoneparse :net (name data rec) |
777 | ":net (NETWORK*)" | |
778 | (dolist (net (listify data)) | |
32ebbe9b MW |
779 | (dolist (ipn (net-ipnets (net-must-find net))) |
780 | (let* ((base (ipnet-net ipn)) | |
781 | (rrtype (ipaddr-rrtype base))) | |
782 | (flet ((frob (kind addr) | |
783 | (when addr | |
784 | (rec :name (zone-parse-host kind name) | |
785 | :type rrtype | |
786 | :data addr)))) | |
787 | (frob "net" base) | |
788 | (frob "mask" (ipaddr (ipnet-mask ipn) (ipnet-family ipn))) | |
789 | (frob "bcast" (ipnet-broadcast ipn))))))) | |
7fff3797 | 790 | |
7e282fb5 | 791 | (defzoneparse (:rev :reverse) (name data rec) |
32ebbe9b | 792 | ":reverse ((NET &key :prefix-bits :family) ZONE*) |
679775ba MW |
793 | |
794 | Add a reverse record each host in the ZONEs (or all zones) that lies | |
32ebbe9b | 795 | within NET." |
7e282fb5 | 796 | (setf data (listify data)) |
32ebbe9b MW |
797 | (destructuring-bind (net &key prefix-bits (family *address-family*)) |
798 | (listify (car data)) | |
799 | ||
800 | (dolist (ipn (net-parse-to-ipnets net family)) | |
801 | (let* ((seen (make-hash-table :test #'equal)) | |
802 | (width (ipnet-width ipn)) | |
803 | (frag-len (if prefix-bits (- width prefix-bits) | |
804 | (ipnet-changeable-bits width (ipnet-mask ipn))))) | |
805 | (dolist (z (or (cdr data) (hash-table-keys *zones*))) | |
806 | (dolist (zr (zone-records (zone-find z))) | |
807 | (when (and (eq (zr-type zr) (ipaddr-rrtype (ipnet-net ipn))) | |
808 | (zr-make-ptr-p zr) | |
809 | (ipaddr-networkp (ipaddr-addr (zr-data zr)) ipn)) | |
810 | (let* ((frag (reverse-domain-fragment (zr-data zr) | |
811 | 0 frag-len)) | |
812 | (name (concatenate 'string frag "." name))) | |
813 | (unless (gethash name seen) | |
814 | (rec :name name :type :ptr | |
815 | :ttl (zr-ttl zr) :data (zr-name zr)) | |
816 | (setf (gethash name seen) t)))))))))) | |
817 | ||
818 | (defzoneparse (:multi) (name data rec :zname zname :ttl ttl) | |
819 | ":multi (((NET*) &key :start :end :family :suffix) . REC) | |
820 | ||
821 | Output multiple records covering a portion of the reverse-resolution | |
822 | namespace corresponding to the particular NETs. The START and END bounds | |
823 | default to the most significant variable component of the | |
824 | reverse-resolution domain. | |
825 | ||
826 | The REC tail is a sequence of record forms (as handled by | |
827 | `zone-process-records') to be emitted for each covered address. Within | |
828 | the bodies of these forms, the symbol `*' will be replaced by the | |
829 | domain-name fragment corresponding to the current host, optionally | |
830 | followed by the SUFFIX. | |
831 | ||
832 | Examples: | |
833 | ||
834 | (:multi ((delegated-subnet :start 8) | |
835 | :ns (some.ns.delegated.example :ip \"169.254.5.2\"))) | |
836 | ||
837 | (:multi ((tiny-subnet :suffix \"128.10.254.169.in-addr.arpa\") | |
838 | :cname *)) | |
839 | ||
840 | Obviously, nested `:multi' records won't work well." | |
841 | ||
842 | (destructuring-bind (nets &key start end (family *address-family*) suffix) | |
843 | (listify (car data)) | |
844 | (dolist (net (listify nets)) | |
845 | (dolist (ipn (net-parse-to-ipnets net family)) | |
846 | (let* ((addr (ipnet-net ipn)) | |
847 | (width (ipaddr-width addr)) | |
848 | (comp-width (reverse-domain-component-width addr)) | |
849 | (end (round-up (or end | |
850 | (ipnet-changeable-bits width | |
851 | (ipnet-mask ipn))) | |
852 | comp-width)) | |
853 | (start (round-down (or start (- end comp-width)) | |
854 | comp-width)) | |
855 | (map (ipnet-host-map ipn))) | |
856 | (multiple-value-bind (host-step host-limit) | |
857 | (ipnet-index-bounds map start end) | |
858 | (do ((index 0 (+ index host-step))) | |
859 | ((> index host-limit)) | |
860 | (let* ((addr (ipnet-index-host map index)) | |
861 | (frag (reverse-domain-fragment addr start end)) | |
862 | (target (concatenate 'string | |
863 | (zone-make-name | |
864 | (if (not suffix) frag | |
865 | (concatenate 'string | |
866 | frag "." suffix)) | |
867 | zname) | |
868 | "."))) | |
869 | (dolist (zr (zone-parse-records (zone-make-name frag zname) | |
870 | ttl | |
871 | (subst target '* | |
872 | (cdr data)))) | |
873 | (rec :name (zr-name zr) | |
874 | :type (zr-type zr) | |
875 | :data (zr-data zr) | |
876 | :ttl (zr-ttl zr) | |
877 | :make-ptr-p (zr-make-ptr-p zr))))))))))) | |
7e282fb5 | 878 | |
fe5fb85a MW |
879 | ;;;-------------------------------------------------------------------------- |
880 | ;;; Zone file output. | |
7e282fb5 | 881 | |
afa2e2f1 | 882 | (export 'zone-write) |
a567a3bc MW |
883 | (defgeneric zone-write (format zone stream) |
884 | (:documentation "Write ZONE's records to STREAM in the specified FORMAT.")) | |
885 | ||
886 | (defvar *writing-zone* nil | |
887 | "The zone currently being written.") | |
888 | ||
889 | (defvar *zone-output-stream* nil | |
890 | "Stream to write zone data on.") | |
891 | ||
892 | (defmethod zone-write :around (format zone stream) | |
b68068e3 | 893 | (declare (ignore format)) |
a567a3bc MW |
894 | (let ((*writing-zone* zone) |
895 | (*zone-output-stream* stream)) | |
896 | (call-next-method))) | |
897 | ||
afa2e2f1 | 898 | (export 'zone-save) |
a567a3bc MW |
899 | (defun zone-save (zones &key (format :bind)) |
900 | "Write the named ZONES to files. If no zones are given, write all the | |
901 | zones." | |
902 | (unless zones | |
903 | (setf zones (hash-table-keys *zones*))) | |
904 | (safely (safe) | |
905 | (dolist (z zones) | |
906 | (let ((zz (zone-find z))) | |
907 | (unless zz | |
908 | (error "Unknown zone `~A'." z)) | |
909 | (let ((stream (safely-open-output-stream safe | |
910 | (zone-file-name z :zone)))) | |
911 | (zone-write format zz stream)))))) | |
912 | ||
913 | ;;;-------------------------------------------------------------------------- | |
914 | ;;; Bind format output. | |
915 | ||
afa2e2f1 | 916 | (export 'bind-hostname) |
a567a3bc MW |
917 | (defun bind-hostname (hostname) |
918 | (if (not hostname) | |
919 | "@" | |
920 | (let* ((h (string-downcase (stringify hostname))) | |
921 | (hl (length h)) | |
922 | (r (string-downcase (zone-name *writing-zone*))) | |
923 | (rl (length r))) | |
924 | (cond ((string= r h) "@") | |
925 | ((and (> hl rl) | |
926 | (char= (char h (- hl rl 1)) #\.) | |
927 | (string= h r :start1 (- hl rl))) | |
928 | (subseq h 0 (- hl rl 1))) | |
929 | (t (concatenate 'string h ".")))))) | |
930 | ||
32ebbe9b MW |
931 | (export 'bind-record) |
932 | (defgeneric bind-record (type zr)) | |
933 | ||
a567a3bc MW |
934 | (defmethod zone-write ((format (eql :bind)) zone stream) |
935 | (format stream "~ | |
7e282fb5 | 936 | ;;; Zone file `~(~A~)' |
937 | ;;; (generated ~A) | |
938 | ||
7d593efd MW |
939 | $ORIGIN ~0@*~(~A.~) |
940 | $TTL ~2@*~D~2%" | |
7e282fb5 | 941 | (zone-name zone) |
942 | (iso-date :now :datep t :timep t) | |
943 | (zone-default-ttl zone)) | |
a567a3bc MW |
944 | (let* ((soa (zone-soa zone)) |
945 | (admin (let* ((name (soa-admin soa)) | |
946 | (at (position #\@ name)) | |
947 | (copy (format nil "~(~A~)." name))) | |
948 | (when at | |
949 | (setf (char copy at) #\.)) | |
950 | copy))) | |
7e282fb5 | 951 | (format stream "~ |
952 | ~A~30TIN SOA~40T~A ~A ( | |
953 | ~45T~10D~60T ;serial | |
954 | ~45T~10D~60T ;refresh | |
955 | ~45T~10D~60T ;retry | |
956 | ~45T~10D~60T ;expire | |
957 | ~45T~10D )~60T ;min-ttl~2%" | |
a567a3bc MW |
958 | (bind-hostname (zone-name zone)) |
959 | (bind-hostname (soa-source soa)) | |
960 | admin | |
7e282fb5 | 961 | (soa-serial soa) |
962 | (soa-refresh soa) | |
963 | (soa-retry soa) | |
964 | (soa-expire soa) | |
965 | (soa-min-ttl soa))) | |
a567a3bc MW |
966 | (dolist (zr (zone-records zone)) |
967 | (bind-record (zr-type zr) zr))) | |
968 | ||
afa2e2f1 | 969 | (export 'bind-format-record) |
a567a3bc MW |
970 | (defun bind-format-record (name ttl type format args) |
971 | (format *zone-output-stream* | |
972 | "~A~20T~@[~8D~]~30TIN ~A~40T~?~%" | |
973 | (bind-hostname name) | |
974 | (and (/= ttl (zone-default-ttl *writing-zone*)) | |
975 | ttl) | |
976 | (string-upcase (symbol-name type)) | |
977 | format args)) | |
978 | ||
afa2e2f1 | 979 | (export 'bind-record-type) |
a567a3bc MW |
980 | (defgeneric bind-record-type (type) |
981 | (:method (type) type)) | |
982 | ||
afa2e2f1 | 983 | (export 'bind-record-format-args) |
a567a3bc MW |
984 | (defgeneric bind-record-format-args (type data) |
985 | (:method ((type (eql :a)) data) (list "~A" (ipaddr-string data))) | |
986 | (:method ((type (eql :ptr)) data) (list "~A" (bind-hostname data))) | |
987 | (:method ((type (eql :cname)) data) (list "~A" (bind-hostname data))) | |
988 | (:method ((type (eql :ns)) data) (list "~A" (bind-hostname data))) | |
989 | (:method ((type (eql :mx)) data) | |
990 | (list "~2D ~A" (cdr data) (bind-hostname (car data)))) | |
716105aa MW |
991 | (:method ((type (eql :srv)) data) |
992 | (destructuring-bind (prio weight port host) data | |
993 | (list "~2D ~5D ~5D ~A" prio weight port (bind-hostname host)))) | |
f1d7d492 MW |
994 | (:method ((type (eql :sshfp)) data) |
995 | (cons "~2D ~2D ~A" data)) | |
9d1d9739 MW |
996 | (:method ((type (eql :txt)) data) |
997 | (cons "~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]" | |
998 | (mapcar #'stringify (listify data))))) | |
7e282fb5 | 999 | |
32ebbe9b MW |
1000 | (defmethod bind-record (type zr) |
1001 | (destructuring-bind (format &rest args) | |
1002 | (bind-record-format-args type (zr-data zr)) | |
1003 | (bind-format-record (zr-name zr) | |
1004 | (zr-ttl zr) | |
1005 | (bind-record-type type) | |
1006 | format args))) | |
1007 | ||
7e282fb5 | 1008 | ;;;----- That's all, folks -------------------------------------------------- |