#!/usr/bin/perl -w
#
# qdomaincheck
# John Simpson <jms1@jms1.net> 2007-07-13
#
# sanity check on qmail control files.
#
# 2007-07-15 jms1 - checking for and ignoring comments and blank lines in the
#   files which support them (rcpthosts, virtualdomains, smtproutes). Thanks
#   to Carl de Kock for pointing out the problem.
#
###############################################################################
#
# Copyright (C) 2007 John Simpson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 or version 3 of the
# license, at your option.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
###############################################################################

require 5.003 ;
use strict ;

use CDB_File ;
use Getopt::Std ;

my $vq	= "/var/qmail" ;
my $vqc	= "$vq/control" ;

my ( %opts , $me , %idom , %ldom , %vdom , %rdom , %adom , %CDB ) ;

my %lvr =
(
	""	=> "relay to host defined via MX record." ,
	"l"	=> "deliver to system mailbox." ,
	"v"	=> "deliver to virtual mailbox." ,
	"r"	=> "relay to host defined via smtproutes entry." ,
	"lv"	=> "IN BOTH locals AND virtualdomains." ,
	"lr"	=> "IN BOTH locals AND smtproutes." ,
	"vr"	=> "IN BOTH virtualdomains AND smtproutes." ,
	"lvr"	=> "IN ALL OF locals, virtualdomains, and smtproutes." ,
) ;

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

sub mtime($)
{
	if ( my @s = stat ( $_[0] ) )
	{
		return $s[9] ;
	}

	return -1 ;
}

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

die "FATAL: directory \"$vqc\" not found\n" unless ( -d $vqc ) ;

getopts ( "ac" , \%opts ) ;

unless ( $opts{"a"} || $opts{"c"} )
{
	print <<EOF ;
$0 [-a] [-c]

Quick sanity check on the domain names configured in your qmail system.

-a  prints a list of every domain mentioned in the control files.

-c  prints a list of domains which look like they may be causing problems.

EOF

	exit 0 ;
}

###############################################################################
#
# the value in control/me is used in a few places. only read it one time.

open ( I , "<$vqc/me" )
	or die "FATAL: $vqc/me not found, qmail will probably not work at all.\n" ;
chomp ( $me = <I> ) ;
close I ;

###############################################################################
#
# list the domains which qmail-smtpd will accept for incoming mail. it uses
# control/rcpthosts and control/morercpthosts.cdb for this.

open ( I , "<$vqc/rcpthosts" )
	or die "FATAL: $vqc/rcpthosts not found, THIS MACHINE IS AN OPEN RELAY!\n" ;
while ( my $line = <I> )
{
	$line =~ s/#.*// ;
	chomp $line ;
	next unless $line ;
	$idom{$line} = 1 ;
}
close I ;

if ( -f "$vqc/morercpthosts.cdb" )
{
	if ( -f "$vqc/morercpthosts" )
	{
		if ( mtime ( "$vqc/morercpthosts" ) > mtime ( "$vqc/morercpthosts.cdb" ) )
		{
			print "WARNING: you need to run \"qmail-newmrh\" to update morercpthosts.cdb\n" ;
		}
	}
	else
	{
		print "WARNING: morercpthosts.cdb exists without a morercpthosts file!\n" ;
	}

	if ( tie ( %CDB , "CDB_File" , "$vqc/morercpthosts.cdb" ) )
	{
		map { $idom{$_} = 1 } keys %CDB ;
		untie %CDB ;
	}
}
elsif ( -f "$vqc/morercpthosts" )
{
	print "WARNING: you need to run \"qmail-newmrh\" to create morercpthosts.cdb\n" ;
}

###############################################################################
#
# now check what qmail-send will do with outbound mail.
#
# domains listed in control/locals are treated as LOCAL, where the mailbox
#   name corresponds to a system account in /etc/passwd etc. if this file
#   doesn't exist, the contents of control/me are used instead.
#
# domains listed in control/virtualdomains are treated as VIRTUAL, which is
#   also handled on the local machine but goes through some userid and
#   directory translation first.

if ( -f "$vqc/locals" )
{
	open ( I , "<$vqc/locals" ) or die "FATAL: $vqc/locals: $!\n" ;
	while ( my $line = <I> )
	{
		chomp $line ;
		if ( exists $ldom{$line} )
		{
			print "WARNING: \"$line\" listed in control/locals multiple times\n" ;
		}
		$ldom{$line} = 1 ;
	}
	close I ;
}
else
{
	print "WARNING: $vqc/locals not found, using $vqc/me instead\n" ;
	$ldom{$me} = 1 ;
}

if ( -f "$vqc/virtualdomains" )
{
	open ( I , "<$vqc/virtualdomains" ) or die "FATAL: $vqc/virtualdomains: $!\n" ;
	while ( my $line = <I> )
	{
		$line =~ s/#.*// ;
		chomp $line ;
		my ( $d , $u ) = split ( /\:/ , $line ) ;
		next unless $d ;
		if ( exists $vdom{$d} )
		{
			print "WARNING: \"$line\" listed in control/virtualdomains multiple times\n" ;
		}
		$vdom{$d} = $u ;
	}
	close I ;
}

###############################################################################
#
# see if qmail-remote has any smtproutes entries

if ( -f "$vqc/smtproutes" )
{
	open ( I , "<$vqc/smtproutes" ) or die "FATAL: $vqc/smtproutes: $!\n" ;
	while ( my $line = <I> )
	{
		chomp $line ;
		$line =~ s/#.*// ;
		my ( $d ) = split ( /\:/ , $line ) ;
		next unless $d ;
		if ( exists $ldom{$d} )
		{
			print "ERROR: \"$d\" is local, but also listed in smtproutes\n" ;
			next ;
		}
		if ( exists $vdom{$d} )
		{
			print "ERROR: \"$d\" is virtual, but also listed in smtproutes\n" ;
			next ;
		}
		$rdom{$d} = 1 ;
	}
	close I ;
}

###############################################################################
#
# make a combined list

map { $adom{$_} .= ""  } keys %idom ;
map { $adom{$_} .= "l" } keys %ldom ;
map { $adom{$_} .= "v" } keys %vdom ;
map { $adom{$_} .= "r" } keys %rdom ;

for my $d ( sort keys %adom )
{
	my $v = $adom{$d} ;

	if ( $opts{"a"} || ( ! exists $idom{$d} ) || ( length($adom{$d}) != 1 ) )
	{
		print "$d: " ,
			( ( exists $idom{$d} ) ? "accept, " : "DO NOT ACCEPT, " ) ,
			( $lvr{$adom{$d}} || "(unknown \"$adom{$d}\")" ) , "\n" ;
	}
}