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 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 );
 104
 105 my %record_type = (
 106     '%' => ':location',
 107     '.' => 'NS',
 108     '&' => 'NS+A',
 109     '=' => 'A+PTR',
 110     '+' => 'A',
 111     '@' => 'MX+A?',
 112     '#' => ':comment',
 113     '-' => ':disabled +',
 114     "'" => 'TXT',
 115     '^' => 'PTR',
 116     'C' => 'CNAME',
 117     'Z' => 'SOA',
 118     ':' => 'GENERIC'
 119 );
 120
 121 # NOTE : This should NOT be translated!
 122 my %line_type = (
 123     '%' => [ ':location', 'lo:ipprefix', 'lo' ],
 124     '.' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
 125     '&' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
 126     '=' => [ 'A+PTR', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
 127     '+' => [ 'A', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
 128     '@' => [ 'MX(+A?)', 'fqdn:ip:x:dist:ttl:timestamp:lo', 'fqdn' ],
 129     '#' => [ ':comment', '', '' ],
 130     '-' => [ ':disabled +', '', '' ],
 131     "'" => [ 'TXT', 'fqdn:s:ttl:timestamp:lo', 'fqdn:s' ],
 132     '^' => [ 'PTR', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
 133     'C' => [ 'CNAME', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
 134     'Z' => [ 'SOA', 'fqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo',
 135             'fqdn:mname:rname' ],
 136     ':' => [ 'GENERIC', 'fqdn:n:rdata:ttl:timestamp:lo', 'fqdn:n:rdata' ]
 137 );
 138
 139
 140 sub validate_integer
 141 {
 142     my ($s, $boundary) = @_;
 143     my $result = 0;
 144
 145     if ($s =~ /^(\d+)$/)
 146     {
 147         my $i = $1;
 148
 149         $result = 1008 if $boundary && ($i >= $boundary);
 150     }
 151     else
 152     {
 153         $result = 1004;
 154     }
 155
 156     return $result;
 157 }
 158
 159
 160 # NOTE : No translation here!
 161 my %token_validator = (
 162     'lo' => [ 2, sub {
 163         my ($type, $s) = @_;
 164         my $result = 0;
 165         return 1001 unless $s =~ /^[a-z][a-z]$/i;
 166         if ($type eq '%')
 167         {
 168             $loreg{$s}++;
 169         }
 170         else
 171         {
 172             return 1002 unless exists($loreg{$s});
 173         }
 174         return $result;
 175     }],
 176     'ipprefix' => [ 3, sub {
 177         my ($type, $s) = @_;
 178         my $result = 0;
 179         if ($s =~ /^(\d+)(\.(\d+)(\.(\d+)(\.(\d+))?)?)?$/)
 180         {
 181             my ($a, $b, $c, $d) = ($1, $3, $5, $7);
 182             $a ||= 0;
 183             $b ||= 0;
 184             $c ||= 0;
 185             $d ||= 0;
 186             if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
 187             {
 188                 $result = 1003;
 189             }
 190         }
 191         else
 192         {
 193             $result = 1003;
 194         }
 195         return $result;
 196     }],
 197     'fqdn' => [ 3, sub {
 198         my ($type, $s) = @_;
 199         my $result = 0;
 200         # remove OK wildcard prefixing, to simplify test.
 201         $s =~ s/^\*\.([a-z0-9].*)$/$1/i;
 202         # check all parts
 203         for my $hostpart (split /\./, $s)
 204         {
 205             return 1005 unless $hostpart =~ /^[-a-z0-9]+$/i;
 206             return 1006 if $hostpart =~ /^-/;
 207             return 1007 if $hostpart =~ /-$/;
 208         }
 209         return $result;
 210     }],
 211     'ip' => [ 4, sub {
 212         my ($type, $s) = @_;
 213         my $result = 0;
 214         if ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\.?$/)
 215         {
 216             my ($a, $b, $c, $d) = ($1, $3, $5, $7);
 217             $a ||= 0;
 218             $b ||= 0;
 219             $c ||= 0;
 220             $d ||= 0;
 221             if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
 222             {
 223                 $result = 1003
 224             }
 225         }
 226         else
 227         {
 228             $result = 1003;
 229         }
 230         return $result;
 231     }],
 232     'x' => [ 5, sub {
 233         my ($type, $s) = @_;
 234         my $result = 0;
 235         # check all parts
 236         for (split /\./, $s)
 237         {
 238             return 1005 unless /^[-[a-z0-9]+$/i;
 239             return 1006 if /^-/;
 240             return 1007 if /-$/;
 241         }
 242         return $result;
 243     }],
 244     'ttl' => [ 6, sub {
 245         my ($type, $s) = @_;
 246     my $result = validate_integer($s, 2**32);
 247         return $result;
 248     }],
 249     'timestamp' => [ 7, sub {
 250         my ($type, $s) = @_;
 251         my $result = validate_integer($s, 2**32);
 252         return $result;
 253     }],
 254     'dist' => [ 9, sub {
 255         my ($type, $s) = @_;
 256         my $result = validate_integer($s, 65536);
 257         return $result;
 258     }],
 259     's' => [ 10, sub {
 260         my ($type, $s) = @_;
 261         my $result = 0;
 262         # TODO : Validation needed?
 263         return $result;
 264     }],
 265     'p' => [ 11, sub {
 266         my ($type, $s) = @_;
 267         my $result = 0;
 268         # check all parts
 269         for (split /\./, $s)
 270         {
 271             return 1005 unless /^[-[a-z0-9]+$/i;
 272             return 1006 if /^-/;
 273             return 1007 if /-$/;
 274         }
 275         return $result;
 276     }],
 277     'mname' => [ 12, sub {
 278         my ($type, $s) = @_;
 279         my $result = 0;
 280         # check all parts
 281         for (split /\./, $s)
 282         {
 283             return 1005 unless /^[-[a-z0-9]+$/i;
 284             return 1006 if /^-/;
 285             return 1007 if /-$/;
 286         }
 287         return $result;
 288     }],
 289     'rname' => [ 13, sub {
 290         my ($type, $s) = @_;
 291         my $result = 0;
 292
 293         # check all parts
 294         my @parts = split /\./, $s;
 295         return 1009 if @parts < 3;
 296
 297         for (split /\./, $s)
 298         {
 299             return 1005 unless /^[-[a-z0-9]+$/i;
 300             return 1006 if /^-/;
 301             return 1007 if /-$/;
 302         }
 303         return $result;
 304     }],
 305     'ser' => [ 14, sub {
 306         my ($type, $s) = @_;
 307         my $result = validate_integer($s, 2**32);
 308         return $result;
 309     }],
 310     'ref' => [ 15, sub {
 311         my ($type, $s) = @_;
 312         my $result = validate_integer($s, 2**32);
 313         return $result;
 314     }],
 315     'ret' => [ 16, sub {
 316         my ($type, $s) = @_;
 317         my $result = validate_integer($s, 2**32);
 318         return $result;
 319     }],
 320     'exp' => [ 17, sub {
 321         my ($type, $s) = @_;
 322         my $result = validate_integer($s, 2**32);
 323         return $result;
 324     }],
 325     'min' => [ 18, sub {
 326         my ($type, $s) = @_;
 327         my $result = validate_integer($s, 2**32);
 328         return $result;
 329     }],
 330     'n' => [ 19, sub {
 331         my ($type, $s) = @_;
 332         my $result = validate_integer($s, 65535);
 333
 334         return 1010 if ($s==2)||($s==5)||($s==6)||($s==12)||($s==15)||($s=252);
 335
 336         return $result;
 337     }],
 338     'rdata' => [ 20, sub {
 339         my ($type, $s) = @_;
 340         # TODO : Validation needed?
 341         my $result = 0;
 342         return $result;
 343     }],
 344
 345
 346
 347 );
 348
 349
 350 sub validate_line ($)
 351 {
 352     my ($s) = @_;
 353
 354     my $result = [ 0, '', '', [] ];
 355
 356     $s =~ s/\s+$//;
 357
 358     if (length($s))
 359     {
 360         my $type = substr($s, 0, 1); $$result[2] = $type;
 361         my $rest = substr($s, 1);
 362         if (exists($line_type{$type}))
 363         {
 364             my $lt = $line_type{$type};
 365             my @mask = split /\:/, $line_type{$type}->[1];
 366             my @mandatory = split /\:/, $line_type{$type}->[2];
 367
 368             if (@mask > 0)
 369             {
 370                 my $c = 0;
 371                 my @tokens = split /\:/, $rest;
 372                 my $ip = '';
 373
 374                 my $vals = @tokens;
 375                 $vals = $#mandatory if $#mandatory > $vals;
 376
 377                 for my $t (0..$vals)
 378                 {
 379                     my $token = $tokens[$t];
 380                     # sanity check; should not fail
 381                     if ($c > $#mask)
 382                     {
 383                         # silently ignore excessive fields
 384                         # as tinydns-data does now
 385                     }
 386                     elsif (exists($token_validator{$mask[$c]}))
 387                     {
 388                         my $validator = $token_validator{$mask[$c]};
 389
 390                         if (length($token))
 391                         {
 392                             # Remember fqdn for later
 393                             if (($c eq 0) && ($mask[0] eq 'fqdn'))
 394                             {
 395                                 my $tmp = $token;
 396                                 $tmp =~ s/\.$//;
 397                                 push @{$$result[3]}, $tmp;
 398                             }
 399
 400                             # Remember x as fqdn IF ip is specified
 401                             if (($mask[$c] eq 'ip') && (length($token)))
 402                             {
 403                                 $ip = $token;
 404                             }
 405
 406                             #
 407                             if (length($ip) && ($mask[$c] eq 'x'))
 408                             {
 409                                 my $tmp = $token;
 410                                 $tmp =~ s/\.$//;
 411                                 push @{$$result[3]}, $tmp;
 412                             }
 413
 414                             # perform validation
 415
 416                             my $tv = &{$$validator[1]}($type, $token);
 417                             if ($tv)
 418                             {
 419                                 $$result[0] ^= (2 ** $$validator[0]);
 420                                 $$result[1] .=
 421                                   "\npos $c; $mask[$c]; $validation_msg{$tv}";
 422                             }
 423                         }
 424                         elsif ($mandatory[$c] eq $mask[$c])
 425                         {
 426                             my $mand = 1;
 427                             $mand = 0 if ($opt{r}) && ($mask[$c] eq 'fqdn');
 428                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'mname');
 429                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'p');
 430                             $mand = 0 if ($opt{R}) && ($mask[$c] eq 'rdata');
 431                             $mand = 0 if ($opt{i}) && ($mask[$c] eq 'ip');
 432
 433                             if ($mand)
 434                             {
 435                                 $$result[0] ^= (2 ** $$validator[0]);
 436                                 $$result[1] .= "\npos $c; $mask[$c]; ".
 437                                 $token_name{$mask[$c]}.' is mandatory';
 438                             }
 439                         }
 440                         # else ignore nonmandatory blanks
 441
 442                     }
 443                     else
 444                     {
 445                         # somebody has modified program in a wrong way
 446                         $result = [ 1,
 447                           "VALIDATOR FAILS ON TOKENS OF TYPE ".$mask[$c]." $c" ];
 448                     }
 449                     $c++;
 450                 }
 451             }
 452
 453             if ($$result[0])
 454             {
 455                 $$result[1] = "expected: ".$line_type{$type}->[1]."\n".
 456                     $$result[1];
 457             }
 458
 459         }
 460         else
 461         {
 462             $result = [ 1, sprintf("unknown record type: #%02x",
 463                 ord($type)) ];
 464         }
 465     }
 466
 467     $$result[1] =~ s/^\n+//;
 468     $$result[1] =~ s/\n+/\n/g;
 469
 470     # result is now [ iErrno, sErrtxt, sRecordType, [ sFQDN ] ]
 471     return $result;
 472 }
 473
 474 sub p ($$)
 475 {
 476     my ($fhv, $line) = @_;
 477     for my $fh (@{$fhv})
 478     {
 479         print $fh $line."\n";
 480     }
 481 }
 482
 483 sub funiq (@)
 484 {
 485     my @files = @_;
 486     my %ufiles;
 487     for my $curpat (@files)
 488     {
 489         for my $elem (glob $curpat)
 490         {
 491             $ufiles{$elem}++;
 492         }
 493     }
 494     return [ sort keys %ufiles ];
 495 }
 496
 497 sub read_file ($$)
 498 {
 499     my ($vfile, $cache) = @_;
 500     my %vresult;
 501     my $result = [ ];
 502
 503     if (exists $cache->{file}->{$vfile})
 504     {
 505         $result = $cache->{file}->{$vfile};
 506     }
 507     else
 508     {
 509         if (open(FILER, $vfile))
 510         {
 511             while (<FILER>)
 512             {
 513                 chomp;
 514                 s/^\s+//;
 515                 s/\s+$//;
 516                 next if /^#/;
 517                 next if /^$/;
 518                 $vresult{$_}++;
 519             }
 520             close FILER;
 521             $cache->{file}->{$vfile} = [ sort keys %vresult ];
 522             $result = $cache->{file}->{$vfile};
 523         }
 524     }
 525
 526     return $result;
 527 }
 528
 529
 530 sub read_filter ($$)
 531 {
 532     my ($file, $cache) = @_;
 533     my $f = {};
 534
 535     if (open(FILEF, $file))
 536     {
 537         while (<FILEF>)
 538         {
 539             chomp;
 540             s/^\s+//;
 541             s/\s+$//;
 542
 543             if (/^(\w+)\s+(.+)$/)
 544             {
 545                 my ($key, $value) = ($1, $2);
 546                 my (@values, @tempvalues);
 547                 if ($value =~ m#^file:(.+)#)
 548                 {
 549                     my $vfile = $1;
 550                     @tempvalues = @{read_file($vfile, $cache)};
 551                 }
 552                 else
 553                 {
 554                     @tempvalues = ( $value );
 555                 }
 556
 557                 if ($key =~ /^zonefiles?$/)
 558                 {
 559                     # This is a globbing action
 560                     for (@tempvalues)
 561                     {
 562                         push @values, @{funiq($_)};
 563                     }
 564                 }
 565                else
 566                {
 567                     @values = @tempvalues;
 568                }
 569
 570                for (@values)
 571                {
 572                     $f->{lc $key}->{$_}++;
 573                }
 574            }
 575         }
 576         close FILEF;
 577     }
 578     else
 579     {
 580         print STDERR "Warning: Couldn't open filterfile: $file; $!\n";
 581     }
 582
 583     return $f;
 584 }
 585
 586 sub regexped_patterns ($)
 587 {
 588     my ($h) = @_;
 589     my $result = [ ];
 590
 591     for my $pat (keys %{$h})
 592     {
 593         unless ($pat =~ /^\^.+\$$/)
 594         {
 595         $pat =~ s/\.+$//;
 596
 597             # fix a regexp for the lazy notation
 598             $pat =~ s/^[\*\.]+//;
 599             $pat =~ s/\./\\./g;
 600             $pat = '^(.*\\.)?'.$pat.'\.?$';
 601         }
 602         push @{$result}, $pat;
 603     }
 604     return $result;
 605 }
 606
 607
 608 sub check_pattern ($$)
 609 {
 610     my ($pattern, $fqdn) = @_;
 611     my $result = 0;
 612
 613     if ($fqdn =~ /$pattern/)
 614     {
 615         $result = 1;
 616     }
 617     else
 618     {
 619         $result = 0;
 620     }
 621
 622     return $result;
 623 }
 624
 625
 626 sub make_char_regexp ($)
 627 {
 628     my ($chars) = @_;
 629     my @rc;
 630     my $regexp;
 631
 632     for (split /\s+/, $chars)
 633     {
 634         if (/^\d+$/)
 635         {
 636             $regexp .= sprintf("\\%03o", $_);
 637         }
 638         else
 639         {
 640             for (split //, $_)
 641             {
 642                 $regexp .= "\\$_";
 643             }
 644         }
 645     }
 646
 647     if (length($regexp))
 648     {
 649         $regexp = "[$regexp]";
 650     }
 651     else
 652     {
 653         $regexp = '.';
 654     }
 655
 656     return $regexp;
 657 }
 658
 659
 660 sub do_filterfile ($$)
 661 {
 662     my ($filterfile, $cache) = @_;
 663     my $result = '';
 664     my $output = [ \*STDERR ];
 665     my @extralogs;
 666
 667     my $f = read_filter($filterfile, $cache);
 668
 669     $$f{allowtype} = (keys %{$$f{allowtype}})[0];
 670     $$f{allowtype} .= $opt{T};
 671
 672     my $allowtyperegex = make_char_regexp($$f{allowtype});
 673
 674     if ($$f{extralog})
 675     {
 676         for my $logfile (sort keys %{$$f{extralog}})
 677         {
 678             my ($fname, $fhandle);
 679             # open logfiles and put them int @{$output};
 680             ($fhandle, $fname) = tempfile();
 681             if ($fhandle)
 682             {
 683                 push @{$output}, $fhandle;
 684                 push @extralogs, [ $fhandle, $fname, $logfile ];
 685             }
 686             else
 687             {
 688                 print STDERR "Warning: Couldn't create tempfile for ${logfile}.\n";
 689             }
 690         }
 691     }
 692
 693     my @zonefiles = sort keys %{$$f{zonefile}};
 694     if (@zonefiles == 0)
 695     {
 696         push @zonefiles, '-';
 697     }
 698     for my $zonefile (@zonefiles)
 699     {
 700         unless ($opt{s})
 701         {
 702             next if $zonefile =~ /$FILESUFFIXREGEXP/i;
 703         }
 704
 705         my $info = 0;
 706     my $filehandle = \*STDIN;
 707     my $fopen = 1;
 708     if ($zonefile ne '-')
 709     {
 710         $fopen = open( $filehandle, $zonefile );
 711     }
 712         if ($fopen)
 713         {
 714             my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
 715             p $output, "File $temp";
 716
 717             %loreg = ();
 718             my $errs = 0;
 719             my $lno = 0;
 720             while (<$filehandle>)
 721             {
 722                 $lno++;
 723                 my $line = $_;
 724                 chomp($line);
 725                 my $v = validate_line($line);
 726                 for ($v)
 727                 {
 728                     my $ok = 1;
 729                     my $fqdnok = 1;
 730                     my $reason = '';
 731
 732                     if ($$v[0])
 733                     {
 734                         $errs++;
 735                         $verrs_total++;
 736                         $$v[1] =~ s/\n/\n    /g;
 737                         p $output, "  line $lno; err $$v[0] $line\n    ".$$v[1];
 738                     }
 739                     else
 740                     {
 741                         if (length($$v[2]))
 742                         {
 743                             if ($$v[2] !~ /$allowtyperegex/)
 744                             {
 745                                 $ok=0;
 746                                 if (($$v[2] ne '#') || ($opt{t} == 1))
 747                                 {
 748                                      $errs++;
 749                                      $perrs_total++;
 750                                      p $output, "  line $lno; err -1 $line";
 751                                      p $output, "    record type $$v[2] disallowed; allowed: $$f{allowtype}";
 752                                 }
 753                             }
 754                             else
 755                             {
 756                                 # just check fqdn if record contains it
 757                                 if (@{$$v[3]})
 758                                 {
 759                                     # Check $$v[3] against allowed fqdn:s:wq!
 760                                     if (keys %{$$f{deny}})
 761                                     {
 762                                         #
 763                                         my $patterns = regexped_patterns($$f{deny});
 764                                         # Default ALLOW ALL
 765                                         $ok = $fqdnok = 1;
 766                                         $reason = 'default allow ^.*$';
 767
 768                                         for my $pat (@{$patterns})
 769                                         {
 770                                             for (@{$$v[3]})
 771                                             {
 772                                                 if (check_pattern($pat, $_))
 773                                                 {
 774                                                     $ok = $fqdnok = 0;
 775                                                     $reason = 'deny '.$pat;
 776                                                 }
 777                                             }
 778                                         }
 779                                     }
 780                                     elsif (keys %{$$f{allow}})
 781                                     {
 782                                         my $patterns = regexped_patterns($$f{allow});
 783                                         # Default DENY ALL
 784                                         $ok = $fqdnok = 0;
 785                                         $reason = 'default deny ^.*$';
 786
 787                                         for my $pat (@{$patterns})
 788                                         {
 789                                             for (@{$$v[3]})
 790                                             {
 791                                                 if (check_pattern($pat, $_))
 792                                                 {
 793                                                     $ok = $fqdnok = 1;
 794                                                     $reason = $pat;
 795                                                 }
 796                                             }
 797                                         }
 798                                     } # if deny/allow
 799                                 } # if fqdn
 800                             } # if recordtype ok
 801                         } #
 802
 803                         if ($ok && length($line))
 804                         {
 805                             print STDOUT "$line\n" unless $opt{q};
 806                         }
 807                         else
 808                         {
 809                             if ($fqdnok == 0)
 810                             {
 811                                 $errs++;
 812                                 $perrs_total++;
 813                                 p $output, "  line $lno; err -2; $line";
 814                                 p $output, "    use of fqdn denied; $reason";
 815                                 if ($opt{I})
 816                                 {
 817                                     print STDOUT "# line $lno; err -2; $line\n";
 818                                     print STDOUT "#   use of fqdn denied; $reason\n";
 819                                 }
 820                             }
 821                         }
 822                     }
 823                 } # for ($v)
 824             } # while (<$filehandle>)
 825             close $filehandle unless $zonefile eq '-';
 826             my $plur = ($errs == 1) ? '' : 's';
 827             p $output, "$lno lines, $errs error${plur}.";
 828         }
 829         else
 830         {
 831             p $output, "Warning: Trouble opening '$zonefile'; $!";
 832         }
 833     }
 834
 835
 836       # Close all extra logfiles
 837     for my $el (@extralogs)
 838     {
 839         if (close($$el[0]))
 840         {
 841             if (move($$el[1], $$el[2]))
 842             {
 843                 print STDERR "Copy of logfile portion to $$el[2]\n";
 844             }
 845             else
 846             {
 847                 print STDERR "Warning: Couldn't rename tempfile to $$el[2].\n";
 848                 unlink $$el[1];
 849             }
 850         }
 851         else
 852         {
 853             print STDERR "Warning: Couldn't close tempfile for $$el[2].\n";
 854             unlink $$el[1];
 855         }
 856     }
 857
 858     return $result;
 859 }
 860
 861 #
 862 ## Start
 863 #
 864
 865 my $files = funiq(@ARGV);
 866
 867
 868 if ($opt{h} || $opt{H} || $opt{'?'})
 869 {
 870     print <<"--EOT";
 871 valtz $VERSION, $COPYRIGHT
 872 validates tinydns-data zone files
 873 Usage:
 874   $0 [-hfFqrRiItTx] <file(s)>
 875
 876   -h shows this help.
 877
 878
 879   -f filter (don't just validate) file and output accepted lines to STDOUT.
 880
 881
 882   -F treat files as filter configuration files for more advanced filtering.
 883      These filterfiles one or several of the following filter directives:
 884
 885      zonefile <zonefilepath>
 886      zonefile file:<path to textfile including zonefilepaths>
 887         Defines the file(s) to be filtered. Can be a globbed value, like
 888         /var/zones/external/*
 889
 890      extralog <logfile>
 891         Defines an extra logfile that the STDERR output will be copied for
 892         this specific filterfile. Useful if you have a lot of filterfiles
 893         and want to separate the logs.
 894
 895      deny <zonepattern>
 896      deny file:<path to <zonepatternfile>
 897         Defines a zonepattern to explicitly DENY after implicitly allowing all.
 898         (cannot be combined with allow)
 899
 900      allow <zonepattern>
 901      allow file:<path to <zonepatternfile>
 902         Defines a zonepattern to explicitly ALLOW after implicitly denying all.
 903
 904      allowtype <recordtype character(s)>
 905         Explicitly sets the allowed recordtypes. Note that even comments
 906         has to be allowed (but these will not result in errors unless -t)
 907         to be copied to the output.
 908
 909      Multiple zonefile, allow- and deny-lines are allowed, but also the
 910      alternative file:-line that points to a textfile containing one
 911      value per line.
 912
 913
 914   -r allows fqdn to be empty thus denoting the root.
 915      This is also allowed per default when doing implict allow - see deny,
 916      or when specifying 'allow .', i.e. explictly allowing root as such.
 917      (cannot be combined with deny)
 918
 919
 920   -R relaxes the validation and allows empty mname and p-fields.xi
 921      This is probably not very useful.
 922
 923
 924   -i allows the ip-fields to be empty as well. These will then not generate any
 925      records.
 926
 927
 928   -I Include rejected lines as comments in output (valid when filtering).
 929
 930
 931   -q Do not echo valid lines to STDOUT.
 932
 933   -s DO NOT ignore files ending with ,v ~ .bak .log .old .swp .tmp
 934      which is done per default.
 935
 936
 937   -t Give error even on #comment-lines when they are not allowed.
 938      (These errors are silently ignored per default)
 939
 940
 941   -T<types>
 942      A commandline way to explicitly set the allowed recordtypes.
 943      This is _concatenated_ to the allowtype-allowed recordtypes.
 944
 945   -x Exit with non-null exit code on errors; i.e. make errors detectable by
 946      e.g. shell scripts; 1 = validation error, 2 = permission error,
 947      3 = combination of 1 and 2.
 948
 949
 950
 951 All errors in the zonefiles are sent to STDERR.
 952
 953      Example; simple use:
 954        valtz zone-bodin-org
 955
 956      Example; simple filter-use;
 957        valtz -f /etc/zones/zone-* \
 958                 >/etc/tinydns/data.filtered \
 959                 2>/var/log/tinydns/valtz.log
 960
 961      Example; filterfile use;
 962        valtz -F /etc/zones/filter/zones-otto \
 963                 >/etc/tinydns/data.otto \
 964                 2>/var/log/tinydns/valtz.log
 965
 966
 967      Example filterfile for using as import from primary (as above):
 968        zonefile   /var/zones/external/otto/zone-*
 969        deny       bodin.org
 970        deny       x42.com
 971        extralog   /var/log/tinydns/external-otto.log
 972
 973      Example #2, strict filter for a certain user editing just A-records
 974
 975        zonefile  /home/felix/zones/zone-fl3x-net
 976        allow     fl3x.net
 977        allowtype +
 978        extralog  /var/log/tinydns/fl3x-net.log
 979
 980      Example #3, export filter to secondary
 981
 982        zonefile  /var/zones/primary/zone-*
 983        # just allow OUR zones to be exported, not to annoy secondary partner
 984        allow     file:/var/zones/primary-zones.txt
 985        # don't allow any other types than this; e.g. comments won't be exported
 986        allowtype Z + @ . C
 987        extralog  /var/log/tinydns/primary-export.log
 988
 989 --EOT
 990   exit 0;
 991 }
 992 elsif (@{$files} == 0)
 993 {
 994     print <<"--EOT";
 995 valtz $VERSION, $COPYRIGHT
 996 validates tinydns-data zone files
 997 Usage:
 998   Simple validation:
 999     $0 [-qrRix] <zonefiles>
1000   Simple filtering:
1001     $0 -f[qrRiItTx] <zonefiles>
1002   Extensive filtering:
1003     $0 -F[qrRiItTx] <zonefiles>
1004
1005   More help and information about options:
1006     $0 -h
1007
1008 --EOT
1009   exit 0;
1010 }
1011
1012
1013 if ($opt{F})
1014 {
1015     my $cache = {};
1016     $cache->{file} = {};
1017     for my $file (@{$files})
1018     {
1019         my $result = do_filterfile($file, $cache);
1020     }
1021
1022 }
1023 else
1024 {
1025
1026     my $output = [ \*STDERR ];
1027
1028     for my $zonefile (sort @{$files})
1029     {
1030         unless ($opt{s})
1031         {
1032             next if $zonefile =~ /$FILESUFFIXREGEXP/i;
1033         }
1034
1035     my $filehandle = \*STDIN;
1036     my $fopen = 1;
1037     if ($zonefile ne '-')
1038     {
1039         $fopen = open( $filehandle, $zonefile );
1040     }
1041         if ($fopen)
1042         {
1043             %loreg = ();
1044             my $errs = 0;
1045             my $lno = 0;
1046             while (<$filehandle>)
1047             {
1048                 $lno++;
1049                 my $line = $_;
1050                 chomp($line);
1051                 my $v = validate_line($line);
1052                 for ($v)
1053                 {
1054                     if ($$v[0])
1055                     {
1056             my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
1057                         p $output, "File $temp" unless $errs;
1058                         $errs++;
1059                         $verrs_total++;
1060                         $$v[1] =~ s/\n/\n    /g;
1061                         p $output, "  line $lno; err $$v[0] $line\n    ".$$v[1];
1062                         if ($opt{I})
1063                         {
1064                              print STDOUT "# line $lno; err $$v[0] $line
1065                              print STDOUT "# $$v[1]; \n";
1066                         }
1067                     }
1068                     else
1069                     {
1070                         # Echo NON-ERRORS to STDOUT
1071                         if ($opt{f})
1072                         {
1073                             print STDOUT "$line\n" unless $opt{q};
1074                         }
1075                     }
1076                 }
1077             }
1078             close $filehandle unless $zonefile eq '-';
1079         }
1080         else
1081         {
1082             p $output, "Error: Trouble opening '$zonefile'; $!";
1083         }
1084     }
1085 }
1086
1087 if ($opt{x} && ($verrs_total + $perrs_total))
1088 {
1089     my $exitcode = $verrs_total > 0 ? 1 : 0;
1090     $exitcode += $perrs_total > 0 ? 2 : 0;
1091     exit $exitcode;
1092 }