#!/usr/local/bin/perl # # $Header: dns_response.pl 28-apr-2005.14:21:40 afontana Exp $ # # dns_response.pl # # Copyright (c) 2004, 2005, Oracle. All rights reserved. # # NAME # dns_response.pl - # # DESCRIPTION # # # NOTES # # # MODIFIED (MM/DD/YY) # afontana 04/28/05 - do not report response time when validation fails # afontana 04/05/05 - clean up error messages # afontana 02/14/05 - dont sleep after last try # afontana 12/30/04 - adjust columns # afontana 12/27/04 - change tries to retries # afontana 11/12/04 - change seconds to millis # afontana 11/02/04 - add em_result= # afontana 11/01/04 - afontana_dns_metric # afontana 10/27/04 - move timing # afontana 10/26/04 - Creation # use Getopt::Long; # set up to accept user input ## ## Note that this requires a special modified version of Net::DNS ## in order to get timing data accurately. ## use Net::DNS; #require "semd_common.pl"; my %cmdLine = (); # Parse the input parameters and put them in the cmdLine hash table GetOptions(\%cmdLine, "beaconName=s", "txnName=s", "address=s", "querytype=s", "nameserver=s", "nameserverport=i", "protocol=s", "timeout=i", "numretries=i", "retryinterval=i", "srcport=i", "srcaddr=s", "validation=s"); my $beaconName = $cmdLine{"beaconName"}; my $txnName = $cmdLine{"txnName"}; my $address = $cmdLine{"address"}; my $querytype = $cmdLine{"querytype"}; my $nameserver = $cmdLine{"nameserver"}; my $nameserverport = $cmdLine{"nameserverport"} ; my $protocol = $cmdLine{"protocol"}; my $timeout = $cmdLine{"timeout"}; my $numretries = $cmdLine{"numretries"}; my $retryinterval = $cmdLine{"retryinterval"}; my $srcport = $cmdLine{"srcport"}; my $srcaddr = $cmdLine{"srcaddr"}; my $validation = $cmdLine{"validation"}; #default $nameserverport = 53 unless (exists $cmdLine{"nameserverport"}); $timeout = 5 unless (exists $cmdLine{"timeout"}); $numretries = 1 unless (exists $cmdLine{"numretries"}); $retryinterval = 5 unless (exists $cmdLine{"retryinterval"}); $srcport = 0 unless(exists $cmdLine{"srcport"}); # # Set up the DNS resolver. # my $res = Net::DNS::Resolver->new(debug=>0, igntc=>1, recurse=>1, retrans=>0, retry=>1); $res->port($nameserverport); if ("" ne $nameserver) { $res->nameservers("$nameserver"); } if ($protocol eq "tcp") { $res->usevc(1); $res->tcp_timeout($timeout); } else { $res->usevc(0); $res->udp_timeout($timeout); } $res->srcport($srcport); if ("" ne $srcaddr) { $res->srcaddr($srcaddr); } ## ## Perform the actual query ## my $query = Net::DNS::Packet->new($address, $querytype); my $response; my $actualtries = 0; while ($numretries >= $actualtries) { $actualtries += 1; $response = $res->send($query); if ( ($response && $response->header->ancount > 0) || ($numretries < $actualtries)) { last; } else { sleep($retryinterval); } } ## ## Validate The Response ## #if ($response && $response->header->ancount > 0) if ($response) { my @result = (); my $missing; my @validate_array = split (/[ ,]+/, $validation); my %result_set = (); my $ttl = 0x7fffffff; ## ## Iterate through each row, skipping answers that are not the desired type. ## if ($response->header->ancount > 0) { foreach my $rr ($response->answer) { my $rr_addr; if ($rr->type eq $querytype && $querytype eq "A"){ $rr_addr = $rr->address; } elsif ($rr->type eq $querytype && $querytype eq "MX") { $rr_addr = $rr->exchange; } elsif ($rr->type eq $querytype && $querytype eq "CNAME") { $rr_addr = $rr->cname; } if ($rr_addr) { $result_set->{$rr_addr} = 1; push(@result, $rr_addr); $ttl = $rr->ttl unless ($ttl < $rr->ttl); } } } foreach my $expected (@validate_array) { $missing .= ($expected . " ") unless ($result_set->{$expected} == 1); } if ($missing || $response->header->ancount < 1) { my $errString; if ($response->header->ancount < 1) { $errString = "No results"; $ttl = ""; } else { $errString = ("Missing entries: " . $missing); } ## ## Validation failure ## print "em_result="; #Transaction Name print $txnName . "|"; #Beacon Name print $beaconName . "|"; #Status print "0|"; #Total Time print "|"; #Connect Time print "|"; #TTL print "|"; #Num Retries print (($actualtries - 1) . "|"); #Num Results print ((scalar keys %$result_set) . "|"); #Result print $errString; } else { ## ## Success case ## print "em_result="; #Transaction Name print $txnName . "|"; #Beacon Name print $beaconName . "|"; #Status print "1|"; #Total Time print (($res->total_time * 1000) . "|"); #Connect Time if ($res->usevc == 1) { print (($res->connect_time * 1000) . "|"); } else { print "|"; } #TTL print ($ttl . "|"); #Num Retries print (($actualtries - 1) . "|"); #Num Results print ((scalar keys %$result_set) . "|"); #Result print join(", ", @result); } } else { ## ## DNS Failure ## print "em_result="; #Transaction Name print $txnName . "|"; #Beacon Name print $beaconName . "|"; #Status print "0|"; #Total Time print "|"; #Connect Time print "|"; #TTL print "|"; #Num Retries print (($actualtries - 1) . "|"); #Num Results print "|"; #Result print "No DNS Response"; #Error string may be useful, but is sometimes unintelligible #print $res->errorstring; }