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