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 }