#!/usr/bin/perl
# xtetsuji 2016/10/26
# qqns.pl - qq.com の MX を qq.com の NS 群全部に問い合わせをして、その記録を取る
#
# 何も考えず雑に書いたのでかなり適当です
# qq.com の NS のうち複数が返答しない場合があるらしく、その調査観察を行うためのスクリプトです

use v5.10;
use strict;
use warnings;
use utf8;

use Getopt::Long qw(:config posix_default no_ignore_case bundling auto_help);
use Pod::Usage qw(pod2usage);
use Time::Piece;
use Data::Dumper;


use constant DEBUG => $ENV{DEBUG};
use constant DAEMON_INTERVAL_SEC  => 3600; # デーモンモード時のインターバル
use constant COMMAND_TIMEOUT_SEC  => 3;    # host コマンドのタイムアウト秒
use constant NS_QUERY_WAITING_SEC => 2;    # 外部NS群に直接MXを聞きに行くときに入れる待ち秒数

GetOptions(
    \my %opt,
    "daemon|d", "domain|D=s", "log|l=s",
);

my $domain       = $opt{domain} || "qq.com";
my $log_filename = $opt{log}    || "./qqns.log";

###
### main
###
# 実際の本体は query()
# どう実行させるか（スタンドアローン・デーモン）が違うところ
if ( $opt{daemon} ) {
    print "daemon mode\n";
    while (1) {
        process_message("PROCESSING");
        query();
    } continue {
        process_message("WAITING");
        my $waiting_rest_sec = DAEMON_INTERVAL_SEC;
        while ($waiting_rest_sec-- >= 0 ) {
            process_message("WAITING: rest_sec=$waiting_rest_sec");
            sleep 1;
        }
    }
} else {
    print "foreground mode\n";
    process_message("PROCESSING_FOREGROUND");
    query();
}

print "process finish.\n" if DEBUG;

exit;

# host(COMMAND_LIST)
# シェルの host コマンドを実行する
# タイムアウトを設定する
sub host {
    my @command = @_;
    unshift @command, 'host';
    my $pid = open my $pipe, '-|', @command;
    local $SIG{ALRM} = sub {
        print "timeout\n";
        kill INT => $pid;
    };
    alarm COMMAND_TIMEOUT_SEC;
    my $result = '';
    while(<$pipe>) {
        print; # for debug
        $result .= $_;
        last unless kill 0 => $pid;
    }
    alarm 0;
    close $pipe; # $? $! などが設定される
    return $result;
}

# query()
# メイン処理
sub query {
    my $current_date = ymd();
    my $current_time = hms();
    my @all_ns_ips;
    for my $ns_server_hostname (nameservers($domain)) {
        print "ns> $ns_server_hostname\n" if DEBUG;
        for my $ns_server_ip (ipaddresses($ns_server_hostname)) {
            print "ns(ip)> $ns_server_ip\n" if DEBUG;
            push @all_ns_ips, $ns_server_ip;
        }
    }

    mkdir for grep { !-d } @all_ns_ips;

    my %ip_query_result;
    for my $ns_ip (@all_ns_ips) {
        #my $list = qx{host -t mx $domain $ns_ip};
        my $list = host(qw(-t mx), $domain, $ns_ip);
        ( my $mx_lines = $list ) =~ s/.*?Aliases:\s*//s;
        #$ip_query_result{$ns_ip} = $list;
        my $status = $? == 0 ? "SUCCESS" : "FAILED";

        logging("querying $domain MX to NS $ns_ip is $status. MX server count is " . line_count($mx_lines));

        print "host command status is $status\n";
        print "list lines count is " . line_count($mx_lines) . "\n";
        print "=== $ns_ip\n$list\n";


        my $filepath = "$ns_ip/$current_date\_$current_time";
        my $content = "=== $ns_ip $current_time";
        print_file($filepath => $content);
        print "===/ $ns_ip done\n";
    } continue {
        sleep NS_QUERY_WAITING_SEC;
    }
}

sub nameservers {
    my $fqdn = shift;
    my $output = qx{host -t ns $fqdn};
    # //m での $ は、改行の直前かマッチ文字列の終端直前のこと
    my @result = $output =~ / name server (.*?)\.$/gm;
    return @result;
}

sub ipaddresses {
    my $fqdn = shift;
    my $output = qx{host -t a $fqdn};
    my @result = $output =~ / has address (\d+\.\d+\.\d+\.\d+)$/gm;
    return @result;
}

sub logging {
    my $line = shift;
    my $now_format = time_format_syslog(time);
    chomp $line;
    state $fh;
    open $fh, '>>', $log_filename if !defined $fh;
    print {$fh} "$now_format qqns.pl[$$] $line\n";
}

sub process_message {
    state $CMDLINE = $0;
    my $status = shift or die "specify status";
    $0 = "perl $CMDLINE [$status]";
}

sub time_format_syslog {
    my $time = shift;
    state $monname = [undef, qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)];
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $time;
    $mon++;
    return sprintf "%s %2d %02d:%02d:%02d", $monname->[$mon], $mday, $hour, $min, $sec;
}

sub ymd {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
    $mon++;
    $year += 1900;
    return sprintf "%4d%02d%02d", $year, $mon, $mday;
}

sub hms {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
    $mon++;
    $year += 1900;
    return sprintf "%02d%02d%02d", $hour, $min, $sec;
}

sub line_count {
    my $list = shift;
    chomp $list;
    return scalar split /\n/, $list;
}

sub print_file {
    my $file = shift;
    my $content = shift;
    open my $fh, '>>', $file or die;
    print {$fh} $content;
    close $fh;
    return;
}

__END__

=pod

=head1 NAME

qqns.pl - qq.com NS checker

=head1 SYNOPSIS

  qqns.pl [--daemon] [--domain=DOMAIN_NAME] [--log=FILENAME]

=head1 DESCRIPTIONS

qq.com が返す NS 群の中で応答を返さないものが結構あるようで、結果的に
qq.com の MX レコードを引くことに失敗してしまうメールサーバがあるようだったので、
そのような状態がいつ起こるのか調べるために書いたのがこのスクリプトです。

単発だと、ドメイン→NSホスト名群→NS IPアドレス群→各 NS IP に対して最初のドメインの
MXレコードを聞き回る、という動作になります。
C<--daemon> オプション付きだと、これを1時間に一度実行して結果をログに出力する
デーモンとなります。

=head1 OPTIONS

=over

=item --daemon

デーモンモード。プログラムは終了せず、標準では3600秒ごとに一連の問い合わせ処理を
試すモードになります。

端末は離さないので、切り離して本当のデーモンっぽくするには disown などを併用して下さい。

=item --domain=DOMAIN_NAME

問い合わせるドメイン名を指定します。オプションで指定しなければ qq.com が指定されたもの
とみなします。

=item --log=FILENAME

進捗出力のためのログファイルの出力先ファイル名を指定します。

ログ出力フォーマットは Syslog ライクですが、出力は Syslog エコシステムによらない
手製のものです。これは最小構成の CentOS の Perl でも安全なようにという配慮です
（Sys::Syslog すら無い可能性がある）。

=back

=head1 AUTHOR

OGATA Tetsuji E<lt>tetsuji.ogata@gmail.comE<lt>

=cut