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 }