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