Allow underscore characters in FQDNs and pointers.
[valtz.git] / valtz
1 #!/usr/bin/perl
2 #
3 # $Id: valtz,v 0.7 2003/07/10 16:39:30 magnus Exp $
4 #
5 # <BSD-license>
6 #
7 # Copyright (c) 2003, Magnus Bodin, <magnus@bodin.org>, http://x42.com
8 # All rights reserved.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions are
12 # met:
13 #
14 # Redistributions of source code must retain the above copyright notice,
15 # this list of conditions and the following disclaimer.
16 #
17 # Redistributions in binary form must reproduce the above copyright
18 # notice, this list of conditions and the following disclaimer in the
19 # documentation and/or other materials provided with the distribution.
20 #
21 # Neither the name of Magnus Bodin, x42.com nor the names of its
22 # contributors may be used to endorse or promote products derived from
23 # this software without specific prior written permission.
24 #
25 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
26 # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
27 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
28 # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
29 # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
30 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
31 # TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32 # PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33 # LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34 # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 #
37 # </BSD-license>
38
39
40 use strict;
41 use Getopt::Std;
42 use File::Temp qw/ tempfile /;
43 use File::Copy qw/ move /;
44
45
46 my $VERSION = $1 if '$Revision: 0.7 $' =~ /(\d+\.\d+)/;
47 my $COPYRIGHT = '; (C) 2003 Magnus Bodin, http://x42.com/software/';
48
49 $| = 1;
50 my %opt;
51 getopts('?fFhHiIqrRstT:x', \%opt);
52
53
54 my $FILESUFFIXREGEXP = '('.join('|', qw/
55 ,v ~ .bak .log .old .swp .tmp
56 /).')$';
57
58 my $verrs_total = 0;
59 my $perrs_total = 0;
60
61
62 ##
63 # global location registry
64 # (reset for every zone file)
65 my %loreg;
66
67 # NOTE : DO NOT CHANGE the id numbers
68 my %validation_msg = (
69 1001 => 'badly formed; should be just two ASCII letters',
70 1002 => 'location is not previously defined in a %-line',
71 1003 => 'invalid syntax',
72 1004 => 'invalid syntax of integer',
73 1005 => 'parts must only contain ASCII letters, digits and - characters',
74 1006 => 'parts must not begin with the - character',
75 1007 => 'parts must not end with the - character',
76 1008 => 'integer out of bounds',
77 1009 => 'must have at least three labels to be valid as mail address',
78 1010 => 'must not be 2(NS), 5(CNAME), 6(SOA), 12(PTR), 15(MX) or 252(AXFR)',
79 );
80
81 # NOTE : ONLY translate the right-hand part
82 my %token_name = (
83 'lo' => 'Location',
84 'ipprefix' => 'IP prefix',
85 'fqdn' => 'Domain name',
86 'ip' => 'IP number',
87 'x' => 'Host name',
88 'ttl' => 'TTL',
89 'timestamp' => 'Timestamp',
90 'lo' => 'Location',
91 'dist' => 'Distance',
92 's' => 'Text',
93 'p' => 'Pointer',
94 'mname' => 'Master name',
95 'rname' => 'Role name',
96 'ser' => 'Serial number',
97 'ref' => 'Refresh time',
98 'ret' => 'Retry time',
99 'exp' => 'Expire time',
100 'min' => 'Minimum time',
101 'n' => 'Record type number',
102 'rdata' => 'Resource data',
103 );
104
105 my %record_type = (
106 '%' => ':location',
107 '.' => 'NS',
108 '&' => 'NS+A',
109 '=' => 'A+PTR',
110 '+' => 'A',
111 '@' => 'MX+A?',
112 '#' => ':comment',
113 '-' => ':disabled +',
114 "'" => 'TXT',
115 '^' => 'PTR',
116 'C' => 'CNAME',
117 'Z' => 'SOA',
118 ':' => 'GENERIC'
119 );
120
121 # NOTE : This should NOT be translated!
122 my %line_type = (
123 '%' => [ ':location', 'lo:ipprefix', 'lo' ],
124 '.' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
125 '&' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
126 '=' => [ 'A+PTR', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
127 '+' => [ 'A', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
128 '@' => [ 'MX(+A?)', 'fqdn:ip:x:dist:ttl:timestamp:lo', 'fqdn' ],
129 '#' => [ ':comment', '', '' ],
130 '-' => [ ':disabled +', '', '' ],
131 "'" => [ 'TXT', 'fqdn:s:ttl:timestamp:lo', 'fqdn:s' ],
132 '^' => [ 'PTR', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
133 'C' => [ 'CNAME', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
134 'Z' => [ 'SOA', 'fqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo',
135 'fqdn:mname:rname' ],
136 ':' => [ 'GENERIC', 'fqdn:n:rdata:ttl:timestamp:lo', 'fqdn:n:rdata' ]
137 );
138
139
140 sub validate_integer
141 {
142 my ($s, $boundary) = @_;
143 my $result = 0;
144
145 if ($s =~ /^(\d+)$/)
146 {
147 my $i = $1;
148
149 $result = 1008 if $boundary && ($i >= $boundary);
150 }
151 else
152 {
153 $result = 1004;
154 }
155
156 return $result;
157 }
158
159
160 # NOTE : No translation here!
161 my %token_validator = (
162 'lo' => [ 2, sub {
163 my ($type, $s) = @_;
164 my $result = 0;
165 return 1001 unless $s =~ /^[a-z][a-z]$/i;
166 if ($type eq '%')
167 {
168 $loreg{$s}++;
169 }
170 else
171 {
172 return 1002 unless exists($loreg{$s});
173 }
174 return $result;
175 }],
176 'ipprefix' => [ 3, sub {
177 my ($type, $s) = @_;
178 my $result = 0;
179 if ($s =~ /^(\d+)(\.(\d+)(\.(\d+)(\.(\d+))?)?)?$/)
180 {
181 my ($a, $b, $c, $d) = ($1, $3, $5, $7);
182 $a ||= 0;
183 $b ||= 0;
184 $c ||= 0;
185 $d ||= 0;
186 if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
187 {
188 $result = 1003;
189 }
190 }
191 else
192 {
193 $result = 1003;
194 }
195 return $result;
196 }],
197 'fqdn' => [ 3, sub {
198 my ($type, $s) = @_;
199 my $result = 0;
200 # remove OK wildcard prefixing, to simplify test.
201 $s =~ s/^\*\.([a-z0-9].*)$/$1/i;
202 # check all parts
203 for my $hostpart (split /\./, $s)
204 {
205 return 1005 unless $hostpart =~ /^_?[-a-z0-9]+$/i;
206 return 1006 if $hostpart =~ /^-/;
207 return 1007 if $hostpart =~ /-$/;
208 }
209 return $result;
210 }],
211 'ip' => [ 4, sub {
212 my ($type, $s) = @_;
213 my $result = 0;
214 if ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\.?$/)
215 {
216 my ($a, $b, $c, $d) = ($1, $3, $5, $7);
217 $a ||= 0;
218 $b ||= 0;
219 $c ||= 0;
220 $d ||= 0;
221 if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
222 {
223 $result = 1003
224 }
225 }
226 else
227 {
228 $result = 1003;
229 }
230 return $result;
231 }],
232 'x' => [ 5, sub {
233 my ($type, $s) = @_;
234 my $result = 0;
235 # check all parts
236 for (split /\./, $s)
237 {
238 return 1005 unless /^[-[a-z0-9]+$/i;
239 return 1006 if /^-/;
240 return 1007 if /-$/;
241 }
242 return $result;
243 }],
244 'ttl' => [ 6, sub {
245 my ($type, $s) = @_;
246 my $result = validate_integer($s, 2**32);
247 return $result;
248 }],
249 'timestamp' => [ 7, sub {
250 my ($type, $s) = @_;
251 my $result = validate_integer($s, 2**32);
252 return $result;
253 }],
254 'dist' => [ 9, sub {
255 my ($type, $s) = @_;
256 my $result = validate_integer($s, 65536);
257 return $result;
258 }],
259 's' => [ 10, sub {
260 my ($type, $s) = @_;
261 my $result = 0;
262 # TODO : Validation needed?
263 return $result;
264 }],
265 'p' => [ 11, sub {
266 my ($type, $s) = @_;
267 my $result = 0;
268 # check all parts
269 for (split /\./, $s)
270 {
271 return 1005 unless /^_?[-[a-z0-9]+$/i;
272 return 1006 if /^-/;
273 return 1007 if /-$/;
274 }
275 return $result;
276 }],
277 'mname' => [ 12, sub {
278 my ($type, $s) = @_;
279 my $result = 0;
280 # check all parts
281 for (split /\./, $s)
282 {
283 return 1005 unless /^[-[a-z0-9]+$/i;
284 return 1006 if /^-/;
285 return 1007 if /-$/;
286 }
287 return $result;
288 }],
289 'rname' => [ 13, sub {
290 my ($type, $s) = @_;
291 my $result = 0;
292
293 # check all parts
294 my @parts = split /\./, $s;
295 return 1009 if @parts < 3;
296
297 for (split /\./, $s)
298 {
299 return 1005 unless /^[-[a-z0-9]+$/i;
300 return 1006 if /^-/;
301 return 1007 if /-$/;
302 }
303 return $result;
304 }],
305 'ser' => [ 14, sub {
306 my ($type, $s) = @_;
307 my $result = validate_integer($s, 2**32);
308 return $result;
309 }],
310 'ref' => [ 15, sub {
311 my ($type, $s) = @_;
312 my $result = validate_integer($s, 2**32);
313 return $result;
314 }],
315 'ret' => [ 16, sub {
316 my ($type, $s) = @_;
317 my $result = validate_integer($s, 2**32);
318 return $result;
319 }],
320 'exp' => [ 17, sub {
321 my ($type, $s) = @_;
322 my $result = validate_integer($s, 2**32);
323 return $result;
324 }],
325 'min' => [ 18, sub {
326 my ($type, $s) = @_;
327 my $result = validate_integer($s, 2**32);
328 return $result;
329 }],
330 'n' => [ 19, sub {
331 my ($type, $s) = @_;
332 my $result = validate_integer($s, 65535);
333
334 return 1010 if ($s==2)||($s==5)||($s==6)||($s==12)||($s==15)||($s==252);
335
336 return $result;
337 }],
338 'rdata' => [ 20, sub {
339 my ($type, $s) = @_;
340 # TODO : Validation needed?
341 my $result = 0;
342 return $result;
343 }],
344
345
346
347 );
348
349
350 sub validate_line ($)
351 {
352 my ($s) = @_;
353
354 my $result = [ 0, '', '', [] ];
355
356 $s =~ s/\s+$//;
357
358 if (length($s))
359 {
360 my $type = substr($s, 0, 1); $$result[2] = $type;
361 my $rest = substr($s, 1);
362 if (exists($line_type{$type}))
363 {
364 my $lt = $line_type{$type};
365 my @mask = split /\:/, $line_type{$type}->[1];
366 my @mandatory = split /\:/, $line_type{$type}->[2];
367
368 if (@mask > 0)
369 {
370 my $c = 0;
371 my @tokens = split /\:/, $rest;
372 my $ip = '';
373
374 my $vals = @tokens;
375 $vals = $#mandatory if $#mandatory > $vals;
376
377 for my $t (0..$vals)
378 {
379 my $token = $tokens[$t];
380 # sanity check; should not fail
381 if ($c > $#mask)
382 {
383 # silently ignore excessive fields
384 # as tinydns-data does now
385 }
386 elsif (exists($token_validator{$mask[$c]}))
387 {
388 my $validator = $token_validator{$mask[$c]};
389
390 if (length($token))
391 {
392 # Remember fqdn for later
393 if (($c eq 0) && ($mask[0] eq 'fqdn'))
394 {
395 my $tmp = $token;
396 $tmp =~ s/\.$//;
397 push @{$$result[3]}, $tmp;
398 }
399
400 # Remember x as fqdn IF ip is specified
401 if (($mask[$c] eq 'ip') && (length($token)))
402 {
403 $ip = $token;
404 }
405
406 #
407 if (length($ip) && ($mask[$c] eq 'x'))
408 {
409 my $tmp = $token;
410 $tmp =~ s/\.$//;
411 push @{$$result[3]}, $tmp;
412 }
413
414 # perform validation
415
416 my $tv = &{$$validator[1]}($type, $token);
417 if ($tv)
418 {
419 $$result[0] ^= (2 ** $$validator[0]);
420 $$result[1] .=
421 "\npos $c; $mask[$c]; $validation_msg{$tv}";
422 }
423 }
424 elsif ($mandatory[$c] eq $mask[$c])
425 {
426 my $mand = 1;
427 $mand = 0 if ($opt{r}) && ($mask[$c] eq 'fqdn');
428 $mand = 0 if ($opt{R}) && ($mask[$c] eq 'mname');
429 $mand = 0 if ($opt{R}) && ($mask[$c] eq 'p');
430 $mand = 0 if ($opt{R}) && ($mask[$c] eq 'rdata');
431 $mand = 0 if ($opt{i}) && ($mask[$c] eq 'ip');
432
433 if ($mand)
434 {
435 $$result[0] ^= (2 ** $$validator[0]);
436 $$result[1] .= "\npos $c; $mask[$c]; ".
437 $token_name{$mask[$c]}.' is mandatory';
438 }
439 }
440 # else ignore nonmandatory blanks
441
442 }
443 else
444 {
445 # somebody has modified program in a wrong way
446 $result = [ 1,
447 "VALIDATOR FAILS ON TOKENS OF TYPE ".$mask[$c]." $c" ];
448 }
449 $c++;
450 }
451 }
452
453 if ($$result[0])
454 {
455 $$result[1] = "expected: ".$line_type{$type}->[1]."\n".
456 $$result[1];
457 }
458
459 }
460 else
461 {
462 $result = [ 1, sprintf("unknown record type: #%02x",
463 ord($type)) ];
464 }
465 }
466
467 $$result[1] =~ s/^\n+//;
468 $$result[1] =~ s/\n+/\n/g;
469
470 # result is now [ iErrno, sErrtxt, sRecordType, [ sFQDN ] ]
471 return $result;
472 }
473
474 sub p ($$)
475 {
476 my ($fhv, $line) = @_;
477 for my $fh (@{$fhv})
478 {
479 print $fh $line."\n";
480 }
481 }
482
483 sub funiq (@)
484 {
485 my @files = @_;
486 my %ufiles;
487 for my $curpat (@files)
488 {
489 for my $elem (glob $curpat)
490 {
491 $ufiles{$elem}++;
492 }
493 }
494 return [ sort keys %ufiles ];
495 }
496
497 sub read_file ($$)
498 {
499 my ($vfile, $cache) = @_;
500 my %vresult;
501 my $result = [ ];
502
503 if (exists $cache->{file}->{$vfile})
504 {
505 $result = $cache->{file}->{$vfile};
506 }
507 else
508 {
509 if (open(FILER, $vfile))
510 {
511 while (<FILER>)
512 {
513 chomp;
514 s/^\s+//;
515 s/\s+$//;
516 next if /^#/;
517 next if /^$/;
518 $vresult{$_}++;
519 }
520 close FILER;
521 $cache->{file}->{$vfile} = [ sort keys %vresult ];
522 $result = $cache->{file}->{$vfile};
523 }
524 }
525
526 return $result;
527 }
528
529
530 sub read_filter ($$)
531 {
532 my ($file, $cache) = @_;
533 my $f = {};
534
535 if (open(FILEF, $file))
536 {
537 while (<FILEF>)
538 {
539 chomp;
540 s/^\s+//;
541 s/\s+$//;
542
543 if (/^(\w+)\s+(.+)$/)
544 {
545 my ($key, $value) = ($1, $2);
546 my (@values, @tempvalues);
547 if ($value =~ m#^file:(.+)#)
548 {
549 my $vfile = $1;
550 @tempvalues = @{read_file($vfile, $cache)};
551 }
552 else
553 {
554 @tempvalues = ( $value );
555 }
556
557 if ($key =~ /^zonefiles?$/)
558 {
559 # This is a globbing action
560 for (@tempvalues)
561 {
562 push @values, @{funiq($_)};
563 }
564 }
565 else
566 {
567 @values = @tempvalues;
568 }
569
570 for (@values)
571 {
572 $f->{lc $key}->{$_}++;
573 }
574 }
575 }
576 close FILEF;
577 }
578 else
579 {
580 print STDERR "Warning: Couldn't open filterfile: $file; $!\n";
581 }
582
583 return $f;
584 }
585
586 sub regexped_patterns ($)
587 {
588 my ($h) = @_;
589 my $result = [ ];
590
591 for my $pat (keys %{$h})
592 {
593 unless ($pat =~ /^\^.+\$$/)
594 {
595 $pat =~ s/\.+$//;
596
597 # fix a regexp for the lazy notation
598 $pat =~ s/^[\*\.]+//;
599 $pat =~ s/\./\\./g;
600 $pat = '^(.*\\.)?'.$pat.'\.?$';
601 }
602 push @{$result}, $pat;
603 }
604 return $result;
605 }
606
607
608 sub check_pattern ($$)
609 {
610 my ($pattern, $fqdn) = @_;
611 my $result = 0;
612
613 if ($fqdn =~ /$pattern/)
614 {
615 $result = 1;
616 }
617 else
618 {
619 $result = 0;
620 }
621
622 return $result;
623 }
624
625
626 sub make_char_regexp ($)
627 {
628 my ($chars) = @_;
629 my @rc;
630 my $regexp;
631
632 for (split /\s+/, $chars)
633 {
634 if (/^\d+$/)
635 {
636 $regexp .= sprintf("\\%03o", $_);
637 }
638 else
639 {
640 for (split //, $_)
641 {
642 $regexp .= "\\$_";
643 }
644 }
645 }
646
647 if (length($regexp))
648 {
649 $regexp = "[$regexp]";
650 }
651 else
652 {
653 $regexp = '.';
654 }
655
656 return $regexp;
657 }
658
659
660 sub do_filterfile ($$)
661 {
662 my ($filterfile, $cache) = @_;
663 my $result = '';
664 my $output = [ \*STDERR ];
665 my @extralogs;
666
667 my $f = read_filter($filterfile, $cache);
668
669 $$f{allowtype} = (keys %{$$f{allowtype}})[0];
670 $$f{allowtype} .= $opt{T};
671
672 my $allowtyperegex = make_char_regexp($$f{allowtype});
673
674 if ($$f{extralog})
675 {
676 for my $logfile (sort keys %{$$f{extralog}})
677 {
678 my ($fname, $fhandle);
679 # open logfiles and put them int @{$output};
680 ($fhandle, $fname) = tempfile();
681 if ($fhandle)
682 {
683 push @{$output}, $fhandle;
684 push @extralogs, [ $fhandle, $fname, $logfile ];
685 }
686 else
687 {
688 print STDERR "Warning: Couldn't create tempfile for ${logfile}.\n";
689 }
690 }
691 }
692
693 my @zonefiles = sort keys %{$$f{zonefile}};
694 if (@zonefiles == 0)
695 {
696 push @zonefiles, '-';
697 }
698 for my $zonefile (@zonefiles)
699 {
700 unless ($opt{s})
701 {
702 next if $zonefile =~ /$FILESUFFIXREGEXP/i;
703 }
704
705 my $info = 0;
706 my $filehandle = \*STDIN;
707 my $fopen = 1;
708 if ($zonefile ne '-')
709 {
710 $fopen = open( $filehandle, $zonefile );
711 }
712 if ($fopen)
713 {
714 my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
715 p $output, "File $temp";
716
717 %loreg = ();
718 my $errs = 0;
719 my $lno = 0;
720 while (<$filehandle>)
721 {
722 $lno++;
723 my $line = $_;
724 chomp($line);
725 my $v = validate_line($line);
726 for ($v)
727 {
728 my $ok = 1;
729 my $fqdnok = 1;
730 my $reason = '';
731
732 if ($$v[0])
733 {
734 $errs++;
735 $verrs_total++;
736 $$v[1] =~ s/\n/\n /g;
737 p $output, " line $lno; err $$v[0] $line\n ".$$v[1];
738 }
739 else
740 {
741 if (length($$v[2]))
742 {
743 if ($$v[2] !~ /$allowtyperegex/)
744 {
745 $ok=0;
746 if (($$v[2] ne '#') || ($opt{t} == 1))
747 {
748 $errs++;
749 $perrs_total++;
750 p $output, " line $lno; err -1 $line";
751 p $output, " record type $$v[2] disallowed; allowed: $$f{allowtype}";
752 }
753 }
754 else
755 {
756 # just check fqdn if record contains it
757 if (@{$$v[3]})
758 {
759 # Check $$v[3] against allowed fqdn:s:wq!
760 if (keys %{$$f{deny}})
761 {
762 #
763 my $patterns = regexped_patterns($$f{deny});
764 # Default ALLOW ALL
765 $ok = $fqdnok = 1;
766 $reason = 'default allow ^.*$';
767
768 for my $pat (@{$patterns})
769 {
770 for (@{$$v[3]})
771 {
772 if (check_pattern($pat, $_))
773 {
774 $ok = $fqdnok = 0;
775 $reason = 'deny '.$pat;
776 }
777 }
778 }
779 }
780 elsif (keys %{$$f{allow}})
781 {
782 my $patterns = regexped_patterns($$f{allow});
783 # Default DENY ALL
784 $ok = $fqdnok = 0;
785 $reason = 'default deny ^.*$';
786
787 for my $pat (@{$patterns})
788 {
789 for (@{$$v[3]})
790 {
791 if (check_pattern($pat, $_))
792 {
793 $ok = $fqdnok = 1;
794 $reason = $pat;
795 }
796 }
797 }
798 } # if deny/allow
799 } # if fqdn
800 } # if recordtype ok
801 } #
802
803 if ($ok && length($line))
804 {
805 print STDOUT "$line\n" unless $opt{q};
806 }
807 else
808 {
809 if ($fqdnok == 0)
810 {
811 $errs++;
812 $perrs_total++;
813 p $output, " line $lno; err -2; $line";
814 p $output, " use of fqdn denied; $reason";
815 if ($opt{I})
816 {
817 print STDOUT "# line $lno; err -2; $line\n";
818 print STDOUT "# use of fqdn denied; $reason\n";
819 }
820 }
821 }
822 }
823 } # for ($v)
824 } # while (<$filehandle>)
825 close $filehandle unless $zonefile eq '-';
826 my $plur = ($errs == 1) ? '' : 's';
827 p $output, "$lno lines, $errs error${plur}.";
828 }
829 else
830 {
831 p $output, "Warning: Trouble opening '$zonefile'; $!";
832 }
833 }
834
835
836 # Close all extra logfiles
837 for my $el (@extralogs)
838 {
839 if (close($$el[0]))
840 {
841 if (move($$el[1], $$el[2]))
842 {
843 print STDERR "Copy of logfile portion to $$el[2]\n";
844 }
845 else
846 {
847 print STDERR "Warning: Couldn't rename tempfile to $$el[2].\n";
848 unlink $$el[1];
849 }
850 }
851 else
852 {
853 print STDERR "Warning: Couldn't close tempfile for $$el[2].\n";
854 unlink $$el[1];
855 }
856 }
857
858 return $result;
859 }
860
861 #
862 ## Start
863 #
864
865 my $files = funiq(@ARGV);
866
867
868 if ($opt{h} || $opt{H} || $opt{'?'})
869 {
870 print <<"--EOT";
871 valtz $VERSION, $COPYRIGHT
872 validates tinydns-data zone files
873 Usage:
874 $0 [-hfFqrRiItTx] <file(s)>
875
876 -h shows this help.
877
878
879 -f filter (don't just validate) file and output accepted lines to STDOUT.
880
881
882 -F treat files as filter configuration files for more advanced filtering.
883 These filterfiles one or several of the following filter directives:
884
885 zonefile <zonefilepath>
886 zonefile file:<path to textfile including zonefilepaths>
887 Defines the file(s) to be filtered. Can be a globbed value, like
888 /var/zones/external/*
889
890 extralog <logfile>
891 Defines an extra logfile that the STDERR output will be copied for
892 this specific filterfile. Useful if you have a lot of filterfiles
893 and want to separate the logs.
894
895 deny <zonepattern>
896 deny file:<path to <zonepatternfile>
897 Defines a zonepattern to explicitly DENY after implicitly allowing all.
898 (cannot be combined with allow)
899
900 allow <zonepattern>
901 allow file:<path to <zonepatternfile>
902 Defines a zonepattern to explicitly ALLOW after implicitly denying all.
903
904 allowtype <recordtype character(s)>
905 Explicitly sets the allowed recordtypes. Note that even comments
906 has to be allowed (but these will not result in errors unless -t)
907 to be copied to the output.
908
909 Multiple zonefile, allow- and deny-lines are allowed, but also the
910 alternative file:-line that points to a textfile containing one
911 value per line.
912
913
914 -r allows fqdn to be empty thus denoting the root.
915 This is also allowed per default when doing implict allow - see deny,
916 or when specifying 'allow .', i.e. explictly allowing root as such.
917 (cannot be combined with deny)
918
919
920 -R relaxes the validation and allows empty mname and p-fields.xi
921 This is probably not very useful.
922
923
924 -i allows the ip-fields to be empty as well. These will then not generate any
925 records.
926
927
928 -I Include rejected lines as comments in output (valid when filtering).
929
930
931 -q Do not echo valid lines to STDOUT.
932
933 -s DO NOT ignore files ending with ,v ~ .bak .log .old .swp .tmp
934 which is done per default.
935
936
937 -t Give error even on #comment-lines when they are not allowed.
938 (These errors are silently ignored per default)
939
940
941 -T<types>
942 A commandline way to explicitly set the allowed recordtypes.
943 This is _concatenated_ to the allowtype-allowed recordtypes.
944
945 -x Exit with non-null exit code on errors; i.e. make errors detectable by
946 e.g. shell scripts; 1 = validation error, 2 = permission error,
947 3 = combination of 1 and 2.
948
949
950
951 All errors in the zonefiles are sent to STDERR.
952
953 Example; simple use:
954 valtz zone-bodin-org
955
956 Example; simple filter-use;
957 valtz -f /etc/zones/zone-* \
958 >/etc/tinydns/data.filtered \
959 2>/var/log/tinydns/valtz.log
960
961 Example; filterfile use;
962 valtz -F /etc/zones/filter/zones-otto \
963 >/etc/tinydns/data.otto \
964 2>/var/log/tinydns/valtz.log
965
966
967 Example filterfile for using as import from primary (as above):
968 zonefile /var/zones/external/otto/zone-*
969 deny bodin.org
970 deny x42.com
971 extralog /var/log/tinydns/external-otto.log
972
973 Example #2, strict filter for a certain user editing just A-records
974
975 zonefile /home/felix/zones/zone-fl3x-net
976 allow fl3x.net
977 allowtype +
978 extralog /var/log/tinydns/fl3x-net.log
979
980 Example #3, export filter to secondary
981
982 zonefile /var/zones/primary/zone-*
983 # just allow OUR zones to be exported, not to annoy secondary partner
984 allow file:/var/zones/primary-zones.txt
985 # don't allow any other types than this; e.g. comments won't be exported
986 allowtype Z + @ . C
987 extralog /var/log/tinydns/primary-export.log
988
989 --EOT
990 exit 0;
991 }
992 elsif (@{$files} == 0)
993 {
994 print <<"--EOT";
995 valtz $VERSION, $COPYRIGHT
996 validates tinydns-data zone files
997 Usage:
998 Simple validation:
999 $0 [-qrRix] <zonefiles>
1000 Simple filtering:
1001 $0 -f[qrRiItTx] <zonefiles>
1002 Extensive filtering:
1003 $0 -F[qrRiItTx] <zonefiles>
1004
1005 More help and information about options:
1006 $0 -h
1007
1008 --EOT
1009 exit 0;
1010 }
1011
1012
1013 if ($opt{F})
1014 {
1015 my $cache = {};
1016 $cache->{file} = {};
1017 for my $file (@{$files})
1018 {
1019 my $result = do_filterfile($file, $cache);
1020 }
1021
1022 }
1023 else
1024 {
1025
1026 my $output = [ \*STDERR ];
1027
1028 for my $zonefile (sort @{$files})
1029 {
1030 unless ($opt{s})
1031 {
1032 next if $zonefile =~ /$FILESUFFIXREGEXP/i;
1033 }
1034
1035 my $filehandle = \*STDIN;
1036 my $fopen = 1;
1037 if ($zonefile ne '-')
1038 {
1039 $fopen = open( $filehandle, $zonefile );
1040 }
1041 if ($fopen)
1042 {
1043 %loreg = ();
1044 my $errs = 0;
1045 my $lno = 0;
1046 while (<$filehandle>)
1047 {
1048 $lno++;
1049 my $line = $_;
1050 chomp($line);
1051 my $v = validate_line($line);
1052 for ($v)
1053 {
1054 if ($$v[0])
1055 {
1056 my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
1057 p $output, "File $temp" unless $errs;
1058 $errs++;
1059 $verrs_total++;
1060 $$v[1] =~ s/\n/\n /g;
1061 p $output, " line $lno; err $$v[0] $line\n ".$$v[1];
1062 if ($opt{I})
1063 {
1064 print STDOUT "# line $lno; err $$v[0] $line
1065 print STDOUT "# $$v[1]; \n";
1066 }
1067 }
1068 else
1069 {
1070 # Echo NON-ERRORS to STDOUT
1071 if ($opt{f})
1072 {
1073 print STDOUT "$line\n" unless $opt{q};
1074 }
1075 }
1076 }
1077 }
1078 close $filehandle unless $zonefile eq '-';
1079 }
1080 else
1081 {
1082 p $output, "Error: Trouble opening '$zonefile'; $!";
1083 }
1084 }
1085 }
1086
1087 if ($opt{x} && ($verrs_total + $perrs_total))
1088 {
1089 my $exitcode = $verrs_total > 0 ? 1 : 0;
1090 $exitcode += $perrs_total > 0 ? 2 : 0;
1091 exit $exitcode;
1092 }