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