#!/usr/bin/perl -w

# Copyright 2002, 2006 Thus Plc (assigned to TDINL B.V.), All rights reserved.
# Copyright 2006, TDINL B.V, All rights reserved.
# Author: Phil Pennock, Demon NL NOC
# Approved for public release: Jim Segrave, 2002-02-12
#                              (minus internal mail-address information)
# Current maintainance of this branch: Phil Pennock <sw-tools@phil.globnix.org>
#
# 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 author and/or TDINL B.V. may not be used to endorse or
#    promote products derived from this software without specific prior
#    written permission. 
#
# THIS SOFTWARE IS PROVIDED BY TDINL B.V. ``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 TDINL B.V. 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.

use strict;
# Demon SCM Header: /cvsroot/NL/mail/RBL-check.pl,v 1.37 2006/06/06 15:33:47
# $HeadURL: https://svn.spodhuis.org/ksvn/spodhuis-tools/bin/RBL-check.pl $
# $Id: RBL-check.pl 227 2008-07-24 23:01:31Z pdp@SPODHUIS.ORG $
#
# Check multiple DNS-based anti-spam RBLs for listing of address(es)

use Carp;
use Getopt::Std;
use Net::DNS;
use Socket;
BEGIN { require 'sysexits.ph' };

# This script does not do mailing itself, instead you should put it inside
# a wrapper program which does email/whatever.  However, as a convenience,
# if in normal quiet mode we're going to output any text at all then this
# $Leading_Text will be put at the start, followed immediately by a blank line.
# Need to be invoked "very quiet" (-Q) to suppress this, or not be invoked
# "quiet" at all.
my $Leading_Text = <<'EOTEXT';
These entries below indicate, for each IP, that the IP address is listed
on an RBL service.  This does not warrant any kind of night-time call-out!
These will be acted upon during office hours.  We run them during the night
so that we can have an indication of when a problem started.
EOTEXT

# A useful site: <URL:http://www.sdsc.edu/~jeff/spam/cbc.html>
# And <URL:http://www.declude.com/junkmail/support/ip4r.htm>
# And <URL:http://spamlinks.net/filter-dnsbl-lists.htm>

# If there are no NS records linking an RBL domain to the servers which answer
# for that RBL domain, use an underscore to separate them: rbl.domain_ser.vers
# Some domains which require that people configure a server might be run like
# this.

# At this time, we default to treating IPv6 as disallowed.
# Use { af => keyword } to changed, 'ip46' or 'ip6'

# Woo, about ready to move this to an external config file!  :^)

my %rbl_doms = (

 't1.dnsbl.net.au'			=> 1,
 'dnsbl.isoc.bg'			=> 1,
 'dnswl.isoc.bg'			=> { skip => 'whitelist' },
 'rbl.triumf.ca'			=> 1,
 'spamrbl.imp.ch'			=> 1, # no 127.0.0.2 test
 'cbl.anti-spam.org.cn'			=> 1,
 'cml.anti-spam.org.cn'			=> { skip => 'whitelist' },
 'bogons.cymru.com'			=> { skip => 'IP bogons' },
 'bl.deadbeef.com'			=> 1,
 'blackholes.five-ten-sg.com'		=> 1,
 '0spam.fusionzero.com'			=> 1,
 'sa-accredit.habeas.com'		=> { skip => 'whitelist' },
 'rabl.nuclearelephant.com'		=> { direct => 1 }, # no 127.0.0.2 test
 'whitelist.spamblocked.com'		=> { skip => 'whitelist', direct => 1},
 'psbl.surriel.com'			=> 1,
 'dnsbl.tqmcube.com'			=> { direct => 1 },
 'ubl.unsubscore.com'			=> 1,
 'relays.bl.kundenserver.de'		=> { direct => 1 },
 'spamsources.fabel.dk'			=> 1,
 'no-more-funn.moensted.dk'		=> 1,
 'dev.null.dk'				=> 1,
 'db.wpbl.info'				=> 1,
 'all.rbl.jp'				=> 1,
 'dnsbl.cyberlogic.net'			=> 1,
 'rbl.interserver.net'			=> 1, # no 127.0.0.2 test
 'blackholes.intersil.net'		=> 1,
 'spamguard.leadmon.net'		=> 1,
 'combined.rbl.msrbl.net'		=> 1,
 'relays.nether.net'			=> 1,
 'unsure.nether.net'			=> 1,
 'rbl.snark.net'			=> 1,
 'dnsbl.sorbs.net'			=> 1,
 'bl.spamcop.net'			=> { direct => 1 },
 'dnsbl-1.uceprotect.net'		=> { direct => 1 },
 'dnsbl-2.uceprotect.net'		=> { direct => 1 },
 'dnsbl-3.uceprotect.net'		=> { direct => 1 },
 'all.ascc.dnsbl.bit.nl'		=> { skip => 'AS & CC lookup' },
 'nlwhitelist.dnsbl.bit.nl'		=> { skip => 'whitelist' },
 'virbl.dnsbl.bit.nl'			=> 1,
 'blacklist.sci.kun.nl'			=> 1,
 'whitelist.sci.kun.nl'			=> { skip => 'whitelist' },
 'black.dnsbl.securityplanet.nl'	=> 1,
 'white.dnsbl.securityplanet.nl'	=> { skip => 'whitelist' },
 'spews.block.transip.nl'		=> { direct => 1 },
 'cbl.abuseat.org'			=> 1,
 'dnsbl.ahbl.org'			=> 1,
 'exemptions.ahbl.org'			=> { skip => 'whitelist' },
 'ircbl.ahbl.org'			=> { skip => 'IRC serverlist' },
 'tor.ahbl.org'				=> { skip => 'TOR serverlist' },
 'orvedb.aupads.org'			=> 1,
 'rsbl.aupads.org'			=> 1,
 'ips.backscatterer.org'		=> { direct => 1 },
 'block.blars.org'			=> { skip => 'too inclusive' },
 'opm.blitzed.org'			=> 1,
 'sa-other.bondedsender.org'		=> { skip => 'whitelist', direct => 1 },
 'sa-trusted.bondedsender.org'		=> { skip => 'whitelist', direct => 1 },
 'ex.dnsbl.org'				=> 1,
 'list.dsbl.org'			=> { direct => 1 },
 'multihop.dsbl.org'			=> { direct => 1 },
 'unconfirmed.dsbl.org'			=> { direct => 1 },
 'mail-abuse.blacklist.jippg.org'	=> 1,
 'dnsbl.njabl.org'			=> 1, # http://www.njabl.org/use.html
 'abuse.rfc-ignorant.org'		=> { domain => 1 },
 'bogusmx.rfc-ignorant.org'		=> { domain => 1 },
 'dsn.rfc-ignorant.org'			=> { domain => 1 },
 'postmaster.rfc-ignorant.org'		=> { domain => 1 },
 'whois.rfc-ignorant.org'		=> { domain => 1 },
 'query.senderbase.org' => { qtype => 'TXT', direct => 1, skip => 'info' },
 'bl.spamcannibal.org'			=> 1,
 'zen.spamhaus.org'			=> 1,
 'spf.trusted-forwarder.org'		=> { skip => 'whitelist', direct => 1},
 'hardcore.rbl.sns.ro'			=> 1,
 'softcore.rbl.sns.ro'			=> 1,
 'dul.ru'				=> 1,
 'spam.wytnij.to'			=> 1,

);

# Aggregates:
# t1.dnsbl.net.au
#   various sources
#   <URL:http://dnsbl.net.au/t1/>
# dnsbl.sorbs.net
#   own sub-domains
#   <URL:http://www.dnsbl.au.sorbs.net/using.html>
#
# blackholes.us creates sub-domains for various ISPs with policies which the
# domain operators deem spam-friendly, and list the entire ISP address-space

# Various removed items
# 'combined-HIB.dnsiplists.completewhois.com' => { direct => 1, skip => 'servfail' },
# 'relays.ordb.org'			=> 1,	# service removed rather quickly.
# 'bl.csma.biz'				=> 1,	# query timed out
# 'hil.habeas.com'			=> 1,	# No NS
# 'dnsbl.jammconsulting.com'		=> 1,	# No NS
# 'blackhole.securitysage.com'		=> 1,	# No NS
# 'blocked.hilli.dk'			=> 1,	# No NS
# 'dnsbl.antispam.or.id'		=> 1,	# No NS
# 'blacklist.spambag.org'		=> 1,	# No NS
# 'blackholes.uceb.org'			=> 1,	# No NS
#	proxies.relays.monkeys.com		# No NS, servfail
#	formmail.relays.monkeys.com		# No NS, servfail
#	relays.visi.com				# No NS, servfail
#	bl.blueshore.net			# No NS, 127.0.0.2 empty
#	blackholes.wirehub.net			# No NS, 127.0.0.2 empty
#	dynablock.wirehub.net			# No NS, 127.0.0.2 empty
#	http.opm.blitzed.org			# No NS, 127.0.0.2 empty
#	socks.opm.blitzed.org			# No NS, 127.0.0.2 empty
#	ipwhois.rfc-ignorant.org		# No NS, no response
#	t1.bl.reynolds.net.au			# No NS, no response
#	blackholes.2mbit.com			# No NS, servfail
#	relays.osirusoft.com			# No NS, no response
#	blocktest.relays.osirusoft.com		# No NS, no response
#	input.relays.osirusoft.com		# No NS, no response
#	socks.relays.osirusoft.com		# No NS
#	spamhaus.relays.osirusoft.com		# No NS
#	spamsources.relays.osirusoft.com	# No NS
#	spews.relays.osirusoft.com		# No NS
#	spews.relays.osirusoft.com		# No NS
#	rss.maps.vix.com			# No NS, 127.0.0.2 empty
#	xbl.selwerd.cx				# No NS, no domain
#	work.drbl.croco.net	# Broken Policy; distributed, no way off
#	blackholes.mail-abuse.org		# now pay to query
#	dialups.mail-abuse.org			# now pay to query
#	relays.mail-abuse.org			# now pay to query
#	outputs.orbs.org			# No NS, no domain.  RIP.
#	relays.orbs.org				# No NS, no domain.  RIP.
#	inputs.orbz.org				# DEAD, every query matches
#	outputs.orbz.org			# DEAD, every query matches
#	dews.qmail.org				# NS points to localhost
#	spammers.v6net.org			# Every query matches

# We don't check RHS-BLs.  Some known include:
# rbl.mailpolice.com

########################################################################
# NO USER-SERVICEABLE PARTS BEYOND THIS POINT
########################################################################


# Core functionality
sub check_host;
sub check_ip;
sub check_domain;
sub check_rblentry;
sub fetch_nameservers;
sub fetch_A_records;
sub strip_nameserver;
sub parse_cmdline_servers;

# Auxilliary functions
sub usage		(;$);
sub leading_text	();
sub hostsort;

my $quiet	= 0;
my $verbose	= 0;
my $domain_based = 0;
my $coerce_ipv6	= 0;
my %opts;

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

getopts('6hqQvds:S:x:', \%opts);
usage 0 if exists $opts{'h'};
usage if exists $opts{'m'} and exists $opts{'M'};
usage if exists $opts{'s'} and exists $opts{'S'};

$quiet += 1 if exists $opts{'q'};
$quiet += 2 if exists $opts{'Q'};
$verbose = 1 if exists $opts{'v'};
if ($quiet and $verbose) {
	die "$0: I refuse to be both quiet and verbose!\n";
}

$domain_based = 1 if exists $opts{'d'};

if (exists $opts{'s'}) {
	usage unless defined $opts{'s'};
	my %t = parse_cmdline_servers($opts{'s'});
	my @keys = keys %t;
	foreach my $k (@keys) {
		if (ref($t{$k}) ne 'HASH'
		    and exists $rbl_doms{$k}
		    and ref($rbl_doms{$k}) eq 'HASH') {
			$t{$k} = $rbl_doms{$k};
		}
	}
	%rbl_doms = %t;

}
if (exists $opts{'S'}) {
	usage unless defined $opts{'S'};
	my %t = parse_cmdline_servers($opts{'S'});
	@rbl_doms{keys %t} = values %t;
}
if (exists $opts{'x'}) {
	usage unless defined $opts{'x'};
	my %nameset;
	foreach (split /[,\s]+/, $opts{'x'}) {
		delete $rbl_doms{$_};
	}
}
$coerce_ipv6 = 1 if exists $opts{'6'};


usage unless scalar @ARGV;

$| = 1;

foreach my $a (@ARGV) {
	check_host($a);
}

exit 0;

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

sub check_host
{
	my $h = shift;

	if ($domain_based) {
		check_domain($h);
		return;
	}

	if ($h =~ /^[0-9:.]+$/) {
		check_ip($h);
		return;
	}

	# Perl doesn't directly provide gethostbyname2() or other IPv6-capable
	# resolution.  Since we're using Net::DNS anyway ...
	my $res = Net::DNS::Resolver->new;
	my @addrs;
	my $matched = 0;
	my @errs;
	foreach my $qtype ('A', 'AAAA') {
		my $addrq = $res->query($h, $qtype);
		unless ($addrq) {
			push @errs, $res->errorstring;
			next;
		}
		foreach my $rr ($addrq->answer) {
			next unless $rr->type eq 'A' or $rr->type eq 'AAAA';
			push @addrs, $rr->address;
			++$matched;
		}
	}
	unless ($matched) {
		leading_text;
		my $etext = "IPv4=$errs[0] IPv6=$errs[1]";
		warn "DNS queries for '${h}' failed: $etext\n";
		return undef;
	}
	undef $res;

	foreach my $a (@addrs) {
		check_ip($a);
	}
}

# {{{ done_hosts closure
{
	my %done_hosts;

sub check_ip
{
	my $ip = shift;
	local $_;
	return if exists $done_hosts{$ip};

	print " (Checking $ip)\n" unless $quiet;

	my $ipv6 = 0;
	my $stem;
	if ($ip =~ /:/) {
		$ipv6 = 1;
		my @alignedsects = (0,0,0,0,0,0,0,0);
		my @s = split /:/, $ip;
		if (@s == 8) {
			@alignedsects = map {hex} @s;
		} else {
			my $i = 0;
			while (length(my $item = shift @s)) {
				$alignedsects[$i++] = hex $item;
			}
			$i = 7;
			while (defined (my $item = pop @s)) {
				$alignedsects[$i--] = hex $item;
			}
		}
		my @nibbles;
		foreach my $d (@alignedsects) {
			# signedness and 32-bits,
			# so don't use bitmasks and shifts
			my $t;
			push @nibbles, ($t = int($d / 0x1000));
			$d -= $t * 0x1000;
			push @nibbles, ($t = int($d / 0x0100));
			$d -= $t * 0x0100;
			push @nibbles, ($t = int($d / 0x0010));
			$d -= $t * 0x0010;
			push @nibbles, $d;
		}
		$stem = join('.', reverse(map {sprintf '%x', $_} @nibbles));

	} else {
		$stem = join('.', reverse(split(/\./, $ip)));
	}
	print "  (Search stem: $stem)\n" if $verbose;

	foreach my $rd (hostsort keys %rbl_doms) {
		print "  (in: $rd)\n" if $verbose;
		check_rblentry(
		    search_for		=> $stem,
		    search_where	=> $rd,
		    search_params	=> $rbl_doms{$rd},
		    label		=> $ip,
		    ipv6		=> $ipv6,
		    );
	}
	$done_hosts{$ip} = scalar time();
}

sub check_domain
{
	my $d = shift;
	return if exists $done_hosts{$d};
	print " (Checking $d)\n" unless $quiet;

	foreach my $rd (hostsort keys %rbl_doms) {
		print "  in: $rd)\n" if $verbose;
		check_rblentry(
			search_for	=> $d,
			search_where	=> $rd,
			search_params	=> $rbl_doms{$rd},
			label		=> $d,
			domain_based	=> 1,
		);
	}
	$done_hosts{$d} = scalar time();
}

}
# }}} done_hosts closure

sub check_rblentry
{
	local %_ = @_;
	my $query_data	= $_{search_for};
	my $domain	= $_{search_where};
	my $params	= $_{search_params};
	my $label	= $_{label};
	my $ipv6_p	= exists $_{ipv6} ? $_{ipv6} : 0;
	my $domain_bl	= exists $_{domain_based} ? $_{domain_based} : 0;
	my $domain_ns	= $domain;
	my $ns_a_only	= 0;
	my $rbl_qtype	= 'A';

	my ($res, $query);
	my @servers;
	my @display;

	$params = {} unless ref($params) eq 'HASH';
	if (exists $params->{skip}) {
		# Probably an information lookup, eg senderbase
		# Or is overly inclusive and we don't normally want to see it.
		return unless $verbose;
	}
	my $rbl_domain_based_p = 0;
	$rbl_domain_based_p = 1 if exists $params->{domain} and $params->{domain};
	if ($rbl_domain_based_p and not $domain_bl) {
		print "   (Skipping Domain BL for IP lookup)\n" if $verbose;
		return;
	}
	if ($domain_bl and not $rbl_domain_based_p) {
		print "   (Skipping IP BL for Domain lookup)\n" if $verbose;
		return;
	}

	if (exists $params->{svr}) {
		$domain_ns = $params->{svr};
		$ns_a_only = 1;
	}
	if (exists $params->{qtype}) {
		$rbl_qtype = uc($params->{qtype});
	}
	my $af = exists $params->{af} ? lc($params->{af}) : 'ip4';

	if ($ipv6_p) {
		unless ($coerce_ipv6 or $af eq 'ip46' or $af eq 'ip6') {
			print "   (Skipping IPv6 query)\n" if $verbose;
			return;
		}
	} else {
		if ($af eq 'ip6') {
			print "   (Skipping IPv4 query)\n" if $verbose;
			return;
		}
	}

	$domain .= '.' unless $domain =~ /\.\z/;
	$domain_ns .= '.' unless $domain_ns =~ /\.\z/;
	$query_data .= '.' . $domain;

RESTART_QUERY:
	if (exists $params->{direct}) {
		@servers = ();
		print "   (querying directly)\n" if $verbose;
	} else {
		@servers = fetch_nameservers(
			domain => $domain_ns,
			A_only => $ns_a_only,
			);
		if (scalar @servers == 0) {
			warn "No nameservers for '${domain}'\n"
				unless $quiet;
			return undef;
		}
		print "   (against: @servers)\n" if $verbose;
	}

	$res = new Net::DNS::Resolver;
	$res->searchlist('.');
	$res->nameservers(@servers) if @servers;

#	print "DBG: $query_data\n";

	if (not ($query = $res->query($query_data, $rbl_qtype))) {
		if ($res->errorstring eq 'REFUSED'
		    and defined $res->answerfrom) {
			print "$domain ! REFUSED: @{[$res->answerfrom]}\n"
				unless $quiet;
			strip_nameserver($domain, $res->answerfrom);
			goto RESTART_QUERY;
		}
		unless ($quiet and (
		    $res->errorstring eq 'NXDOMAIN'	or
		    $res->errorstring eq 'NOERROR'	or
		    $res->errorstring eq 'SERVFAIL'	or
		    $res->errorstring eq 'query timed out'
		    )) {
			leading_text;
			print "$domain ! => @{[$res->errorstring]}\n";
		}
		return;
	}
	if ($rbl_qtype eq 'A') {
		foreach my $rr ($query->answer) {
			push @display, ('  A ' . $rr->rdatastr)
				if $rr->type eq 'A';
		}
		$query = $res->query($query_data, 'TXT');
	}
	if (not defined $query) {
		push @display, ('   ! No TXT records!');
	} else {
		foreach my $rr ($query->answer) {
			push @display, ('TXT ' . $rr->rdatastr)
				if $rr->type eq 'TXT';
		}
	}

	{
		leading_text;
		local $" = "\n ";
		print "[$label]\t$domain => {\n @display\n}\n\n";
	}

	return scalar @display;
}

{
 my %ns_servers;
sub fetch_nameservers
{
	local %_ = @_;
	my $domain = $_{domain};

	return @{$ns_servers{$domain}} if exists $ns_servers{$domain};

	if (exists $_{A_only} and $_{A_only}) {
		$ns_servers{$domain} = fetch_A_records $domain;
		return @{$ns_servers{$domain}};
	}

	my ($res, $dq);
	my @servers;

	$res = new Net::DNS::Resolver;
	$res->searchlist('.');

	if (not $dq = $res->query($domain, 'NS')) {
		warn "No data returned for NS query of '${domain}'\n"
			unless $quiet;
		$ns_servers{$domain} = [];
	} else {
		foreach my $rr ($dq->answer) {
			push @servers, $rr->nsdname if $rr->type eq 'NS';
		}
# If server refuses, Net::DNS returns refusal without trying other IPs
# So we want to store the list of IPs corresponding to the canonical names
# returned (since one name can have multiple IPs, even when an NS record).
# That way, if we get a refusal, then _we_ can try again.
		$ns_servers{$domain} = fetch_A_records @servers;
	}

	return @{$ns_servers{$domain}};
}

sub strip_nameserver
{
	my ($domain, $badserver) = @_;
	return unless exists $ns_servers{$domain};
	@{$ns_servers{$domain}} = grep { $_ ne $badserver} @{$ns_servers{$domain}};
}
}

sub fetch_A_records
{
	my ($res, $dq, @results);
	$res = new Net::DNS::Resolver;
	$res->searchlist('.');
	foreach my $d (@_) {
		if ($dq = $res->query($d, 'A')) {
			foreach my $rr ($dq->answer) {
				push @results, $rr->address if $rr->type eq 'A';
			}
		}
	}
	return \@results;
}

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

sub parse_cmdline_servers
{
	croak "internal error, undef arg" unless defined $_[0];
	my $line = $_[0];
	my %rbls;
	local $_;

	my @list = split /[,\s]+/, $line;
	foreach my $li (@list) {
		if ($li =~ /^([^=]+)=(.+)$/) {
			my ($dom, $v) = ($1, $2);
			$dom =~ s/\.\z//;
			my %param;
			foreach my $cmd (split /:/, $v) {
				if (uc($cmd) eq 'TXT') {
					$param{qtype} = 'TXT';
				} elsif (uc($cmd) eq 'DIRECT') {
					$param{direct} = 1;
				} elsif (uc($cmd) eq 'DOMAIN') {
					$param{domain} = 1;
				} elsif (lc($cmd) =~ /^(ip(?:4)?(?:6)?)\z/
						and length($1) > 2) {
					$param{af} = $1;
				} else {
					$param{svr} = $cmd;
				}
			}
			$rbls{$dom} = \%param;
		} else {
			$li =~ s/\.\z//;
			$rbls{$li} = 2;
		}
	}

	return %rbls;
}

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

sub usage (;$)
{
	my $exval = EX_USAGE;
	$exval = $_[0] if defined $_[0];
	select STDERR if $exval;

	my $prog = $0;
	$prog =~ s{.*/}{};

	print "Usage: $prog [-q|Q|v] [-6d] [-[sSx] servers] host [host ...]\n";
	print " -h   this help\n -q   quiet\n -Q  very quiet\n -v   verbose\n";
	print " -s   RBL servers to this list (comma-separated)\n";
	print " -S   add this list to standard RBL servers\n";
	print " -x   eXclude this comma-separated list from servers to check\n";
	print " -d   do a Domain-based RBL lookup (not IP-based)\n";
	print " -6   do an IPv6 lookup even against RBLs not tagged for IPv6\n";
	print " host hostname or IP to query in RBLs\n";

	exit $exval;
}

{
 my $done_leading_text = 0;

sub leading_text ()
{
	return if $done_leading_text;
	$done_leading_text = 1;
	return unless $quiet == 1;
	print $Leading_Text, "\n" if defined $Leading_Text;
}
}

sub hostsort
{
	local $_;
	return map {$_->[1]} sort {
		$a->[0] cmp $b->[0]
	} map {[join('.', reverse(split(/\./, $_))), $_]} @_;
}