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