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 = $1 if '$Revision: 0.7 $' =~ /(\d+\.\d+)/;
  47 my $COPYRIGHT = '; (C) 2003 Magnus Bodin, http://x42.com/software/';
  48
  49 $| = 1;
  50 my %opt;
  51 getopts('?fFhHiIqrRstT:x', \%opt);
  52
  53
  54 my $FILESUFFIXREGEXP = '('.join('|', qw/
  55         ,v ~ .bak .log .old .swp .tmp
  56     /).')$';
  57
  58 my $verrs_total = 0;
  59 my $perrs_total = 0;
  60
  61
  62 ##
  63 # global location registry
  64 # (reset for every zone file)
  65 my %loreg;
  66
  67 # NOTE : DO NOT CHANGE the id numbers
  68 my %validation_msg = (
  69     1001 => 'badly formed; should be just two ASCII letters',
  70     1002 => 'location is not previously defined in a %-line',
  71     1003 => 'invalid syntax',
  72     1004 => 'invalid syntax of integer',
  73     1005 => 'parts must only contain ASCII letters, digits and - characters',
  74     1006 => 'parts must not begin with the - character',
  75     1007 => 'parts must not end with the - character',
  76     1008 => 'integer out of bounds',
  77     1009 => 'must have at least three labels to be valid as mail address',
  78     1010 => 'must not be 2(NS), 5(CNAME), 6(SOA), 12(PTR), 15(MX) or 252(AXFR)',
  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         # check all parts
 242         for (split /\./, $s)
 243         {
 244             return 1005 unless /^[-[a-z0-9]+$/i;
 245             return 1006 if /^-/;
 246             return 1007 if /-$/;
 247         }
 248         return $result;
 249     }],
 250     'ttl' => [ 6, sub {
 251         my ($type, $s) = @_;
 252     my $result = validate_integer($s, 2**32);
 253         return $result;
 254     }],
 255     'timestamp' => [ 7, sub {
 256         my ($type, $s) = @_;
 257         my $result = validate_integer($s, 2**32);
 258         return $result;
 259     }],
 260     'dist' => [ 9, sub {
 261         my ($type, $s) = @_;
 262         my $result = validate_integer($s, 65536);
 263         return $result;
 264     }],
 265     's' => [ 10, sub {
 266         my ($type, $s) = @_;
 267         my $result = 0;
 268         # TODO : Validation needed?
 269         return $result;
 270     }],
 271     'p' => [ 11, sub {
 272         my ($type, $s) = @_;
 273         my $result = 0;
 274         # check all parts
 275         for (split /\./, $s)
 276         {
 277             return 1005 unless /^_?[-[a-z0-9]+$/i;
 278             return 1006 if /^-/;
 279             return 1007 if /-$/;
 280         }
 281         return $result;
 282     }],
 283     'mname' => [ 12, sub {
 284         my ($type, $s) = @_;
 285         my $result = 0;
 286         # check all parts
 287         for (split /\./, $s)
 288         {
 289             return 1005 unless /^[-[a-z0-9]+$/i;
 290             return 1006 if /^-/;
 291             return 1007 if /-$/;
 292         }
 293         return $result;
 294     }],
 295     'rname' => [ 13, sub {
 296         my ($type, $s) = @_;
 297         my $result = 0;
 298
 299         # check all parts
 300         my @parts = split /\./, $s;
 301         return 1009 if @parts < 3;
 302
 303         for (split /\./, $s)
 304         {
 305             return 1005 unless /^[-[a-z0-9]+$/i;
 306             return 1006 if /^-/;
 307             return 1007 if /-$/;
 308         }
 309         return $result;
 310     }],
 311     'ser' => [ 14, sub {
 312         my ($type, $s) = @_;
 313         my $result = validate_integer($s, 2**32);
 314         return $result;
 315     }],
 316     'ref' => [ 15, sub {
 317         my ($type, $s) = @_;
 318         my $result = validate_integer($s, 2**32);
 319         return $result;
 320     }],
 321     'ret' => [ 16, sub {
 322         my ($type, $s) = @_;
 323         my $result = validate_integer($s, 2**32);
 324         return $result;
 325     }],
 326     'exp' => [ 17, sub {
 327         my ($type, $s) = @_;
 328         my $result = validate_integer($s, 2**32);
 329         return $result;
 330     }],
 331     'min' => [ 18, sub {
 332         my ($type, $s) = @_;
 333         my $result = validate_integer($s, 2**32);
 334         return $result;
 335     }],
 336     'n' => [ 19, sub {
 337         my ($type, $s) = @_;
 338         my $result = validate_integer($s, 65535);
 339
 340         return 1010 if ($s==2)||($s==5)||($s==6)||($s==12)||($s==15)||($s==252);
 341
 342         return $result;
 343     }],
 344     'rdata' => [ 20, sub {
 345         my ($type, $s) = @_;
 346         # TODO : Validation needed?
 347         my $result = 0;
 348         return $result;
 349      }],
 350     'port' => [ 21, sub {
 351         my ($type, $s) = @_;
 352         my $result = validate_integer($s, 65536);
 353         return $result;
 354     }],
 355     'priority' => [ 22, sub {
 356         my ($type, $s) = @_;
 357         my $result = validate_integer($s, 65536);
 358         return $result;
 359     }],
 360     'weight' => [ 23, sub {
 361         my ($type, $s) = @_;
 362         my $result = validate_integer($s, 65536);
 363         return $result;
 364     }],
 365
 366
 367
 368 );
 369
 370
 371 sub validate_line ($)
 372 {
 373     my ($s) = @_;
 374
 375     my $result = [ 0, '', '', [] ];
 376
 377     $s =~ s/\s+$//;
 378
 379     if (length($s))
 380     {
 381         my $type = substr($s, 0, 1); $$result[2] = $type;
 382         my $rest = substr($s, 1);
 383         if (exists($line_type{$type}))
 384         {
 385             my $lt = $line_type{$type};
 386             my @mask = split /\:/, $line_type{$type}->[1];
 387             my @mandatory = split /\:/, $line_type{$type}->[2];
 388
 389             if (@mask > 0)
 390             {
 391                 my $c = 0;
 392                 my @tokens = split /\:/, $rest;
 393                 my $ip = '';
 394
 395                 my $vals = @tokens;
 396                 $vals = $#mandatory if $#mandatory > $vals;
 397
 398                 for my $t (0..$vals)
 399                 {
 400                     my $token = $tokens[$t];
 401                     # sanity check; should not fail
 402                     if ($c > $#mask)
 403                     {
 404                         # silently ignore excessive fields
 405                         # as tinydns-data does now
 406                     }
 407                     elsif (exists($token_validator{$mask[$c]}))
 408                     {
 409                         my $validator = $token_validator{$mask[$c]};
 410
 411                         if (length($token))
 412                         {
 413                             # Remember fqdn for later
 414                             if (($c eq 0) && ($mask[0] eq 'fqdn'))
 415                             {
 416                                 my $tmp = $token;
 417                                 $tmp =~ s/\.$//;
 418                                 push @{$$result[3]}, $tmp;
 419                             }
 420
 421                             # Remember x as fqdn IF ip is specified
 422                             if (($mask[$c] eq 'ip') && (length($token)))
 423                             {
 424                                 $ip = $token;
 425                             }
 426
 427                             #
 428                             if (length($ip) && ($mask[$c] eq 'x'))
 429                             {
 430                                 my $tmp = $token;
 431                                 $tmp =~ s/\.$//;
 432                                 push @{$$result[3]}, $tmp;
 433                             }
 434
 435                             # perform validation
 436
 437                             my $tv = &{$$validator[1]}($type, $token);
 438                             if ($tv)
 439                             {
 440                                 $$result[0] ^= (2 ** $$validator[0]);
 441                                 $$result[1] .=
 442                                   "\npos $c; $mask[$c]; $validation_msg{$tv}";
 443                             }
 444                         }
 445                         elsif ($mandatory[$c] eq $mask[$c])
 446                         {
 447                             my $mand = 1;
 448                             $mand = 0 if ($opt{r}) && ($mask[$c] eq 'fqdn');
 449                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'mname');
 450                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'p');
 451                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'rdata');
 452                             $mand = 0 if ($opt{i}) && ($mask[$c] eq 'ip');
 453
 454                             if ($mand)
 455                             {
 456                                 $$result[0] ^= (2 ** $$validator[0]);
 457                                 $$result[1] .= "\npos $c; $mask[$c]; ".
 458                                 $token_name{$mask[$c]}.' is mandatory';
 459                             }
 460                         }
 461                         # else ignore nonmandatory blanks
 462
 463                     }
 464                     else
 465                     {
 466                         # somebody has modified program in a wrong way
 467                         $result = [ 1,
 468                           "VALIDATOR FAILS ON TOKENS OF TYPE ".$mask[$c]." $c" ];
 469                     }
 470                     $c++;
 471                 }
 472             }
 473
 474             if ($$result[0])
 475             {
 476                 $$result[1] = "expected: ".$line_type{$type}->[1]."\n".
 477                     $$result[1];
 478             }
 479
 480         }
 481         else
 482         {
 483             $result = [ 1, sprintf("unknown record type: #%02x",
 484                 ord($type)) ];
 485         }
 486     }
 487
 488     $$result[1] =~ s/^\n+//;
 489     $$result[1] =~ s/\n+/\n/g;
 490
 491     # result is now [ iErrno, sErrtxt, sRecordType, [ sFQDN ] ]
 492     return $result;
 493 }
 494
 495 sub p ($$)
 496 {
 497     my ($fhv, $line) = @_;
 498     for my $fh (@{$fhv})
 499     {
 500         print $fh $line."\n";
 501     }
 502 }
 503
 504 sub funiq (@)
 505 {
 506     my @files = @_;
 507     my %ufiles;
 508     for my $curpat (@files)
 509     {
 510         for my $elem (glob $curpat)
 511         {
 512             $ufiles{$elem}++;
 513         }
 514     }
 515     return [ sort keys %ufiles ];
 516 }
 517
 518 sub read_file ($$)
 519 {
 520     my ($vfile, $cache) = @_;
 521     my %vresult;
 522     my $result = [ ];
 523
 524     if (exists $cache->{file}->{$vfile})
 525     {
 526         $result = $cache->{file}->{$vfile};
 527     }
 528     else
 529     {
 530         if (open(FILER, $vfile))
 531         {
 532             while (<FILER>)
 533             {
 534                 chomp;
 535                 s/^\s+//;
 536                 s/\s+$//;
 537                 next if /^#/;
 538                 next if /^$/;
 539                 $vresult{$_}++;
 540             }
 541             close FILER;
 542             $cache->{file}->{$vfile} = [ sort keys %vresult ];
 543             $result = $cache->{file}->{$vfile};
 544         }
 545     }
 546
 547     return $result;
 548 }
 549
 550
 551 sub read_filter ($$)
 552 {
 553     my ($file, $cache) = @_;
 554     my $f = {};
 555
 556     if (open(FILEF, $file))
 557     {
 558         while (<FILEF>)
 559         {
 560             chomp;
 561             s/^\s+//;
 562             s/\s+$//;
 563
 564             if (/^(\w+)\s+(.+)$/)
 565             {
 566                 my ($key, $value) = ($1, $2);
 567                 my (@values, @tempvalues);
 568                 if ($value =~ m#^file:(.+)#)
 569                 {
 570                     my $vfile = $1;
 571                     @tempvalues = @{read_file($vfile, $cache)};
 572                 }
 573                 else
 574                 {
 575                     @tempvalues = ( $value );
 576                 }
 577
 578                 if ($key =~ /^zonefiles?$/)
 579                 {
 580                     # This is a globbing action
 581                     for (@tempvalues)
 582                     {
 583                         push @values, @{funiq($_)};
 584                     }
 585                 }
 586                else
 587                {
 588                     @values = @tempvalues;
 589                }
 590
 591                for (@values)
 592                {
 593                     $f->{lc $key}->{$_}++;
 594                }
 595            }
 596         }
 597         close FILEF;
 598     }
 599     else
 600     {
 601         print STDERR "Warning: Couldn't open filterfile: $file; $!\n";
 602     }
 603
 604     return $f;
 605 }
 606
 607 sub regexped_patterns ($)
 608 {
 609     my ($h) = @_;
 610     my $result = [ ];
 611
 612     for my $pat (keys %{$h})
 613     {
 614         unless ($pat =~ /^\^.+\$$/)
 615         {
 616         $pat =~ s/\.+$//;
 617
 618             # fix a regexp for the lazy notation
 619             $pat =~ s/^[\*\.]+//;
 620             $pat =~ s/\./\\./g;
 621             $pat = '^(.*\\.)?'.$pat.'\.?$';
 622         }
 623         push @{$result}, $pat;
 624     }
 625     return $result;
 626 }
 627
 628
 629 sub check_pattern ($$)
 630 {
 631     my ($pattern, $fqdn) = @_;
 632     my $result = 0;
 633
 634     if ($fqdn =~ /$pattern/)
 635     {
 636         $result = 1;
 637     }
 638     else
 639     {
 640         $result = 0;
 641     }
 642
 643     return $result;
 644 }
 645
 646
 647 sub make_char_regexp ($)
 648 {
 649     my ($chars) = @_;
 650     my @rc;
 651     my $regexp;
 652
 653     for (split /\s+/, $chars)
 654     {
 655         if (/^\d+$/)
 656         {
 657             $regexp .= sprintf("\\%03o", $_);
 658         }
 659         else
 660         {
 661             for (split //, $_)
 662             {
 663                 $regexp .= "\\$_";
 664             }
 665         }
 666     }
 667
 668     if (length($regexp))
 669     {
 670         $regexp = "[$regexp]";
 671     }
 672     else
 673     {
 674         $regexp = '.';
 675     }
 676
 677     return $regexp;
 678 }
 679
 680
 681 sub do_filterfile ($$)
 682 {
 683     my ($filterfile, $cache) = @_;
 684     my $result = '';
 685     my $output = [ \*STDERR ];
 686     my @extralogs;
 687
 688     my $f = read_filter($filterfile, $cache);
 689
 690     $$f{allowtype} = (keys %{$$f{allowtype}})[0];
 691     $$f{allowtype} .= $opt{T};
 692
 693     my $allowtyperegex = make_char_regexp($$f{allowtype});
 694
 695     if ($$f{extralog})
 696     {
 697         for my $logfile (sort keys %{$$f{extralog}})
 698         {
 699             my ($fname, $fhandle);
 700             # open logfiles and put them int @{$output};
 701             ($fhandle, $fname) = tempfile();
 702             if ($fhandle)
 703             {
 704                 push @{$output}, $fhandle;
 705                 push @extralogs, [ $fhandle, $fname, $logfile ];
 706             }
 707             else
 708             {
 709                 print STDERR "Warning: Couldn't create tempfile for ${logfile}.\n";
 710             }
 711         }
 712     }
 713
 714     my @zonefiles = sort keys %{$$f{zonefile}};
 715     if (@zonefiles == 0)
 716     {
 717         push @zonefiles, '-';
 718     }
 719     for my $zonefile (@zonefiles)
 720     {
 721         unless ($opt{s})
 722         {
 723             next if $zonefile =~ /$FILESUFFIXREGEXP/i;
 724         }
 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                                         #
 784                                         my $patterns = regexped_patterns($$f{deny});
 785                                         # Default ALLOW ALL
 786                                         $ok = $fqdnok = 1;
 787                                         $reason = 'default allow ^.*$';
 788
 789                                         for my $pat (@{$patterns})
 790                                         {
 791                                             for (@{$$v[3]})
 792                                             {
 793                                                 if (check_pattern($pat, $_))
 794                                                 {
 795                                                     $ok = $fqdnok = 0;
 796                                                     $reason = 'deny '.$pat;
 797                                                 }
 798                                             }
 799                                         }
 800                                     }
 801                                     elsif (keys %{$$f{allow}})
 802                                     {
 803                                         my $patterns = regexped_patterns($$f{allow});
 804                                         # Default DENY ALL
 805                                         $ok = $fqdnok = 0;
 806                                         $reason = 'default deny ^.*$';
 807
 808                                         for my $pat (@{$patterns})
 809                                         {
 810                                             for (@{$$v[3]})
 811                                             {
 812                                                 if (check_pattern($pat, $_))
 813                                                 {
 814                                                     $ok = $fqdnok = 1;
 815                                                     $reason = $pat;
 816                                                 }
 817                                             }
 818                                         }
 819                                     } # if deny/allow
 820                                 } # if fqdn
 821                             } # if recordtype ok
 822                         } #
 823
 824                         if ($ok && length($line))
 825                         {
 826                             print STDOUT "$line\n" unless $opt{q};
 827                         }
 828                         else
 829                         {
 830                             if ($fqdnok == 0)
 831                             {
 832                                 $errs++;
 833                                 $perrs_total++;
 834                                 p $output, "  line $lno; err -2; $line";
 835                                 p $output, "    use of fqdn denied; $reason";
 836                                 if ($opt{I})
 837                                 {
 838                                     print STDOUT "# line $lno; err -2; $line\n";
 839                                     print STDOUT "#   use of fqdn denied; $reason\n";
 840                                 }
 841                             }
 842                         }
 843                     }
 844                 } # for ($v)
 845             } # while (<$filehandle>)
 846             close $filehandle unless $zonefile eq '-';
 847             my $plur = ($errs == 1) ? '' : 's';
 848             p $output, "$lno lines, $errs error${plur}.";
 849         }
 850         else
 851         {
 852             p $output, "Warning: Trouble opening '$zonefile'; $!";
 853         }
 854     }
 855
 856
 857       # Close all extra logfiles
 858     for my $el (@extralogs)
 859     {
 860         if (close($$el[0]))
 861         {
 862             if (move($$el[1], $$el[2]))
 863             {
 864                 print STDERR "Copy of logfile portion to $$el[2]\n";
 865             }
 866             else
 867             {
 868                 print STDERR "Warning: Couldn't rename tempfile to $$el[2].\n";
 869                 unlink $$el[1];
 870             }
 871         }
 872         else
 873         {
 874             print STDERR "Warning: Couldn't close tempfile for $$el[2].\n";
 875             unlink $$el[1];
 876         }
 877     }
 878
 879     return $result;
 880 }
 881
 882 #
 883 ## Start
 884 #
 885
 886 my $files = funiq(@ARGV);
 887
 888
 889 if ($opt{h} || $opt{H} || $opt{'?'})
 890 {
 891     print <<"--EOT";
 892 valtz $VERSION, $COPYRIGHT
 893 validates tinydns-data zone files
 894 Usage:
 895   $0 [-hfFqrRiItTx] <file(s)>
 896
 897   -h shows this help.
 898
 899
 900   -f filter (don't just validate) file and output accepted lines to STDOUT.
 901
 902
 903   -F treat files as filter configuration files for more advanced filtering.
 904      These filterfiles one or several of the following filter directives:
 905
 906      zonefile <zonefilepath>
 907      zonefile file:<path to textfile including zonefilepaths>
 908         Defines the file(s) to be filtered. Can be a globbed value, like
 909         /var/zones/external/*
 910
 911      extralog <logfile>
 912         Defines an extra logfile that the STDERR output will be copied for
 913         this specific filterfile. Useful if you have a lot of filterfiles
 914         and want to separate the logs.
 915
 916      deny <zonepattern>
 917      deny file:<path to <zonepatternfile>
 918         Defines a zonepattern to explicitly DENY after implicitly allowing all.
 919         (cannot be combined with allow)
 920
 921      allow <zonepattern>
 922      allow file:<path to <zonepatternfile>
 923         Defines a zonepattern to explicitly ALLOW after implicitly denying all.
 924
 925      allowtype <recordtype character(s)>
 926         Explicitly sets the allowed recordtypes. Note that even comments
 927         has to be allowed (but these will not result in errors unless -t)
 928         to be copied to the output.
 929
 930      Multiple zonefile, allow- and deny-lines are allowed, but also the
 931      alternative file:-line that points to a textfile containing one
 932      value per line.
 933
 934
 935   -r allows fqdn to be empty thus denoting the root.
 936      This is also allowed per default when doing implict allow - see deny,
 937      or when specifying 'allow .', i.e. explictly allowing root as such.
 938      (cannot be combined with deny)
 939
 940
 941   -R relaxes the validation and allows empty mname and p-fields.xi
 942      This is probably not very useful.
 943
 944
 945   -i allows the ip-fields to be empty as well. These will then not generate any
 946      records.
 947
 948
 949   -I Include rejected lines as comments in output (valid when filtering).
 950
 951
 952   -q Do not echo valid lines to STDOUT.
 953
 954   -s DO NOT ignore files ending with ,v ~ .bak .log .old .swp .tmp
 955      which is done per default.
 956
 957
 958   -t Give error even on #comment-lines when they are not allowed.
 959      (These errors are silently ignored per default)
 960
 961
 962   -T<types>
 963      A commandline way to explicitly set the allowed recordtypes.
 964      This is _concatenated_ to the allowtype-allowed recordtypes.
 965
 966   -x Exit with non-null exit code on errors; i.e. make errors detectable by
 967      e.g. shell scripts; 1 = validation error, 2 = permission error,
 968      3 = combination of 1 and 2.
 969
 970
 971
 972 All errors in the zonefiles are sent to STDERR.
 973
 974      Example; simple use:
 975        valtz zone-bodin-org
 976
 977      Example; simple filter-use;
 978        valtz -f /etc/zones/zone-* \
 979                 >/etc/tinydns/data.filtered \
 980                 2>/var/log/tinydns/valtz.log
 981
 982      Example; filterfile use;
 983        valtz -F /etc/zones/filter/zones-otto \
 984                 >/etc/tinydns/data.otto \
 985                 2>/var/log/tinydns/valtz.log
 986
 987
 988      Example filterfile for using as import from primary (as above):
 989        zonefile   /var/zones/external/otto/zone-*
 990        deny       bodin.org
 991        deny       x42.com
 992        extralog   /var/log/tinydns/external-otto.log
 993
 994      Example #2, strict filter for a certain user editing just A-records
 995
 996        zonefile  /home/felix/zones/zone-fl3x-net
 997        allow     fl3x.net
 998        allowtype +
 999        extralog  /var/log/tinydns/fl3x-net.log
1000
1001      Example #3, export filter to secondary
1002
1003        zonefile  /var/zones/primary/zone-*
1004        # just allow OUR zones to be exported, not to annoy secondary partner
1005        allow     file:/var/zones/primary-zones.txt
1006        # don't allow any other types than this; e.g. comments won't be exported
1007        allowtype Z + @ . C
1008        extralog  /var/log/tinydns/primary-export.log
1009
1010 --EOT
1011   exit 0;
1012 }
1013 elsif (@{$files} == 0)
1014 {
1015     print <<"--EOT";
1016 valtz $VERSION, $COPYRIGHT
1017 validates tinydns-data zone files
1018 Usage:
1019   Simple validation:
1020     $0 [-qrRix] <zonefiles>
1021   Simple filtering:
1022     $0 -f[qrRiItTx] <zonefiles>
1023   Extensive filtering:
1024     $0 -F[qrRiItTx] <zonefiles>
1025
1026   More help and information about options:
1027     $0 -h
1028
1029 --EOT
1030   exit 0;
1031 }
1032
1033
1034 if ($opt{F})
1035 {
1036     my $cache = {};
1037     $cache->{file} = {};
1038     for my $file (@{$files})
1039     {
1040         my $result = do_filterfile($file, $cache);
1041     }
1042
1043 }
1044 else
1045 {
1046
1047     my $output = [ \*STDERR ];
1048
1049     for my $zonefile (sort @{$files})
1050     {
1051         unless ($opt{s})
1052         {
1053             next if $zonefile =~ /$FILESUFFIXREGEXP/i;
1054         }
1055
1056     my $filehandle = \*STDIN;
1057     my $fopen = 1;
1058     if ($zonefile ne '-')
1059     {
1060         $fopen = open( $filehandle, $zonefile );
1061     }
1062         if ($fopen)
1063         {
1064             %loreg = ();
1065             my $errs = 0;
1066             my $lno = 0;
1067             while (<$filehandle>)
1068             {
1069                 $lno++;
1070                 my $line = $_;
1071                 chomp($line);
1072                 my $v = validate_line($line);
1073                 for ($v)
1074                 {
1075                     if ($$v[0])
1076                     {
1077             my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
1078                         p $output, "File $temp" unless $errs;
1079                         $errs++;
1080                         $verrs_total++;
1081                         $$v[1] =~ s/\n/\n    /g;
1082                         p $output, "  line $lno; err $$v[0] $line\n    ".$$v[1];
1083                         if ($opt{I})
1084                         {
1085                              print STDOUT "# line $lno; err $$v[0] $line
1086                              print STDOUT "# $$v[1]; \n";
1087                         }
1088                     }
1089                     else
1090                     {
1091                         # Echo NON-ERRORS to STDOUT
1092                         if ($opt{f})
1093                         {
1094                             print STDOUT "$line\n" unless $opt{q};
1095                         }
1096                     }
1097                 }
1098             }
1099             close $filehandle unless $zonefile eq '-';
1100         }
1101         else
1102         {
1103             p $output, "Error: Trouble opening '$zonefile'; $!";
1104         }
1105     }
1106 }
1107
1108 if ($opt{x} && ($verrs_total + $perrs_total))
1109 {
1110     my $exitcode = $verrs_total > 0 ? 1 : 0;
1111     $exitcode += $perrs_total > 0 ? 2 : 0;
1112     exit $exitcode;
1113 }