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 }