xref: /netbsd-src/external/mpl/bind/dist/bin/tests/system/ditch.pl (revision 8e33eff89e26cf71871ead62f0d5063e1313c33a)
1#!/usr/bin/perl
2
3# Copyright (C) Internet Systems Consortium, Inc. ("ISC")
4#
5# SPDX-License-Identifier: MPL-2.0
6#
7# This Source Code Form is subject to the terms of the Mozilla Public
8# License, v. 2.0.  If a copy of the MPL was not distributed with this
9# file, you can obtain one at https://mozilla.org/MPL/2.0/.
10#
11# See the COPYRIGHT file distributed with this work for additional
12# information regarding copyright ownership.
13
14# This is a tool for sending queries via UDP to specified address and
15# port, then exiting without waiting for a response.
16#
17# Usage: ditch.pl [-s <address>] [-p <port>] [filename]
18#
19# Input (in filename, if specified, otherwise stdin) is a series of one
20# or more DNS names and types to send as queries, e.g.:
21#
22# www.example.com A
23# www.example.org MX
24#
25# If not specified, address defaults to 127.0.0.1, port to 53.
26
27require 5.006.001;
28
29use strict;
30use Getopt::Std;
31use Net::DNS;
32use Net::DNS::Packet;
33use IO::File;
34use IO::Socket;
35
36sub usage {
37    print ("Usage: ditch.pl [-s address] [-p port] [-b source_port] [file]\n");
38    exit 1;
39}
40
41my %options={};
42getopts("s:p:b:", \%options);
43
44my $addr = "127.0.0.1";
45$addr = $options{s} if defined $options{s};
46
47my $port = 53;
48$port = $options{p} if defined $options{p};
49
50my $source_port = 0;
51$source_port = $options{b} if defined $options{b};
52
53my $file = "STDIN";
54if (@ARGV >= 1) {
55    my $filename = shift @ARGV;
56    open FH, "<$filename" or die "$filename: $!";
57    $file = "FH";
58}
59
60my $input = "";
61while (defined(my $line = <$file>) ) {
62    chomp $line;
63    next if ($line =~ m/^ *#/);
64    my @tokens = split (' ', $line);
65
66    my $packet;
67    if ($Net::DNS::VERSION > 0.68) {
68            $packet = new Net::DNS::Packet();
69            $@ and die $@;
70    } else {
71            my $err;
72            ($packet, $err) = new Net::DNS::Packet();
73            $err and die $err;
74    }
75
76    my $q = new Net::DNS::Question($tokens[0], $tokens[1], "IN");
77    $packet->header->rd(1);
78    $packet->push(question => $q);
79
80    my $sock = IO::Socket::INET->new(
81        PeerAddr => $addr,
82        PeerPort => $port,
83        Proto => "udp",
84        LocalPort => $source_port,
85        ) or die "$!";
86
87    my $bytes = $sock->send($packet->data);
88    #print ("sent $bytes bytes to $addr:$port:\n");
89    #print ("  ", unpack("H* ", $packet->data), "\n");
90
91    $sock->close;
92}
93
94close $file;
95