#!/usr/bin/perl
#
# $Id: fpdns.pl,v 1.79 2004/02/10 14:12:59 jakob Exp $
#
# Copyright (c) 2003,2004 Roy Arends & Jakob Schlyter.  All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. The name of the authors may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

require 5.6.0;

use warnings;
use strict;
use Getopt::Std;
use Net::DNS;
use vars qw/ %opt /;
use POSIX ":sys_wait_h";

my $progname = "fpdns";
my $version = "0.9.0";

my $debug = 0;
my $versionlength = 40;

my @qy = ("0,IQUERY,0,0,1,0,0,0,NOERROR,0,0,0,0",
          "0,NS_NOTIFY_OP,0,0,0,0,0,0,NOERROR,0,0,0,0",
          "0,QUERY,0,0,0,0,0,0,NOERROR,0,0,0,0",
          "0,IQUERY,0,0,0,0,1,1,NOERROR,0,0,0,0",
          "0,QUERY,0,0,0,0,0,0,NOTIMP,0,0,0,0",
          "0,IQUERY,1,0,1,1,1,1,NOERROR,0,0,0,0",
          "0,UPDATE,0,0,0,1,0,0,NOERROR,0,0,0,0",
          "0,QUERY,1,1,1,1,1,1,NOERROR,0,0,0,0", 
         );

my %initrule = (header => $qy[0], query  => ". IN A", );
my @iq = ("1,IQUERY,0,0,1,0,0,0,FORMERR,0,0,0,0",
          "1,IQUERY,0,0,1,0,0,0,FORMERR,1,0,0,0",
          "1,IQUERY,0,0,1,0,0,0,NOTIMP,0,0,0,0", 
          "1,IQUERY,0,0,1,0,0,0,NOTIMP,1,0,0,0",
          "1,IQUERY,0,0,1,1,0,0,FORMERR,0,0,0,0",
          "1,IQUERY,0,0,1,1,0,0,NOTIMP,0,0,0,0", 
          "1,IQUERY,0,0,1,1,0,0,NOTIMP,1,0,0,0", 
          "1,IQUERY,1,0,1,0,0,0,NOTIMP,1,0,0,0",
          "1,QUERY,1,0,1,0,0,0,NOTIMP,1,0,0,0",
          "1,QUERY,0,0,0,0,0,0,NOTIMP,0,0,0,0",
          "1,IQUERY,0,0,1,1,0,0,FORMERR,1,0,0,0",
	  "1,NS_NOTIFY_OP,0,0,0,0,0,0,FORMERR,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,0,0,0,NOTIMP,0,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,0,0,0,NOTIMP,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,0,0,0,NXDOMAIN,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,0,0,0,REFUSED,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,0,0,0,SERVFAIL,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,1,0,0,FORMERR,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,1,0,0,NOTIMP,0,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,1,0,0,NOTIMP,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,1,0,0,REFUSED,1,0,0,0",
          "1,NS_NOTIFY_OP,0,0,0,1,0,0,SERVFAIL,1,0,0,0",
          "1,NS_NOTIFY_OP,1,0,0,0,0,0,NOTIMP,1,0,0,0",
          "1,QUERY,1,0,0,0,0,0,NOTIMP,1,0,0,0",
          "1,NS_NOTIFY_OP,1,0,0,0,0,0,SERVFAIL,1,0,0,0",
	  "1,IQUERY,0,0,0,0,1,1,NOTIMP,0,0,0,0",
          "1,IQUERY,0,0,0,0,0,0,NOTIMP,0,0,0,0",
          "1,IQUERY,0,0,1,1,1,1,FORMERR,0,0,0,0",
          "1,IQUERY,1,0,1,1,1,1,FORMERR,0,0,0,0",
	  "1,QUERY,.,0,1,.,.,.,NOTIMP,.+,.+,.+,.+",
          "1,QUERY,.,0,1,.,.,.,.+,.+,.+,.+,.+",
          "1,QUERY,0,0,.,.,0,0,NXDOMAIN,1,0,0,0",    
	  "1,QUERY,0,0,.,.,0,0,FORMERR,1,0,0,0",
          "1,UPDATE,0,0,0,0,0,0,NOTIMP,0,0,0,0",
          "1,UPDATE,0,0,0,1,0,0,NOTIMP,0,0,0,0",
          "1,QUERY,0,0,1,0,0,0,NOERROR,1,0,0,0",
          "1,QUERY,1,1,1,1,1,1,NOTIMP,1,0,0,0",
          "1,QUERY,0,0,0,0,0,0,NOERROR,1,0,.+,0",
          "1,QUERY,0,0,1,0,0,0,FORMERR,1,0,0,0",
          "1,IQUERY,0,0,1,0,1,1,NOTIMP,1,0,0,0",
          "1,IQUERY,0,0,0,1,1,1,REFUSED,1,0,0,0",
          "1,UPDATE,0,0,0,1,0,0,REFUSED,1,0,0,0",
          "1,IQUERY,0,0,0,1,1,1,FORMERR,0,0,0,0",
          "1,IQUERY,0,0,0,1,0,0,NOTIMP,0,0,0,0",
          "1,QUERY,1,0,1,0,0,0,FORMERR,1,0,0,0",
          "1,UPDATE,0,0,0,0,0,0,FORMERR,1,0,0,0",
          "1,UPDATE,0,0,0,0,0,0,FORMERR,0,0,0,0",
          "1,QUERY,0,0,1,0,0,0,FORMERR,0,0,0,0",
          "1,QUERY,0,0,1,0,0,0,SERVFAIL,1,0,0,0",
          "1,QUERY,1,0,1,0,0,0,NXDOMAIN,1,0,1,0",
          "1,QUERY,0,0,1,0,0,0,REFUSED,1,0,0,0",
          "1,QUERY,0,0,1,0,0,0,NOERROR,1,1,0,0",
          "1,IQUERY,0,0,1,0,0,0,REFUSED,0,0,0,0",
          "1,QUERY,0,0,0,0,0,0,FORMERR,0,0,0,0",
          "1,QUERY,0,0,1,1,1,0,NOERROR,1,0,1,0",
          "1,QUERY,0,0,1,1,0,0,NOERROR,1,0,1,0",
          "1,QUERY,0,0,1,0,1,0,NOERROR,.+,.+,.+,.+", 
          "1,QUERY,0,0,1,0,0,0,.+,.+,.+,.+,.+",
          "1,QUERY,1,0,1,0,0,0,NOERROR,1,1,0,0",
          "1,QUERY,0,0,1,1,0,0,SERVFAIL,1,0,0,0", 
          "1,QUERY,1,0,1,1,0,0,NOERROR,1,1,0,0",
          "1,QUERY,0,0,1,1,0,0,REFUSED,1,0,0,0",
          "1,QUERY,0,0,0,0,0,0,NOTIMP,1,0,0,0",
          "1,QUERY,1,0,1,1,0,0,NOERROR,1,0,1,0",
	  "1,IQUERY,0,0,1,1,1,1,NOTIMP,0,0,0,0",
          "1,UPDATE,0,0,0,0,0,0,REFUSED,0,0,0,0",
          "1,IQUERY,0,0,0,1,1,1,NOTIMP,1,0,0,0",
          "1,IQUERY,0,0,0,1,0,0,NOTIMP,1,0,0,0",
          "1,QUERY,0,1,1,1,1,1,NOERROR,1,0,.,0",
          "1,QUERY,0,1,1,1,0,1,NOERROR,1,0,.,0",
);

my @ruleset = (
    { fingerprint => "query timed out" , header => $qy[0],  query => "com. IN A", ruleset => [
          { fingerprint => "query timed out", header => $qy[7], query => ". CH A", ruleset => [
                 { fingerprint => "query timed out", header => $qy[6], query => ". IN A", ruleset => [
                        { fingerprint => $iq[38], result => "Oak DNS",  qv => "version.oak",},  
                        { fingerprint => ".+", state => "q0tq0tq7tq6r?", }, ]
                 },
                 { fingerprint => $iq[36], result => "QuickDNS", }, 
                 { fingerprint => $iq[37], result => "NonSequitur DNS", },
                 { fingerprint => ".+", state => "q0tq0tq7r?", }, ]  
          },
	  { fingerprint => $iq[35], result => "eNom DNS", },
          { fingerprint => ".+", state => "q0tq0r?", },]
    },
 
    { fingerprint => $iq[0], header => $qy[1], query=> "jjjjjjjjjjjj IN A", ruleset => [
	  { fingerprint => $iq[12], result => "BIND 8.4.1-p1",  qv => "version.bind",},                         
	  { fingerprint => $iq[13], result => "BIND 8 plus root-server modification",  qv => "version.bind",}, 
	  { fingerprint => $iq[16], header => $qy[2], query => "hostname.bind CH TXT", ruleset => [
                  { fingerprint => $iq[58], result => "BIND 8.3.0-RC1 -- 8.4.4",  qv => "version.bind",},     
                  { fingerprint => $iq[50], result => "BIND 8.3.0-RC1 -- 8.4.4",  qv => "version.bind",},    
                  { fingerprint => $iq[48], result => "BIND 8.2.2-P3 -- 8.3.0-T2A",  qv => "version.bind",},
                  { fingerprint => ".+", state => "q0r0q1r16q2r?", },]
          },
          { fingerprint => ".+", state => "q0r0q1r?", },]
    },

    { fingerprint => $iq[1], header => $qy[2], query => ". IN IXFR", ruleset => [
          { fingerprint => $iq[31], result => "Microsoft Windows 2000", },				
          { fingerprint => $iq[32], result => "Microsoft Windows NT4", },                              
          { fingerprint => ".+", state => "q0r1q2r?", }, ]
    },

    { fingerprint => $iq[2], header => $qy[1], ruleset => [
	  { fingerprint => $iq[11], result => "BIND 9.2.3rc1 -- 9.4.0a0",  qv => "version.bind",},    
	  { fingerprint => $iq[12],  header => $qy[3], ruleset => [
		{ fingerprint => $iq[25], header => $qy[6], ruleset => [
                      { fingerprint => $iq[33], result => "MyDNS", },				
                      { fingerprint => $iq[34], header => $qy[2],  query  => "012345678901234567890123456789012345678901234567890123456789012.012345678901234567890123456789012345678901234567890123456789012.012345678901234567890123456789012345678901234567890123456789012.0123456789012345678901234567890123456789012345678901234567890. IN A", ruleset => [
                           { fingerprint => $iq[47], result => "NSD 1.0.3 -- 1.2.1",  qv => "version.server", }, 
                           { fingerprint => $iq[48], header => $qy[2],  query  => "hostname.bind CH TXT", ruleset => [
                                     { fingerprint => $iq[50], result => "NSD 1.2.2", qv => "version.server", },
				     { fingerprint => $iq[51], result => "NSD 1.2.3", qv => "version.server",  }, 
                                     { fingerprint => ".+", state => "q0r2q1r12q3r25q6r34q2r48q2r?", }, ]
                           },
                           { fingerprint => $iq[49], header => $qy[2],  query  => "hostname.bind CH TXT", ruleset => [
                                     { fingerprint => $iq[50], result => "NSD 1.2.2 [root]", qv => "version.server",  },
                                     { fingerprint => $iq[51], result => "NSD 1.2.3 [root]", qv => "version.server", }, 
                                     { fingerprint => ".+", state => "q0r2q1r12q3r25q6r34q2r49q2r?", }, ]
                           },
                           { fingerprint => $iq[53], result => "NSD 1.0.2", qv => "version.server", },
                           { fingerprint => ".+", state => "q0r2q1r12q3r25q6r34q2a?", },]
                      },
                      { fingerprint => ".+", state => "q0r2q1r12q3r25q6r?", },]
                },
		{ fingerprint => $iq[26], result => "ATLAS",}, 
                { fingerprint => ".+", state => "q0r2q1r12q3r?", },] 
          },
	  { fingerprint => $iq[15],  header => $qy[6], ruleset => [
               { fingerprint => $iq[45], result => "Nominum ANS", qv => "version.bind",},
               { fingerprint => $iq[65], result => "BIND 9.2.3rc1 -- 9.4.0a0",  qv => "version.bind",},
               { fingerprint => $iq[46], header => $qy[7], ruleset => [
                      { fingerprint => $iq[56], result => "BIND 9.0.0b5 -- 9.0.1", qv => "version.bind",},
                      { fingerprint => $iq[57], result => "BIND 9.1.0 -- 9.1.3", qv => "version.bind",}, 
                      { fingerprint => ".+", state => "q0r2q1r15q6r46q7r?", }, ]
               },
               { fingerprint => ".+", state => "q0r2q1r15q6r?", },]
          },
	  { fingerprint => $iq[16], header => $qy[4], ruleset => [
                { fingerprint => $iq[29], result => "BIND 9.2.0a1 -- 9.2.0rc3", qv => "version.bind",},
                { fingerprint => $iq[30],  header => $qy[0], query  => ". A CLASS0" , ruleset => [
                        { fingerprint => $iq[2], result => "BIND 9.2.0rc7 -- 9.2.2-P3", qv => "version.bind", },
                        { fingerprint => $iq[0], result => "BIND 9.2.0rc4 -- 9.2.0rc6", qv => "version.bind", },
                        { fingerprint => ".+", state => "BIND 9.2.0rc4 -- 9.2.2-P3", qv => "version.bind", }, ]
                },
                { fingerprint => ".+", state => "q0r2q1r16q4r?", },]
          },
          { fingerprint => ".+", state => "q0r2q1r?", }, ]
    },
    
    { fingerprint => $iq[3], header => $qy[1], ruleset => [
          { fingerprint => "query timed out", result => "Microsoft Windows 2003", },
	  { fingerprint => $iq[14], result => "UltraDNS v2.7.0.2 -- 2.7.3", qv => "version.bind", }, 
          { fingerprint => $iq[13], header => $qy[5], ruleset => [
                { fingerprint => $iq[39], result => "pliant DNS Server", },
                { fingerprint => $iq[7], result => "simple DNS plus", }, 
                { fingerprint => ".+", state => "q0r3q1r13q5r?", }, ]
                },
          { fingerprint => ".+", state => "q0r3q1r?", }, ]
    },
    
    { fingerprint => $iq[4], header => $qy[1], query=> "jjjjjjjjjjjj IN A", ruleset => [
          { fingerprint => $iq[17], result => "BIND 9.0.0b5 -- 9.0.1 [rcursion enabled]",qv => "version.bind", },
	  { fingerprint => $iq[18], header => $qy[5], query=> ". IN A" , ruleset => [
                { fingerprint => $iq[27], result => "BIND 4.9.3 -- 4.9.11", qv => "version.bind", },
                { fingerprint => $iq[28], result => "BIND 4.8 -- 4.8.3", }, 
                { fingerprint => ".+", state => "q0r4q1r18q5r?", }, ]
          },
          { fingerprint => $iq[19], result => "BIND 8.2.1 [recursion enabled]", qv => "version.bind", },           
	  { fingerprint => $iq[20], header => $qy[3], query=> ". IN A", ruleset => [
                { fingerprint => $iq[42], result => "BIND 8.1-REL -- 8.2.1-T4B [recursion enabled]", qv => "version.bind", }, 
                { fingerprint => ".+", state => "q0r4q1r20q3r?", },]
          },
	  { fingerprint => $iq[21], header => $qy[2], query => "hostname.bind CH TXT", ruleset => [
                { fingerprint => $iq[60], result => "BIND 8.3.0-RC1 -- 8.4.4 [recursion enabled]",  qv => "version.bind",},
                { fingerprint => $iq[59], header => $qy[7], query=> ". IN A", ruleset => [
			 { fingerprint => $iq[68], result => "BIND 8.1-REL -- 8.2.1-T4B [recursion enabled]", qv => "version.bind", },
                         { fingerprint => $iq[69], result => "BIND 8.2.2-P3 -- 8.3.0-T2A [recursion enabled]",  qv => "version.bind",},
                	 { fingerprint => ".+", state => "q0r4q1r21q2r59q7r?", },]
                },

	        { fingerprint => $iq[58], result => "BIND 8.3.0-RC1 -- 8.4.4 [recursion local]",  qv => "versiOn.bind",},
                { fingerprint => $iq[50], result => "BIND 8.3.0-RC1 -- 8.4.4 [recursion local]",  qv => "version.bind",},
		{ fingerprint => $iq[61], result => "BIND 8.3.0-RC1 -- 8.4.4 [recursion local]",  qv => "version.bind",},
                { fingerprint => $iq[48], result => "BIND 8.2.2-P3 -- 8.3.0-T2A [recursion local]",  qv => "version.bind",},
                { fingerprint => ".+", state => "q0r4q1r21q2r?", },]
          },
          { fingerprint => ".+", state => "q0r4q1r?", }, ]
    },

    { fingerprint => $iq[5], header => $qy[1], ruleset => [
          { fingerprint => $iq[11], result => "BIND 9.2.3rc1 -- 9.4.0a0 [recursion enabled,split view]", qv => "version.bind",},
	  { fingerprint => $iq[17], result => "BIND 9.2.3rc1 -- 9.4.0a0 [recursion enabled]", qv => "version.bind",},
          { fingerprint => $iq[18], header => $qy[5], ruleset => [
		{ fingerprint => $iq[5], result => "Nominum CNS", }, 
                { fingerprint => $iq[64], result => "unknown, smells like old BIND 4", },
                { fingerprint => ".+", state => "q0r5q1r18q5r?", }, ]
          }, 
	  { fingerprint => $iq[20], header => $qy[7], ruleset => [
                { fingerprint => $iq[54], result => "BIND 9.0.0b5 -- 9.0.1 [recursion enabled]", qv => "version.bind",},
                { fingerprint => $iq[55], result => "BIND 9.1.0 -- 9.1.3 [recursion enabled]", qv => "version.bind",},
                { fingerprint => $iq[63], result => "BIND 4.9.3 -- 4.9.11 [recursion enabled]", qv => "version.bind",},
                { fingerprint => $iq[61], result => "BIND 9.0.0b5 -- 9.1.3 [recursion local]", qv => "version.bind",},
                { fingerprint => ".+", state => "q0r5q1r20q7r?", }, ]
          },   
	  { fingerprint => $iq[21], header => $qy[4], ruleset => [
	        { fingerprint => "query timed out", result => "BIND 9.2.0a1 -- 9.2.2-P3 [recursion enabled]", qv => "version.bind", },
                { fingerprint => $iq[29], result => "BIND 9.2.0a1 -- 9.2.0rc3 [recursion enabled]", qv => "version.bind", },
		{ fingerprint => $iq[61], header => $qy[0], query  => ". A CLASS0" , ruleset => [
                        { fingerprint => $iq[2], result => "BIND 9.2.0rc7 -- 9.2.2-P3 [recursion local]", qv => "version.bind", },
                        { fingerprint => $iq[0], result => "BIND 9.2.0a1 -- 9.2.0rc6 [recursion local]", qv => "version.bind", },
                        { fingerprint => ".+", state => "BIND 9.2.0a1 -- 9.2.2-P3 [recursion local]", qv => "version.bind", }, ]
                },
                { fingerprint => $iq[30], header => $qy[0], query  => ". A CLASS0" , ruleset => [
		 	{ fingerprint => $iq[2], result => "BIND 9.2.0rc7 -- 9.2.2-P3 [recursion enabled]", qv => "version.bind", },
                        { fingerprint => $iq[0], result => "BIND 9.2.0rc4 -- 9.2.0rc6 [recursion enabled]", qv => "version.bind", },
                        { fingerprint => ".+", state => "BIND 9.2.0rc4 -- 9.2.2-P3 [recursion enabled]", qv => "version.bind", }, ] 
                },
                { fingerprint => ".+", state => "q0r5q1r21q4r?", }, ]
          }, 
          { fingerprint => ".+", state => "q0r5q1r?", }, ]
    },
	 
    { fingerprint => $iq[6], header => $qy[1], ruleset => [
	  { fingerprint => $iq[15], result => "incognito DNS Commander v2.3.1.1 -- 4.0.5.1", qv => "version.bind",  },
	  { fingerprint => $iq[19], header => $qy[3], ruleset => [
            	{ fingerprint => $iq[66], result => "totd", },
                { fingerprint => $iq[67], result => "simple DNS plus [recursion enabled]", }, 
                { fingerprint => ".+", state => "q0r6q1r19q3r?", }, ]
          },
          { fingerprint => ".+", state => "q0r6q1r?", }, ]
    },
    
    { fingerprint => $iq[7], header => $qy[1], ruleset => [
	  { fingerprint => $iq[22], result => "PowerDNS 2.9.4 -- 2.9.11", qv => "version.bind", },
          { fingerprint => $iq[24], result => "PowerDNS 2.8 -- 2.9.3", qv => "version.bind", },
	  { fingerprint => ".+", state => "q0r7q1r?", }, ]
    },

    { fingerprint => $iq[8], header => $qy[1], ruleset => [
          { fingerprint => $iq[23], header => $qy[2] , query => ". CH A", ruleset => [
                { fingerprint => "query timed out", result => "TinyDNS 1.04" ,},
                { fingerprint => $iq[32], result => "TinyDNS 1.05" ,}, 
                { fingerprint => ".+", state => "q0r8q1r23q2r?",},]
          },
	  { fingerprint => ".+", state => "q0r8q1r?", }, ]
    },
    
    { fingerprint => $iq[9], header => $qy[1], ruleset => [
	  { fingerprint => $iq[9], result => "MaraDNS", qv => "erre-con-erre-cigarro.maradns.org"}, 
	  { fingerprint => ".+", state => "q0r9q1r?", }, ]
    },

    { fingerprint => $iq[10], result => "recursion enabled Microsoft Implementation", },
    { fingerprint => $iq[26], result => "Posadis", },
    { fingerprint => $iq[44], result => "Net::DNS::Nameserver", qv => "version.bind", },
    { fingerprint => $iq[52], result => "NSD 1.0 alpha", },
    { fingerprint => $iq[62], result => "rbldnsd", qv => "version.bind",},
    { fingerprint => ".+", state => "q0r?", }, 

);

######################################################################

sub fp_process($$$$);

sub main
{
    $opt{p}=53;
    $opt{t}=5;
    $opt{r}=1;
    $opt{F}=10;

    my %children;

    my $concurrent = 0;

    getopts('F:p:t:r:cfsdv', \%opt);

    if ($opt{v}) {
	print STDERR "$progname version $version\n";
	exit(1);
    }

    unless ($#ARGV == 0) {
        usage();
        exit(1);
    }

    $debug = 1 if ($opt{d});

    my $server = $ARGV[0];

    if ($server eq "-") {
       while(<STDIN>) {
          my $pid = fork;
          if ((not defined $pid) and not ($! =~ /Resource temporarily unavailable/)) {
             die "Can't fork: $!\n";
          } elsif ($pid == 0) {
             chomp;
             fingerprint($_);
             exit(0);
          } else {
             $concurrent++;
             $children{$pid} = 1;
             while ($concurrent >= $opt{F}) {
                my $child = waitpid -1, 0;
                $concurrent--;
                delete($children{$child});
             }
          }
       }
       while ($concurrent) {
          my $child = waitpid -1, 0;
          $concurrent--;
          delete($children{$child});
       }
    } else {
        fingerprint($server);
    }
}

sub fingerprint
{
    my $server = shift;
    my @addresses = dnslookup($server);

    if ($#addresses >= 0) {
	foreach my $a (@addresses) {
	    my $fp = fp_init($a, $opt{p});
	    if ($opt{s}) {
            	printf("%-15s %s\n", $a, $fp);
	    } else {
	 	print "fingerprint ($server, $a): $fp\n";
	    }
	}
    } else {
	warning("host not found ($server)");
    }
}

sub dnslookup
{
    my $arg = shift;
    my @addresses = ();

    return $arg if ($arg =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/);

    my $resolver = Net::DNS::Resolver->new;
    $resolver->srcaddr($opt{Q}); 
    my $query = $resolver->query($arg, "A");

    if ($query) {
	foreach my $rr ($query->answer) {
	    push @addresses, $rr->address if $rr->type eq "A";
	}
    }

    return @addresses;
}

sub query_version
{  
    my $arg = shift;
    my $ident = shift;
    my $rrset = " id: ";
    my $resolver = Net::DNS::Resolver->new;
    $resolver->nameservers($arg);
    $resolver->port($opt{p});
    $resolver->srcaddr($opt{Q});
    $resolver->retry($opt{r});
    $resolver->retrans($opt{t});

    my $query = $resolver->query($ident, 'TXT', 'CH');

    if ($query && $query->header->ancount > 0) {
        foreach my $rr ($query->answer) {
            ($rrset = $rrset . "\"" . $rr->txtdata . "\" ") if ($rr->type eq "TXT");
        }
       $rrset =~ s/\n/\" \"/g;
       if (length($rrset) > $versionlength) {
          $rrset = substr($rrset,0,$versionlength)."..."
       }
       return $rrset;
    }

    return " id unavailable (".$resolver->errorstring.")";
}

sub usage
{
    print STDERR <<EOF;
Usage: $progname [-c] [-d] [-f] [-p port] [-Q srcaddr] [-r retry] [-s] [-t timeout] [-v] server
Where: server is an ip address or a resolvable name
       or '-' to read list of servers from stdin
       -c         (where appropriate check CH TXT version) [off]
       -d         (debug) [off]
       -f         (force check CH TXT version) [off]
       -F         (maximum forked processes) [10]
       -p port    (nameserver is on this port) [53]
       -Q srcaddr (source IP address) [0.0.0.0]
       -r retry   (set number of attempts) [1]
       -s	  (short form) [off]
       -t time    (set query timeout) [5]
       -v         (show version)

EOF
        exit 2;

}

sub fp_init
{
    my $qserver = shift;
    return fp_process($qserver, $initrule{header}, $initrule{query}, \@ruleset);
}

sub fp_process($$$$)
{
    my $qserver = shift;
    my $qheader = shift;
    my $qstring = shift;
    my $ruleref = shift;
    my $ver;
    my $id;

    if ($debug) {
	print "==> PROCESS $qserver $qheader $qstring\n";
	print "\n";
    }

    my ($answer, $ress) = probe($qserver, $qheader, $qstring);

    if ($answer) {
	$id = header2fp($answer->header);
    } else {
	$id = $ress;
    }

    print "==> \"$id\"\n" if ($debug);

    for my $rule (@$ruleref) {

 	$ver = " "; 

	# we must have a fingerprint
	fatal("missing fingerprint") unless (defined $rule->{fingerprint});

	# skip to next rule unless we have a matching fingerprint
	next unless ($id =~ /$rule->{fingerprint}/);

	# return if we have a result
	if (defined $rule->{result}) {
            if (defined $rule->{qv}) { 
               $ver = query_version($qserver, $rule->{qv}) if $opt{c};
            }
            if ($opt{f}) {
               $ver = query_version($qserver, "version.bind");

            } 
	    return ($rule->{result} . $ver);
	}

        # print state if no matches
        if (defined $rule->{state}) {
            $ver = query_version($qserver, "version.bind") if $opt{c};
	    return ($rule->{state} . $id . $ver);
        }

	# update query if defined
	if (defined $rule->{query}) {
	    $qstring = $rule->{query};
	}

	# recurse if we have a new header and a new ruleset
	if (defined $rule->{header} && defined $rule->{ruleset}) {
	    return fp_process($qserver, $rule->{header}, $qstring,
			      $rule->{ruleset});
	}

	fatal("syntax error");
    }

    return "UNKNOWN";
}

sub header2fp
{
    my $header = shift;

    my @list = ($header->qr, 
		$header->opcode,
		$header->aa,
		$header->tc,
		$header->rd,
		$header->ra,
		$header->ad,
		$header->cd,
		$header->rcode,
		$header->qdcount,
		$header->ancount,
		$header->nscount,
		$header->arcount);

    return join(",", @list);
}

sub fp2header
{
    my @list = split(/,/, shift);

    my $header = Net::DNS::Header->new;

    $header->qr(shift @list);
    $header->opcode(shift @list);
    $header->aa(shift @list);
    $header->tc(shift @list);
    $header->rd(shift @list);
    $header->ra(shift @list);
    $header->ad(shift @list);
    $header->cd(shift @list);
    $header->rcode(shift @list);
    $header->qdcount(shift @list);
    $header->ancount(shift @list);
    $header->nscount(shift @list);
    $header->arcount(shift @list);

    return $header;
}

sub probe
{
    my $qserver = shift;
    my $qheader = shift;
    my @qstring = split(/ /, shift);

    my $header = fp2header($qheader);

    my $packet = Net::DNS::Packet->new(\$header->data);
    $packet->push("question", Net::DNS::Question->new(@qstring));

    if ($debug) {
	print "==> QUERY BEGIN\n";
	$packet->print;
	print "==> QUERY END\n";
	print "\n";
    }

    my $resolver =  Net::DNS::Resolver->new;
    $resolver->nameservers($qserver);
    $resolver->port($opt{p});
    $resolver->srcaddr($opt{Q});
    $resolver->retry($opt{r});
    $resolver->retrans($opt{t});

    my $answer = $resolver->send($packet);
    if ($answer && $debug) {
	print "==> ANSWER BEGIN\n";
	$answer->print;
	print "==> ANSWER END\n";
	print "\n";
    }

    return ($answer, $resolver->errorstring);
}

sub fatal
{
    my $message = shift;

    print STDERR "FATAL ERROR: $message\n";
    exit(1);
}

sub warning
{
    my $message = shift;

    print STDERR "WARNING: $message\n";
}

&main;
