Tuesday, November 05, 2013

qmail - Dynamic SMTP server

If you use qmail's "qmail-remote" command to send mail via a remote dynamic SMTP server, this Perl script will help you to choose the best remote SMTP server (server that has the lowest preference value) to use. One of my mail server is using Google's SMTP server as remote mail server, but Google changes SMTP server from time to time, I had to manually update the remost host IP in all dot-qmail file which is very annoying. So I wrote this script.

This Perl script requires Net::SMTP, Net::DNS, MIME::Lite and Socket module, which can be installed easily from CPAN.


# libs will be used
use strict;
use warnings;
use Net::SMTP;
use Net::DNS;
use MIME::Lite;
use Socket;

                                                  # Current server file
my $smtp_server_file = "Path_to_file_contains_SMTP_server";
my $log_file = "/var/log/qmail/smtp_server.log";  # Log file
my $domain = 'yourdomain';                  # your domain

# Open log file:
my $FILE;
open FILE, ">", "$log_file" or die "Can't open $log_file: $!\n";

# Set up time
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
$year += 1900;
$mon += 1;

# Testing the current SMTP server

# Get current SMTP server
my $FILE1;
open FILE1, "<", "$smtp_server_file" or die "Can't open SMTP server file, $!\n";
my $smtp_server_old = <FILE1>;
my $smtp_server_new;                             # New server IP
my $smtp_server_name;                            # New server name

print FILE "Getting SMTP server from $smtp_server_file\n";
print FILE "Old SMTP server is $smtp_server_old\n";
print FILE "Testing $smtp_server_old....\n";

# Test server
my $smtp = Net::SMTP->new($smtp_server_old, Timeout => 10, Debug => 0);

if (!$smtp) { # We need a new SMTP server
    print FILE "Testing failed, updating SMTP server...\n\n";
    backup_dot_qmail($FILE);                     # Backup dot-qmail files
    get_new_smtp_server($FILE);                  # Get a new SMTP server
    update_dot_qmail($FILE);                     # Update dot-qmail files
    close(FILE);                                 # Close log
    send_mail('Updated');                        # Email report
} else {
    print FILE "SMTP server $smtp_server_old is fine\n";

sub backup_dot_qmail {
    my $FILE = shift;
    my $bk_dir = $year . $mon .$mday;
    my $re;

    printf FILE "Backup dot-qmail files...\n";
    if (! -e "/home/tony/qmail-file-bk/$bk_dir") {
        $re = `/bin/mkdir -v /home/tony/qmail-file-bk/$bk_dir`; # Create bk fir if not exist
        print FILE "Creating backup directory /home/tony/qmail-file-bk/$bk_dir\n";
        print FILE $re;
    print FILE "Copying all dot-qmail files to /home/tony/qmail-file-bk/$bk_dir\n";
    $re = `/bin/cp -v you_domain_dot_qmail_files /home/tony/qmail-file-bk/$bk_dir`;
    print FILE "$re";
    print FILE"\n\n";

sub get_new_smtp_server {
    my $FILE = shift;

    # Get a new SMTP server
    my $dns = new Net::DNS::Resolver;
    my $mx = $dns->query($domain, 'MX' );                  # MX record query

    print FILE "Choosing available SMTP server\n";
    my $min_preference = 10000;
    print FILE "Available SMTP servers:\n";

    # Choose the server that has the lowest preference (distance)
    foreach my $rr ($mx->answer) {
        print FILE $rr->exchange, '(', $rr->preference, ')', "\n";
        if ($rr->preference < $min_preference) {
            $min_preference = $rr->preference;
            $smtp_server_name = $rr->exchange;
            $smtp_server_new = inet_ntoa(inet_aton($rr->exchange));
    print FILE "Choose server: $smtp_server_name - $smtp_server_new with preference $min_preference\n\n";

sub update_dot_qmail {
    my $FILE = shift;

    # dot-mail content
    my $dot_qmail_content = q(|qmail-remote '[) . $smtp_server_new . q(]' "$SENDER" "$EXT@$HOST");
    print FILE "Updating all dot-qmail files to \n";
    print FILE $dot_qmail_content, "\n";

    my @file_list = `ls -a your_domain_dot_qmail_files`;
    my $TMPFILE;
    foreach my $file (@file_list) {
        print FILE "Updating $file ...\n";
        open TMPFILE, '>', "$file" or die "Can't open $file for updating...\n";
        print TMPFILE $dot_qmail_content;
        print FILE "Done.\n";
    print FILE "dot-qmail file all updated.\n";
    print FILE "Updating $smtp_server_file ... \n";
    open TMPFILE, '>', "$smtp_server_file" or die "Can't open $smtp_server_file for updating...\n";
    print TMPFILE $smtp_server_new;
    print FILE "Done.\n";

sub send_mail {
    my $status   = shift;
    my $from     = 'root@your.mailserver.com';
    my $to       = 'who@should.receive.com';
    my $sub      = 'domain's SMTP server is ' . $status . ' - ' . $year . $mon .$mday;

    my $msg  = MIME::Lite->new(
                                From     => $from,
                                To       => $to,
                                Subject  => $sub,
                                Type     => 'multipart/Mixed',

                 Type => 'text',
                 Path => '/var/log/qmail/smtp_server.log',

    $msg->send;                 # Sent out msg via default

No comments: