Commit | Line | Data |
---|---|---|
7e282fb5 | 1 | ;;; -*-lisp-*- |
2 | ;;; | |
7e282fb5 | 3 | ;;; Zone generator frontend |
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 | ||
24 | (defpackage #:zone.frontend | |
e9a4984f | 25 | (:use #:common-lisp #:mdw.base #:mdw.sys-base #:optparse #:net #:zone |
3f0a7127 | 26 | #+(or cmu clisp) #:mop |
8e7c1366 | 27 | #+sbcl #:sb-mop) |
7e282fb5 | 28 | (:export #:main)) |
29 | (in-package #:zone.frontend) | |
30 | ||
7e282fb5 | 31 | (defvar opt-zones nil |
32 | "Which zones to be emitted.") | |
a567a3bc MW |
33 | (defvar opt-format :bind |
34 | "Which format to use on output.") | |
9d6fbc71 MW |
35 | (defvar opt-debug nil |
36 | "Whether to emit stack backtraces on error.") | |
7e282fb5 | 37 | |
afb5d9e6 | 38 | (defun directory-exists-p (name) |
da455301 | 39 | |
afb5d9e6 MW |
40 | ;; Make a pathname for NAME which has the right form for a directory. |
41 | (let ((dirpath | |
42 | (let ((path (pathname name))) | |
43 | (if (null (pathname-name path)) | |
44 | path | |
da455301 | 45 | (make-pathname :directory |
afb5d9e6 MW |
46 | (append (or (pathname-directory path) |
47 | (list :relative)) | |
48 | (list (pathname-name path))) | |
49 | :name nil | |
50 | :type nil | |
51 | :defaults path))))) | |
52 | ||
53 | ;; Now check that it exists. | |
54 | #+clisp (and (ext:probe-directory dirpath) (truename dirpath)) | |
55 | #-clisp (probe-file dirpath))) | |
56 | ||
122041a0 MW |
57 | (eval-when (:compile-toplevel :load-toplevel) |
58 | (defopthandler dir (var arg) () | |
afb5d9e6 | 59 | (let ((path (directory-exists-p arg))) |
122041a0 MW |
60 | (if (and path |
61 | (not (pathname-name path))) | |
62 | (setf var path) | |
e9a4984f MW |
63 | (option-parse-error "path `~A' doesn't name a directory." arg)))) |
64 | (let ((duration-units (make-hash-table :test #'equal))) | |
65 | (dolist (item '((("Gs") #.(* 1000 1000 1000)) | |
66 | (("Ms") #.(* 1000 1000)) | |
67 | (("ks") 1000) | |
68 | (("hs") 100) | |
69 | (("das") 10) | |
70 | (("yr" "year" "years" "y") #.(* 365 24 60 60)) | |
71 | (("wk" "week" "weeks" "w") #.(* 7 24 60 60)) | |
72 | (("day" "days" "dy" "d") #.(* 24 60 60)) | |
73 | (("hr" "hour" "hours" "h") #.(* 60 60)) | |
74 | (("min" "minute" "minutes" "m") 60) | |
75 | (("s" "second" "seconds" "sec" "") 1))) | |
76 | (dolist (name (car item)) | |
77 | (setf (gethash name duration-units) (cadr item)))) | |
78 | (defopthandler dur (var arg) () | |
79 | (let ((len (length arg))) | |
80 | (multiple-value-bind (n i) (parse-integer arg :junk-allowed t) | |
81 | (unless n | |
82 | (option-parse-error "invalid duration `~A': ~ | |
83 | integer expected" arg)) | |
84 | (loop (cond ((or (>= i len) | |
85 | (not (whitespace-char-p (char arg i)))) | |
86 | (return)) | |
87 | (t | |
88 | (incf i)))) | |
89 | (let ((u0 i)) | |
90 | (loop (cond ((or (>= i len) | |
91 | (whitespace-char-p (char arg i))) | |
92 | (return)) | |
93 | (t | |
94 | (incf i)))) | |
95 | (let* ((u1 i) | |
96 | (unit (subseq arg u0 u1)) | |
97 | (scale (gethash unit duration-units))) | |
98 | (unless scale | |
99 | (option-parse-error "invalid duration `~A': ~ | |
100 | unknown unit `~A'" | |
101 | arg unit)) | |
102 | (setf var (* n scale))))))))) | |
122041a0 | 103 | |
f41a8783 MW |
104 | (define-program |
105 | :version "1.0.0" :usage "ZONEDEF..." | |
106 | :help "Generates BIND zone files from Lisp descriptions." | |
884a01ff | 107 | :options (options help-options |
122041a0 MW |
108 | "Parsing options" |
109 | (#\f "feature" (:arg "KEYWORD") | |
110 | (list *features* 'keyword) | |
111 | "Insert KEYWORD in *features* list.") | |
112 | (#\s "subnet" (:arg "NET") | |
113 | (list zone:*preferred-subnets*) | |
114 | "Designate NET as a preferred subnet.") | |
9d6fbc71 MW |
115 | (#\D "debug" (set opt-debug) |
116 | "Produce stack backtrace on error.") | |
e9a4984f MW |
117 | "Timeout options" |
118 | (#\E "expire" (:arg "DURATION") | |
119 | (dur *default-zone-expire*) | |
120 | "Set default zone expiry period.") | |
121 | (#\N "min-ttl" (:arg "DURATION") | |
122 | (dur *default-zone-min-ttl*) | |
123 | "Set default zone minimum/negative time-to-live.") | |
124 | (#\R "refresh" (:arg "DURATION") | |
125 | (dur *default-zone-refresh*) | |
126 | "Set default zone refresh period.") | |
127 | (#\T "ttl" (:arg "DURATION") | |
128 | (dur *default-zone-ttl*) | |
129 | "Set default zone time-to-live.") | |
130 | (#\Y "retry" (:arg "DURATION") | |
131 | (dur *default-zone-retry*) | |
132 | "Set default zone retry period.") | |
f41a8783 | 133 | "Output options" |
122041a0 MW |
134 | (#\d "directory" (:arg "DIRECTORY") |
135 | (dir *zone-output-path*) | |
136 | "Write zone and serial files to DIRECTORY.") | |
a567a3bc MW |
137 | (#\F "format" (:arg "FORMAT") |
138 | (keyword opt-format | |
139 | (delete-duplicates | |
140 | (loop for method in | |
146571da MW |
141 | (append |
142 | (generic-function-methods | |
143 | #'zone:zone-write) | |
144 | (generic-function-methods | |
145 | #'zone:zone-write-header)) | |
a567a3bc | 146 | for specs = |
8e7c1366 | 147 | (method-specializers method) |
a567a3bc | 148 | if (typep (car specs) |
8e7c1366 | 149 | 'eql-specializer) |
a567a3bc | 150 | collect |
8e7c1366 | 151 | (eql-specializer-object |
a567a3bc MW |
152 | (car specs))))) |
153 | "Format to use for output.") | |
f41a8783 MW |
154 | (#\z "zone" (:arg "NAME") (list opt-zones) |
155 | "Write information about zone NAME."))) | |
7e282fb5 | 156 | |
157 | (defun main () | |
10b8955c | 158 | (set-command-line-arguments) |
9d6fbc71 MW |
159 | (let ((files nil)) |
160 | (flet ((run () | |
161 | (dolist (f files) | |
162 | (let ((*package* (make-package "ZONE.SCRATCH" | |
163 | :use '(#:common-lisp | |
164 | #:net #:zone)))) | |
2d8313b9 MW |
165 | (progv *zone-config* (mapcar #'symbol-value *zone-config*) |
166 | (load f :verbose nil :print nil :if-does-not-exist :error) | |
167 | (delete-package *package*)))) | |
76ffa76c MW |
168 | (zone-save opt-zones :format opt-format) |
169 | t)) | |
9d6fbc71 MW |
170 | (with-unix-error-reporting () |
171 | (unless (option-parse-try | |
172 | (do-options () | |
173 | (nil (rest) | |
174 | (when (zerop (length rest)) | |
175 | (option-parse-error "no files to read")) | |
176 | (setf files rest)))) | |
177 | (die-usage))) | |
178 | (if opt-debug | |
179 | (run) | |
22b979aa MW |
180 | (with-unix-error-reporting () (run))) |
181 | t))) | |
7e282fb5 | 182 | |
183 | ;;;----- That's all, folks -------------------------------------------------- |