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