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