chiark / gitweb /
frontend.lisp: Whitespace fixing.
[zone] / frontend.lisp
CommitLineData
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
8e7c1366
MW
25 (:use #:common-lisp #:optparse #:net #:zone
26 #+cmu #:mop
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.")
7e282fb5 35
afb5d9e6 36(defun directory-exists-p (name)
da455301 37
afb5d9e6
MW
38 ;; Make a pathname for NAME which has the right form for a directory.
39 (let ((dirpath
40 (let ((path (pathname name)))
41 (if (null (pathname-name path))
42 path
da455301 43 (make-pathname :directory
afb5d9e6
MW
44 (append (or (pathname-directory path)
45 (list :relative))
46 (list (pathname-name path)))
47 :name nil
48 :type nil
49 :defaults path)))))
50
51 ;; Now check that it exists.
52 #+clisp (and (ext:probe-directory dirpath) (truename dirpath))
53 #-clisp (probe-file dirpath)))
54
122041a0
MW
55(eval-when (:compile-toplevel :load-toplevel)
56 (defopthandler dir (var arg) ()
afb5d9e6 57 (let ((path (directory-exists-p arg)))
122041a0
MW
58 (if (and path
59 (not (pathname-name path)))
60 (setf var path)
61 (option-parse-error "path `~A' doesn't name a directory." arg)))))
62
f41a8783
MW
63(define-program
64 :version "1.0.0" :usage "ZONEDEF..."
65 :help "Generates BIND zone files from Lisp descriptions."
884a01ff 66 :options (options help-options
122041a0
MW
67 "Parsing options"
68 (#\f "feature" (:arg "KEYWORD")
69 (list *features* 'keyword)
70 "Insert KEYWORD in *features* list.")
71 (#\s "subnet" (:arg "NET")
72 (list zone:*preferred-subnets*)
73 "Designate NET as a preferred subnet.")
f41a8783 74 "Output options"
122041a0
MW
75 (#\d "directory" (:arg "DIRECTORY")
76 (dir *zone-output-path*)
77 "Write zone and serial files to DIRECTORY.")
a567a3bc
MW
78 (#\F "format" (:arg "FORMAT")
79 (keyword opt-format
80 (delete-duplicates
81 (loop for method in
8e7c1366 82 (generic-function-methods
a567a3bc
MW
83 #'zone:zone-write)
84 for specs =
8e7c1366 85 (method-specializers method)
a567a3bc 86 if (typep (car specs)
8e7c1366 87 'eql-specializer)
a567a3bc 88 collect
8e7c1366 89 (eql-specializer-object
a567a3bc
MW
90 (car specs)))))
91 "Format to use for output.")
f41a8783
MW
92 (#\z "zone" (:arg "NAME") (list opt-zones)
93 "Write information about zone NAME.")))
7e282fb5 94
95(defun main ()
96 (with-unix-error-reporting ()
ee983904 97 (let ((files nil))
7e282fb5 98 (unless (option-parse-try
f41a8783
MW
99 (do-options ()
100 (nil (rest)
101 (when (zerop (length rest))
102 (option-parse-error "no files to read"))
103 (setf files rest))))
104 (die-usage))
7e282fb5 105 (dolist (f files)
ee983904 106 (let ((*package* (make-package "ZONE.SCRATCH"
9c44003b 107 :use '(#:common-lisp #:net #:zone))))
ee983904
MW
108 (load f :verbose nil :print nil :if-does-not-exist :error)
109 (delete-package *package*)))
a567a3bc 110 (zone-save opt-zones :format opt-format))))
7e282fb5 111
112;;;----- That's all, folks --------------------------------------------------