New Wind

sendmail 送信元 IP アドレス自動切替え (Part 1) の続きです。

プログラム概要は以下の通りです。

• 現在の送信元 IP アドレスと IP アドレスプールを取得。
• ブラックリストデータベース別に IP アドレスプールすべての A レコード登録の検索。(今回は SpamCop のみ) –> 利用可能な IP アドレスの収集。
• A レコードが返る場合 (検索対象の IP アドレスが 202.152.209.33 とし、33.209.152.202.bl.spamcom.net の A レコードが 127.0.0.2 と検索された場合) は “Info: MX Address Down” で通知。
• 返らない場合は “Info: MX Address Up” で通知。
• 利用可能な IP アドレスが 0 の場合は “MX Address: ” で警告通知。
• 現在の送信元 IP アドレスが A レコードが存在する場合、利用可能な IP アドレスの先頭を新送信先とする。

SpamCop 以外のブラックリストデータベースにも対応する場合は、check_spamcop() を流用し、77 行目の前後に追加すれば良いでしょう。

#!/usr/bin/perl -w
#
# blcheck.pl
#

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// use Module
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

use strict;

use Net::DNS;
use Net::IP;

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Controller
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

    #// ----------------------------------------------------------
    #// Option Parse
    #// ----------------------------------------------------------

    my @basename = split(/\//, $0);
    my $basename = pop(@basename);

    #// ----------------------------------------------------------
    #// Item Set
    #// ----------------------------------------------------------

    my $item = {
        mkdir    => '/bin/mkdir',
        cat      => '/bin/cat',
        chmod    => '/bin/chmod',
        ps       => '/bin/ps',
        hostname => '/bin/hostname',
        mail     => '/usr/bin/mail',
        awk      => '/usr/bin/awk',
        grep     => '/usr/bin/grep',
        chown    => '/usr/sbin/chown',

        sed      => '/usr/bin/sed',
        ifconfig => '/sbin/ifconfig',
        sendmail => '/usr/local/etc/rc.d/sendmail.sh',
        cf       => '/etc/mail/sendmail.cf',

        dir      => '/home/tools/blcheck/',
        maddr    => 'trouble@example.jp',

        base     => $basename,
        file     => '/tmp/.' . $basename
    };

    if ( !-d $item->{dir} ) {
        `$item->{mkdir} $item->{dir}`;
        `$item->{chmod} 750 $item->{dir}`;
    }

    my $host = `$item->{hostname}`; chomp $host;
    $item->{host} = $host;

    #// bl define

    $item->{spamcop} = {
        target => '.bl.spamcop.net',
        result => '127.0.0.2',
    };

    my $ipaddr = {};

    #// ----------------------------------------------------------
    #// Start
    #// ----------------------------------------------------------

    #// List

    $ipaddr = check_ipaddr($item, $ipaddr);   #// src, alias
    $ipaddr = check_spamcop($item, $ipaddr);

    #// Change

    my $old = $ipaddr->{src};
    my $new = {};
    my @new = ();

    foreach (@{$ipaddr->{alias}}) {
        next if ($ipaddr->{blist}->{$_});

        $new->{$_} = 1;
        push(@new, $_);
    }

    my $src = $ipaddr->{src};

    if ($new->{$src}) {

    } else {
        if (@new == 0) {
            report_ipna($item, $old);

        } else {
            chg_cf($item, $old, $new[0]);
            report_chg($item, $old, $new[0]);
        }
    }

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

sub utime2date {
    my ($sec, $min, $hours, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($_[0]);

    my $years    = $year + 1900;
    my $this_mon = sprintf("%02d",$mon + 1);

    $mday  = sprintf("%02d", "$mday");
    $hours = sprintf("%02d", "$hours");
    $min   = sprintf("%02d", "$min");
    $sec   = sprintf("%02d", "$sec");

    my $date = "$years/$this_mon/$mday $hours:$min:$sec";

    return $date;
}

sub check_ipaddr {
    my ($item) = @_;

    my $ipaddr = {};

    #// check source ipaddr

    my $line = `$item->{cat} $item->{cf} | $item->{grep} "^O ClientPortOptions"`;

    $line =~ s/Address=(.*)/$1/;
    $ipaddr->{src} = $1;

    #// check stock ipaddr

    my @list0 = `$item->{ifconfig} | $item->{grep} "0xffffffff" | $item->{awk} '{print \$2}'`;

    my @list = ();

    foreach (@list0) {
        chomp;

        my $ref = new Net::IP("$_");
        next unless ($ref->iptype() =~ /public/i);

        push(@list, $_);
    }

    $ipaddr->{alias} = \@list;

    return $ipaddr;
}

sub check_spamcop {
    my ($item, $ipaddr) = @_;

    foreach (@{$ipaddr->{alias}}) {
        my @rev   = reverse(split(/\./, $_)); $" = '.';
        my $line  = "@rev" . $item->{spamcop}->{target};
        my $check = check_rr($line, $item->{spamcop}->{result});

        if ($check) {
            $ipaddr->{blist}->{$_} = $check;

            report_down($item, $_, 'spamcop', tml_spamcop($_));

        } else {
            my $file = file_down($item, $_, 'spamcop');

            if ( -e $file ) {
                report_up($item, $_, 'spamcop', $file);

                unlink($file);
            }
        }
    }

    return $ipaddr;
}

sub tml_spamcop {
    my ($ip) = @_;

    my $tml = <<"TML";
#// SpamCop (http://www.spamcop.net/)

http://www.spamcop.net/w3m?action=checkblock&ip=$ip

http://www.spamcop.net/w3m?action=dispute;ip=$ip

TML

    return $tml;
}

sub check_rr {
    my ($line, $result) = @_;

    my $res   = Net::DNS::Resolver->new;
    my $query = $res->search($line);
    my $check = 0;

    if ($query) {
        foreach my $rr ($query->answer) {
            next unless ($rr->type eq "A");

            if ($rr->address eq $result) {
                $check = 1;
                last;
            }
        }
    }

    return $check;
}

sub chg_cf {
    my ($item, $old, $new) = @_;

    `$item->{sed} -i'.0' -e 's/Address=$old/Address=$new/' $item->{cf}`;
    `$item->{sendmail} restart`;

    sleep(5);
}

#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
#// Model (Report)
#// -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

sub file_down {
    my ($item, $ip, $btype) = @_;

    my $file = $item->{dir} . $ip . '.' . $btype;

    return $file;
}

sub report_down {
    my ($item, $ip, $btype, $tml) = @_;

    my $time = utime2date(time());
    my $down = file_down($item, $ip, $btype);

    open WRITE, "+>$down";
    print WRITE $time;
    close WRITE;

    my $file = $item->{file};
    my $subj = "Info: MX Address Down ($item->{host})";

    my $body = <<"BODY";
$time => $ip (add $btype)

$tml
BODY

    report($item, $file, $subj, $body);
}

sub report_up {
    my ($item, $ip, $btype, $down) = @_;

    my $time  = utime2date(time());
    my $time0 = `$item->{cat} $down`; chomp $time0;

    my $file = $item->{file};
    my $subj = "Info: MX Address Up ($item->{host})";

    my $body = <<"BODY";
$time0 -> $time => $ip (del $btype)
BODY

    report($item, $file, $subj, $body);
}

sub report_chg {
    my ($item, $old, $new) = @_;

    my $time = utime2date(time());

    my $file = $item->{file};
    my $subj = "Info: MX Address Change ($item->{host})";

    my $body = <<"BODY";
$time => $old -> $new (restart)
BODY

    report($item, $file, $subj, $body);
}

sub report_ipna {
    my ($item, $old) = @_;

    my $time = utime2date(time());

    my $file = $item->{file};
    my $subj = "MX Address ($item->{host})";

    my $body = <<"BODY";
$time => $old -> Failed: No IP Address Pool
BODY

    report($item, $file, $subj, $body);
}

sub report {
    my ($item, $file, $subj, $body) = @_;

    open  FILE, "+>$file";
    print FILE $body;
    close FILE;

    `$item->{mail} -s "$subj" $item->{maddr} < $file`;

    unlink($file);
}