chiark / gitweb /
zoneconf.in: Set up a temporary directory when signing.
[zoneconf] / zoneconf.in
... / ...
CommitLineData
1#! @TCLSH@
2### -*-tcl-*-
3###
4### Generate `named.conf' stanze for multiple views.
5###
6### (c) 2011 Mark Wooding
7###
8
9###----- Licensing notice ---------------------------------------------------
10###
11### This program is free software; you can redistribute it and/or modify
12### it under the terms of the GNU General Public License as published by
13### the Free Software Foundation; either version 2 of the License, or
14### (at your option) any later version.
15###
16### This program is distributed in the hope that it will be useful,
17### but WITHOUT ANY WARRANTY; without even the implied warranty of
18### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19### GNU General Public License for more details.
20###
21### You should have received a copy of the GNU General Public License
22### along with this program; if not, write to the Free Software Foundation,
23### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24
25###--------------------------------------------------------------------------
26### Utility functions.
27
28proc pushnew {var args} {
29 ## Append each of the ARGS onto the list VAR if they're not there already.
30
31 upvar 1 $var list
32 foreach item $list { set found($item) t }
33 foreach item $args {
34 if {![info exists found($item)]} {
35 lappend list $item
36 set found($item) t
37 }
38 }
39}
40
41proc merge-lists {lists} {
42 ## Merge the given LISTS into a single list, respecting the order of the
43 ## items in the original list. If that's not possible, signal an error.
44 ## Any ambiguity is resolved by choosing the item from the earlier list.
45
46 ## Strip out any empty lists in the input.
47 set nlists {}
48 foreach list $lists {
49 if {[llength $list]} { lappend nlists $list }
50 }
51 set lists $nlists
52
53 ## Clear the output list.
54 set output {}
55
56 ## Now pick out items one by one.
57 while {[llength $lists]} {
58
59 ## Find the candidate items
60 set cand {}
61 foreach list $lists { pushnew cand [lindex $list 0] }
62
63 ## Remove candidate items which are not first in some other list.
64 set ncand {}
65 foreach cand $cand {
66 foreach list $lists {
67 if {[lsearch -exact $list $cand] <= 0} { lappend ncand $cand }
68 }
69 }
70 set cand $ncand
71
72 ## If there's nothing left, report an error.
73 if {![llength $cand]} {
74 error "Inconsistent lists in `merge-lists'."
75 }
76
77 ## Otherwise take the first item.
78 set chosen [lindex $cand 0]
79 lappend output $chosen
80
81 ## Remove the chosen item from the input lists.
82 set nlists {}
83 foreach list $lists {
84 if {[string equal $chosen [lindex $list 0]]} {
85 set list [lrange $list 1 end]
86 if {![llength $list]} { continue }
87 }
88 lappend nlists $list
89 }
90 set lists $nlists
91 }
92
93 return $output
94}
95
96proc adjust-uplevel {spec offset} {
97 ## Adjust an `uplevel' SPEC by OFFSET to take account of intervening call
98 ## frames. If SPEC begins with `#' then it is left alone; otherwise it is
99 ## incremented by OFFSET.
100
101 switch -glob -- $spec {
102 \#* { return $spec }
103 default { return [expr {$spec + $offset}] }
104 }
105}
106
107proc unwind-protect {body cleanup} {
108 ## Evaluate BODY; then evaluate CLEANUP, regardless of whether BODY
109 ## returned normally or did something complicated. If CLEANUP completes
110 ## normally then the final result is that of BODY (including any errors or
111 ## abnormal returns it made); otherwise the result of CLEANUP takes
112 ## precedence and the results of BODY are discarded.
113
114 catch { uplevel 1 $body } bodyval bodyopts
115 if {[catch { uplevel 1 $cleanup } cleanval cleanopts]} {
116 return -options $cleanopts $cleanval
117 } else {
118 return -options $bodyopts $bodyval
119 }
120}
121
122proc let {args} {
123 ## Syntax: let VAR VALUE ... BODY
124 ##
125 ## Evaluate BODY with the VARs bound to the VALUEs. Reestore the previous
126 ## values when the BODY returns.
127
128 ## Parse the argument syntax.
129 if {[llength $args] % 2 == 0} {
130 error "bad number of arguments to `let'"
131 }
132 set body [lindex $args end]
133
134 ## Now work through the bindings, setting the variables to their new
135 ## values. As we go, also build up code in `cleanup' to restore everything
136 ## the way it's meant to be.
137 set cleanup {}
138 set i 0
139 foreach {var value} [lrange $args 0 end-1] {
140 upvar 1 $var fluid-$i
141 if {[info exists fluid-$i]} {
142 append cleanup "set fluid-$i [list [set fluid-$i]]\n"
143 } else {
144 append cleanup "unset fluid-$i\n"
145 }
146 set fluid-$i $value
147 incr i
148 }
149
150 ## Now evaluate the body.
151 unwind-protect { uplevel 1 $body } $cleanup
152}
153
154proc set* {names values} {
155 ## Set each of the variables listed in NAMES to the corresponding element
156 ## of VALUES. The two lists must have the same length.
157
158 if {[llength $names] != [llength $values]} {
159 error "length mismatch"
160 }
161 foreach name $names value $values {
162 upvar 1 $name var
163 set var $value
164 }
165}
166
167proc run {what command args} {
168 ## Run a command, reporting the result. WHAT is shown in the output;
169 ## COMMAND are the command and arguments as a list; these are substituted
170 ## according to the string map ARGS. Return true if the command succeeded,
171 ## false if it failed.
172
173 global QUIS
174
175 ## Substitute tokens in the command.
176 set cmd {}
177 set subst [concat [list "%%" "%"] $args]
178 foreach item $command { lappend cmd [string map $subst $item] }
179
180 ## Run the command.
181 set rc [catch {
182 set out [eval exec -ignorestderr $cmd 2>@1]
183 } msg]
184
185 ## Sort out the report.
186 if {$rc} { set out $msg }
187 set out "| [string map [list "\n" "\n| "] $out]"
188
189 ## Announce the result.
190 if {$rc} {
191 puts stderr "$QUIS: $what failed..."
192 puts stderr $out
193 return false
194 } else {
195 puts "$QUIS: $what output..."
196 puts $out
197 return true
198 }
199}
200
201proc isolate {body} {
202 ## Evaluate BODY without changing the caller's variables. Return its
203 ## result.
204
205 eval $body
206}
207
208###--------------------------------------------------------------------------
209### Configuration spaces.
210###
211### A configuration space is essentially a collection of Tcl commands and a
212### global array which the commands act on. The commands live in their own
213### namespace and their availability can be altered by modifying the
214### namespace path. The basic idea is to support a structured configuration
215### language with short directive names and where the available directives
216### varies in a context-sensitive manner.
217###
218### A configuration space can include other spaces, and they can include
219### further spaces. The graph of inclusions must be acyclic; further, since
220### the available commands are determined using the C3 linearization
221### algorithm, the relation in which a space precedes the spaces it includes,
222### and a space A precedes another space B if a third space includes A before
223### B, must be a partial order, and the linearizations of all of the spaces
224### must be monotonic. Don't worry about that if you don't know what it
225### means. If you don't do anything weird, it'll probably be all right.
226
227proc confspc-create {space confvar} {
228 ## Define a new configuration space called SPACE. You must do this before
229 ## defining directives or including other spaces.
230
231 global CONFSPC_CMD CONFSPC_INCL CONFSPC_CPL CONFSPC_CHANGE CONFSPC_VAR
232 if {![info exists CONFSPC_CMD($space)]} {
233 set CONFSPC_CMD($space) {}
234 set CONFSPC_INCL($space) {}
235 set CONFSPC_CPL($space) [list $space]
236 set CONFSPC_CHANGE($space) 0
237 set CONFSPC_VAR($space) $confvar
238 namespace eval ::confspc::$space {}
239 }
240}
241
242## Change sequence numbers are used to decide whether the linearized
243## inclusion caches are up to date.
244set CONFSPC_LASTCHANGESEQ 0
245set CONFSPC_CHANGESEQ 0
246
247proc confspc-command {space name bvl body} {
248 ## Define a configuration directive NAME in SPACE, accepting the arguments
249 ## specified by the BVL, and executing BODY when invoked. The SPACE's
250 ## configuration array is available within the BODY.
251
252 global CONFSPC_CMD CONFSPC_VAR
253 pushnew CONFSPC_CMD($space) $name
254
255 ## Define the configuration command in the caller's namespace.
256 set ns [uplevel 1 { namespace current }]
257 eval [list proc ${ns}::conf/$space/$name $bvl \
258 "global $CONFSPC_VAR($space)\n$body"]
259 namespace eval $ns [list namespace export conf/$space/$name]
260
261 ## Now arrange for this command to exist properly in the configuration
262 ## space.
263 namespace eval ::confspc::$space \
264 [list namespace import ${ns}::conf/$space/$name]
265 catch {
266 namespace eval ::confspc::$space [list rename $name {}]
267 }
268 namespace eval ::confspc::$space \
269 [list rename conf/$space/$name $name]
270}
271
272proc confspc-include {space includes} {
273 ## Arrange for SPACE to include the directives from the INCLUDES spaces.
274
275 global CONFSPC_INCL CONFSPC_LASTCHANGESEQ CONFSPC_CHANGESEQ
276 pushnew CONFSPC_INCL($space) $includes
277 if {$CONFSPC_CHANGESEQ <= $CONFSPC_LASTCHANGESEQ} {
278 set CONFSPC_CHANGESEQ [expr {$CONFSPC_LASTCHANGESEQ + 1}]
279 }
280}
281
282proc confspc-update {space} {
283 ## Update cached data for SPACE and its included spaces. We recompute the
284 ## space's class-precedence list, for which we use the C3 linearization
285 ## algorithm, which has known good properties.
286
287 global CONFSPC_CPL CONFSPC_CHANGE CONFSPC_INCL
288 global CONFSPC_CHANGESEQ CONFSPC_LASTCHANGESEQ
289 set CONFSPC_LASTCHANGESEQ $CONFSPC_CHANGESEQ
290
291 ## If the space is already up-to-date, do nothing.
292 if {$CONFSPC_CHANGE($space) == $CONFSPC_CHANGESEQ} { return }
293
294 ## Arrange for the included spaces to be up-to-date, and gather the CPLs
295 ## together so we can merge them.
296 set merge {}
297 lappend merge [concat $space $CONFSPC_INCL($space)]
298 foreach included $CONFSPC_INCL($space) {
299 confspc-update $included
300 lappend merge $CONFSPC_CPL($included)
301 }
302
303 ## Do the merge and update the change indicator.
304 set CONFSPC_CPL($space) [merge-lists $merge]
305 set CONFSPC_CHANGE($space) $CONFSPC_CHANGESEQ
306}
307
308proc confspc-path {ns cpl} {
309 ## Update namespace NS's command path so that it has (only) the
310 ## directives of the given CPL. Pass an empty CPL to clear the
311 ## configuration space hacking.
312
313 set path {}
314
315 ## Add the new namespaces to the front.
316 foreach spc $cpl { lappend path ::confspc::$spc }
317
318 ## Now add the existing path items, with any existing confspc hacking
319 ## stripped out.
320 foreach item [namespace eval $ns { namespace path }] {
321 if {![string match "::confspc::*" $item]} { lappend npath $item }
322 }
323
324 ## Commit the result.
325 namespace eval $ns [list namespace path $path]
326}
327
328proc confspc-set {ns space} {
329 ## Set the command path for namespace NS to include the configuration
330 ## directives of SPACE (and its included spaces).
331
332 global CONFSPC_CPL
333 confspc-update $space
334 confspc-path $ns $CONFSPC_CPL($space)
335}
336
337proc confspc-eval {space body} {
338 ## Evaluate BODY in the current namespace, but augmented with the
339 ## directives from the named SPACE. The command path of the current
340 ## namespace is restored afterwards.
341
342 set ns [uplevel 1 { namespace current }]
343 set path [namespace eval $ns { namespace path }]
344 unwind-protect {
345 confspc-set $ns $space
346 uplevel 1 $body
347 } {
348 namespace eval $ns [list namespace path $path]
349 }
350}
351
352proc preserving-config {confvar body} {
353 ## Evaluate BODY, but on exit restore the CONFVAR array so that the BODY
354 ## has no lasting effect on it.
355
356 upvar #0 $confvar CONFIG
357 set old [array get CONFIG]
358 unwind-protect {
359 uplevel 1 $body
360 } {
361 array unset CONFIG
362 array set CONFIG $old
363 }
364}
365
366confspc-create confspc CONFSPC_CONFIG
367
368confspc-command confspc include {args} {
369 ## Include the named configuration spaces in the current one.
370
371 confspc-include $CONFSPC_CONFIG(space) $args
372}
373
374confspc-command confspc define {name bvl body} {
375 ## Define a directive NAME in the current space, taking arguments BVL, and
376 ## having the given BODY.
377
378 confspc-command $CONFSPC_CONFIG(space) $name $bvl $body
379}
380
381confspc-command confspc define-simple {setting default} {
382 ## Define a directive SETTING which sets the appropriately prefixed entry
383 ## in the CONFIG array to its single arguments, and immediately set the
384 ## CONFIG entry to DEFAULT.
385
386 global CONFSPC_VAR
387 set space $CONFSPC_CONFIG(space)
388 upvar #0 $CONFSPC_VAR($space) config
389 confspc-command $space $setting arg \
390 "set $CONFSPC_VAR($space)($CONFSPC_CONFIG(prefix)$setting) \$arg"
391 set config($CONFSPC_CONFIG(prefix)$setting) $default
392}
393
394confspc-command confspc define-list {setting default} {
395 ## Define a directive SETTING which sets the appropriately prefixed entry
396 ## in the CONFIG array to its entire argument list, and immediately set the
397 ## CONFIG entry to DEFAULT (which should be a Tcl list, not a collection of
398 ## arguments).
399
400 global CONFSPC_VAR
401 set space $CONFSPC_CONFIG(space)
402 upvar #0 $CONFSPC_VAR($space) config
403 confspc-command $space $setting args \
404 "set $CONFSPC_VAR($space)($CONFSPC_CONFIG(prefix)$setting) \$args"
405 set config($CONFSPC_CONFIG(prefix)$setting) $default
406}
407
408confspc-command confspc prefix {prefix} {
409 set CONFSPC_CONFIG(prefix) $prefix
410}
411
412proc define-configuration-space {space confvar body} {
413 ## Define a new configuration space named SPACE. The BODY is Tcl code,
414 ## though it may make use of `include' and `define'.
415
416 global CONFSPC_CONFIG
417 set ns [uplevel 1 { namespace current }]
418 set oldpath [namespace eval $ns { namespace path }]
419 confspc-create $space $confvar
420 unwind-protect {
421 preserving-config CONFSPC_CONFIG {
422 array set CONFSPC_CONFIG [list space $space \
423 prefix ""]
424 confspc-set $ns confspc
425 uplevel 1 $body
426 }
427 } {
428 namespace eval $ns [list namespace path $oldpath]
429 }
430}
431
432###--------------------------------------------------------------------------
433### Option parsing.
434###
435### The option parsing machinery makes extensive use of a state array
436### OPTPARSE_STATE in order to maintain its context. The procedure
437### `with-option-parser' establishes this array correctly, and preserves any
438### existing state, so there should be no trouble with multiple parsers in
439### the same program.
440
441proc optparse-more-p {} {
442 ## Answer whether there are more argument words available.
443
444 upvar #0 OPTPARSE_STATE state
445 if {[llength $state(words)]} { return true } else { return false }
446}
447
448proc optparse-next-word {} {
449 ## Return the next word in the argument list. It is an error if there are
450 ## no more words left.
451
452 upvar #0 OPTPARSE_STATE state
453 set word [lindex $state(words) 0]
454 set state(words) [lrange $state(words) 1 end]
455 return $word
456}
457
458proc optparse-error {message} {
459 ## Report an error message and exit.
460
461 global QUIS
462 puts stderr "$QUIS: $message"
463 exit 1
464}
465
466proc optparse-option/short {var} {
467 ## Parse the next short option from the current cluster. If there are no
468 ## more short options, set the mode back to `free' and call back into
469 ## `optparse-option/free'.
470 ##
471 ## See the description of `optparse-option/free' for the interface
472 ## implemented by this procedure.
473
474 ## Get hold of my state and the caller's array.
475 upvar #0 OPTPARSE_STATE state
476 upvar 1 $var opt
477
478 ## Work out what to do based on the remaining length of the cluster. (The
479 ## cluster shouldn't be empty because the mode should only be set to
480 ## `short' if there is an initial nonempty cluster to parse, and we set it
481 ## back to `free' when we consume the final character from the cluster.)
482 ## Specifically, set `argp' according to whether we have a potential
483 ## argument in the cluster, and `name' to the option character extracted.
484 array unset opt
485 switch [string length $state(rest)] {
486 0 {
487 error "empty cluster"
488 }
489 1 {
490 set argp false
491 set state(mode) free
492 set name $state(rest)
493 }
494 default {
495 set argp true
496 set name [string index $state(rest) 0]
497 set state(rest) [string range $state(rest) 1 end]
498 }
499 }
500
501 ## Try to look up the option in the map.
502 if {![dict exists $state(short-map) $name]} {
503 optparse-error "Unknown option `$state(prefix)$name'"
504 }
505 array set opt [dict get $state(short-map) $name]
506 set state(name) $name
507
508 ## Collect an argument if one is required.
509 catch { unset state(arg) }
510 switch -glob -- "$opt(arg),$argp" {
511 "required,false" {
512 if {![optparse-more-p]} {
513 optparse-error "Option `$state(prefix)$name' requires an argument"
514 }
515 set state(arg) [optparse-next-word]
516 }
517 "required,true" - "optional,true" {
518 set state(arg) $state(rest)
519 set state(mode) free
520 }
521 }
522
523 ## Report success.
524 return 1
525}
526
527proc optparse-option/free {var} {
528 ## Parse the next option from the argument list. This procedure is called
529 ## to process a new argument word, i.e., we are in `free' mode. It
530 ## analyses the next argument word and either processes it internally or
531 ## sets the mode appropriately and calls a specialized handler
532 ## `optparse-option/MODE' for that mode.
533 ##
534 ## The interface works as follows. If an option was found, then the array
535 ## VAR is set according to the option's settings dictionary; and state
536 ## variables are set as follows.
537 ##
538 ## prefix The prefix character(s) to write before the option name in
539 ## messages, e.g., `--' for long options.
540 ##
541 ## name The option name without any prefix attached.
542 ##
543 ## arg The option's argument, if there is one; otherwise unset.
544
545 upvar #0 OPTPARSE_STATE state
546 upvar 1 $var opt
547
548 ## Set stuff up.
549 array unset opt
550 catch { unset state(arg) }
551 if {![optparse-more-p]} { return 0 }
552 set word [optparse-next-word]
553
554 ## Work out what to do based on the word. The order of these tests is
555 ## critically important.
556 switch -glob -- $word {
557
558 "--" {
559 ## End-of-options marker.
560
561 return 0
562 }
563
564 "--*" {
565 ## Long option.
566
567 set state(prefix) "--"
568
569 ## If there's an equals sign, the name is the bit to the left; keep the
570 ## remainder as an argument.
571 set eq [string first "=" $word 2]
572 if {$eq >= 0} {
573 set name [string range $word 2 [expr {$eq - 1}]]
574 set state(arg) [string range $word [expr {$eq + 1}] end]
575 set argp true
576 } else {
577 set name [string range $word 2 end]
578 set argp false
579 }
580 set state(name) name
581
582 ## Look the name up in the map.
583 if {[dict exists $state(long-map) $name]} {
584 array set opt [dict get $state(long-map) $name]
585 } else {
586 set matches [dict keys $state(long-map) "$name*"]
587 switch -exact -- [llength $matches] {
588 1 { array set opt [dict get $state(long-map) [lindex $matches 0]] }
589 0 { optparse-error "Unknown option `--$name'" }
590 default {
591 optparse-error "Ambiaguous option `--$name' \
592 (matches: --[join $matches {, --}])"
593 }
594 }
595 }
596
597 ## Now check whether we want an argument. The missing cases are
598 ## because we are already in the correct state.
599 switch -glob -- "$opt(arg),$argp" {
600 "none,true" {
601 optparse-error "Option `$name' doesn't accept an argument"
602 }
603 "required,false" {
604 if {![optparse-more-p]} {
605 optparse-error "Option `$name' requires an argument"
606 }
607 set state(arg) [optparse-next-word]
608 }
609 }
610
611 ## Done. We consumed either one or two entire argument words, so we
612 ## should remain in the `free' state.
613 return 1
614 }
615
616 "-?*" {
617 ## Short option. Set state, initialize the cluster, and go.
618
619 set state(rest) [string range $word 1 end]
620 set state(mode) short
621 set state(prefix) "-"
622 return [optparse-option/short opt]
623 }
624
625 default {
626 ## Some non-option thing. Under POSIX rules, this ends the parse. (We
627 ## could do something more adventurous later.)
628
629 set state(words) [concat [list $word] $state(words)]
630 return 0
631 }
632 }
633}
634
635proc optparse-arg-p {} {
636 ## Return the whether the most recently processed option had an argument.
637
638 upvar #0 OPTPARSE_STATE state
639 return [info exists state(arg)]
640}
641
642proc optparse-arg {} {
643 ## Return the argument from the most recently processed option. It is an
644 ## error if no argument was supplied.
645
646 upvar #0 OPTPARSE_STATE state
647 return $state(arg)
648}
649
650proc optparse-words {} {
651 ## Return the remaining unparsed argument words as a list.
652
653 upvar #0 OPTPARSE_STATE state
654 return $state(words)
655}
656
657proc optparse-option {} {
658 ## Parse the next option(s). The action taken depends on the option
659 ## dictionary: if an `action' is provided then it is evaluated in the
660 ## caller's context; otherwise the option's `tag' is returned.
661
662 upvar #0 OPTPARSE_STATE state
663 while 1 {
664 if {![optparse-option/$state(mode) opt]} {
665 return done
666 } elseif {[info exists opt(action)]} {
667 uplevel 1 $opt(action)
668 } elseif {[info exists opt(tag)]} {
669 return $opt(tag)
670 } else {
671 error "Don't know what to do with option `$state(prefix)$state(name)'"
672 }
673 }
674}
675
676proc with-option-parser {state words body} {
677 ## Establish an option parsing context, initialized with the STATE
678 ## (constructed using `define-options') and the lits of argument WORDS.
679 ## The BODY may use `optparse-option', `optparse-arg', etc. to parse the
680 ## options.
681
682 global OPTPARSE_STATE
683 set old [array get OPTPARSE_STATE]
684
685 unwind-protect {
686 array unset OPTPARSE_STATE
687 array set OPTPARSE_STATE $state
688 set OPTPARSE_STATE(mode) free
689 set OPTPARSE_STATE(words) $words
690 uplevel 1 $body
691 } {
692 array set OPTPARSE_STATE $old
693 }
694}
695
696define-configuration-space optparse-option OPTCFG {
697 define-list short {}
698 define-list long {}
699 define action {act} { set OPTCFG(action) $act }
700 define tag {tag} { set OPTCFG(tag) $tag }
701 define-simple arg none
702}
703
704define-configuration-space optparse OPTCFG {
705 define option {body} {
706 upvar #0 OPTPARSE_STATE state
707 uplevel 1 [list confspc-eval optparse-option $body]
708 set opt [array get OPTCFG]
709 foreach kind {long short} {
710 foreach name $OPTCFG($kind) {
711 if {[dict exists $state($kind-map) $name]} {
712 error "Already have an option with $kind name `$name'"
713 }
714 dict set state($kind-map) $name $opt
715 }
716 }
717 }
718}
719
720proc define-options {statevar body} {
721 ## Define an option state, and write it to STATEVAR. The BODY may contain
722 ## `optparse' configuration directives to define the available options.
723
724 global OPTPARSE_STATE
725 upvar 1 $statevar state
726 set old [array get OPTPARSE_STATE]
727 unwind-protect {
728 array unset OPTPARSE_STATE
729 if {[info exists state]} {
730 array set OPTPARSE_STATE $state
731 } else {
732 array set OPTPARSE_STATE {
733 long-map {}
734 short-map {}
735 }
736 }
737 uplevel 1 [list confspc-eval optparse $body]
738 set state [array get OPTPARSE_STATE]
739 } {
740 array set OPTPARSE_STATE $old
741 }
742}
743
744###--------------------------------------------------------------------------
745### Subcommand handling.
746
747## Determine the program name.
748set QUIS [file tail $argv0]
749
750## This is fluid-bound to the name of the current command.
751set COMMAND {}
752
753proc find-command {name} {
754 ## Given a command NAME as typed by the user, find the actual command and
755 ## return it.
756
757 global HELP
758 set matches [info commands cmd/$name*]
759 set cmds {}
760 set doc {}
761 foreach match $matches {
762 set cmd [string range $match 4 end]
763 lappend cmds $cmd
764 if {[info exists HELP($cmd)]} { lappend doc $cmd }
765 }
766 switch -exact -- [llength $cmds] {
767 1 { return [lindex $cmds 0] }
768 0 { optparse-error "Unknown command `$name'" }
769 }
770 if {[llength $doc]} { set cmds $doc }
771 switch -exact -- [llength $cmds] {
772 1 { return [lindex $cmds 0] }
773 0 { optparse-error "Unknown command `$name'" }
774 default { optparse-error "Ambiguous command `$name' -- matches: $cmds" }
775 }
776}
777
778proc usage {cmd} {
779 ## Return a usage message for CMD. The message is taken from the `USAGE'
780 ## array if that contains an entry for CMD (it should not include the
781 ## command name, and should begin with a leading space); otherwise a
782 ## message is constructed by examining the argument names and defaulting
783 ## arrangements of the Tcl command cmd/CMD.
784 ##
785 ## By convention, the main program is denoted by an empty CMD name.
786
787 global USAGE
788 if {[info exists USAGE($cmd)]} {
789 set usage $USAGE($cmd)
790 } else {
791 set usage ""
792 foreach arg [info args cmd/$cmd] {
793 if {[string equal $arg "args"]} {
794 append usage " ..."
795 } elseif {[info default cmd/$cmd $arg hunoz]} {
796 append usage " \[[string toupper $arg]\]"
797 } else {
798 append usage " [string toupper $arg]"
799 }
800 }
801 }
802 return $usage
803}
804
805proc usage-error {} {
806 ## Report a usage error in the current command. The message is obtained by
807 ## the `usage' procedure.
808
809 global QUIS COMMAND
810 if {[string length $COMMAND]} { set cmd " $COMMAND" } else { set cmd "" }
811 puts stderr "Usage: $QUIS$cmd[usage $COMMAND]"
812 exit 1
813}
814
815proc dispatch {name argv} {
816 ## Invokes the handler for CMD, passing it the argument list ARGV. This
817 ## does some minimal syntax checking by examining the argument list to the
818 ## command handler procedure cmd/COMMAND and issuing a usage error if
819 ## there's a mismatch.
820
821 global COMMAND
822 let COMMAND [find-command $name] {
823
824 ## Decode the argument list of the handler and set min and max
825 ## appropriately.
826 set args [info args cmd/$COMMAND]
827 if {![llength $args]} {
828 set* {min max} {0 0}
829 } else {
830 if {[string equal [lindex $args end] "args"]} {
831 set max inf
832 set args [lrange $args 0 end-1]
833 } else {
834 set max [llength $args]
835 }
836 set min 0
837 foreach arg $args {
838 if {[info default cmd/$COMMAND $arg hunoz]} { break }
839 incr min
840 }
841 }
842
843 ## Complain if the number of arguments is inappropriate.
844 set n [llength $argv]
845 if {$n < $min || ($max != inf && $n > $max)} { usage-error }
846
847 ## Invoke the handler.
848 eval cmd/$COMMAND $argv
849 }
850}
851
852define-configuration-space subcommand SUBCMD {
853 define-simple help-text -
854 define-simple usage-text -
855}
856
857proc defcmd {name bvl defs body} {
858 ## Define a command NAME with arguments BVL. The `usage-text' and
859 ## `help-text' commands can be used in DEFS to set messages for the new
860 ## command.
861
862 global SUBCMD USAGE HELP
863
864 preserving-config SUBCMD {
865 confspc-eval subcommand { uplevel 1 $defs }
866 foreach tag {usage-text help-text} array {USAGE HELP} {
867 if {![string equal $SUBCMD($tag) -]} {
868 set ${array}($name) $SUBCMD($tag)
869 }
870 }
871 }
872 proc cmd/$name $bvl $body
873}
874
875## Standard subcommand handler to show information about the program or its
876## subcommands. To use this, you need to set a bunch of variables.
877##
878## USAGE(cmd) Contains the usage message for cmd -- including
879## leading space -- to use instead of the `usage'
880## procedure's automagic.
881##
882## HELP(cmd) Contains descriptive text -- not including a final
883## trailing newline -- about the command.
884##
885## VERSION The program's version number.
886##
887## The `defcmd' procedure can be used to set these things up conveniently.
888defcmd help {args} {
889 usage-text " \[SUBCOMMAND ...]"
890 help-text "Show help on the given SUBCOMMANDs, or on the overall program."
891} {
892 global QUIS VERSION USAGE HELP
893 if {[llength $args]} {
894 foreach name $args {
895 set cmd [find-command $name]
896 puts "Usage: $QUIS $cmd[usage $cmd]"
897 if {[info exists HELP($cmd)]} { puts "\n$HELP($cmd)" }
898 }
899 } else {
900 puts "$QUIS, version $VERSION\n"
901 puts "Usage: $QUIS$USAGE()\n"
902 if {[info exists HELP()]} { puts "$HELP()\n" }
903 puts "Subcommands available:"
904 foreach name [info commands cmd/*] {
905 set cmd [string range $name 4 end]
906 puts "\t$cmd[usage $cmd]"
907 }
908 }
909}
910
911###--------------------------------------------------------------------------
912### Build the configuration space for zone files.
913
914proc host-addr {host} {
915 ## Given a HOST name, return a list of its addresses.
916
917 if {![string match $host {*[!0-9.]*}]} { return $host }
918 set adns [open [list | adnshost +Dc -s $host] r]
919 unwind-protect {
920 set addrs {}
921 while {[gets $adns line] >= 0} {
922 set* {name type fam addr} $line
923 switch -glob -- $type:$fam {
924 A:INET { lappend addrs $addr }
925 }
926 }
927 return [lindex $addrs 0]
928 } {
929 close $adns
930 }
931}
932
933proc host-canonify {host} {
934 ## Given a HOST name, return a canonical version of it.
935
936 set adns [open [list | adnshost -Dc -s $host] r]
937 unwind-protect {
938 while {[gets $adns line] >= 0} {
939 switch -exact -- [lindex $line 1] {
940 CNAME { return [lindex $line 2] }
941 A - AAAA { return [lindex $line 0] }
942 }
943 }
944 error "failed to canonify $host"
945 } {
946 close $adns
947 }
948}
949
950proc local-address-p {addr} {
951 ## Answer whether the ADDR is one of the host's addresses.
952 global env
953
954 if {[info exists env(ZONECONF_LOCAL_ADDRESSES)]} {
955 if {[string match "*:$addr:*" ":$env(ZONECONF_LOCAL_ADDRESSES):"]} {
956 return true
957 } else {
958 return false
959 }
960 } else {
961 if {[catch { set sk [socket -server {} -myaddr $addr 0] }]} {
962 return false
963 } else {
964 close $sk
965 return true
966 }
967 }
968}
969
970## The list of zones configured by the user.
971set ZONES {}
972
973## Dynamic zone update policy specifications.
974define-configuration-space policy ZONECFG {
975 define allow {identity nametype name args} {
976 lappend ZONECFG(ddns-policy) \
977 [concat grant [list $identity $nametype $name] $args]
978 }
979 define deny {identity nametype name args} {
980 lappend ZONECFG(ddns-policy) \
981 [concat deny [list $identity $nametype $name] $args]
982 }
983}
984
985## Dynamic zone details.
986define-configuration-space dynamic ZONECFG {
987 prefix "ddns-"
988 define-simple key "ddns"
989 define-simple auto-dnssec off
990 define-list types {A TXT PTR}
991
992 define policy {body} {
993 set ZONECFG(ddns-policy) {}
994 uplevel 1 [list confspc-eval policy $body]
995 }
996
997 set ZONECFG(ddns-policy) {}
998}
999
1000## Everything about a zone.
1001set HOME "@pkgstatedir@"
1002set BINDPROGS "@bindprogsdir@"
1003define-configuration-space zone ZONECFG {
1004 define-simple user root
1005 define-simple home-dir $HOME
1006 define-simple static-dir "$HOME/static"
1007 define-simple dynamic-dir "$HOME/dynamic"
1008 define-simple dir-mode 2775
1009 define-simple zone-file "%v/%z.zone"
1010 define-simple soa-format increment
1011 define-simple allow-query nil
1012 define-list views *
1013 define-list sign-views {}
1014 define-list signzone-command \
1015 [list "$BINDPROGS/dnssec-signzone" \
1016 "-S" \
1017 "-K%h/key" \
1018 "-d%h/ds" \
1019 "-s-3600" "-e+176400" "-i90000" \
1020 "-N%q" \
1021 "-o%z" \
1022 "-f%o" \
1023 "%f"]
1024 define-list reload-command [list "$BINDPROGS/rndc" "reload" "%z" "IN" "%v"]
1025 define-list autosign-command [list "$BINDPROGS/rndc" "sign" "%z" "IN" "%v"]
1026 define-list checkzone-command \
1027 [list "$BINDPROGS/named-checkzone" \
1028 "-ifull" \
1029 "-kfail" \
1030 "-Mfail" \
1031 "-nfail" \
1032 "-Sfail" \
1033 "-Wfail" \
1034 "%z" "%f"]
1035 define-list also-notify nil
1036
1037 define setvar {name value} {
1038 dict set ZONECFG(var) $name $value
1039 }
1040
1041 define primary {map} {
1042 ## There's a grim hack here: a primary-address entry may have the form
1043 ## REAL!FAKE. If the REAL address is not a local address then this
1044 ## is used as the master address; otherwise the FAKE address is used.
1045 ## This is useful for inter-view updates of dynamic zones on the same
1046 ## host. I suggest abusing 127.0.0.0/8 addresses for this kind of
1047 ## chicanery.
1048 if {[llength $map] % 2} {
1049 error "master map must have an even number of items"
1050 }
1051 set ZONECFG(master-map) $map
1052 }
1053
1054 define dynamic {{body {}}} {
1055 array set ZONECFG [list type dynamic]
1056 uplevel 1 [list confspc-eval dynamic $body]
1057 }
1058
1059 define view-map {map} {
1060
1061 ## OK, this needs careful documentation.
1062 ##
1063 ## The local nameserver presents a number of views according to its
1064 ## configuration. It is our purpose here to generate a configuration
1065 ## snippet for such a view.
1066 ##
1067 ## A user might have several different views of a zone which are meant to
1068 ## be presented to different clients. These map on to the server views
1069 ## in a one-to-many fashion. The `view-map' option defines this mapping.
1070 ## The argument is a list of alternating SERVER-VIEW USER-VIEW pairs; the
1071 ## SERVER-VIEW may be a glob pattern; the USER-VIEW may be the special
1072 ## token `=' to mean `same as the SERVER-VIEW'.
1073 ##
1074 ## We only keep one copy of the zone file for each user view: if the user
1075 ## view is used by many server views, then the zone stanza for each of
1076 ## those views refers to the same zone file.
1077
1078 if {[llength $map] % 2} {
1079 error "view map must have an even number of items"
1080 }
1081 set ZONECFG(view-map) $map
1082 }
1083
1084 array set ZONECFG {
1085 type static
1086 view-map {* =}
1087 }
1088}
1089
1090## Top-level configuration. Allow most zone options to be set here, so that
1091## one can set defaults for multiple zones conveniently.
1092define-configuration-space toplevel ZONECFG {
1093 include zone
1094
1095 define-list all-views {}
1096 define-simple conf-file "$HOME/config/%v.conf"
1097 define-simple max-zone-size [expr {512*1024}]
1098 define-list reconfig-command {/usr/sbin/rndc reconfig}
1099
1100 define scope {body} {
1101 preserving-config ZONECFG { uplevel 1 $body }
1102 }
1103
1104 define zone {name {body {}}} {
1105 global ZONES
1106 preserving-config ZONECFG {
1107 array set ZONECFG \
1108 [list name $name \
1109 type static]
1110 uplevel 1 [list confspc-eval zone $body]
1111 lappend ZONES [array get ZONECFG]
1112 }
1113 }
1114}
1115
1116###--------------------------------------------------------------------------
1117### Processing the results.
1118
1119proc zone-file-name {view config} {
1120 ## Return the relative file name for the zone described by CONFIG, relative
1121 ## to the given VIEW. An absolute filename may be derived later, depending
1122 ## on whether the zone data is static and the calling host is the master
1123 ## for the zone.
1124
1125 array set zone $config
1126 return [string map [list \
1127 "%v" $view \
1128 "%z" $zone(name)] \
1129 $zone(zone-file)]
1130}
1131
1132proc output-file-name {view} {
1133 ## Return the output file name for the given VIEW.
1134
1135 global ZONECFG
1136 return [string map [list %v $view] $ZONECFG(conf-file)]
1137}
1138
1139proc temporary-directory {} {
1140 ## Create a temporary directory and set as the working directory.
1141
1142 global ZONECFG
1143 set tmp [file join $ZONECFG(home-dir) "tmp"]
1144 file mkdir $tmp
1145 cd $tmp
1146 return $tmp
1147}
1148
1149proc compute-zone-properties {view config} {
1150 ## Derive interesting information from the zone configuration plist CONFIG,
1151 ## relative to the stated server VIEW. Return a new plist.
1152
1153 array set zone $config
1154
1155 ## See whether the zone matches the view.
1156 set match 0
1157 foreach wanted $zone(views) {
1158 if {[string match $wanted $view]} { set match 1; break }
1159 }
1160 if {!$match} { return {config-type ignore} }
1161
1162 ## Transform the view name according to the view map.
1163 foreach {inview outview} $zone(view-map) {
1164 if {![string match $inview $view]} { continue }
1165 switch -exact -- $outview {
1166 = { set zone(mapped-view) $view }
1167 default { set zone(mapped-view) $outview }
1168 }
1169 break
1170 }
1171
1172 ## Find out where the master is supposed to be.
1173 set zone(config-type) ignore
1174 if {[info exists zone(mapped-view)]} {
1175 foreach {outview hosts} $zone(master-map) {
1176 if {[string match $outview $zone(mapped-view)]} {
1177 set masters {}
1178 set zone(config-type) slave
1179 foreach host $hosts {
1180 set bang [string first "!" $host]
1181 if {$bang >= 0} {
1182 set after [string range $host [expr {$bang + 1}] end]
1183 if {$bang} {
1184 set before [string range $host 0 [expr {$bang - 1}]]
1185 } else {
1186 set before $after
1187 }
1188 if {[local-address-p $before]} {
1189 set host $after
1190 } else {
1191 set host $before
1192 }
1193 } elseif {[local-address-p $host]} {
1194 set zone(config-type) master
1195 }
1196 lappend masters $host
1197 }
1198 set zone(masters) $masters
1199 break
1200 }
1201 }
1202 }
1203
1204 ## Work out the file names.
1205 switch -glob -- $zone(config-type):$zone(type) {
1206 master:static {
1207 set dir $zone(static-dir)
1208 set nameview $zone(mapped-view)
1209 }
1210 default {
1211 set dir $zone(dynamic-dir)
1212 set nameview $view
1213 }
1214 }
1215 set zone(file-name) [file join $dir \
1216 [zone-file-name $nameview $config]]
1217
1218 ## Find out whether this zone wants signing.
1219 set zone(sign) false
1220 switch -glob -- $zone(config-type):$zone(type) {
1221 master:static {
1222 foreach sview $zone(sign-views) {
1223 if {[string match $zone(mapped-view) $sview]} { set zone(sign) true }
1224 }
1225 }
1226 }
1227 if {$zone(sign)} {
1228 set zone(server-file-name) "$zone(file-name).sig"
1229 } else {
1230 set zone(server-file-name) $zone(file-name)
1231 }
1232
1233 ## Done.
1234 return [array get zone]
1235}
1236
1237proc write-ddns-update-policy {prefix chan config} {
1238 ## Write an `update-policy' stanza to CHAN for the zone described by the
1239 ## CONFIG plist. The PREFIX is written to the start of each line.
1240
1241 array set zone $config
1242 puts $chan "${prefix}update-policy {"
1243 set policyskel "${prefix}\t%s %s %s \"%s\" %s;"
1244
1245 foreach item $zone(ddns-policy) {
1246 set* {verb ident type name} [lrange $item 0 3]
1247 set rrtypes [lrange $item 4 end]
1248 puts $chan [format $policyskel \
1249 $verb \
1250 $ident \
1251 $type \
1252 $name \
1253 $rrtypes]
1254 }
1255
1256 puts $chan [format $policyskel \
1257 grant \
1258 $zone(ddns-key) \
1259 subdomain \
1260 $zone(name) \
1261 $zone(ddns-types)]
1262
1263 puts $chan "${prefix}};"
1264}
1265
1266proc sign-zone-file {info soafmt infile} {
1267 ## Sign the zone described by INFO. The input zone file is INPUT; the SOA
1268 ## should be updated according to SOAFMT.
1269
1270 global QUIS
1271
1272 array set zone $info
1273 set outfile "$zone(server-file-name).new"
1274 if {![run "sign zone `$zone(name)' in view `$zone(mapped-view)'" \
1275 $zone(signzone-command) \
1276 "%h" $zone(home-dir) \
1277 "%m" $zone(static-dir) \
1278 "%s" $zone(dynamic-dir) \
1279 "%z" $zone(name) \
1280 "%f" $infile \
1281 "%o" $outfile \
1282 "%q" $soafmt]} {
1283 file delete -force $outfile
1284 return false
1285 }
1286 file rename -force $outfile $zone(server-file-name)
1287 return true
1288}
1289
1290proc write-zone-stanza {view chan config} {
1291 ## Write a `zone' stanza to CHAN for the zone described by the CONFIG
1292 ## plist in the given VIEW.
1293
1294 array set zone [compute-zone-properties $view $config]
1295 if {[string equal $zone(config-type) "ignore"]} { return }
1296
1297 ## Create the directory for the zone files.
1298 set dir [file dirname $zone(file-name)]
1299 if {![file isdirectory $dir]} {
1300 file mkdir $dir
1301 exec chmod $zone(dir-mode) $dir
1302 }
1303
1304 ## Write the configuration fragment.
1305 puts $chan "\nzone \"$zone(name)\" {"
1306 switch -glob -- $zone(config-type) {
1307 master {
1308 puts $chan "\ttype master;"
1309 puts $chan "\tfile \"$zone(server-file-name)\";"
1310 if {![string equal $zone(also-notify) "nil"]} {
1311 puts $chan "\talso-notify { [join $zone(also-notify) {; }]; };"
1312 }
1313 switch -exact -- $zone(type) {
1314 dynamic {
1315 write-ddns-update-policy "\t" $chan $config
1316 if {![string equal $zone(ddns-auto-dnssec) off]} {
1317 puts $chan "\tauto-dnssec $zone(ddns-auto-dnssec);"
1318 }
1319 }
1320 }
1321 }
1322 slave {
1323 puts $chan "\ttype slave;"
1324 set masters {}
1325 foreach host $zone(masters) { lappend masters [host-addr $host] }
1326 puts $chan "\tmasters { [join $masters {; }]; };"
1327 puts $chan "\tfile \"$zone(file-name)\";"
1328 switch -exact -- $zone(type) {
1329 dynamic { puts $chan "\tallow-update-forwarding { any; };" }
1330 }
1331 }
1332 }
1333 if {![string equal $zone(allow-query) nil]} {
1334 puts $chan "\tallow-query {$zone(allow-query)};"
1335 }
1336 puts $chan "};";
1337}
1338
1339###--------------------------------------------------------------------------
1340### Command-line interface.
1341
1342set CONFFILE "@pkgconfdir@/zones.in"
1343
1344defcmd outputs {} {
1345 help-text "List the output file names to stdout."
1346} {
1347 global ZONECFG CONFFILE
1348
1349 isolate [list confspc-eval toplevel [list source $CONFFILE]]
1350 foreach view $ZONECFG(all-views) { puts [output-file-name $view] }
1351}
1352
1353defcmd update {} {
1354 help-text "Generate BIND configuration files."
1355} {
1356 global ZONECFG ZONES CONFFILE
1357
1358 ## Read the configuration.
1359 isolate [list confspc-eval toplevel [list source $CONFFILE]]
1360
1361 ## Safely update the files.
1362 set win false
1363 unwind-protect {
1364
1365 ## Work through each server view.
1366 foreach view $ZONECFG(all-views) {
1367
1368 ## Open an output file.
1369 set out($view) [output-file-name $view]
1370 set chan($view) [open "$out($view).new" w]
1371
1372 ## Write a header.
1373 set now [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]
1374 puts $chan($view) "### -*-conf-javaprop-*-"
1375 puts $chan($view) "### Generated at $now: do not edit"
1376
1377 ## Now print a stanza for each zone in the view.
1378 foreach zone $ZONES {
1379 write-zone-stanza $view $chan($view) $zone
1380 }
1381 }
1382
1383 ## Done: don't delete the output.
1384 set win true
1385 } {
1386
1387 ## Close the open files.
1388 foreach view $ZONECFG(all-views) {
1389 catch { close $chan($view) }
1390 }
1391
1392 ## If we succeeded, rename the output files into their proper places;
1393 ## otherwise, delete them.
1394 if {$win} {
1395 foreach view $ZONECFG(all-views) {
1396 file rename -force -- "$out($view).new" $out($view)
1397 }
1398 eval exec $ZONECFG(reconfig-command)
1399 } else {
1400 catch { file delete -force -- "$out($view).new" }
1401 }
1402 }
1403}
1404
1405defcmd install {user view name} {
1406 help-text "Install a new zone file.
1407
1408The file is for the given zone NAME and \(user-side) VIEW. The file is
1409provided by the named USER."
1410} {
1411 global QUIS ZONECFG ZONES CONFFILE errorInfo errorCode
1412
1413 ## Read the configuration.
1414 isolate [list confspc-eval toplevel [list source $CONFFILE]]
1415
1416 ## Make sure there's a temporary directory.
1417 set tmpdir [temporary-directory]
1418
1419 ## Keep track of cleanup jobs.
1420 set cleanup {}
1421 unwind-protect {
1422
1423 ## Find out which server views are affected by this update.
1424 set matchview {}
1425 foreach iview $ZONECFG(all-views) {
1426 foreach info $ZONES {
1427 array unset zone
1428 array set zone [compute-zone-properties $iview $info]
1429 if {[string equal $user $zone(user)] && \
1430 [string equal "$zone(config-type)/$zone(type)" \
1431 "master/static"] && \
1432 [string equal $zone(name) $name] && \
1433 [string equal $zone(mapped-view) $view]} {
1434 lappend matchview $iview
1435 if {![info exists matchinfo]} { set matchinfo [array get zone] }
1436 }
1437 }
1438 }
1439 if {![llength $matchview]} {
1440 optparse-error "No match for zone `$name' in view `$view'"
1441 }
1442 array unset zone
1443 array set zone $matchinfo
1444
1445 ## Make a new temporary file to read the zone into.
1446 set pid [pid]
1447 for {set i 0} {$i < 1000} {incr i} {
1448 set tmp [file join $tmpdir "tmp.$pid.$i.$user.$name"]
1449 if {![catch { set chan [open $tmp {WRONLY CREAT EXCL}] } msg]} {
1450 break
1451 } elseif {[string equal [lindex $errorCode 0] POSIX] && \
1452 ![string equal [lindex $errorCode 1] EEXIST]} {
1453 error $msg $errorInfo $errorCode
1454 }
1455 }
1456 if {![info exists chan]} { error "failed to create temporary file" }
1457 set cleanup [list file delete $tmp]
1458
1459 ## Read the zone data from standard input into the file.
1460 set total 0
1461 while {true} {
1462 set stuff [read stdin 4096]
1463 if {![string length $stuff]} { break }
1464 puts -nonewline $chan $stuff
1465 incr total [string bytelength $stuff]
1466 if {$total > $ZONECFG(max-zone-size)} {
1467 error "zone file size limit exceeded"
1468 }
1469 }
1470 close $chan
1471
1472 ## Check the zone for sanity.
1473 if {![run "zone check" $zone(checkzone-command) \
1474 "%z" $name \
1475 "%v" $view \
1476 "%f" $tmp]} {
1477 eval $cleanup
1478 exit 1
1479 }
1480
1481 ## If the zone wants signing, better to do that now.
1482 if {$zone(sign) && ![sign-zone-file $matchinfo keep $tmp]} {
1483 eval $cleanup
1484 exit 2
1485 }
1486
1487 ## All seems good: stash the file in the proper place and reload the
1488 ## necessary server views.
1489 file rename -force -- $tmp $zone(file-name)
1490 set cleanup {}
1491 foreach view $matchview {
1492 if {![run "reload zone `$zone(name) in view `$view'" \
1493 $zone(reload-command) \
1494 "%v" $view \
1495 "%z" $zone(name)]} {
1496 exit 3
1497 }
1498 }
1499 } {
1500 eval $cleanup
1501 }
1502}
1503
1504defcmd sign {} {
1505 help-text "Sign DNSSEC zones."
1506} {
1507 global QUIS ZONECFG ZONES CONFFILE
1508
1509 set rc 0
1510
1511 ## Read the configuration.
1512 isolate [list confspc-eval toplevel [list source $CONFFILE]]
1513
1514 ## Sometimes `dnssec-signzone' tries to write temporary files to the
1515 ## current directory. Make sure this is sensible.
1516 temporary-directory
1517
1518 ## Grind through all of the zones.
1519 array unset seen
1520 foreach view $ZONECFG(all-views) {
1521 foreach info $ZONES {
1522
1523 ## Fetch the zone information.
1524 array unset zone
1525 set compinfo [compute-zone-properties $view $info]
1526 array set zone $compinfo
1527 if {![string equal $zone(config-type) master]} { continue }
1528
1529 if {[string equal $zone(type) static] && $zone(sign)} {
1530 ## Static zone: re-sign it if we haven't seen this user view before,
1531 ## and then reload.
1532
1533 ## Sign the zone file if we haven't tried before.
1534 set id [list $zone(name) $zone(mapped-view)]
1535 if {![info exists seen($id)]} {
1536 if {[sign-zone-file $compinfo $zone(soa-format) \
1537 $zone(server-file-name)]} {
1538 set seen($id) true
1539 } else {
1540 set rc 2
1541 set seen($id) failed
1542 }
1543 }
1544
1545 ## If we succeeded, reload the zone in this server view.
1546 if {[string equal $seen($id) true]} {
1547 if {![run "reload zone `$zone(name) in server view `$view'" \
1548 $zone(reload-command) \
1549 "%z" $zone(name) \
1550 "%v" $view]} {
1551 set rc 2
1552 }
1553 }
1554 } elseif {[string equal $zone(type) dynamic] &&
1555 ![string equal $zone(ddns-auto-dnssec) off]} {
1556 ## Dynamic zone: get BIND to re-sign it.
1557
1558 if {![run "re-sign zone `$zone(name) in server view `$view'" \
1559 $zone(autosign-command) \
1560 "%z" $zone(name) \
1561 "%v" $view]} {
1562 set rc 2
1563 }
1564 }
1565 }
1566 }
1567 exit $rc
1568}
1569
1570###--------------------------------------------------------------------------
1571### Main program.
1572
1573set VERSION "@VERSION@"
1574set USAGE() " \[-OPTIONS] SUBCOMMAND \[ARGUMENTS...]"
1575
1576define-options OPTS {
1577 option {
1578 short "h"; long "help"
1579 action { eval cmd/help [optparse-words]; exit }
1580 }
1581 option {
1582 short "v"; long "version"
1583 action { puts "$QUIS, version $VERSION"; exit }
1584 }
1585 option {
1586 short "c"; long "config"; arg required
1587 action { set CONFFILE [optparse-arg] }
1588 }
1589}
1590
1591with-option-parser $OPTS $argv {
1592 optparse-option
1593 set argv [optparse-words]
1594}
1595
1596if {![llength $argv]} { usage-error }
1597dispatch [lindex $argv 0] [lrange $argv 1 end]
1598
1599###----- That's all, folks --------------------------------------------------